;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; exquisite code script, connecting words to make shapes

;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; a node just has a name and a position

(define (make-node name pos)
  (cons name (list pos)))

(define (node-name node)
  (car node))

(define (node-pos node)
  (list-ref (cdr node) 0))

;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; an edge has the node names it connects from and a to 

(define (make-edge from to)
  (list from to))

(define (edge-from edge)
  (car edge))

(define (edge-to edge)
  (cadr edge))

; an edge is equal without worrying about direction
(define (edge=? a b)
  (or 
   (and (eq? (edge-from a) (edge-from b)) (eq? (edge-to a) (edge-to b)))
   (and (eq? (edge-to a) (edge-from b)) (eq? (edge-from a) (edge-to b)))))

;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; basic graph functions

(define (make-graph nodes edges)
  (list nodes edges))

(define (graph-nodes graph)
  (car graph))

(define (graph-edges graph)
  (cadr graph))

(define (graph-find-node graph name)
  (assq name (graph-nodes graph)))

(define (graph-find-edge graph edge)
  (foldl
      (lambda (oedge r)
      (if (edge=? edge oedge) #t r))
    #f
    (graph-edges graph)))
  
(define (graph-find-node-edges graph name)
  (foldl
   (lambda (edge r)
     (if (or (eq? (edge-from edge) name) 
             (eq? (edge-to edge) name))
         (cons edge r) r))
   '()
   (graph-edges graph)))

(define (graph-nodes-connected? graph namea nameb)
  (foldl
   (lambda (edge r)
     (if (or (eq? (edge-from edge) nameb)
             (eq? (edge-to edge) nameb))
         edge r))
   #f
   (graph-find-node-edges graph namea)))

;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; a geoedge is an edge with a length

(define (make-geoedge from to length)
  (list from to length))

(define (geoedge-length edge)
  (list-ref edge 2))

;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; functions to balance the graph using a spring model

; get the attraction/repulsion value for two connected nodes
(define (balance-connected dst edge-len)
  (if (< dst edge-len) 
    (* 0.01 dst)
    (* -0.01 (- dst edge-len)))) ; make proportional

; get the repulsion value for two disconnected nodes
(define (balance-unconnected dst)
  (* 0.1 (/ 1 dst)))

; change the positions for this node, by comparing it with all the others
(define (geonode-balance node graph)
  (make-node
   (node-name node)
   (foldl
    (lambda (other-node r)
      (let ((name (node-name node))
            (other-name (node-name other-node)))
        (if (not (eq? name other-name))
              (let* ((v (vsub (node-pos node) (node-pos other-node)))
                     (dst (vmag v))
                     (edge (graph-nodes-connected? graph name other-name)))                    
                (vadd r (vmul (vnormalise v) 
                              (if edge  
                                  (balance-connected dst (geoedge-length edge))
                                  (balance-unconnected dst))))) r)))
    (vadd (node-pos node) (vmul (node-pos node) -0.05))
    (graph-nodes graph))))

; change the positions for each node
(define (geograph-balance graph)
  (make-graph
   (map
    (lambda (node)
      (geonode-balance node graph))
    (graph-nodes graph))
   (graph-edges graph)))

;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; a flxgraph is a fluxus visualisation of a graph

(define (flxgraph nodes edges)
    (list nodes edges))

(define (flxgraph-nodes flxgraph)
    (car flxgraph))

(define (flxgraph-edges flxgraph)
    (cadr flxgraph))

(define (flxgraph-find-node flxgraph name)
    (foldl
        (lambda (node r)
            (if (eq? (car node) name)
                node r))
        #f
        (flxgraph-nodes flxgraph)))

(define (flxgraph-find-edge flxgraph edge)
    (foldl
        (lambda (nedge r)
            (if (edge=? (car nedge) edge)
                nedge r))
        #f
        (flxgraph-edges flxgraph)))

(define (flxgraph-clean flxgraph graph)
    ;    (display (length (flxgraph-nodes flxgraph)))(newline)
    (list 
        (filter
            (lambda (n)
                (cond ((not (graph-find-node graph (car n)))
                        (destroy (cadr n))
                        #f) (else #t)))
            (flxgraph-nodes flxgraph))
        (filter
            (lambda (n)
                (cond ((not (graph-find-edge graph (car n)))
                        (destroy (cadr n))
                        #f) (else #t)))
            (flxgraph-edges flxgraph))))


(define (flxgraph-update flxgraph graph r)
    (let ((flxgraph (flxgraph-clean flxgraph graph)))
        (list
            (map
                (lambda (node)
                    (let ((n (flxgraph-find-node flxgraph (node-name node))))
                        (if n 
                            (with-primitive (cadr n)
                                (identity)
                                (translate (node-pos node))
                                (scale 0.1)
                                (rotate (vector 0 r 0))
                                ;(scale (+ 0.2 (* (ainode-size node) 0.02)))
                                ;(display (ainode-energy node))(newline)
                                #;(colour (vlerp (vector 1 1 0) (vector 1 0 0) 
                                        (ainode-energy node))) n)
                            (with-state
                                ;                                (hint-cast-shadow)
                                (translate (node-pos node))
                                (scale 0.1)
                                (hint-unlit)
                                (backfacecull 0)
                                (list (node-name node) (build-type "Bitstream-Vera-Sans-Mono.ttf" 
                                    (symbol->string (node-name node))))))))
                (graph-nodes graph))
            (map
                (lambda (edge)
                    (let ((e (flxgraph-find-edge flxgraph edge)))
                        (if e 
                            (with-primitive
                             (cadr e)
                             (pdata-set! "p" 0 (node-pos (graph-find-node graph (edge-from edge))))
                             (pdata-set! "p" 1 (node-pos (graph-find-node graph (edge-to edge)))) e)
                            (let ((p (with-state
                                      (hint-none)
                                      (hint-unlit)
                                      (hint-wire)
                                      (line-width 2)
                                      (wire-colour (vector 1 1 1))
                                      (build-ribbon 2))))
                              (with-primitive p
                                              (pdata-set! "p" 0 (node-pos (graph-find-node graph (edge-from edge))))
                                              (pdata-set! "p" 1 (node-pos (graph-find-node graph (edge-to edge)))) 
                                              (list edge p))))))
                (graph-edges graph)))))



;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; text processing stuff 

(define (string-split s c)
  (define (_ sl tl cl)
    (cond 
      ((null? sl) (if (null? cl) tl (append tl (list (list->string cl)))))
      ((eq? (car sl) c)
       (_ (cdr sl) (append tl (list (list->string cl))) '()))
      (else
       (_ (cdr sl) tl (append cl (list (car sl)))))))
  (_ (string->list s) '() '()))

(define (choose l)
  (list-ref l (random (length l))))

(define (read-string-from-file s f)
  (let ((c (read-char f)))
    (if (eof-object? c)
        s
        (read-string-from-file (string-append s (string c)) f))))

(define (file->list filename)
  (let ((f (open-input-file filename)))
    (let ((r (string-split (read-string-from-file "" f) #\ )))
      (close-input-port f) r)))

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

(define all (map string->symbol (file->list "text.txt")))
(define words (build-list 1 (lambda (_) (choose all))))

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

(define (add-node graph)
    (make-graph
        (cons (make-node (choose all) (crndvec)) (graph-nodes graph))
        (graph-edges graph)))

(define (make-new-edge graph)
    (make-geoedge     
        (node-name (choose (graph-nodes graph)))    
        (node-name (choose (graph-nodes graph))) (random 5)))

(define (add-edge graph)
    (let ((e (make-new-edge graph)))
        (if (eq? (edge-from e) (edge-to e))
            graph
            (make-graph 
                (graph-nodes graph)
                (cons e (graph-edges graph))))))


(define g (make-graph 
        (list (make-node (choose all) (crndvec)))
        (list)))


(clear)
;(flxseed 3)
;(random-seed 3)
(clear-colour 0)
(define n (flxgraph '() '()))
(define t 0)

(light-diffuse 0 (vector 0.4 0.4 0.4))
(let ((l (make-light 'point 'free)))
    (light-diffuse l (vector 1 1 1))
    (light-position l (vector 100 40 10))
    #;(shadow-light l))

(define cam (build-locator))
(lock-camera cam)
(fog (vector 0 0 0) 0 1 100)
(define r 0)

(define (animate)
    (when (> (length (graph-edges g)) 40)
        (set! g (make-graph 
                (list (make-node (choose all) (crndvec)))
                (list))))
    
    (set! r (+ r 0.2))
    (with-primitive cam (identity) (rotate (vector 0 r 0)))
    
    (when (zero? (random 100))
        (set! g (add-node g)))
    (when (zero? (random 100))
        (set! g (add-edge g)))
    
    (set! g (geograph-balance g))
    (set! n (flxgraph-update n g r))
    (set! t (+ t 1)))

(every-frame (animate))