;;   
;;   ( )    d a i s y   c h a i n             ( )
;; ( )O( )              .--.     .---.  .---( )O( )-.    .---
;;   ( )\   .-.     ( )/    `---'     `'      ( )    `--'
;;       `-'   `--( )O( )  
;;                  ( )    for john isaac robinson
;;
;; naive livecoding 
;;
;; L1/L2       : Change token type (activate/instruction)
;; R1/R2       : Change token speed
;; DPad        : Zoom/Tilt
;; Left Stick  : Token menu
;; Right Stick : Move cursor to new flower
;; Button 1    : Execute instruction on current flower
;; Button 2    : Insert token into graph at current flower
;;
;;
;; change history:
;; 24 sept 2007 : put all the code in one file, tidied naming conventions, 
;;                started adding the daisy language logic
;; 26 sept 2007 : token passing distribution implemented, tests pass for loops, branch dups 
;;                and killing off blocked tokens
;; 1 oct 2007   : visualisation of token passing
;; 3 oct 2007   : cleaned up the distribution, animated the tokens
;; 4 oct 2007   : started implementing instructions and executing
;; 7 oct 2007   : instructions are activated and removed, an instruction list is now built per update
;; 8 oct 2007   : first grammar tokens working, renamed edges to arcs (as they have direction)
;; 10 oct 2007  : arc and vertex removal, lots of graph grammars, self replicating graph 
;; 16 oct 2007  : started working on space partitioning grid
;; 18 oct 2007  : space partitioning working, increases framerate at end of self rep cycle from ~6fps to ~30fps... 
;;                changes look a lot, and still not fast enough.
;; 22 oct 2007  : token icon textures working, joypad, navigation/zoom, smoothed vertex movement, 
;;                sprite animation playback
;; 23 oct 2007  : ring menu, token adding, in-place grammar changes
;; 28 oct 2007  : switched to fluxus 0.14, shored things up a little, token limit set to 2 - (makes things
;;                non-deterministic)
;;                type selection menu, black bg, icon ordering glitches fixed
;; 17 nov 2007  : switched to with-*, more map, filter etc, put repulse counting in, removed grid, tidied balance, 
;;                everything nicer + faster! added chop and prune, first play-able-ish but still very far off.
;; 25 dec 2007  : tokens now eliminate each other, and restricted to one per arc - deterministic again
;;                wrote interface for new itchy, note triggering, patch loading, **first playable** 
;; 26 dec 2007  : arcs dissolve with age, fixed sample voice play, changed bg to black, more playable
;; 27 dec 2007  : arcs dissolve when not used, removes detached and useless arcs quickly, bg noise added
;;                first passable play
;; 11 mar 2008  : made start mode with a single flower for **demo at groningen 'hello process' lecture**
;; 6 apr 2008   : added external sync, new flower anim, new textures for cursor and arcs. put limits on token spawning
;;                and max global tokens, tweaked global contraints for balancing - upped max vertices from 200 to 500
;; 7 apr 2008   : subgraph pausing, new vertex button
;; 8 apr 2008   : fixed big timing bug, better subgraph parsing, better sounds
;; 9 apr 2008   : another sync fix, simple synth patch loading, added metro and soundcheck graphs
;; 10 apr 2008  : added pause texture, unpause all, particles on execute
;; 24 jun 2008  : removed itchy - converted to fluxa
;; 28 jun 2008  : multispeed tokens!
;;
;;
;; todos:
;; - optimise force directed algo (make portable to qfwfq)
;; - retain subgraph pause when changing structure
;; - tokens don't follow verts when paused
;; - new verts still appearing at origin - use something like for-each-connected-vertex-id to find closest initialised vertex?
;;

;(show-fps 1)

