diff --git a/README b/README index 36a9ae2..ddf4f13 100644 --- a/README +++ b/README @@ -5,11 +5,13 @@ scientific devices. In one story, Qfwfq is a dinosaur, but in other stories he is also a fish, a small mammal, a subatomic particle eternally plummeting through the void. Qfwfq's constantly shifting position in the universe, despite his consistent first-person narration, suggests the extent to which his form -accommodates his point of view." +accommodates his point of view." -- Dean Swinford + +further documentation can be found in the folder 't-zero' and several examples +can be found in the folder 'games without end' libarynth topics http://libarynth.fo.am/cgi-bin/view/Libarynth/VisualProgramming http://libarynth.fo.am/cgi-bin/view/Libarynth/ProjectQfwfq - diff --git a/punctiform-convergence/eddies.scm b/punctiform-convergence/eddies.scm index 689bb7d..ce7980f 100644 --- a/punctiform-convergence/eddies.scm +++ b/punctiform-convergence/eddies.scm @@ -155,9 +155,10 @@ ;; a recursive-snip can contain other node-snips,. ;; should be incorporated into basic node-snips - ;(define recursive-snip-mixin - ; (mixin (graph-snip<%>) (editor<%>))) +;; (define recursive-snip% +;; (graph-snipboard-mixin editor-snip%)) + (define recursive-snip% (class (graph-snip-mixin editor-snip%) ;; details.. @@ -195,6 +196,10 @@ ((list? x) (apply string-append (map to-string x))) (else (error "don't know how to convert to string: " x)))) + ;; copypaste + (define (copypaste pb) + (debug 1 "selection: " (selected-snips pb)) + ) ;; decor ;; brushes/ pens see -> 6.15 pen% @@ -289,7 +294,7 @@ (set! result link))) links) result)) ;; relabel - ;; note that this uses a global so is not threadsafe + ;; note that this uses a mutable global so is not threadsafe (define *travail* 0) (define (re-label! link) @@ -313,6 +318,11 @@ (list-ref c 2) (list-ref c 3))) + ;;;; ; ;;; ; ; ; ; ; ; ; + ;; + ;; translation, evaluation, circumspection + ;; + ;;;;;; ; ;; ; ;; eval [sub]graph from a node. .. ;; absolutely no chekcing or error handling yet. @@ -321,7 +331,7 @@ (eval (tree->sexp (car (send node get-parents)))))) ;; traverse a tree [or graph] to create a corresponding s-expresion - ;; doesnt cope with cycles, nor muliple children (if a node has muliple + ;; doesnt cope with cycles, nor multiple children (if a node has muliple ;; children, it is translated into separate expressions) (define (tree->sexp node) (let ([parents (send node get-parents)] @@ -333,6 +343,79 @@ (set! out (read-from-string data))) (debug 1 "tree->sexp: ~a ~%" out) out)) + + ;; return a list of the selected snips + (define (selected-snips pb) + (let* ((snip (send pb find-next-selected-snip #f)) + (selection (list snip))) + (while snip + (set! snip (send pb find-next-selected-snip snip)) + (if snip + (set! selection (cons snip selection)) #f)) + selection)) + + + ;; convert a given selection to a (pseudonymous) function, given a list of + ;; nodes, and a pasteboard to draw to. namespace is currently unspecified, + ;; values not yet multiple. + (define (encapsulate selection pb) + (let* ((fname (string->symbol (symbol->string (gensym "q-")))) + (nodes selection) + (inputs (find-inputs nodes)) + (outputs (find-outputs nodes))) + + (debug 1 "function: ~a~%" fname) + (debug 1 "nodes: ~a~%" nodes) + (debug 1 "input: ~a~%" inputs) + (debug 1 "outpt: ~a~%" outputs) + + ;; subtree -> leaves ie. no inputs, single output + (cond ((empty? inputs) + (debug 1 "grnks...~%") + (let* ((fnode (make-node-snip)) + (prune (caar outputs)) ;; map -> multiple + (graft (cadar outputs))) + + (debug 1 "prune ~a~%" prune) + (debug 1 "graft ~a -> ~a ~% " graft (send graft get-parents)) + (send pb insert fnode) + (add-links fnode graft pen1 pen2 brush1 brush2) + (send (send fnode get-editor) insert (format "(~a)" (to-string fname))) + (send graft remove-parent prune) + (debug 1 "fdef ~a ~%" + (eval `(define ,fname (lambda () ,(tree->sexp prune))))) + + ))))) + + + + ;; find the nodes leading into/outof a subgraph, given as a list returns a + ;; list of lists (node in the subgraph, followed by nodes to which it + ;; connects) + + (define (find-inputs nodes) + (if nodes + (let ((inputs + (filter + (lambda (l) (< 1 (length l))) + (map + (lambda (node) + (cons node (remove* nodes (send node get-parents)))) + nodes)))) + inputs) + #f)) + + (define (find-outputs nodes) + (if nodes + (let ((outputs + (filter + (lambda (l) (< 1 (length l))) + (map + (lambda (node) + (cons node (remove* nodes (send node get-children)))) + nodes)))) + outputs) + #f)) ) ;; end of module diff --git a/punctiform-convergence/graph.scm b/punctiform-convergence/graph.scm index d3f2c21..03df5d0 100644 --- a/punctiform-convergence/graph.scm +++ b/punctiform-convergence/graph.scm @@ -12,7 +12,10 @@ (provide graph-snip<%> graph-snip-mixin graph-pasteboard<%> - graph-pasteboard-mixin) + graph-pasteboard-mixin + graph-snipboard<%> + graph-snipboard-mixin) + (define graph-snip<%> (interface () @@ -275,12 +278,13 @@ (define/augment (on-interactive-move evt) (invalidate-selected-snips) - #;(super on-interactive-move evt) + ;;(super on-interactive-move evt) ) (define/augment (after-interactive-move evt) (invalidate-selected-snips) - #;(super on-interactive-move evt)) + ;;(super on-interactive-move evt) + ) (define/override (interactive-adjust-move snip x y) (let ([dc (get-dc)]) @@ -292,7 +296,8 @@ (let ([dc (get-dc)]) (when dc (invalidate-to-children/parents snip dc))) - #;(super after-insert snip before x y)) + ;;(super after-insert snip before x y) + ) ;; invalidate-selected-snips : -> void ;; invalidates the region around the selected @@ -775,7 +780,8 @@ [(x) (/ (+ from-x to-x) 2)] [(y) (/ (+ from-y to-y) 2)] [(theta) (- (angle (- to-pt from-pt)))] - [(flip?) #f #;(negative? (- to-x from-x))] + [(flip?) #f ] ;(negative? (- to-x from-x)) + [(text-angle) (if flip? (+ theta pi) @@ -1050,5 +1056,32 @@ ;; get-all-parents : snip -> (listof snip) (define (get-all-parents snip) - (get-all-relatives (lambda (snip) (send snip get-parents)) snip))) + (get-all-relatives (lambda (snip) (send snip get-parents)) snip)) + + + + ;; merge graph-snips and pasteboard, for which there must be a simpler way... + (define graph-snipboard<%> + (interface () + get-children + add-child + remove-child + + get-parents + add-parent + remove-parent + has-self-loop? + find-shortest-path + + on-mouse-over-snips + set-arrowhead-params + get-arrowhead-params)) + + (define graph-snipboard-mixin + (mixin ((class->interface pasteboard%)) (graph-pasteboard<%>)) + ;;(mixin ((class->interface snip%)) (graph-snip<%>)) + ) + + + ) diff --git a/punctiform-convergence/layout.scm b/punctiform-convergence/layout.scm index b5db7b6..1d024e9 100644 --- a/punctiform-convergence/layout.scm +++ b/punctiform-convergence/layout.scm @@ -13,16 +13,19 @@ ;; authors ;; - nik gaffney ;; - tim boykett +;; - dave griffiths ;; requirements ;; - qfwfq and descendants ;; commentary ;; - wobble -> hierarchical rectangular spread -;; - shuffle -> randomise positions +;; - shuffle -> randomise positions ;; - relax -> pseudo stabilisation using edge lengths +;; - circles -> concentric radial layout ;; - shadowpi -> variation on circular parent-centric splay + ;; changes ;; 2006-09-11 ;; - scraped into coherence from various sources @@ -44,6 +47,7 @@ (provide wobble-tree shuffle-tree relax-tree + circles-tree shadowpi-tree) @@ -108,28 +112,26 @@ ;;;;; ; ;; ;; ; ; (define (circles-tree node pb x y angle-start angle-end radius) - ; loop over all parents for this node + ;; loop over all parents for this node (define (parent-loop parents n angle-per-parent) - ; calculate the section of angles for this node, and call circles-tree for it + ;; calculate the section of angles for this node, and call circles-tree for it (let ([parent-start (+ angle-start (* angle-per-parent n))]) (circles-tree (car parents) pb x y parent-start (+ parent-start angle-per-parent) (+ radius 50))) - (if (null? (cdr parents)) - 0 - (parent-loop (cdr parents) (+ n 1) angle-per-parent))) + (if (not (null? (cdr parents))) + (parent-loop (cdr parents) + (+ n 1) angle-per-parent))) - ; position this in the middle of the range of angles we've been given + ;; position this in the middle of the range of angles we've been given (send pb move node - (* (sin (+ angle-start (/ (- angle-end angle-start) 2))) radius) - (* (cos (+ angle-start (/ (- angle-end angle-start) 2))) radius)) + (* (sin (+ angle-start (/ (- angle-end angle-start) 2))) radius) + (* (cos (+ angle-start (/ (- angle-end angle-start) 2))) radius)) - ; now call parent-loop for the parents if we have any parents + ;; now call parent-loop for the parents if we have any parents (let ([parents (send node get-parents)]) - (cond - ((null? parents) - 0) - (else - (let ([angle-per-parent (/ (- angle-end angle-start) (length parents))]) - (parent-loop parents 0 angle-per-parent)))))) + (if (not (null? parents)) + (let ([angle-per-parent (/ (- angle-end angle-start) + (length parents))]) + (parent-loop parents 0 angle-per-parent))))) @@ -225,7 +227,7 @@ ;; Christopher Homan & Jonathan Schull ;; ;;;;; ; ;;; ; ; - + (define twopi (* 2 pi)) (define (shadowpi-tree node pb theta r) diff --git a/punctiform-convergence/snipets.scm b/punctiform-convergence/snipets.scm index 4fb7383..73f6b42 100644 --- a/punctiform-convergence/snipets.scm +++ b/punctiform-convergence/snipets.scm @@ -16,7 +16,7 @@ ;; a snip to act as the varying argument to a recursive functions (define linked-snip? (union snip? false/c)) ;; a function to act on snips being mapped - (define snip-visitor? any/c #;((snip?) (listof any/c) . ->* . (void))) + (define snip-visitor? any/c ) ;((snip?) (listof any/c) . ->* . (void)) ;; the rest of the lists passed to a snip mapping function (define rest-lists? (listof (listof any/c))) ;; a class that contains a snip @@ -29,8 +29,8 @@ (snip-y (snip? . -> . number?)) (snip-parent (snip? . -> . (union editor? false/c))) (fold-snip ((snip? any/c . -> . any/c) any/c linked-snip? . -> . any/c)) - (for-each-snip any/c #;((snip-visitor? linked-snip?) rest-lists? . ->* . (void))) - (map-snip any/c #;((snip-visitor? linked-snip?) rest-lists? . ->* . ((listof any/c))))) + (for-each-snip any/c ) ;((snip-visitor? linked-snip?) rest-lists? . ->* . (void)) + (map-snip any/c )) ;((snip-visitor? linked-snip?) rest-lists? . ->* . ((listof any/c))) ;; the width of a snip in the parent pasteboard (define (snip-width snip) diff --git a/qfwfq.scm b/qfwfq.scm index e05d103..f066867 100644 --- a/qfwfq.scm +++ b/qfwfq.scm @@ -49,6 +49,10 @@ insert-nodes add-links + selected-snips + find-inputs + find-outputs + set-node-text get-node-text set-node-value @@ -60,6 +64,9 @@ relax-tree eval-tree shadowpi-tree + circles-tree + + encapsulate tree->sexp to-string diff --git a/xaueneuax.scm b/xaueneuax.scm index 5e9bf5a..408e782 100644 --- a/xaueneuax.scm +++ b/xaueneuax.scm @@ -14,7 +14,7 @@ ;; - nik gaffney ;; requirements -;; - uses qfwfq for layout and slipulation +;; - uses qfwfq for layout and slipping between ;; commentary ;; a simple dataflow like visual wrapper to the underlying scheme, @@ -41,12 +41,15 @@ (require "qfwfq.scm") + (define xauen-pasteboard% (class graph-pasteboard% ;; should probably figure out how keymaps work,. (define/override (on-char event) (temp-keymap event) (super on-char event)) + (define/override (do-paste time) + (super do-paste time)) (super-new))) ;; setup frame and windows.. @@ -121,6 +124,8 @@ (colour-tree selected-snip p)] [(#\l) ;; C-l re.lapse -> splay (shadowpi-tree selected-snip p 0 63)] + [(#\e) ;; C-e encapsulate the selection + (encapsulate (selected-snips p) p)] [(#\=) ;; C-= zoom->out (send p zoom 1.1)] [(#\-) ;; C-- zoom->in @@ -133,11 +138,10 @@ (send p move-to n1 15 15) ;; test a recursive node -;; (define r1 (new recursive-snip%)) -;; (send p insert r1) -;; (define n2 (new output-snip%)) -;; (send r1 insert n1) +;(define r1 (new recursive-snip%)) +;(send p insert r1) +;(define n2 (new output-snip%)) +;(send r1 insert n1) (send f show #t) -