;(module daisy scheme/base

;(provide render)

(require scheme/class)
(require fluxus-017/fluxus)
(require fluxus-017/time)
(require fluxus-017/fluxa)
(require fluxus-017/joylisten)

;(require fluxus-016/drflux)

(osc-source "4444")

;; /show-code sf [code-string, time-to-display-seconds]
(define do-card #f)
(define card-scale 200)

(define attract-mul 1.1)
(define repulse-mul 1)
(define animation-fps 0.1)

;(define start-program 'start)
(define start-program 'metro)
;(define start-program 'random)
;(define start-program 'sndchk)
;(define start-program 'selfrep)
;(define start-program 'test)

(define bpm 120)
(define daisy-tick (* (/ 1 (/ bpm 60)) 0.25))
;(define daisy-tick 2)
(define time-offset 0.02)
(define sync-offset 0.)
(define sync-tick-multiplier 0.5)

(define immortal-flowers #f)
(define max-arc-usage 300)
(define max-arc-last-used 100)
(define max-vertices 500)
(define max-tokens 100)
(define max-new-tokens 10)
(define new-balance-count 10)
(define max-repulses 40)

; mapping for saitek p2600 joypad
(define joymap-a 1)
(define joymap-b 0)
(define joymap-c 2)
(define joymap-d 3)
(define joymap-e 8)
(define joymap-f 9)
(define joymap-l1 4)
(define joymap-l2 6)
(define joymap-r1 5)
(define joymap-r2 7)
(define joymap-select 11)
(define joymap-dpad 2)
(define joymap-lstick 0)
(define joymap-rstick 1)

;; colours...
;(define bg-colour (vector 0.8 0.7 0.5))
;(define bg-colour (vmul (vector 0.3 0.2 0.1) 0.3))
(define bg-colour (vector 0 0 0))
(define any-colour (vector 0.5 0.5 0.5))
(define instruction-colour (vector 0.5 0 0))
(define activate-colour (vector 0 0.5 0))
(define instruction-token-colour (vector 1 0.5 0.5))
(define activate-token-colour (vector 0.5 1 0.5))
(define max-scale 30)

;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

(eq 0.5 0.4 0.1)

(define noise-maker%
  (class object%
    
    (field (time 0))
    
    (define/public (noise token execution a b c d)
      (let ((a (sin a))
            (b (cos b))
            (c (sin c))
            (d (cos d)))
        
        (cond ((not execution)
               (cond
                 ((eq? token 'activate)
                  (if (> a 0)
                      (play time (mooghp (mul (adsr 0 (* 0.005 (+ 6 (* b b))) 0 0) (pink (* 100 c)))
                                     (pow (adsr b (+ 0.1 (* 0.5 a)) 0.3 1) 50) 0.4))

                      (play time (mul 
                            (mooglp (saw (mul (* c 500) (pow (adsr (* 0.1 a) 1.9 0.1 0.5) 10)))
                                (sine d) 0.45)
                            (adsr 0 0.1 0.5 2)))))

                 ((eq? token 'nop)
                  (play time (mul (adsr 0 0.1 0 0) (white 4))))
                 
                 ((or (eq? token 'branch) (eq? token 'branch-ins) (eq? token 'branch-act))
                  (play time (mul (adsr 0 (* 0.1 (+ 1 (sin b))) 0 0) (white a))))
                 
                 ((or (eq? token 'loop-ins) (eq? token 'loop-act) (eq? token 'loop))
                  (play time (mul (adsr 0 0.05 0.1 0.5) (if (< a b) (saw (mul 100 (sine (* c 3))))
                                                            (squ (mul 100 (sine (* d 4))))))))
                 
                 ((eq? token 'double-extend)
                  (play time (mul (adsr 0 d 0.05 2) 
                                  (tri (add (note (inexact->exact (round (* 4 b))))
                                            (mul 100 (sine (* a 10))))))))
                 
                 ((eq? token 'extend)
                  (play time (mul (adsr 0.5 0.1 0 0) 
                                  (tri (add (note (inexact->exact (round (* 30 b))))
                                            (mul 100 (saw (* a 100))))))))
                 
                 ((eq? token 'double-branch-ins-act)
                  (play time (moogbp (mul (adsr 0 (* 0.1 (+ 2 b)) 0 0) (pink (* 40 b)))
                                     (* 0.1 (+ 1 a)) c)))
                 
                 ((eq? token 'prune)
                  (play time (mul (white (* 40 b)) (adsr 0 0.4 0 0))))
                 
                 ((eq? token 'split)
                  (play time (mul (white (* 400 b)) (adsr 0 0.05 0.05 4))))
                 
                 ((eq? token 'pre-extend)
                  (play time (mul (white (* 50 c)) (adsr 0 (* 0.1 d) 0 0))))
                 
                 ((eq? token 'chop)
                  (play time (mul (mul (sine (add (* 500 b) (mul 1000 (mul (adsr b a 0 0) 
                                                                           (sine (* a 400))))))
                                       (adsr a b 0 0)) 0.2)))
                 
                 (else
                  (display token)(newline))))
              (else
              
                (let ((n (modulo (inexact->exact (round (* (+ 1 c) 50))) 40)))
                  (play time (mul (adsr 0 0.4 0.1 4)
                        (sine (add (note n) 
                            (mul 500 (sine (/ (note n) b))))))))

              
              
                #;(let ((f (inexact->exact (round (* a 20)))))
                (play time (mul (mul (adsr 0.1 0.1 0.1 4) 5)                                                  
                            (cond
                                ((or (eq? token 'branch)
                                     (eq? token 'loop)
                                     (eq? token 'loop-ins)
                                     (eq? token 'loop-act))
                                    (sine (add f (mul 700 (saw (/ f 3))))))
                                (else
                                    (sine (add f (mul 700 (sine (/ f 3))))))))))

                ))))
      
      (define/public (set-time t)
        (set! time t))
      
      (super-new)))
  
  (define noise-maker (make-object noise-maker%))
  
  ;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  ;; a set is a collection of unique keys
  (define set%
    (class object%
      (public
        add     ;; add a key to the set or do nothing if it already exists
        remove  ;; removes the key from the set
        exists? ;; does the key exist in the set?
        print   ;; print the set out nicely
        clear   ;; empty the set
        size    ;; returns the size of the set
        empty?  ;; are we empty?
        set-ref ;; get key n
        get-raw-list ;; get the underlying list for iteration
        )
      
      (define (add key)    
        (when (not (exists? key))
          (set! set (cons key set))))
      
      (define (remove key)
        (set! set (filter 
                   (lambda (item)
                     (not (equal? key item)))
                   set)))
      
      (define (exists? key)
        (if (equal? (member key set) #f)
            #f
            #t))
      
      (define (print)
        (for-each
         (lambda (item)
           (printf "key: [~a]~n" item))
         set))
      
      (define (clear)
        (set! set '()))
      
      (define (size)
        (length set))
      
      (define (empty?)
        (zero? (size)))
      
      (define (set-ref n)
        (list-ref set n))
      
      (define (get-raw-list)
        set)
      
      (init-field (set '()))
      
      (super-new)))
  
  ;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  ;; a map is a collection of key value pairs,
  ;; based on an association list
  (define map%
    (class object%
      (public
        add     ;; add a key value pair to the map or replaces the value if it already exists
        remove  ;; removes the element with the given key
        exists? ;; does the element key exist?
        get     ;; returns the value associated with the key
        print   ;; print the list out nicely
        clear   ;; empty the map
        size    ;; returns the size of the map
        empty?  ;; are we empty?
        get-raw-list ;; get the underlying list for iteration
        )
      
      (define (add key-value)    
        (when (not (pair? key-value))
          (error "map: add expects a key value pair"))
        
        (when (exists? (car key-value))
          (remove (car key-value)))
        (set! map (cons key-value map)))
      
      (define (remove key)
        (set! map (filter 
                   (lambda (item)
                     (not (equal? key (car item))))
                   map)))
      
      (define (exists? key)
        (if (equal? (assoc key map) #f)
            #f
            #t))
      
      (define (get key)
        (let ((v (assoc key map)))
          (if (equal? v #f)
              (error "key doesn't exist:" key)
              (cdr v))))
      
      (define (print)
        (for-each
         (lambda (item)
           (printf "key: [~a] value: [~a]~n" (car item) (cdr item)))
         map))
      
      (define (clear)
        (set! map '()))
      
      (define (size)
        (length map))
      
      (define (empty?)
        (zero? (size)))
      
      (define (get-raw-list)
        map)
      
      (init-field (map '()))
      
      (super-new)))
  
  ;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  ;; an arc of a graph
  (define arc%
    (class object%
      (public 
        get-from ;; returns the vertex id we come from
        get-to   ;; returns the vertex id we go to
        set-from ;; sets the vertex id we come from
        set-to   ;; sets the vertex id we go to
        )
      (pubment
       delete ;; called before we are removed from the graph
       )
      
      (define (delete)
        (inner (void) delete))
      
      (define (get-from)
        from)
      
      (define (get-to)
        to)
      
      (define (set-from s)
        (set! from s))
      
      (define (set-to s)
        (set! from s))
      
      (init-field (from 0))
      (init-field (to 0))
      
      (super-new)))
  
  ;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  ;; a graph vertex
  (define vertex%
    (class object%
      (public
        get-degree               ;; returns the degree of the vertex (the number of arcs it is connected to)
        add-in-arc-id           ;; adds a new in arc (increments the degree)
        add-out-arc-id          ;; adds a new out arc (increments the degree)
        remove-arc-id           ;; removes an arc (decrements the degree)
        get-in-arcs-list        ;; get in arcs for this vertex
        get-out-arcs-list       ;; get out arcs for this vertex
        connected-to-arc-id?    ;; are we connected to this arc?
        )
      (pubment
       print                    ;; print stuff out
       delete                   ;; called before the vertex is removed
       )
      
      (define (delete)
        (inner (void) delete))
      
      (define (get-degree)
        (+ (send in-arcs-set size) (send out-arcs-set size)))
      
      (define (add-in-arc-id id)
        (when (send in-arcs-set exists? id)
          (error "vertex add-arc: arc already exists on this vertex?!"))
        (send in-arcs-set add id))
      
      (define (add-out-arc-id id)
        (when (send out-arcs-set exists? id)
          (error "vertex add-arc: arc already exists on this vertex?!"))
        (send out-arcs-set add id))
      
      (define (remove-arc-id id)
        (if (send in-arcs-set exists? id)
            (send in-arcs-set remove id)
            (if (send out-arcs-set exists? id)
                (send out-arcs-set remove id)
                (begin
                  (print)
                  (error "vertex remove-arc: arc doesn't exist on this vertex?!" id)
                  ))))
      
      (define (connected-to-arc-id? id)
        (if (send in-arcs-set exists? id)
            #t
            (if (send out-arcs-set exists? id)
                #t
                #f)))       
      
      (define (get-in-arcs-list)
        (send in-arcs-set get-raw-list))
      
      (define (get-out-arcs-list)
        (send out-arcs-set get-raw-list))
      
      (define (print)
        (printf "in arcs: ~n")
        (send in-arcs-set print)
        (printf "out arcs: ~n")
        (send out-arcs-set print)
        (inner (void) print))
      
      (init-field (in-arcs-set (make-object set%)))
      (init-field (out-arcs-set (make-object set%)))
      
      (super-new)))
  
  ;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  ;; a directional graph
  (define graph%
    (class object%
      (public 
        add-vertex  ;; adds a vertex to the graph, if it doesn't already exist
        add-arc     ;; adds an arc, and corresponding vertices to the graph
        remove-arc  ;; removes the arc, and connected vertices if there are no other connections left
        num-vertices ;; returns the number of vertices in the graph
        num-arcs    ;; returns the number of arcs in the graph
        get-vertices ;; direct access to the vertex map
        get-arcs    ;; direct access to the arc map
        get-vertex   ;; get the vertex from id
        vertex-exists? ;; does this vertex id still exist?
        get-arc     ;; get the arc from the id
        vertices-connected? ;; are these vertices connected?
        get-connected-vert-ids ;; get all the verts connected to the supplied one
        get-connected-invert-ids ;; get all the verts connected by incoming arcs
        get-connected-outvert-ids ;; get all the verts connected by outgoing arcs
        vertex-factory ;; allows derived classes to use derived vertices
        for-each-connected-vertex-id ;; visits every connected vert in no particular order
        )
      (pubment
       print        ;; print out the arc and vertex information
       )
      
      ; default version of the vertex factory
      (define (vertex-factory)
        (make-object vertex%))
      
      (define (add-vertex vertex-id)
        ; do we have too many vertices?        
        (cond ((< (send vertex-map size) max-vertices)
               (when (not (send vertex-map exists? vertex-id)) ; silently fail if it already exists
                 (send vertex-map add (cons vertex-id (vertex-factory)))))))
      
      (define (add-arc arc-id arc)
        ; do we have too many vertices?        
        (cond ((< (send vertex-map size) max-vertices)
               
               ; check this arc doesn't already exist?
               ; no - we support multiple arcs connecting the same vertices
               (send arc-map add (cons arc-id arc))
               ; todo - do we want the vertices to store the arc ids they connect?
               (let ((from (send arc get-from))
                     (to (send arc get-to)))               
                 (add-vertex from)
                 (send (send vertex-map get from) add-out-arc-id arc-id)               
                 (add-vertex to)
                 (send (send vertex-map get to) add-in-arc-id arc-id)))))
      
      (define (remove-arc arc-id)
        (let ((from-vert-id (send (get-arc arc-id) get-from))
              (to-vert-id (send (get-arc arc-id) get-to)))
          ;; remove the vertices if we are the last edge connecting them
          (cond 
            ((and (eq? (send (get-vertex from-vert-id) get-degree) 1)
                  (> (send vertex-map size) 1)) ; don't remove last vertex
             (send (get-vertex from-vert-id) delete)
             (send vertex-map remove from-vert-id))
            (else 
             (send (get-vertex from-vert-id) remove-arc-id arc-id)))
          (cond
            ((and (eq? (send (get-vertex to-vert-id) get-degree) 1)
                  (> (send vertex-map size) 1)) ; don't remove last vertex
             (send (get-vertex to-vert-id) delete)
             (send vertex-map remove to-vert-id))
            (else 
             (send (get-vertex to-vert-id) remove-arc-id arc-id)))
          (send (send arc-map get arc-id) delete)
          (send arc-map remove arc-id)))
      
      (define (vertices-connected? vertex-id1 vertex-id2)
        (define (arc-loop arcs)
          (cond 
            ((null? arcs) 
             #f)
            (else
             (if (send (get-vertex vertex-id2) connected-to-arc-id? (car arcs))
                 #t
                 (arc-loop (cdr arcs))))))
        (or
         (arc-loop (send (get-vertex vertex-id1) get-in-arcs-list)) 
         (arc-loop (send (get-vertex vertex-id1) get-out-arcs-list))))
      
      
      (define (get-connected-invert-ids vert-id)      
        (define (collect-in-arcs ins l)
          (cond 
            ((null? ins) l)
            (else
             (collect-in-arcs (cdr ins) (cons (send (send arc-map get (car ins)) get-from) l)))))      
        (collect-in-arcs (send (send vertex-map get vert-id) get-in-arcs-list) '()))
      
      (define (get-connected-outvert-ids vert-id)      
        (define (collect-out-arcs outs l)
          (cond 
            ((null? outs) l)
            (else
             (collect-out-arcs (cdr outs) (cons (send (send arc-map get (car outs)) get-to) l)))))      
        (collect-out-arcs (send (send vertex-map get vert-id) get-out-arcs-list) '()))
      
      (define (get-connected-vert-ids vert-id)
        (append (get-connected-invert-ids vert-id) (get-connected-outvert-ids vert-id)))
      
      (define (num-vertices)
        (send vertex-map size))
      
      (define (num-arcs)
        (send arc-map size))
      
      (define (get-vertex id)
        (send vertex-map get id))
      
      (define (vertex-exists? id)
        (send vertex-map exists? id))
      
      (define (get-arc id)
        (send arc-map get id))
      
      (define (get-vertices)
        vertex-map)
      
      (define (get-arcs)
        arc-map)
      
      (define (print)
        (define (print-loop vertex-list)
          (cond
            ((not (null? vertex-list)) 
             (printf "--------------------~n")
             (printf "vertex ~a~n" (car (car vertex-list)))
             (send (cdr (car vertex-list)) print)
             (print-loop (cdr vertex-list)))))
        (print-loop (send vertex-map get-raw-list))
        (inner (void) print))
      
      (define (for-each-connected-vertex-id proc vertex-id)
        (for-each-impl proc (list vertex-id) '()))
      
      (define (for-each-impl proc lst visited)
        (cond 
          ((null? lst) visited)
          ((memq (car lst) visited) 
           (for-each-impl proc (cdr lst) (cons (car lst) visited)))
          (else      
           (proc (car lst))         
           (for-each-impl proc (get-connected-invert-ids (car lst)) 
                          (for-each-impl proc (get-connected-outvert-ids (car lst)) 
                                         (for-each-impl proc (cdr lst)
                                                        (cons (car lst) visited)))))))
      
      (init-field (arc-map (make-object map%)))
      (init-field (vertex-map (make-object map%)))
      
      (super-new)))
  
  ;; test the low level graph stuff
  (define (test-lowlevel-graph)
    (let ((s (make-object set%)))
      (send s add 1)
      (send s add 2)
      (send s add 2)
      (when (send s exists? 4) (error "set test failed" ))
      (when (not (send s exists? 2)) (error "set test failed"))
      (send s remove 1)
      (send s remove 2)
      (when (send s exists? 1) (error "set test failed"))
      (when (send s exists? 2) (error "set test failed"))
      )
    
    (let ((m (make-object map%)))
      (send m add '(1 . "hello"))
      (send m add '(2 . "there"))
      (send m add '(2 . "boo"))
      (when (send m exists? 4) (error "map test failed" ))
      (when (not (send m exists? 2)) (error "map test failed"))
      (send m remove 1)
      (send m remove 2)
      (when (send m exists? 1) (error "map test failed"))
      (when (send m exists? 2) (error "map test failed"))
      )
    
    (let ((e (make-object arc% 49 19)))
      (when (not (eq? (send e get-from) 49)) (error "arc test failed"))
      (when (not (eq? (send e get-to) 19)) (error "arc test failed")))
    
    (let ((v (make-object vertex%)))
      (send v add-in-arc-id 1)
      (send v add-out-arc-id 2)
      (when (not (eq? (send v get-degree) 2)) (error "vertex test failed"))
      (send v remove-arc-id 2)
      (when (not (eq? (send v get-degree) 1)) (error "vertex test failed"))
      (send v remove-arc-id 1)
      (when (not (eq? (send v get-degree) 0)) (error "vertex test failed")))
    
    (let ((g (make-object graph%)))
      (send g add-arc 0 (make-object arc% 1 2))
      (when (not (eq? (send g num-arcs) 1)) (error "graph test failed"))
      (when (not (eq? (send g num-vertices) 2)) (error "graph test failed"))
      (send g add-arc 1 (make-object arc% 2 3))
      (send g add-arc 2 (make-object arc% 2 3))
      (send g add-arc 3 (make-object arc% 3 1))
      (send g add-arc 4 (make-object arc% 1 20))
      (when (not (eq? (send g num-arcs) 5)) (error "graph test failed"))
      (when (not (eq? (send g num-vertices) 4)) (error "graph test failed"))
      (when (not (eq? (send (send g get-vertex 2) get-degree) 3)) (error "graph test failed"))
      ;(send g print)
      (when (not (send g vertices-connected? 1 2)) (error "graph test failed"))
      (when (send g vertices-connected? 3 20) (error "graph test failed"))       
      (let ((count 0)) 
        (send g for-each-connected-vertex-id
              (lambda (v)
                (set! count (+ count 1)))
              1)
        (when (not (eq? count 4)) (error "graph test failed")))
      )
    
    ;; test arc removal
    (let ((g (make-object graph%)))
      (send g add-arc 0 (make-object arc% 1 2))
      (send g add-arc 1 (make-object arc% 2 3))    
      (send g remove-arc 1)
      (when (not (eq? (send g num-arcs) 1)) (error "graph test failed"))
      (when (not (eq? (send g num-vertices) 2)) (error "graph test failed"))
      (when (not (eq? (send (send g get-vertex 2) get-degree) 1)) (error "graph test failed"))
      
      ))
  
  (test-lowlevel-graph) ; do we want to test all the time (why not?)
  
  ;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  ;; now we get specific to the daisy chain language - token passing, instructions
  ;; and graph replacement grammars etc
  
  ;; a token is the core element of the language - and is 
  ;; passed around the graph, and collide together to activate
  (define daisy-token%
    (class object%
      (public
        get-type        ;; get the type of this token (instruction or activate)
        get-instruction ;; if we are an instruction, this is it
        set-type        ;; get the type of this token (instruction or activate)
        set-instruction ;; if we are an instruction, this is it
        last-tick       ;; we need to be removed after the next tick
        last-tick?      ;; de we need to be removed?
        distribute
        executable?
        )
      (pubment
       make-copy       ;; copy constructor
       delete          ;; clean up stuff
       switch          ;; tell the token it's switched verts
       )
      
      (init-field (type 'none))
      (init-field (instruction 'none))
      (init-field (slow 1))
      
      (define distribute-count 0)
      (define last #f)
      (field (local-t 0)) ; how far we've got from one vert to another - used by renderering, move
      
      (define (make-copy)
        (inner (make-object daisy-token% type instruction slow) make-copy))      
      
      (define (switch from to)
        (inner (void) switch from to))
      
      (define (delete)
        (inner (void) delete))
      
      (define (get-type)
        type)
      
      (define (get-instruction)
        instruction)
      
      (define (executable?)
        (eq? (+ distribute-count 1) slow)) ; we are only executable when we've reached out destination vertex
      
      (define (set-type s)
        (set! type s))
      
      (define (set-instruction s)
        (set! instruction s))
      
      (define (last-tick)
        (set! last #t))
      
      (define (last-tick?)
        last)
      
      (define (distribute graph from-vert)
        (set! distribute-count (+ distribute-count 1))
        (cond 
          ((not (eq? distribute-count slow)) ; slow slows the token distribution
           (set! local-t (+ local-t (/ 1 slow)))) ; tells the rendering how far we've got :/
          (else ; do the distribution!          
           (set! distribute-count 0)
           (set! local-t 0)
           (let ((copies 0) (arc-ids 0))
             (for-each
              (lambda (arc-id)
                (let* ((arc (send graph get-arc arc-id))
                       (dst-vertex (send graph get-vertex (send arc get-to))))
                  (cond 
                    ((and
                      (or (eq? (send arc get-type) 'any) ; if the arc allows any type
                          (eq? type (send arc get-type))) ; or the type matches
                      (not (last-tick?))) ; and we didn't activate last time round
                     (cond 
                       ((zero? copies) ; pass on to the first vertex
                        (send dst-vertex add-token this)
                        (switch from-vert dst-vertex))
                       (else ; otherwise this is a branch, and copies are needed
                        (when (and (< (send graph get-token-count) max-tokens)
                                   (< (send graph get-new-token-count) max-new-tokens))
                          (let ((new-token (make-copy)))
                            (send graph inc-token-count)
                            (send graph inc-new-token-count)
                            (send dst-vertex add-token new-token)
                            (send new-token switch from-vert dst-vertex)))))
                     (set! copies (+ copies 1))
                     (set! arc-ids (+ arc-ids arc-id)) ; just for noise fun
                     (send arc token-pass)))))
              (send from-vert get-out-arcs-list))
             
             (send from-vert remove-token this)
             
             ;; try playing a note here
             (cond ((> copies 1)
                    (if (eq? (get-type) 'activate)
                        (send noise-maker noise 'activate #f
                              (send graph get-new-token-count) ; just for noise fun
                              (send graph get-token-count) ; just for noise fun
                              copies ; ~= degree
                              arc-ids)
                        (send noise-maker noise instruction #f
                              (send graph get-new-token-count) ; just for noise fun
                              (send graph get-token-count) ; just for noise fun
                              copies
                              arc-ids))))
             
             (cond ((zero? copies)
                    (delete)))))))
      
      (super-new)))
  
  ;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  ;; arcs have type, and an idea of how well used they are
  (define daisy-arc%
    (class arc%
      (public
        get-type    ;; what type is this arc (all daisy arcs have a type to filter tokens)
        token-pass  ;; increment the usage
        tick        ;; update stuff
        delete-me?  ;; is it time to be removed due to over or under use?
        )
      
      (define (get-type)
        type)
      
      (define (tick)
        (when (not immortal-flowers)
          (set! delme (or (> last-used max-arc-last-used)
                          (> usage max-arc-usage))))
        (set! last-used (+ last-used 1)))
      
      (define (token-pass)
        (set! last-used 0)
        (set! usage (+ usage 1)))
      
      (define (delete-me?)
        delme)
      
      (init-field (type 'any))
      (define usage 0)
      (define last-used 0)
      (define delme #f)
      
      (super-new)))
  
  ;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  ;; vertices - store the tokens 
  ;;          - pass them on
  ;;          - check for activates, tell graph
  
  (define daisy-vertex%
    (class vertex%       
      (public 
        add-token   ;; adds a new token to the vertex
        remove-token 
        num-tokens  ;; how many tokens are here?
        distribute  ;; move the tokens to the connected out vertices
        post-distribute ;; set the moved tokens in place
        process     ;; get list of instructions if this vertex also contains an activate token
        get-tokens  ;; the list of tokens
        get-typed-tokens ;; filtered list for a specific type
        token-factory ;; allows derived classes to use their own token types
        pause ;; stop computation
        flip-pause
        is-paused? 
        )
      (augment
       print
       delete
       )
      (inherit
        get-out-arcs-list
        )
      
      (init-field (new-token-set (make-object set%)))
      (init-field (token-set (make-object set%)))
      (define paused #f)
      
      (define (token-factory)
        (make-object daisy-token%))
      
      (define (delete)
        (for-each
         (lambda (token)
           (send token delete))
         (send token-set get-raw-list))
        (inner (void) delete))
      
      (define (pause s)
        (set! paused s))
      
      (define (flip-pause)
        (set! paused (if paused #f #t)))
      
      (define (is-paused?)
        paused)
      
      (define (num-tokens)
        (send token-set size))
      
      (define (add-token token)
        (send new-token-set add token))
      
      (define (remove-token token)
        (send token-set remove token))
      
      (define (get-typed-tokens type)
        (define (loop in out)
          (cond 
            ((null? in) out)
            ((not (eq? (send (car in) get-type) type))
             (loop (cdr in) out))
            (else
             (loop (cdr in) (cons (car in) out)))))
        (loop (send token-set get-raw-list) '()))
      
      (define (get-tokens)
        (send token-set get-raw-list))
      
      (define (distribute this-id graph)
        (when (not paused)
          (for-each 
           (lambda (token)
             (send token distribute graph this))
           (send token-set get-raw-list))))
      
      ;; store new tokens in a seperate set so we can add them when all 
      ;; the distribution has occurred - means we don't need to double
      ;; buffer the entire graph (do it internally to the vertices)
      (define (post-distribute)
        (for-each
         (lambda (token)
           (send token-set add token))
         (send new-token-set get-raw-list))
        (send new-token-set clear))
      
      (define (process)
        ;; look for execution tokens
        (define (activate? token-list)
          (cond
            ((null? token-list) #f)
            (else
             (if (eq? (send (car token-list) get-type) 'activate)
                 #t
                 (activate? (cdr token-list))))))
        ;; get a list of all the instructions on this vertex
        (define (gather-executable-instructions token-list instr-list)
          (cond 
            ((null? token-list) instr-list)
            (else
             (if (and (send (car token-list) executable?)
                      (eq? (send (car token-list) get-type) 'instruction))
                 (gather-executable-instructions (cdr token-list) 
                                                 (cons (send (car token-list) get-instruction) instr-list))             
                 (gather-executable-instructions (cdr token-list) 
                                                 instr-list)))))
        
        (cond ((not paused)
               ;; look for exection and instruction tokens here
               (let ((token-list (send token-set get-raw-list))) 
                 ;; if we have more than 1 other token,
                 ;; we need to remove them all now - to prevent more than one token
                 ;; passing over the arcs
                 (when (> (length token-list) 1)
                   (for-each
                    (lambda (token)
                      (send token last-tick))
                    token-list))
                 (if (activate? token-list) (gather-executable-instructions token-list '())
                     '())))
              (else '())))
      
      (define (print)
        (printf "tokens:~n")
        (send token-set print)
        (inner (void) print))
      
      (super-new)))
  
  ;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  ;; the graph language
  (define daisy-graph%
    (class graph% 
      (inherit
        get-vertex
        get-arc
        get-arcs
        add-arc
        remove-arc
        )
      (inherit-field
       vertex-map
       arc-map
       )
      (public
        distribute ;; pass the tokens around
        add-token  ;; insert a token to the graph
        get-connected-typed-outvert-ids ;; gets typed out vert ids
        get-instruction-list ;; the current list of instruction waiting for the next tick
        arc-factory
        run-instructions ;; run some instructions externally
        get-token-count
        inc-token-count ; for keeping a running count
        get-new-token-count
        inc-new-token-count ; for keeping a running count
        new-vertex-id
        clean-arcs
        unpause-all
        set-execute-callback
        )
      
      (define token-count 0)
      (define new-token-count 0)
      
      (define/override (vertex-factory)
        (make-object daisy-vertex%))
      
      (define (arc-factory type from to)
        (error "!!"));(make-object arc-factory% type from to))
      
      (define (add-token vertex-id token)
        (send (get-vertex vertex-id) add-token token))
      
      (define (get-connected-typed-outvert-ids vert-id arc-type)  
        (define (collect-out-arcs outs l)
          (cond 
            ((null? outs) l)
            ((not (eq? (send (send arc-map get (car outs)) get-type) arc-type))
             (collect-out-arcs (cdr outs) l))
            (else
             (collect-out-arcs (cdr outs) (cons (send (send arc-map get (car outs)) get-to) l)))))
        (collect-out-arcs (send (send vertex-map get vert-id) get-out-arcs-list) '()))
      
      (define (get-new-token-count)
        new-token-count)
      
      (define (inc-new-token-count)
        (set! new-token-count (+ new-token-count 1)))
      
      (define (get-token-count)
        token-count)
      
      (define (inc-token-count)
        (set! token-count (+ token-count 1)))
      
      (define (update-token-count)
        (set! new-token-count 0)
        (set! token-count 
              (foldl
               (lambda (vertex count)
                 (+ count (send (cdr vertex) num-tokens)))
               0
               (send vertex-map get-raw-list))))
      
      (define (unpause-all)
        (for-each
         (lambda (vertex)
           (send (cdr vertex) pause #f))
         (send vertex-map get-raw-list)))
      
      
      (define (distribute)
        (define (get-instructions verts instr-list)
          (cond 
            ((null? verts) instr-list)
            (else
             (let ((instr (send (cdr (car verts)) process)))
               (if (null? instr)
                   (get-instructions (cdr verts) instr-list)
                   (get-instructions (cdr verts) 
                                     (cons (list (car (car verts)) (send (cdr (car verts)) process)) 
                                           instr-list)))))))
        (update-token-count)
        ;; first run the previous instructions we collected
        (run-instruction-list)      
        ;; now distribute the tokens around
        (for-each
         (lambda (vertex)
           (send (cdr vertex) distribute (car vertex) this))
         (send vertex-map get-raw-list))      
        ;; run post distribute to finish the token distribution
        (for-each
         (lambda (vertex)
           (send (cdr vertex) post-distribute))
         (send vertex-map get-raw-list))
        ;; get all the instructions resulting from this distrubution
        (set! instruction-list (get-instructions (send vertex-map get-raw-list) '()))
        
        (clean-arcs))
      
      (define (clean-arcs)
        ;; tick the arcs and look for arcs which are needing to be removed,
        ;; due to under or over use
        (for-each 
         (lambda (arc-item)
           (when (not (send (get-vertex (send (cdr arc-item) get-from)) is-paused?))
             (send (cdr arc-item) tick))
           (when (send (cdr arc-item) delete-me?)
             (remove-arc (car arc-item))))
         (send (get-arcs) get-raw-list)))
      
      
      
      (define (get-instruction-list)
        instruction-list)
      
      (define (new-arc type from to)
        (add-arc (new-arc-id) (arc-factory type from to)))
      
      (define (run-instruction-list)
        (for-each 
         (lambda (instruction-list)
           (run-instructions instruction-list))
         instruction-list))
      
      (define (execute-callback vertex)
        0)
      
      (define (set-execute-callback cb)
        (set! execute-callback cb))
      
      (define (run-instructions vertex-instruction-list)
        (for-each
         (lambda (instruction)
           (let* ((vertex-id (car vertex-instruction-list))
                  (vertex (get-vertex vertex-id)))
             (execute-callback vertex)
             
             (send noise-maker noise instruction #t
                              (get-new-token-count) ; just for noise fun
                              (get-token-count) ; just for noise fun
                              vertex-id
                              1)
             
             ;; this comprises the daisy chain instruction set of grammars
             (cond
               ((eq? instruction 'nop) 0)
               
               ;; simple branch
               ((eq? instruction 'branch)
                (new-arc 'any vertex-id (new-vertex-id)))
               
               ;; simple branch
               ((eq? instruction 'branch-ins)
                (new-arc 'instruction vertex-id (new-vertex-id)))
               
               ;; simple branch
               ((eq? instruction 'branch-act)
                (new-arc 'activate vertex-id (new-vertex-id)))
               
               ;; add a loop to this vertex through 2 new ones
               ((eq? instruction 'loop)
                (let ((a (new-vertex-id))
                      (b (new-vertex-id)))
                  (new-arc 'any vertex-id a)
                  (new-arc 'any a b)
                  (new-arc 'any b vertex-id)))
               
               ;; add a loop to this vertex through 2 new ones - instruction type
               ((eq? instruction 'loop-ins)
                (let ((a (new-vertex-id))
                      (b (new-vertex-id)))
                  (new-arc 'instruction vertex-id a)
                  (new-arc 'instruction a b)
                  (new-arc 'instruction b vertex-id)))
               
               ;; add a loop to this vertex through 2 new ones - exectute type
               ((eq? instruction 'loop-act)
                (let ((a (new-vertex-id))
                      (b (new-vertex-id)))
                  (new-arc 'activate vertex-id a)
                  (new-arc 'activate a b)
                  (new-arc 'activate b vertex-id)))
               
               ;; double-vertex
               ((eq? instruction 'double-branch-ins-act)
                (let ((a (new-vertex-id)))
                  (new-arc 'instruction vertex-id a)
                  (new-arc 'activate vertex-id a)))
               
               ;; extend all out arcs
               ((eq? instruction 'extend)
                (for-each
                 (lambda (out-arc-id)
                   (let* ((out-arc (get-arc out-arc-id))
                          (a (new-vertex-id))
                          (b (send out-arc get-to)))
                     (new-arc (send out-arc get-type) vertex-id a)
                     (new-arc (send out-arc get-type) a b)                
                     (remove-arc out-arc-id)))
                 (send vertex get-out-arcs-list)))
               
               ;; double extend all out arcs
               ((eq? instruction 'double-extend)
                (for-each
                 (lambda (out-arc-id)
                   (let* ((out-arc (get-arc out-arc-id))
                          (a (new-vertex-id))
                          (b (send out-arc get-to)))
                     (new-arc (send out-arc get-type) vertex-id a)
                     (new-arc (send out-arc get-type) a b)                
                     (remove-arc out-arc-id)))
                 (send vertex get-out-arcs-list))
                (for-each
                 (lambda (out-arc-id)
                   (let* ((out-arc (get-arc out-arc-id))
                          (a (new-vertex-id))
                          (b (send out-arc get-to)))
                     (new-arc (send out-arc get-type) vertex-id a)
                     (new-arc (send out-arc get-type) a b)                
                     (remove-arc out-arc-id)))
                 (send vertex get-out-arcs-list)))
               
               ;; pre extend all out arcs
               ((eq? instruction 'pre-extend)
                (let ((activate-vert (new-vertex-id))
                      (instruction-vert (new-vertex-id))
                      (any-vert (new-vertex-id))
                      (found-activate #f)
                      (found-instruction #f)
                      (found-any #f))                  
                  
                  (for-each
                   (lambda (out-arc-id)
                     (let* ((out-arc (get-arc out-arc-id))                         
                            (dst (send out-arc get-to)))
                       (cond
                         ((eq? (send out-arc get-type) 'instruction)
                          (set! found-instruction #t)
                          (new-arc 'instruction instruction-vert dst))                      
                         ((eq? (send out-arc get-type) 'activate)
                          (set! found-activate #t)
                          (new-arc 'activate activate-vert dst))
                         (else
                          (set! found-any #t)
                          (new-arc 'any any-vert dst)))
                       (remove-arc out-arc-id)))
                   (send vertex get-out-arcs-list))
                  
                  (when found-instruction (new-arc 'instruction vertex-id instruction-vert))
                  (when found-activate (new-arc 'activate vertex-id activate-vert))
                  (when found-any (new-arc 'any vertex-id any-vert))
                  
                  ))                      
               
               ;; split types into new vertices (removes current vert)
               ((eq? instruction 'split)
                (let ((activate-vert (new-vertex-id))
                      (instruction-vert (new-vertex-id))
                      (any-vert (new-vertex-id)))
                  (for-each
                   (lambda (out-arc-id)
                     (let* ((out-arc (get-arc out-arc-id))                         
                            (dst (send out-arc get-to)))
                       (cond
                         ((eq? (send out-arc get-type) 'instruction)
                          (new-arc 'instruction instruction-vert dst))
                         ((eq? (send out-arc get-type) 'activate)
                          (new-arc 'activate activate-vert dst))
                         (else
                          (new-arc 'any any-vert dst)))
                       (remove-arc out-arc-id)))
                   (send vertex get-out-arcs-list))
                  (for-each
                   (lambda (in-arc-id)
                     (let* ((in-arc (get-arc in-arc-id))                         
                            (src (send in-arc get-from)))
                       (cond
                         ((eq? (send in-arc get-type) 'instruction)
                          (new-arc 'instruction src instruction-vert))
                         ((eq? (send in-arc get-type) 'activate)
                          (new-arc 'activate src activate-vert))
                         (else
                          (new-arc 'any src any-vert)))
                       (remove-arc in-arc-id)))
                   (send vertex get-in-arcs-list))))
               
               ;; remove all out arcs
               ((eq? instruction 'chop)                 
                (for-each
                 (lambda (out-arc-id)                                                            
                   (remove-arc out-arc-id))
                 (send vertex get-out-arcs-list)))
               
               ;; remove all out and in arcs to vertices of degree one 
               ((eq? instruction 'prune)
                (for-each
                 (lambda (out-arc-id) 
                   (let* ((out-arc (get-arc out-arc-id))
                          (dst (send out-arc get-to)))
                     (when (eq? (send (get-vertex dst) get-degree) 1)
                       (remove-arc out-arc-id))))
                 (send vertex get-out-arcs-list))
                (for-each
                 (lambda (in-arc-id) 
                   (let* ((in-arc (get-arc in-arc-id))
                          (src (send in-arc get-from)))
                     (when (eq? (send (get-vertex src) get-degree) 1)
                       (remove-arc in-arc-id))))
                 (send vertex get-in-arcs-list)))
               
               )))
         
         (car (cdr vertex-instruction-list))))
      
      ;; for procedurally making new vertices
      (define (new-vertex-id)
        (set! current-vertex (+ current-vertex 1))
        current-vertex)
      
      ;; for procedurally making new arcs
      (define (new-arc-id)
        (set! current-arc (+ current-arc 1))
        current-arc)
      
      (define instruction-list '())
      (define current-vertex 1000)
      (define current-arc 1000)
      
      (super-new)))
  
  (define (test-daisy-graph)
    (let ((g (make-object daisy-graph%)))
      (send g add-arc 100 (make-object daisy-arc% 'any 0 1))
      (send g add-token 0 (make-object daisy-token%))
      (send g distribute)
      (when (not (eq? (send (send g get-vertex 0) num-tokens) 1)) (error "daisy graph test failed"))
      (send g distribute)
      
      (display (send (send g get-vertex 0) num-tokens))(newline)
      
      (when (not (eq? (send (send g get-vertex 0) num-tokens) 0)) (error "daisy graph test failed"))
      (when (not (eq? (send (send g get-vertex 1) num-tokens) 1)) (error "daisy graph test failed"))
      (send g add-arc 101 (make-object daisy-arc% 'any 1 2))
      (send g add-arc 102 (make-object daisy-arc% 'any 2 0))
      (send g distribute)
      (when (not (eq? (send (send g get-vertex 2) num-tokens) 1)) (error "daisy graph test failed"))
      (when (not (eq? (send (send g get-vertex 1) num-tokens) 0)) (error "daisy graph test failed"))
      (when (not (eq? (send (send g get-vertex 0) num-tokens) 0)) (error "daisy graph test failed"))
      ; do we loop succesfully?
      (send g distribute)
      (when (not (eq? (send (send g get-vertex 0) num-tokens) 1)) (error "daisy graph test failed"))
      (when (not (eq? (send (send g get-vertex 1) num-tokens) 0)) (error "daisy graph test failed"))
      (when (not (eq? (send (send g get-vertex 2) num-tokens) 0)) (error "daisy graph test failed"))
      ; branch?
      (send g add-arc 103 (make-object daisy-arc% 'any 0 3))
      (send g distribute)
      (when (not (eq? (send (send g get-vertex 0) num-tokens) 0)) (error "daisy graph test failed"))
      (when (not (eq? (send (send g get-vertex 1) num-tokens) 1)) (error "daisy graph test failed"))
      (when (not (eq? (send (send g get-vertex 2) num-tokens) 0)) (error "daisy graph test failed"))
      (when (not (eq? (send (send g get-vertex 3) num-tokens) 1)) (error "daisy graph test failed"))
      ; kill off tokens at dead ends?
      (send g distribute)
      (when (not (eq? (send (send g get-vertex 0) num-tokens) 0)) (error "daisy graph test failed"))
      (when (not (eq? (send (send g get-vertex 1) num-tokens) 0)) (error "daisy graph test failed"))
      (when (not (eq? (send (send g get-vertex 2) num-tokens) 1)) (error "daisy graph test failed"))
      (when (not (eq? (send (send g get-vertex 3) num-tokens) 0)) (error "daisy graph test failed")))
    
    ;; test the execution
    (let ((g (make-object daisy-graph%)))
      (send g add-arc 100 (make-object daisy-arc% 'any 0 1))
      (send g add-arc 102 (make-object daisy-arc% 'any 2 1))
      (send g add-arc 103 (make-object daisy-arc% 'any 1 3))
      
      (send g add-token 0 (make-object daisy-token% 'activate))
      (send g add-token 2 (make-object daisy-token% 'instruction))
      (send g distribute)
      (send g distribute) 
      ; check we get an instruction message
      (when (not (equal? (send g get-instruction-list) '((1 (none))))) (error "daisy graph test failed"))
      (send g distribute)
      ; check the tokens are then removed
      (when (not (eq? (send (send g get-vertex 3) num-tokens) 0)) (error "daisy graph test failed"))
      ))
  
  (test-daisy-graph)
  
  ;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  ;; particle system
  
  (define particle-system%
    (class object%
      (public
        add
        render
        spawn
        )
      
      (define p 0)
      (define current 0)
      
      (define (particle-system-new)
        (with-state
         (hint-ignore-depth)
         (texture (load-texture "textures/tokenbg.png"))
         (set! p (build-particles 200)))
        (with-primitive p
                        (pdata-add "vel" "v")
                        (pdata-map!
                         (lambda (c)
                           (vmul (vector 1 (flxrnd) (* (flxrnd) 0.7)) 0.5))
                         "c")
                        (pdata-map!
                         (lambda (p)
                           (vector 1 0 0))
                         "p")
                        (pdata-map!
                         (lambda (p)
                           (vector 10 10 0))
                         "s")
                        (pdata-map!
                         (lambda (vel)
                           (vmul (srndvec) 2))
                         "vel"))
        (super-new))
      
      
      (define (add pos)
        (with-primitive p
                        (pdata-set! "p" current pos)
                        (set! current (modulo (+ current 1) (pdata-size)))))
      
      (define (spawn count pos)
        (cond ((not (zero? count))
               (add pos)
               (spawn (- count 1) pos))))
      
      (define (render)
        (with-primitive p (pdata-op "+" "p" "vel")))
      
      (particle-system-new)))
  
  ;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  ;; visualisation of a token
  (define flx-daisy-token%
    (class daisy-token%
      (public
        render       ;; update the primitive
        set-position ;; set the destination position
        set-last-position ;; set the source position (for init)
        made-from-input ;; are we created by the user?
        )
      (inherit-field
       type
       instruction
       slow
       local-t
       )
      
      (define token-scale 1)
      (define position (vector 0 0 0))
      (define root 0)
      (define last-position (vector 0 0 0))
      
      (define/augment (make-copy)
        (inner (make-object flx-daisy-token% type instruction slow) make-copy))      
      
      (define (made-from-input)
        (set! token-scale 10))
      
      (define (flx-daisy-token-new)
        (define (set-tex-coords num)
          (let ((topleft (vector (/ (modulo num 4) 4) (/ (floor (/ num 4)) 4) 0)))
            (with-primitive root
                            (pdata-set! "t" 0 topleft)
                            (pdata-set! "t" 1 (vadd topleft (vector 0.25 0 0)))
                            (pdata-set! "t" 2 (vadd topleft (vector 0.25 0.25 0)))
                            (pdata-set! "t" 3 (vadd topleft (vector 0 0.25 0))))))
        
        (super-new)
        (set! root (with-state
                    (hint-unlit)
                    ;(opacity 0.5)
                    (hint-depth-sort)
                    (translate (vector 0 0 (+ 5 (* (flxrnd) 0.01))))
                    (scale (vector 20 20 20))
                    (colour (vector 0 0 0))
                    (if (eq? type 'instruction)
                        (texture (load-texture "textures/tokens.png"))
                        (texture (load-texture "textures/activate.png")))
                    (build-plane)))
        
        (apply-transform root)
        
        (cond
          ((eq? type 'instruction) 
           (cond
             ((eq? instruction 'nop) (set-tex-coords 1))
             ((eq? instruction 'branch) (set-tex-coords 2))
             ((eq? instruction 'branch-ins) (set-tex-coords 2))
             ((eq? instruction 'branch-act) (set-tex-coords 2))
             ((eq? instruction 'loop) (set-tex-coords 3))
             ((eq? instruction 'loop-ins) (set-tex-coords 3))
             ((eq? instruction 'loop-act) (set-tex-coords 3))
             ((eq? instruction 'double-branch-ins-act) (set-tex-coords 4))
             ((eq? instruction 'extend) (set-tex-coords 5))
             ((eq? instruction 'double-extend) (set-tex-coords 6))
             ((eq? instruction 'split) (set-tex-coords 7))
             ((eq? instruction 'chop) (set-tex-coords 8))
             ((eq? instruction 'prune) (set-tex-coords 9))
             ((eq? instruction 'cross-branch) (set-tex-coords 10))
             ((eq? instruction 'pre-extend) (set-tex-coords 11))
             (else (set-tex-coords 1))         
             ))))
      
      (define/augment (delete)
        (destroy root)
        (inner (void) delete))
      
      (define (set-position pos t)
        (set! position (vadd last-position (vmul (vsub pos last-position) (+ local-t (/ t slow))))))
      
      (define (set-last-position s)
        (set! last-position s))
      
      (define/augment (switch from to)
        (set! last-position (send from get-position)))
      
      (define (render)
        (with-primitive root
                        (cond 
                          ((eq? type 'activate)
                           (colour activate-token-colour))
                          (else (colour instruction-token-colour)))
                        (identity)
                        (translate position)
                        (cond ((> token-scale 1)
                               (set! token-scale (* token-scale 0.95))
                               (scale (vector token-scale token-scale token-scale))))))
      
      
      (flx-daisy-token-new)))
  
  ;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  ;; visualisation of a daisy arc
  (define flx-daisy-arc%
    (class daisy-arc%
      (public
        render ;; update the graphics arc
        )
      (inherit-field
       type
       )
      
      (define time 0)
      
      (define (flx-daisy-arc-new)
        (set! root (with-state
                    (hint-unlit)
                    ;(hint-vertcols)
                    (colour any-colour)
                    (line-width 5)
                    (texture (load-texture "textures/arc-1.png"))
                    (build-ribbon 2)))
        
        (with-primitive root
                        (pdata-set! "c" 1 (vector 1 1 1))
                        (pdata-set! "w" 0 5)
                        (pdata-set! "w" 1 5))
        (super-new))
      
      (define/augment (delete)
        (destroy root)
        (inner (void) delete))
      
      (define (render delta from to)
        (with-primitive root
                        (set! time (+ time delta))
                        #;(cond ((> time animation-fps)
                               (set! time 0)
                               (let ((r (random 3)))
                                 (cond 
                                   ((eq? r 0) (texture (load-texture "textures/arc-1.png")))
                                   ((eq? r 1) (texture (load-texture "textures/arc-2.png")))
                                   ((eq? r 2) (texture (load-texture "textures/arc-3.png")))))))
                        
                        
                        ;; move this to the new func (type doesn't seem to be initialised in time)
                        (cond 
                          ((eq? type 'instruction) (colour instruction-colour))
                          ((eq? type 'activate) (colour activate-colour))
                          (else (colour any-colour)))
                        (pdata-set! "p" 0 (send from get-position))
                        (pdata-set! "p" 1 (send to get-position))))
      
      (define root 0)
      
      (flx-daisy-arc-new)))
  
  ;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  (define flx-daisy-vertex%
    (class daisy-vertex%
      (public 
        balance ;; balance the graph with a force directed algorithm
        render ;; update the vertex position
        get-position ;; world space position
        set-dir ;; override the calulated direction
        init-position ;; should be called after we have been connected to the graph
        get-balance-count
        set-position ;; brute force
        )
      (inherit
        get-tokens
        is-paused?
        )
      
      (define root 0)
      (define pause-obj 0)
      (define pos (vector 0 0 0)) ; cache this as we will be asked for it often :)
      (define position (vector 0 0 0)) ; smoothed position in world space
      (define dir (vector 0 0 0))
      (define first-time #t)
      (define smooth 0.1)
      (define balance-count 0)
      (define frame 0)
      (define time 0)
      (define graph-scale 1)
      (define graph-activity 0.95)
      
      (define/override (token-factory)
        (make-object flx-daisy-token%))
      
      (define (flx-daisy-vertex-new)
        (set! root (with-state
                    (hint-unlit)
                    (hint-ignore-depth)
                    (hint-depth-sort)
                    ;(opacity 0.5)
                    (scale (vector 20 20 20))
                    (colour (vector 1 (flxrnd) (* (flxrnd) 0.7)))
                    
                    (let ((r (random 2)))
                      (cond
                        ((eq? r 0) (texture (load-texture "textures/flower-1.png")))
                        ((eq? r 1) (texture (load-texture "textures/flower-2.png")))))
                    
                    (build-plane)))
        
        (apply-transform root)
        
        (set! pause-obj (with-state
                         (hint-unlit)
                         (hint-ignore-depth)
                         (hint-depth-sort)
                         (scale (vector 60 60 60))
                         (texture (load-texture "textures/pause.png"))
                         (parent root)
                         (build-plane)))
        
        (with-primitive pause-obj (hide 1))
        
        (with-primitive root
                        (translate (vmul (vsub (vector (flxrnd) (flxrnd) 0) 
                                               (vector 0.5 0.5 0)) 10))
                        (set! pos (vtransform (vector 0 0 0) (get-transform))))
        
        (set-anim-texture frame)
        (super-new))
      
      (define (get-balance-count)
        balance-count)
      
      (define (do-animation delta)
        ;; decouple the animation playback from the framerate
        (set! time (+ time delta))
        (cond        
          ((> time animation-fps)
           (set! time 0)
           (set! frame (+ frame 1))
           (when (> frame 29) (set! frame (+ 27 (random 3))))
           (set-anim-texture frame))))
      
      (define (set-anim-texture frame)
        (let ((v (vector (/ (modulo frame 6) 6) (/ (floor (/ frame 6)) 6) 0)))
          (with-primitive root
                          (pdata-set! "t" 0 v)
                          (pdata-set! "t" 1 (vadd v (vector 1/6 0 0)))
                          (pdata-set! "t" 2 (vadd v (vector 1/6 1/6 0)))
                          (pdata-set! "t" 3 (vadd v (vector 0 1/6 0))))))
      
      (define (set-position p)
        (with-primitive root
                        (translate p)                           
                        (set! pos (vtransform (vector 0 0 0) (get-transform)))
                        (set! position pos)))
      
      (define (init-position this-id graph)      
        ; init the postion to the average of all the connected verts
        ; which have already been initialised + a small randomness
        (let* ((count 0)
               (avg (foldl
                     (lambda (vertex-id accum)
                       (let ((position (send (send graph get-vertex vertex-id) get-position)))
                         (cond 
                           ((not (equal? position (vector 0 0 0))) ; drop unitialised ones
                            (set! count (+ count 1))
                            (vadd accum (send (send graph get-vertex vertex-id) get-position)))
                           (else
                            accum))))
                     (vmul (vsub (vector (flxrnd) (flxrnd) 0) (vector 0.5 0.5 0)) 0.01) ; start with a little randomness
                     (append
                      (send graph get-connected-invert-ids this-id)
                      (send graph get-connected-outvert-ids this-id)))))
          (when (not (zero? count))
            (set! avg (vdiv avg count)))
          (set-position avg)))
      
      (define/augment (delete)
        (destroy root)
        (inner (void) delete))
      
      (define (balance this-id graph)
        
        (define (repulse)
          (foldl
           (lambda (vertex-item vec)
             (cond 
               ((eq? (car vertex-item) this-id) vec)
               (else
                (send graph inc-repulses) ; record this calculation
                (let ((v (vsub pos (send (cdr vertex-item) get-position))))
                  (vadd vec (vmul (vnormalise v) (/ 1 (vmag v))))))))
           (vector 0 0 0)
           (send (send graph get-vertices) get-raw-list)))
        
        (define (attract)
          (foldl
           (lambda (vertex-id vec)
             (vadd vec (vsub (send (send (send graph get-vertices) get vertex-id) get-position) pos)))
           (vector 0 0 0)
           (send graph get-connected-vert-ids this-id)))
        
        (cond 
          (first-time 
           (init-position this-id graph)
           (set! first-time #f)))
        
        (set! balance-count (+ balance-count 1))
        (set! dir (vadd dir (vadd (vmul (vnormalise (attract)) attract-mul)
                                  (vmul (vnormalise (repulse)) repulse-mul)))))
      
      (define (render t delta) ; t is 0->1 based on the graph tick      
        (cond ((is-paused?) 
               (set! t 0.001)
               (with-primitive pause-obj 
                               (hide 0)
                               (rotate (vector 0 0 2))))
              (else
               (with-primitive pause-obj (hide 1))))
        
        (do-animation delta)
        (set! pos (vadd pos dir))
        (set! dir (vmul dir graph-activity))
        (set! position (vadd
                        (vmul position (- 1 smooth))
                        (vmul pos smooth)))
        
        
        (with-primitive root
                        (identity)
                        (translate position))
        
        (for-each
         (lambda (token)
           (send token set-position position t)
           (send token render))
         (get-tokens)))
      
      (define (get-position)
        position)
      
      (define (set-dir s)
        (set! dir s))
      
      (flx-daisy-vertex-new)))
  
  ;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  
  (define flx-daisy-graph%
    (class daisy-graph% 
      (inherit
        get-vertex
        distribute
        new-vertex-id
        add-vertex
        )
      (inherit-field
       vertex-map
       arc-map
       )
      (public
        render ;; update the graph
        get-tick ;; time taken for token transfer
        set-tick ;; time taken for token transfer
        inc-repulses ;; records the sort calculation, so we can limit the time spent doing this
        inc-next-tick ;; for sync
        get-next-tick ;; for sync
        new-vertex
        )
      
      (define repulses 0)
      (define tick 0.3)
      (define next-tick (+ time-offset (/ (current-inexact-milliseconds) 1000)))
      (define balance-pos 0)
      
      (define (get-tick)
        tick)
      
      (define (set-tick s)
        (set! tick s))
      
      (define (inc-next-tick t)
        (set! next-tick (+ next-tick t)))
      
      (define (get-next-tick)
        next-tick)
      
      (define (inc-repulses)
        (set! repulses (+ repulses 1)))
      
      (define/override (vertex-factory)
        (make-object flx-daisy-vertex%))
      
      (define/override (arc-factory type from to)
        (make-object flx-daisy-arc% type from to))
      
      (define (new-vertex)
        (let ((id (new-vertex-id)))
          (add-vertex id)
          id))
      
      (define (render time delta)      
        (define (balance current l)
          (cond
            ((> repulses max-repulses) current)
            (else
             (let ((vertex-item (list-ref l (modulo current (length l)))))
               (send (cdr vertex-item) balance (car vertex-item) this))
             (balance (+ current 1) l))))
        
        (define (balance-all l)
          (for-each
           (lambda (vertex-item)
             (send (cdr vertex-item) balance (car vertex-item) this))
           l))
        
        (define (balance-new l)
          (cond
            ((and (not (null? l)) (< repulses max-repulses) )
             (when (< (send (cdr (car l)) get-balance-count) new-balance-count)
               (send (cdr (car l)) balance (car (car l)) this))
             (balance-new (cdr l)))))
        
        ;; first do the distribution
        (cond 
          ((> time next-tick)
           (distribute)
           (set! next-tick (+ next-tick tick))
           (send noise-maker set-time next-tick)))
        
        ;; do the layout balance 
        ;; start off my varying the repulses by some random value
        ;; repulses gets added to automatically by balance
        (set! repulses (- (random 20) 10)) 
        
        (cond ((> (send vertex-map size) 1)
               (balance-new (send vertex-map get-raw-list))
               (set! balance-pos (balance balance-pos (send vertex-map get-raw-list)))))
        
        ;(balance-all (send vertex-map get-raw-list))
        
        ;; render verts
        (let ((t (- 1 (/ (- next-tick time) tick))))
          (for-each
           (lambda (vertex-item)
             (send (cdr vertex-item) render t delta))
           (send vertex-map get-raw-list)))
        
        ;; render arcs
        (for-each
         (lambda (arc-item)
           (let ((arc (cdr arc-item)))
             (send arc render delta 
                   (get-vertex (send arc get-from))
                   (get-vertex (send arc get-to)))))
         (send arc-map get-raw-list)))
      
      (super-new)))
  
  ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  ; ring menu (from betablocker)
  ; ring menus are great with analogue controllers as they allow fast selection
  ; from quite a large range - and the positions can be memorised quickly
  
  ; items is a list of strings for the menu selector
  (define ring-menu%
    (class object%
      (public
        get-selected ;; what is currently selected
        get-shown ;; are we shown
        set-attach ;; set a parent
        get-root ;; get the root object
        update ;; update with a joypad
        build ;; make the thing
        set-colour ;; set the colour of all the objects
        )
      
      (init-field (items '()))
      (init-field (tex-dim 4))
      
      (define attach 0)
      (define objs '())
      (define selected -1)
      (define shown #f)
      (define root 0)
      (define size 1)
      (define deadzone 0.1)
      
      (define (ring-menu-new)
        (super-new))
      
      (define (get-root)
        root)
      
      (define (set-attach s)
        (set! attach s))
      
      (define (get-selected)
        (list-ref items selected))
      
      (define (get-shown)
        shown)
      
      (define (set-colour col)
        (for-each
         (lambda (obj)
           (with-primitive obj (colour col)))
         objs))
      
      (define (build tex)
        (with-state
         (scale (vector 150 150 150))
         (hint-unlit) 
         (translate (vector 0 0 0.1))
         ;(hint-ignore-depth)
         (hint-depth-sort)
         (parent attach)
         (set! root (build-locator))
         (parent root)
         (texture tex) 
         (let ((n 0))
           (set! objs (map
                       (lambda (item)
                         (let ((obj (with-state
                                     (let ((angle (- 90 (* 360 (/ n (length items))))))
                                       (scale (vector 0.5 0.5 0.5))
                                       (rotate (vector 0 0 angle))
                                       (translate (vector 2 0 0))
                                       (rotate (vector 0 0 (- angle)))
                                       (build-plane)))))
                           (with-primitive obj
                                           ; just set the forward facing quad texture coords
                                           (let ((tc (vector (/ (modulo n tex-dim) tex-dim) 
                                                             (/ (floor (/ n tex-dim)) tex-dim) 0)))
                                             (pdata-set! "t" 0 tc)
                                             (pdata-set! "t" 1 (vadd tc (vector (/ 1 tex-dim) 0 0)))
                                             (pdata-set! "t" 2 (vadd tc (vector (/ 1 tex-dim) (/ 1 tex-dim) 0)))
                                             (pdata-set! "t" 3 (vadd tc (vector 0 (/ 1 tex-dim) 0)))))
                           (set! n (+ n 1))
                           obj))
                       items))))
        (hide-menu))
      
      (define (update joylisten axis)
        (define (ang y x)
          (let ((q (/ 3.141 2)))
            (when (zero? y) (set! y 0.0001))
            (cond 
              ((>= y 0)
               (+ q q (- (atan (/ x y)))))
              (else
               (- q q (atan (/ x y)))))))
        
        ; set the scale
        (set! size (sqrt (+ (* (vector-ref (send joylisten get-axis axis) 0) 
                               (vector-ref (send joylisten get-axis axis) 0))
                            (* (vector-ref (send joylisten get-axis axis) 1) 
                               (vector-ref (send joylisten get-axis axis) 1)))))
        (when (> size 0.5) (set! size 0.5))     
        
        (with-primitive root
                        (identity)
                        (scale (vector size size size)))
        
        ; if out of the deadzone, show and run the menu
        (cond
          ((> size deadzone)                
           (show-menu)
           (menu-select (inexact->exact 
                         (round (* (length items)
                                   (/ (ang (vector-ref (send joylisten get-axis axis) 0)
                                           (vector-ref (send joylisten get-axis axis) 1)) (* 3.141 2)))))))
          (else
           (hide-menu))))
      
      (define (menu-select sel-count)           
        ; unselect
        (cond 
          ((not (eq? selected -1))
           (with-primitive (list-ref objs selected)
                           (translate (vector 0 0 -0.1))
                           (scale (vector 0.5 0.5 0.5)))))
        
        (set! selected (modulo sel-count (length items)))
        
        ; select
        (with-primitive (list-ref objs selected)
                        (scale (vector 2 2 2))
                        (translate (vector 0 0 0.1))))
      
      (define (show-menu)
        (with-primitive root (hide 0))
        (set! shown #t))
      
      (define (hide-menu)
        (with-primitive root (hide 1))
        (set! shown #f))
      
      (ring-menu-new)))
  
  ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  
  (define flx-daisy-cursor%
    (class object% 
      (public
        render
        )
      
      (define vertex-id 0)
      (define position (vector 0 0 0))
      (define root 0)
      (define cursor-ob 0)
      (define speed-ob 0)
      (define arrow 0)
      (define dst 0)
      (define current-type 'any)
      (define ring-menu (make-object ring-menu% 
                          '(
                            activate
                            nop
                            branch
                            loop  
                            double-branch-ins-act
                            extend
                            double-extend
                            split
                            chop
                            prune
                            cross-branch
                            pre-extend
                            )))
      (define joypad (make-object joylisten%))
      (define position-blend 0.1)
      (define zoom -300)
      (define angle 0)
      (define debounce #f)
      (define anim-time 0)
      (define token-speed-time 0)
      (define speed 8)
      (define cursor-size (vector 1 1 1))
      
      (define (flx-daisy-cursor-new)
        (super-new)
        (with-state
         (hint-depth-sort)
         (translate (vector 0 0 5))
         (set! root (build-locator))        
         (texture (load-texture "textures/daisy-cursor-1.png"))
         (scale (vector 40 40 40))       
         (with-state
          (parent root)       
          (set! cursor-ob (build-plane))
          (texture (load-texture "textures/pause.png"))
          (translate (vector 0 0 1))
          (scale (vector 0.7 0.7 0.7))
          (set! speed-ob (build-plane)))
         (set! dst (build-plane)))
        (apply-transform cursor-ob)
        (apply-transform dst)
        (apply-transform speed-ob)
        (lock-camera root)
        
        (send ring-menu set-attach root)
        (send ring-menu build (load-texture "textures/tokens.png"))
        
        (set! arrow (with-state
                     (texture (load-texture "textures/arc-1.png"))
                     (parent root)
                     (hint-unlit)
                     (build-ribbon 2)))
        
        (with-primitive arrow
                        (pdata-set! "w" 0 5)
                        (pdata-set! "w" 1 5)))
      
      (define/public (get-root)
        root)  

      (define (render graph delta)
        (send joypad update)
        (send ring-menu update joypad joymap-lstick)
        (update-input graph)
        (update-position graph)
        (update-zoom)
        
        (with-primitive root                      
                        (identity)
                        (translate position))
        
        (with-primitive cursor-ob
                        (set! anim-time (+ anim-time delta))
                        (cond ((> anim-time animation-fps)
                               (set! anim-time 0)
                               (let ((r (random 3)))
                                 (cond 
                                   ((eq? r 0) 
                                    (texture (load-texture "textures/daisy-cursor-1.png")))
                                   ((eq? r 1) 
                                    (texture (load-texture "textures/daisy-cursor-2.png")))
                                   ((eq? r 2) 
                                    (texture (load-texture "textures/daisy-cursor-3.png"))))))))
        
        (with-primitive speed-ob                      
                        (set! token-speed-time (+ token-speed-time delta))
                        (if (> token-speed-time (* daisy-tick speed 0.5))
                            (hide 0) (hide 1))
                        (cond ((> token-speed-time (* daisy-tick speed))                             
                               (set! token-speed-time 0)))))
      
      (define (set-colour col)
        (with-primitive root (colour col))
        (send ring-menu set-colour col))
      
      (define (set-type type)
        (cond 
          ((eq? type 'any) (set-colour (vadd any-colour (vector 0.5 0.5 0.5))))
          ((eq? type 'instruction) (set-colour (vadd instruction-colour (vector 0.5 0.5 0.5))))
          ((eq? type 'activate) (set-colour (vadd activate-colour (vector 0.5 0.5 0.5)))))
        (set! current-type type))
      
      ;; a bit awkward, but map instruction menu item and current type
      ;; to the actual instruction symbol
      (define (get-typed-instruction instruction)
        (cond        
          ((eq? instruction 'branch)
           (cond 
             ((eq? current-type 'any) 'branch)
             ((eq? current-type 'instruction) 'branch-ins)
             ((eq? current-type 'activate) 'branch-act)))
          ((eq? instruction 'loop)
           (cond 
             ((eq? current-type 'any) 'loop)
             ((eq? current-type 'instruction) 'loop-ins)
             ((eq? current-type 'activate) 'loop-act)))
          (else instruction)))                                          
      
      (define (update-input graph)
        (cond 
          ((and (> (send joypad get-button joymap-a) 0)
                (send ring-menu get-shown))
           (let ((instruction (send ring-menu get-selected)))
             
             (cond ((not debounce)
                    (let ((token (if (eq? instruction 'activate)
                                     (make-object flx-daisy-token% 'activate 'none speed)
                                     (make-object flx-daisy-token% 'instruction 
                                       (get-typed-instruction instruction) speed)))
                          (vertex (send graph get-vertex vertex-id)))
                      (send token made-from-input)
                      (send token set-last-position (send vertex get-position))
                      (send vertex add-token token))
                    (set! debounce #t)))))
          
          ((and (> (send joypad get-button joymap-b) 0)
                (send ring-menu get-shown))
           (let ((instruction (send ring-menu get-selected)))
             
             (cond ((not debounce)  
                    ; store initial paused state
                    (let ((paused (send (send graph get-vertex vertex-id) is-paused?)))
                      ; unpause (means disconnected verts will be unpaused)
                      (send graph for-each-connected-vertex-id
                            (lambda (v)
                              (send (send graph get-vertex v) pause #f))
                            vertex-id)
                      
                      ; run the instruction
                      (send graph run-instructions 
                            (list vertex-id (list (get-typed-instruction (send ring-menu get-selected)))))
                      
                      (when (not (send graph vertex-exists? vertex-id))
                        (set! vertex-id (find-closest-vertex graph)))
                      
                      ; set the pause status back to this subgraph
                      (send graph for-each-connected-vertex-id
                            (lambda (v)                            
                              (send (send graph get-vertex v) pause paused))
                            vertex-id))
                    (set! debounce #t)))))
          
          ((> (send joypad get-button joymap-c) 0)
           (cond ((not debounce)                     
                  (send graph for-each-connected-vertex-id
                        (lambda (v)
                          (send (send graph get-vertex v) flip-pause))
                        vertex-id)
                  (set! debounce #t))))
          
          ((> (send joypad get-button joymap-d) 0)
           (cond ((not debounce)                     
                  (let ((id (send graph new-vertex)))
                    (send (send graph get-vertex id) set-position 
                          (send (send graph get-vertex vertex-id) get-position)))
                  (set! debounce #t))))
          
          ((> (send joypad get-button joymap-l1) 0)
           (cond ((not debounce)                     
                  (cond 
                    ((eq? current-type 'any) 
                     (set-type 'instruction))
                    ((eq? current-type 'instruction) 
                     (set-type 'activate))
                    ((eq? current-type 'activate) 
                     (set-type 'any)))
                  (set! debounce #t))))        
          
          ((> (send joypad get-button joymap-r1) 0)
           (cond ((send ring-menu get-shown)  ; only do the speed changes when the ring menu is up
                  (cond ((not debounce)       
                         (set! speed (- speed 1))
                         (when (< speed 1) (set! speed 1))))
                  (set! debounce #t))
                 (else
                    (send (send graph get-vertex vertex-id) 
                         set-dir (vmul (vector
                                       (vector-ref (send joypad get-axis joymap-rstick) 0)
                                       (- (vector-ref (send joypad get-axis joymap-rstick) 1))
                                       0) 10)))))
          
          ((> (send joypad get-button joymap-r2) 0)
           (cond ((not debounce)          
                  (cond ((send ring-menu get-shown)  ; only do the speed changes when the ring menu is up
                         (set! speed (+ speed 1))
                         (when (> speed 8) (set! speed 8)))
                        (else
                         (send graph unpause-all)))
                  (set! debounce #t))))
          
          (else (set! debounce #f))))
      
      (define (update-zoom)
        (cond
          ((and (not do-card) (> (vector-ref (send joypad get-axis joymap-dpad) 0) 0))
           (set! zoom (* zoom 1.05)))
          ((and (not do-card) (< (vector-ref (send joypad get-axis joymap-dpad) 0) 0))
           (set! zoom (* zoom 0.95)))
          #;((> (vector-ref (send joypad get-axis joymap-dpad) 1) 0)
             (set! angle (- angle 1)))
          #;((< (vector-ref (send joypad get-axis joymap-dpad) 1) 0)
             (set! angle (+ angle 1))))
        (set-camera-transform (mmul 
                               (mtranslate (vector 0 0 zoom))
                               (mrotate (vector angle 0 0)))))
      
      (define (update-position graph)
        (let* ((joy (send joypad get-axis joymap-rstick))
               (jvec (vector (vector-ref joy 0) (- (vector-ref joy 1)) 0))
               (strength (vmag jvec)))
          (cond 
            ((and (> strength 0.1)
                  (< (send joypad get-button joymap-r1) 1)) ;; don't want to trigger this when we are yanking
             (with-primitive arrow
                             (hide 0)
                             (pdata-set! "p" 1 (vmul jvec 5)))
             
             (let ((candidate (find-new-vertex graph (vnormalise jvec))))
               (cond 
                 ((not (eq? candidate -1))
                  (let ((pos (send (send graph get-vertex candidate) get-position)))
                    (with-primitive dst
                                    (hide 0)
                                    (identity)
                                    (translate pos))
                    (with-primitive arrow
                                    (hide 0)
                                    (pdata-set! "p" 1 (vsub pos position)))
                    (cond
                      ((> (vmag jvec) 0.8)
                       (set! vertex-id candidate))))))))
            (else
             (with-primitive arrow (hide 1))
             (with-primitive dst (hide 1)))))
        
        ;; check if the vertex has been removed
        (cond 
          ((not (send graph vertex-exists? vertex-id))
           (set! vertex-id (find-closest-vertex graph))))
        
        (let ((vertex (send graph get-vertex vertex-id)))
          (set! position (vadd 
                          (vmul position (- 1 position-blend))
                          (vmul (send vertex get-position) position-blend)))))
      
      (define (find-closest-vertex graph)
        (let ((ret-id -1)
              (closest 9999))
          (for-each 
           (lambda (vertex-pair)
             (let* ((id (car vertex-pair))
                    (vertex (cdr vertex-pair))
                    (to-vertex (vsub (send vertex get-position) position))
                    (dist (vmag to-vertex)))
               (cond
                 ((< dist closest)
                  (set! closest dist)
                  (set! ret-id id)))))
           (send (send graph get-vertices) get-raw-list))
          ret-id))
      
      (define (find-new-vertex graph direction)
        (let ((ret-id -1)
              (closest 9999))
          (for-each 
           (lambda (vertex-pair)
             (let* ((id (car vertex-pair))
                    (vertex (cdr vertex-pair))
                    (to-vertex (vsub (send vertex get-position) position))
                    (dist (vmag to-vertex)))
               (cond
                 ((and (> (vdot direction (vnormalise to-vertex)) 0.95)
                       (< dist closest))
                  (set! closest dist)
                  (set! ret-id id)))))
           (send (send graph get-vertices) get-raw-list))
          ret-id)) 
      
      (flx-daisy-cursor-new)))
  
  ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  
  (define daisy-app%
    (class object% 
      (public
        render
        )
      
      (define graph (make-object flx-daisy-graph%))
      (define cursor (make-object flx-daisy-cursor%))
      (define particles (make-object particle-system%))
      
      (define (daisy-app-new)
        (send graph set-tick daisy-tick)
        (send graph set-execute-callback execute-cb)
        (cond 
          ((eq? start-program 'test) (test-graph))
          ((eq? start-program 'metro) (metro-graph))
          ((eq? start-program 'sndchk) (sndchk-graph))
          ((eq? start-program 'random) (random-graph 50 10))
          ((eq? start-program 'selfrep) (selfrep-graph))
          (else (start-graph)))
        (super-new))
      
      (define/public (get-cursor)
        cursor)

      (define (execute-cb vertex)
        (send particles spawn 20 (send vertex get-position)))
      
      (define (render time delta)
        (check-sync)
        (send graph render time delta)
        (send cursor render graph delta)
        (send particles render))
      
      ; figures out the offset to the nearest tick    
      (define (calc-offset timenow synctime tick)
        (let ((p (/ (- synctime timenow) tick)))
          (let ((f (- p (floor p))))
            (if (< f 0.5)
                (* f tick)
                (- (* (- 1 f) tick))))))
      
      (define (check-sync)
        (cond ((osc-msg "/sync")
               (send graph set-tick (* sync-tick-multiplier (* (/ 1 (osc 3)) 60)))
               (let* ((sync-time (+ sync-offset (timestamp->time (vector (osc 0) (osc 1)))))
                      (offset (calc-offset 
                               (send graph get-next-tick) 
                               sync-time 
                               (send graph get-tick))))                     
                 (printf "time offset: ~a~n" offset)
                 (send graph inc-next-tick offset)))))
      
      (define (start-graph)
        (send graph add-vertex 100)
        )
      
      (define (random-graph e v)
          (define (random-instruction)
            (let ((n (random 14)))
                (cond 
                    ((eq? n 0) 'nop)
                    ((eq? n 1) 'branch)
                    ((eq? n 2) 'branch-ins)
                    ((eq? n 3) 'branch-act)
                    ((eq? n 4) 'loop)
                    ((eq? n 5) 'loop-ins)
                    ((eq? n 6) 'loop-act)
                    ((eq? n 7) 'double-branch-ins-act)
                    ((eq? n 8) 'extend)
                    ((eq? n 9) 'double-extend)
                    ((eq? n 10) 'pre-extend)
                    ((eq? n 11) 'split)
                    ((eq? n 12) 'chop)
                    ((eq? n 13) 'prune))))
      
        (cond 
          ((not (zero? e)) 
           (let ((a (random v)) (b (random v)))
                (let ((n 0));(random 3)))
                 (cond 
                     ((eq? n 0)
                     (send graph add-arc e (make-object flx-daisy-arc% 'any a b)))
                   ((eq? n 1)
                     (send graph add-arc e (make-object flx-daisy-arc% 'instruction a b)))
                   (else
                     (send graph add-arc e (make-object flx-daisy-arc% 'activate a b)))))
                     
                 (if (eq? (random 2) 0)
                    (send graph add-token a (make-object flx-daisy-token% 'activate 'none (+ (random 8) 1)))
                    (send graph add-token a (make-object flx-daisy-token% 'instruction (random-instruction) (+ (random 8) 1))))

                 (if (eq? (random 2) 0)
                    (send graph add-token b (make-object flx-daisy-token% 'activate 'none (+ (random 8) 1)))
                    (send graph add-token b (make-object flx-daisy-token% 'instruction (random-instruction) (+ (random 8) 1)))))
           (random-graph (- e 1) v))))
      
      (define (metro-graph)
        (send graph add-arc 100 (make-object flx-daisy-arc% 'instruction 0 1))
        (send graph add-arc 101 (make-object flx-daisy-arc% 'instruction 1 2))
        (send graph add-arc 102 (make-object flx-daisy-arc% 'instruction 2 3))
        (send graph add-arc 103 (make-object flx-daisy-arc% 'instruction 3 0))
        
        (send graph add-arc 104 (make-object flx-daisy-arc% 'instruction 0 5))
        (send graph add-arc 105 (make-object flx-daisy-arc% 'instruction 1 6))
        (send graph add-arc 106 (make-object flx-daisy-arc% 'instruction 2 7))
        (send graph add-arc 107 (make-object flx-daisy-arc% 'instruction 3 8))
        
        (send graph add-arc 108 (make-object flx-daisy-arc% 'activate 0 9))
        (send graph add-arc 109 (make-object flx-daisy-arc% 'activate 9 10))
        (send graph add-arc 110 (make-object flx-daisy-arc% 'activate 10 11))
        (send graph add-arc 111 (make-object flx-daisy-arc% 'activate 11 13))
        (send graph add-arc 113 (make-object flx-daisy-arc% 'activate 13 9))
        (send graph add-arc 112 (make-object flx-daisy-arc% 'activate 11 12))
        
        (send graph add-token 0 (make-object flx-daisy-token% 'instruction 'branch 8))
        (send graph add-token 13 (make-object flx-daisy-token% 'activate 'none 1)))
      
      (define (sndchk-graph)
        (send graph add-arc 100 (make-object flx-daisy-arc% 'instruction 0 1))
        (send graph add-arc 101 (make-object flx-daisy-arc% 'instruction 1 2))
        (send graph add-arc 102 (make-object flx-daisy-arc% 'instruction 2 3))
        (send graph add-arc 103 (make-object flx-daisy-arc% 'instruction 3 4))
        (send graph add-arc 104 (make-object flx-daisy-arc% 'instruction 4 50))
        (send graph add-arc 105 (make-object flx-daisy-arc% 'instruction 50 6))
        (send graph add-arc 106 (make-object flx-daisy-arc% 'instruction 6 7))
        (send graph add-arc 107 (make-object flx-daisy-arc% 'instruction 7 8))
        (send graph add-arc 108 (make-object flx-daisy-arc% 'instruction 8 9))
        (send graph add-arc 109 (make-object flx-daisy-arc% 'instruction 9 10))
        (send graph add-arc 110 (make-object flx-daisy-arc% 'instruction 10 11))
        (send graph add-arc 111 (make-object flx-daisy-arc% 'instruction 11 0))
        
        (send graph add-arc 154 (make-object flx-daisy-arc% 'instruction 0 100))
        (send graph add-arc 155 (make-object flx-daisy-arc% 'instruction 1 101))
        (send graph add-arc 156 (make-object flx-daisy-arc% 'instruction 50 102))
        (send graph add-arc 157 (make-object flx-daisy-arc% 'instruction 7 103))
        (send graph add-arc 158 (make-object flx-daisy-arc% 'instruction 9 104))
        
        
        (send graph add-arc 159 (make-object flx-daisy-arc% 'activate 3 105))
        (send graph add-arc 160 (make-object flx-daisy-arc% 'activate 105 106))
        (send graph add-arc 161 (make-object flx-daisy-arc% 'activate 106 107))
        (send graph add-arc 162 (make-object flx-daisy-arc% 'activate 107 108))
        (send graph add-arc 163 (make-object flx-daisy-arc% 'activate 108 105))
        (send graph add-arc 164 (make-object flx-daisy-arc% 'activate 105 109))
        
        
        (send graph add-token 0 (make-object flx-daisy-token% 'instruction 'branch))
        (send graph add-token 2 (make-object flx-daisy-token% 'instruction 'loop))
        (send graph add-token 3 (make-object flx-daisy-token% 'instruction 'double-branch-ins-act))
        (send graph add-token 4 (make-object flx-daisy-token% 'instruction 'extend))
        (send graph add-token 50 (make-object flx-daisy-token% 'instruction 'double-extend))
        (send graph add-token 6 (make-object flx-daisy-token% 'instruction 'split))
        (send graph add-token 7 (make-object flx-daisy-token% 'instruction 'chop))
        (send graph add-token 8 (make-object flx-daisy-token% 'instruction 'prune))
        
        (send graph add-token 105 (make-object flx-daisy-token% 'activate 'none 3))
        
        )
      
      
      (define (test-graph)
        (send graph add-arc 100 (make-object flx-daisy-arc% 'activate 0 1))
        (send graph add-arc 101 (make-object flx-daisy-arc% 'activate 1 2))
        (send graph add-arc 102 (make-object flx-daisy-arc% 'activate 2 3))
        (send graph add-arc 103 (make-object flx-daisy-arc% 'activate 3 4))
        
        (send graph add-arc 112 (make-object flx-daisy-arc% 'activate 1 40))
        (send graph add-arc 113 (make-object flx-daisy-arc% 'activate 40 41))
        (send graph add-arc 114 (make-object flx-daisy-arc% 'activate 41 42))
        (send graph add-arc 115 (make-object flx-daisy-arc% 'activate 42 1))
        
        
        (send graph add-arc 104 (make-object flx-daisy-arc% 'instruction 0 5))
        (send graph add-arc 105 (make-object flx-daisy-arc% 'instruction 5 6))
        (send graph add-arc 106 (make-object flx-daisy-arc% 'instruction 6 7))
        (send graph add-arc 107 (make-object flx-daisy-arc% 'instruction 7 4))
        
        
        (send graph add-arc 116 (make-object flx-daisy-arc% 'instruction 5 43))
        (send graph add-arc 117 (make-object flx-daisy-arc% 'instruction 43 44))
        (send graph add-arc 118 (make-object flx-daisy-arc% 'instruction 44 45))
        (send graph add-arc 119 (make-object flx-daisy-arc% 'instruction 45 5))
        
        
        (send graph add-token 1 (make-object flx-daisy-token% 'activate 'none 7))
        ; (send graph add-token 40 (make-object flx-daisy-token% 'activate))
        ;(send graph add-token 41 (make-object flx-daisy-token% 'activate))
        ; (send graph add-token 42 (make-object flx-daisy-token% 'activate))
        
        (send graph add-token 5 (make-object flx-daisy-token% 'instruction 'branch 8))
        ;(send graph add-token 43 (make-object flx-daisy-token% 'instruction 'loop-ins))
        ;(send graph add-token 44 (make-object flx-daisy-token% 'instruction 'double-extend))
        ;(send graph add-token 45 (make-object flx-daisy-token% 'instruction 'double-extend))
        )
      
      (define (selfrep-graph)
        (define arc 100)
        (define (new-arc)
          (set! arc (+ arc 1))
          arc)
        
        ;; activate branch
        (send graph add-arc (new-arc) (make-object flx-daisy-arc% 'activate 0 2))
        (send graph add-arc (new-arc) (make-object flx-daisy-arc% 'activate 2 3))
        
        ;; activate loop
        (send graph add-arc (new-arc) (make-object flx-daisy-arc% 'activate 2 4))
        (send graph add-arc (new-arc) (make-object flx-daisy-arc% 'activate 4 5))
        (send graph add-arc (new-arc) (make-object flx-daisy-arc% 'activate 5 6))
        (send graph add-arc (new-arc) (make-object flx-daisy-arc% 'activate 6 7))
        (send graph add-arc (new-arc) (make-object flx-daisy-arc% 'activate 7 8))
        (send graph add-arc (new-arc) (make-object flx-daisy-arc% 'activate 8 9))
        (send graph add-arc (new-arc) (make-object flx-daisy-arc% 'activate 9 10))
        (send graph add-arc (new-arc) (make-object flx-daisy-arc% 'activate 10 11))
        (send graph add-arc (new-arc) (make-object flx-daisy-arc% 'activate 11 12))
        (send graph add-arc (new-arc) (make-object flx-daisy-arc% 'activate 12 13))
        (send graph add-arc (new-arc) (make-object flx-daisy-arc% 'activate 13 14))
        (send graph add-arc (new-arc) (make-object flx-daisy-arc% 'activate 14 2))
        
        ;; instruction branch
        (send graph add-arc (new-arc) (make-object flx-daisy-arc% 'instruction 0 51))
        (send graph add-arc (new-arc) (make-object flx-daisy-arc% 'instruction 51 3))
        
        ;; instruction loop
        (send graph add-arc (new-arc) (make-object flx-daisy-arc% 'instruction 51 52))
        (send graph add-arc (new-arc) (make-object flx-daisy-arc% 'instruction 52 53))
        (send graph add-arc (new-arc) (make-object flx-daisy-arc% 'instruction 53 54))
        (send graph add-arc (new-arc) (make-object flx-daisy-arc% 'instruction 54 55))
        (send graph add-arc (new-arc) (make-object flx-daisy-arc% 'instruction 55 56))
        (send graph add-arc (new-arc) (make-object flx-daisy-arc% 'instruction 56 57))
        (send graph add-arc (new-arc) (make-object flx-daisy-arc% 'instruction 57 58))
        (send graph add-arc (new-arc) (make-object flx-daisy-arc% 'instruction 58 59))
        (send graph add-arc (new-arc) (make-object flx-daisy-arc% 'instruction 59 60))
        (send graph add-arc (new-arc) (make-object flx-daisy-arc% 'instruction 60 61))
        (send graph add-arc (new-arc) (make-object flx-daisy-arc% 'instruction 61 51))
        
        
        
        (send graph add-token 4 (make-object flx-daisy-token% 'activate 'none 5))
        (send graph add-token 5 (make-object flx-daisy-token% 'activate 'none 5))
        (send graph add-token 6 (make-object flx-daisy-token% 'activate 'none 5))
        (send graph add-token 7 (make-object flx-daisy-token% 'activate 'none 5))
        (send graph add-token 8 (make-object flx-daisy-token% 'activate 'none 5))
        (send graph add-token 9 (make-object flx-daisy-token% 'activate 'none 5))
        (send graph add-token 10 (make-object flx-daisy-token% 'activate 'none 5))
        (send graph add-token 11 (make-object flx-daisy-token% 'activate 'none 5))
        (send graph add-token 12 (make-object flx-daisy-token% 'activate 'none 5))
        
        (send graph add-token 60 (make-object flx-daisy-token% 'instruction 'loop-ins 6))
        (send graph add-token 59 (make-object flx-daisy-token% 'instruction 'loop-act 6))
        (send graph add-token 58 (make-object flx-daisy-token% 'instruction 'double-extend 6))
        (send graph add-token 57 (make-object flx-daisy-token% 'instruction 'double-extend 6))
        (send graph add-token 56 (make-object flx-daisy-token% 'instruction 'double-extend 6))
        (send graph add-token 55 (make-object flx-daisy-token% 'instruction 'double-extend 6))
        (send graph add-token 54 (make-object flx-daisy-token% 'instruction 'double-branch-ins-act 6))
        (send graph add-token 53 (make-object flx-daisy-token% 'instruction 'pre-extend 6))
        (send graph add-token 52 (make-object flx-daisy-token% 'instruction 'split 6))
        
        
        )    
      (daisy-app-new)))
  
  
  ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
  
  (define osc-reader%
    (class object%
      (public
        init
        update)
      
      (define file 0)
      (define dest "")
      (define count 0)
      (define current '())
      (define offset 0)
      
      (define (read-word file)
        (define (inner-read-token str)
          (let ((c (read-char file)))
            (cond
              ((eof-object? c) str)
              ((char-whitespace? c) str)
              (else (inner-read-token (string-append str (string c)))))))   
        (inner-read-token ""))
      
      (define (init time filename destination)
        (set! offset time)
        (set! dest destination)
        (set! file (open-input-file filename))
        (read-word file)
        (set! count (string->number (read-word file))))
      
      (define (update time)
        (cond 
          ((or (null? current) (> time (+ offset (string->number (list-ref current 1)))))
           (cond 
             ((not (null? current))
              (osc-destination dest)
              (display (list-ref current 1))(display " sending: ")(display (list-ref current 0))
              (display " f ")(display (list (string->number (list-ref current 4))))
              (newline)
              (osc-send (list-ref current 0) "f" (list (string->number (list-ref current 4))))))
           (set! current (list (read-word file)(read-word file)(read-word file)(read-word file)
                               (read-word file)(read-word file)))
           (update time))))
      
      (super-new)))
  
  ;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
  ; add more textures to this vector
(define back-textures (vector "back1.png" "back2.png" "back3.png"))

; video aspect ratio
(define aspect-ratio 0.75)

(define (make-card)
    (define back 0)
    (define grain 0)
    (define text 0)
    (define hide-time 0)
    (define hidden #f)
    (define root 0)

    (define (build toproot)
        ; make the background card
        (push)
        (parent toproot)        
        (push)
        (scale (vector card-scale card-scale card-scale))
        (set! root (build-locator))
        (pop)
        (parent root)
        (hint-unlit)
        (push)
        (scale (vector 3 -2.5 1))
        (translate (vector 0 0 -0.01))
        (set! back (build-plane))
        (pop)

        ; make the film grain
        (push)
        (hint-depth-sort)
        (scale (vector 3 3 1))
        (colour (vector 0.2 0.2 0.2))
        (texture (load-texture "grain1.png"))
        (set! grain (build-plane))
        (pop)

        (set! text (build-text "hello"))

        (pop)

        ; squash the texture coords a little to make the grain finer
        (grab grain)
        (pdata-set "t" 0 (vector 0 0 0))
        (pdata-set "t" 1 (vector 3 0 0))
        (pdata-set "t" 2 (vector 3 1 0))
        (pdata-set "t" 3 (vector 0 1 0))
        (ungrab)
        (hide-card))

    (define (show t)
            (grab back)
            (hide 0)
            (ungrab)
            (grab grain)
            (hide 0)
            (ungrab)
            (grab text)
            (hide 0)
            (ungrab)
            (set! hidden #f)
            (set! hide-time (+ (time) t)))

    (define (hide-card)
        (grab back)
        (hide 1)
        (ungrab)
        (grab grain)
        (hide 1)
        (ungrab)
        (grab text)
        (hide 1)
        (ungrab)
        (set! hidden #t))


    (define (set-text! str)
        ; build the text
        (when (not (zero? text)) (destroy text))
        (push)
        (hint-depth-sort)
        (parent root)
        (colour (vector 0.7 0.7 0.7))
        (scale (vector 0.15 0.15 0.15))
        (translate (vector -5 4 0.5))
        (texture (load-texture "font.png"))
        (set! text (build-text str))
        (pop))

    (define (set-back! texnum)
        (grab back)
        ; wrap the texture number to prevent errors
        (texture (load-texture (vector-ref back-textures
            (modulo texnum (vector-length back-textures)))))
        (ungrab))

    (define (animate)

        ; apply an offset to animate the film grain
        (define (anim-grain n x y)
            (pdata-set "t" n (vadd (pdata-get "t" n) (vector x y 0)))
            (if (zero? n)
                0
                (anim-grain (- n 1) x y)))

        (cond 
            ((not hidden)      
          
                (with-primitive grain
                ; jitter the grain left and right while moving it down fast
                (anim-grain (- (pdata-size) 1) (* (- (rndf) 0.5) 0.1) 0.09)
                )
        
                ; see if it's time to hide again
                (when (> (time) hide-time)
                    (hide-card)))))
    
    ; diy oo
    (define (dispatch m)
        (cond
            ((eq? m 'build) build)
            ((eq? m 'set-text!) set-text!)
            ((eq? m 'set-back!) set-back!)
            ((eq? m 'animate) animate)
            ((eq? m 'show) show)
              (else (error "unknown method" m))))
    dispatch)

(define card (make-card))

(define (update-card)
;    (display (osc-peek))(newline)
    (cond
        ((and do-card (osc-msg "/show-code"))
            ((card 'set-text!) (osc 0))
            ((card 'set-back!) 2)
            ((card 'show) (osc 1))))
    ((card 'animate)))

;;------------------------------------------------------


  ;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  
  (clear)

  (clear-colour bg-colour)
  
  ;(flxseed 1)
  ;(random-seed 10)
  
  (blur 0)
  (desiredfps 25)
  (persp)
  
  ;(start-framedump "ttrq/frame-" "jpg")
  ;(define (delta) (/ 1764 44100))
  ;(define current-time (flxtime))
  ;(define (flxtime) current-time)
  
  (show-axis 0)
  
  (define daisy (make-object daisy-app%))
  (define oscreader (make-object osc-reader%))

((card 'build) (send (send daisy get-cursor) get-root))

  
  ;(send oscreader init (+ (flxtime) 10) 
  ;      "/home/dave/code/oscrec/daisy01.osc" 
  ;      "osc.udp://127.0.0.1:4444")
  
  (define (render)
    (send daisy render (+ time-offset (/ (current-inexact-milliseconds) 1000)) (delta))
    ;(send oscreader update (flxtime))
    ;(set! current-time (+ current-time (delta)))
    (update-card)
    )
  
  ;)
  
  ;(require 'daisy)
  
  (every-frame (render))