final fixes for v6 - new textures and camera changes

2009-07-10 11:08:41 +01:00 · 2009-07-10 11:08:41 +01:00 · fb334fe4eb
commit fb334fe4eb
parent cf6745c139
12 changed files with 170 additions and 123 deletions
--- a/plant-eyes/plant-eyes.scm
+++ b/plant-eyes/plant-eyes.scm
@ -1,5 +1,5 @@
-#lang scheme/base
-(require fluxus-016/drflux)
+;#lang scheme/base
+;(require fluxus-016/drflux)
 (require scheme/class)

 ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@ -32,29 +32,35 @@
 ; * in the same way, the line segments can be created in any way by the logic 
 ;   side - eg. lsystem, or different methods per plant (or per twig even)

+(define (ornament-colour) (vector 0.5 1 0.4))
+(define (pickup-colour) (vector 1 1 1))
+(define (earth-colour) (vector 0.2 0.1 0))
+
+(define wire-mode #f)
+(define fog-col (earth-colour))
+(define fog-strength 0.001)
+
 (define debug-messages #f) ; prints out all the messages sent to the renderer
-(define logic-tick 1) ; time between logic updates
+(define logic-tick 0.5) ; time between logic updates

 (define branch-probability 6) ; as in one in branch-probability chance
 (define branch-width-reduction 0.5)
 (define twig-jitter 0.1)
 (define branch-jitter 0.5)
-(define max-twig-points 20)
-(define start-twig-dist 0.3)
-(define start-twig-width 0.3)
+(define max-twig-points 30)
+(define start-twig-dist 0.05)
+(define start-twig-width 0.2)
 (define default-max-twigs 10)
 (define default-scale-factor 1.05)
-(define default-grow-speed 1)
+(define default-grow-speed (/ 1 logic-tick))
 (define root-camera-time (* max-twig-points logic-tick))
 (define num-pickups 10)
-(define pickup-dist-radius 20)
+(define pickup-dist-radius 200)
 (define pickup-size 1)
 (define max-ornaments 2) ; per twig
 (define ornament-grow-probability 4)
 (define curl-amount 40)
-
-(define (ornament-colour) (vector 0.5 1 0.4))
-(define (pickup-colour) (vector 1 1 1))
+(define start-size 50)

 (define (assoc-remove k l)
  (cond
@ -133,6 +139,7 @@
 (define twig-logic%
  (class game-logic-object%
    (init-field
+     (last-point (vector 0 0 0))      
     (id #f)               ; our id (for matching up with the renderer geometry)
     (plant #f)            ; the plant we belong to
     (type 'root)          ; or 'shoot
@ -144,14 +151,18 @@
    
    (field
     (points '())     ; the 3d points for this twig
+     (widths '())
     (twigs '())      ; children are stored with the point number they are connected to.
     (ornaments '())  ; the things attached to this twig, an assoc list with point index
-     (last-point (vector 0 0 0)) ; distance between points     
     (branch #f)   ; are we a main branch twig?
+     (w 0)                ; the width of this segment
     (curl (vmul (crndvec) curl-amount))) ; the angles to turn each point, if curly  
    
    (inherit send-message)

+    (define/public (set-pos s)
+      (set! last-point s))
+    
    (define/public (get-id)
      id)
    
@ -195,42 +206,41 @@
      (when (< (length points) num-points)
        (let ((new-point (if (zero? (length points))
                             ; first point should be at edge of the seed if we are a branch
-                             (if branch (vmul dir 1) (vector 0 0 0))
+                             (if branch (vadd last-point (vmul dir dist)) 
+                                 last-point)
                             (vadd last-point (vmul dir dist)))))
          
-          (set! dir (vmix dir ndir 0.5))
-          
-          #;(cond (curly
-            (set! dir (vtransform dir (mrotate curl)))
-            (when (not branch) 
-              (set! curl (vmul curl 1.2))
-              (set! dist (* dist 0.9))))
-                (else
-                 (set! dir (vadd dir (vmul (srndvec) twig-jitter)))))
+          (set! dir ndir)
+          (set! w (* width (- 1 (/ (length points) num-points))))                  
          
          (set! last-point new-point)
          (set! points (append points (list new-point)))
+          (set! widths (append widths (list w)))
          (send-message 'twig-grow (list 
                                    (list 'plant-id (send plant get-id))
                                    (list 'twig-id id)
-                                    (list 'point new-point))))
-        (when (and (> (length points) 1) (> num-points 1) 
+                                    (list 'point new-point)
+                                    (list 'width w)))
+        #;(when (and (> (length points) 1) (> num-points 1) 
                   (zero? (random branch-probability)))
-          (add-twig (- (length points) 1) 
-                    (make-object twig-logic% (send plant get-next-twig-id) 
-                      plant 
-                      type 
-                      (vadd dir (vmul (srndvec) branch-jitter))
-                      (* width branch-width-reduction)
-                      (quotient num-points 2)
-                      render-type
-                      dist))))
+          (add-twig (- (length points) 1) (vadd dir (vmul (srndvec) branch-jitter))))))
      (for-each
       (lambda (twig)
         (send (cadr twig) grow ndir))
       twigs))
    
-    (define/public (add-twig point-index twig)
+    (define/public (add-twig point-index dir)
+      (let ((twig (make-object twig-logic% 
+                    (get-point point-index)
+                      (send plant get-next-twig-id)
+                      plant 
+                      type 
+                      dir
+                      (list-ref widths point-index)
+                      (quotient num-points 2)
+                      render-type
+                      dist)))
+      
      (send-message 'new-twig (list 
                               (list 'plant-id (send plant get-id))
                               (list 'parent-twig-id id)
@ -242,7 +252,8 @@
                               (list 'num-points (send twig get-num-points))
                               (list 'render-type (send twig get-render-type))
                               ))
-      (set! twigs (cons (list point-index twig) twigs)))
+      (set! twigs (cons (list point-index twig) twigs))
+        twig))
    
    (define/public (get-twig point-index)
      (cadr (assq point-index twigs)))
@ -377,7 +388,7 @@
     (twigs '())     ; a assoc list map of ages to twigs
     (properties '()) ; a list of symbols - properties come from pickups
     (ornaments '()) ; map of ids to ornaments on the plant
-     (size 5)         ; the age of this plant
+     (size start-size)         ; the age of this plant
     (max-twigs default-max-twigs) ; the maximum twigs allowed at any time - oldest removed first
     (next-twig-id 0)
     (next-ornament-id 0)
@ -442,6 +453,7 @@
      (set! size (* size grow-amount))
      (send twig scale size)  
      (send twig set-branch! #t)
+      (send twig set-pos pos)

      (send-message 'grow-seed (list 
                                (list 'plant-id id)
@ -702,10 +714,10 @@
      (define/public (add-child-twig-id twig-id)
        (set! child-twig-ids (cons twig-id child-twig-ids)))
      
-      (define/pubment (grow point)
+      (define/pubment (grow point width)
    (let ((growing-noise (oa-load-sample (fullpath "snd/event01.wav")))) 
      (oa-play growing-noise (vector 0 0 0) (rndf) 0.3))
-        (inner (void) grow point))
+        (inner (void) grow point width))

      (define/public (add-ornament point-index property)
        (when (< (length ornaments) max-ornaments)
@ -761,7 +773,7 @@
        (with-primitive root
                        (pdata-ref "p" point-index)))
     
-      (define/augment (grow point)
+      (define/augment (grow point width)
        (with-primitive root
                        (pdata-index-map! ; set all the remaining points to the end
                         (lambda (i p)    ; in order to hide them
@ -773,7 +785,7 @@
                         (lambda (i w)    
                           (if (< i (+ index 1))
                               w
-                               radius))
+                               width))
                         "w"))
        (set! index (+ index 1)))

@ -798,25 +810,20 @@
       (widths '()))
      
      (define/override (build)
-       (set! profile (build-circle-profile 7 1))
-       (set! path (build-list num-points (lambda (n) (vector 0 0 0))))
-       (set! widths (build-list num-points (lambda (n) (let ((t (/ n num-points)))
-                                                         (if (eq? n (- num-points 1)) 0
-                                                             (* radius  
-                                                                (if (zero? t) 1
-                                                                    (+ (* t 0.5)
-                                                                       (* (- (/ 1 t) 1) 0.1)))))))))
+       (set! profile (build-circle-profile 12 1))
+       (set! path (build-list num-points (lambda (_) (vector 0 0 0))))
+       (set! widths (build-list num-points (lambda (_) 1)))
       (set! root (let ((p (with-state
                            (backfacecull 0)
-                            ;(hint-none)
-                            ;(hint-wire)
-                       (translate pos)
-                       (texture (load-texture "textures/skin.png"))
-                       (opacity 0.6)
+                            (when wire-mode 
+                              (hint-none)
+                              (hint-wire))
+                       (texture (load-texture "textures/root2.png"))
+                       ;(opacity 0.6)
                       (colour (vmul (vector 0.8 1 0.6) 2))
                       #;(colour (vector 1 1 1))
                       #;(texture (load-texture "textures/root.png")) 
-                       (build-partial-extrusion profile path 6))))
+                       (build-partial-extrusion profile path 3))))
               p)))
      
      (define/override (get-root)
@ -830,22 +837,21 @@
              ((zero? c) (cons s (list-set (cdr l) (- c 1) s)))
              (else (cons (car l) (list-set (cdr l) (- c 1) s)))))
      
-      (define/augment (grow point)
-        #;(when (zero? index) (set! path (list-set path index point)))
-        (set! path (list-set path (+ index 1) point))
+      (define/augment (grow point width)
+        (set! path (list-set path index point))
+        (set! widths (list-set widths index width))
        (set! anim-t 0)
        (set! index (+ index 1)))

      (define/augment (update t d)                   
        (when (< anim-t 1)
          (with-primitive root
-            (partial-extrude (+ (- index 1) anim-t) 
+            (partial-extrude (+ (- index 2) anim-t) 
                             profile path widths (vector 1 0 0) 0.05)))
        (set! anim-t (+ anim-t (* d grow-speed))))
      
      (define/public (get-end-pos)
-        (with-primitive root
-                        (pdata-ref "p" (* index (length profile)))))
+        (with-primitive root (pdata-ref "p" (- (* index (length profile)) 1))))

      (super-new)))

@ -866,13 +872,16 @@
               (build-locator)))
        (seed (with-state
               (parent root)
-               (texture (load-texture "textures/skin.png"))
+               (texture (load-texture "textures/root2.png"))
               (backfacecull 0)
               (opacity 0.6)
               (colour (vector 0.8 1 0.6))
               (hint-depth-sort)
-               (scale 0.5)
-               (hint-unlit)
+               (scale (* 0.12 start-size))
+                            (when wire-mode 
+                              (hint-none)
+                              (hint-wire))
+               ;(hint-unlit)
               (load-primitive "meshes/seed.obj"))))
        
      (define/public (get-id)
@ -902,11 +911,11 @@
      (define/public (add-twig parent-twig-id point-index twig)     
        (let ((ptwig (get-twig parent-twig-id)))
          ; attach to parent twig              
+          (send twig set-pos! (send ptwig get-point point-index))
+          (send twig build)
          (with-primitive (send twig get-root)
                          (parent (send ptwig get-root)))
   
-          (send twig set-pos! (send ptwig get-point point-index))
-          (send twig build)
          
          ; tell the twigs about this relationship (might turn out to be overkill)
          (send ptwig add-child-twig-id (send twig get-id))
@ -914,8 +923,8 @@
          
          (set! twigs (cons (list (send twig get-id) twig) twigs))))      
      
-      (define/public (grow-twig twig-id point)
-        (send (get-twig twig-id) grow point)) 
+      (define/public (grow-twig twig-id point width)
+        (send (get-twig twig-id) grow point width)) 
      
      (define/public (grow-seed amount)
        (with-primitive seed (scale amount)))
@ -937,16 +946,22 @@

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

-(define (build-env-box top bottom left right front back)    
+(define (build-env-box top bottom left right front back lower)    
  (let ((p (build-locator)))
    (with-state
     (parent p)
  (hint-unlit)  
-  (with-state
+  
+  (let ((t (with-state
        (texture (load-texture top))
        (translate (vector 0 0.5 0))
        (rotate (vector 90 0 0))
-        (build-plane))
+        (build-plane))))
+      (when lower (with-primitive t
+                      (pdata-map!
+                       (lambda (t)
+                         (vmul t 10))
+                       "t"))))
    
    (with-state
        (texture (load-texture left))
@ -972,11 +987,13 @@
        (rotate (vector 0 90 0))
        (build-plane))
    
+    (when lower
      (with-state
        (texture (load-texture bottom))
        (translate (vector 0 -0.5 0))
        (rotate (vector 90 0 0))        
-        (build-plane))
+        (build-plane)))
+                         
    p)))

 ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@ -988,7 +1005,7 @@
     (plants '()) ; map of ids -> plants     
     (pickups '()) ; map of ids -> pickups
     (camera-dist 1)
-     (env-root (with-state (scale 20) (build-locator)))
+     (env-root (with-state (scale 1000) (build-locator)))
     (root-camera-t 0)
     #;(upper-env (with-state
                 (parent env-root)
@ -1005,6 +1022,23 @@
                 (build-env-box "textures/bottom-trans.png" "textures/bottom.png" 
                                "textures/sleft.png" "textures/sright.png"
                                "textures/sfront.png" "textures/sback.png")))
+    (upper-env (with-state
+                 (parent env-root)
+                 ;(hint-depth-sort)
+                 (hint-unlit)
+                 (translate (vector 0 0.28 0))
+                 (build-env-box "textures/sky-top.png" "textures/floor.png" 
+                                "textures/sky-side.png" "textures/sky-side.png"
+                                "textures/sky-side.png" "textures/sky-side.png" #f)))
+    (lower-env (with-state
+                (parent env-root)
+                 ;(hint-depth-sort)
+                 (hint-unlit)
+                 (colour (earth-colour))
+                 (translate (vector 0 -0.22001 0))
+                 (build-env-box "textures/floor.png" "textures/earth-bottom.png" 
+                                "textures/earth-side.png" "textures/earth-side.png"
+                                "textures/earth-side.png" "textures/earth-side.png" #t)))
    (nutrients (let ((p (with-state
                            (hint-depth-sort)
                            (texture (load-texture "textures/particle.png"))
@ -1012,7 +1046,7 @@
                        (with-primitive p
                            (pdata-map! 
                                (lambda (p)
-                                    (vmul (vadd (crndvec) (vector 0 -1 0)) 90))
+                                    (vmul (vadd (crndvec) (vector 0 -1 0)) 900))
                                "p")
                            (pdata-map! 
                                (lambda (s)
@ -1026,10 +1060,9 @@
      (light-diffuse l (vector 1 1 1))
      (light-position l (vector 10 50 -4)))

-      (clear-colour (vector 0.5 0.3 0.2))
-      
-      (fog (vector 0.5 0.3 0.2) 0.02 1 100)
-      #;(fog (vector 0.2 0.5 0.3) 0.02 1 100))
+      (clear-colour fog-col)
+      (clip 0.5 10000)
+      (fog fog-col fog-strength 1 100))
    
    (define/public (add-plant plant)
      (set! plants (cons (list (send plant get-id) plant) plants)))
@ -1146,7 +1179,8 @@
           ((eq? (send msg get-name) 'twig-grow)
            (send (get-plant (send msg get-data 'plant-id)) grow-twig
                  (send msg get-data 'twig-id)
-                  (send msg get-data 'point)))
+                  (send msg get-data 'point)
+                  (send msg get-data 'width)))
           
           ((eq? (send msg get-name) 'new-pickup)
            (add-pickup 
@ -1210,22 +1244,29 @@
    
    (define/public (setup)
      (lock-camera cam)
-      (camera-lag 0.1)
+      (camera-lag 0.2)
      (clip 1 1000)
-      (set-camera-transform (mtranslate (vector 0 0 -1))))
+      (set-camera-transform (mtranslate (vector 0 0 -4))))
    
    (define/public (update)
      (when (key-pressed-this-frame " ")
-        (set! current-twig (make-object twig-logic% 0 player-plant 'root 
+        (cond ((and current-twig (not current-twig-growing))      
+                 (let ((new-twig (send current-twig add-twig current-point 
+                                       (vector 0 1 0) #;(vsub (send current-twig get-point current-point)
+                                             (send current-twig get-point (- current-point 1))))))
+                 (set! current-twig-growing #t)
+                 (set! current-twig new-twig)))
+              (else
+               (set! current-twig (make-object twig-logic%  (vector 0 0 0) 0 player-plant 'root 
                                    (vmul fwd -1)
                                    start-twig-width max-twig-points 'extruded))
        (send player-plant add-twig current-twig)
-        (set! current-twig-growing #t))
+        (set! current-twig-growing #t))))
      
-      (when (or (key-pressed "a") (key-special-pressed 100)) (set! yaw (+ yaw 1)))
-      (when (or (key-pressed "d") (key-special-pressed 102)) (set! yaw (- yaw 1)))
-      (when (or (key-pressed "w") (key-special-pressed 101)) (set! tilt (+ tilt 1)))
-      (when (or (key-pressed "s") (key-special-pressed 103)) (set! tilt (- tilt 1)))      
+      (when (or (key-pressed "a") (key-special-pressed 100)) (set! yaw (+ yaw 2)))
+      (when (or (key-pressed "d") (key-special-pressed 102)) (set! yaw (- yaw 2)))
+      (when (or (key-pressed "w") (key-special-pressed 101)) (set! tilt (+ tilt 2)))
+      (when (or (key-pressed "s") (key-special-pressed 103)) (set! tilt (- tilt 2)))      
      
      ; clamp tilt to prevent gimbal lock
      (when (> tilt 88) (set! tilt 88))
@ -1233,7 +1274,7 @@
      
      (when (key-pressed-this-frame "q")
        (cond ((not current-twig)
-               (set! current-twig (send player-plant get-twig-from-dir (vmul fwd 1)))
+               (set! current-twig (send player-plant get-twig-from-dir (vmul fwd -1)))
               (set! current-point 2))
              (else
               (when (< current-point (- (send current-twig get-num-points) 1))
@ -1245,33 +1286,35 @@
               (when (< current-point 2)
                 (set! current-twig #f)
                 (set! pos (vector 0 0 0))
-                 (set-camera-transform (mtranslate (vector 0 0 -1)))))))                     
-      
-      ; if we are on a twig not growing
-      (cond ((and current-twig (not current-twig-growing))
-             (set! pos (send current-twig get-point current-point))
-             (when (> current-point 0)
-               (set! fwd (vnormalise (vsub (send current-twig get-point (- current-point 1))
-                                           pos)))))
-            
-            (else
-             (when current-twig-growing
-               (set-camera-transform (mtranslate (vector 0 0 0)))
-               (let ((twig-view (send (send game-view get-plant (send player-plant get-id))
-                                      get-twig (send current-twig get-id))))
-                 (when twig-view
-                   (set! pos (vsub (send twig-view get-end-pos) 
-                                   (vmul (send current-twig get-dir) 5)))))
-               (when (eq? (send current-twig get-num-points) 
-                          (send current-twig get-length))
-                 (set! current-twig-growing #f)
-                 (set! current-twig #f)))
+                 #;(set-camera-transform (mtranslate (vector 0 0 -1)))))))                     

                   ; get camera fwd vector from key-presses                   
             (set! fwd (vtransform (vector 0 0 1) 
                                   (mmul 
                            (mrotate (vector 0 yaw 0))
-                            (mrotate (vector tilt 0 0)))))))      
+                            (mrotate (vector tilt 0 0)))))
+
+      
+      ; if we are on a twig not growing
+      (cond ((and current-twig (not current-twig-growing))
+             (set! pos (send current-twig get-point current-point))
+             #;(when (> current-point 0)
+               (set! fwd (vmix fwd (vnormalise (vsub (send current-twig get-point 
+                                                           (- current-point 1))
+                                           pos)) 0.5))))
+            
+            (else
+             (when current-twig-growing
+               (let ((twig-view (send (send game-view get-plant (send player-plant get-id))
+                                      get-twig (send current-twig get-id))))
+                 (when twig-view
+                   (set! pos (vsub (send twig-view get-end-pos) 
+                                   (vmul (send current-twig get-dir) 1)))))
+               (when (eq? (send current-twig get-num-points) 
+                          (send current-twig get-length))
+                 (set! current-twig-growing #f)
+                 (set! current-point (- (send current-twig get-num-points) 1))))))
+                     
      
      (let* ((side (vnormalise (vcross up fwd)))
             (up (vnormalise (vcross fwd side))))
@ -1297,14 +1340,14 @@
 (send gl setup)

 (define plant1 (make-object plant-logic% "dave@fo.am" (vector 0 0 0)))
-(define plant2 (make-object plant-logic% "plant00001@fo.am" (vector 0 0 9)))
+(define plant2 (make-object plant-logic% "plant00001@fo.am" (vector 0 0 90)))

 (send c set-player-plant plant1)
      
 (send gl add-plant plant1)
 (send gl add-plant plant2)

-(send plant2 add-twig (make-object twig-logic% 0 plant2 'root (vector 0 -1 0) start-twig-width 10 'ribbon))
+(send plant2 add-twig (make-object twig-logic% (vector 0 0 0) 0 plant2 'root (vector 0 -1 0) start-twig-width 10 'ribbon))

 (define tick-time 0)

--- a/plant-eyes/textures/earth-bottom.png
+++ b/plant-eyes/textures/earth-bottom.png
--- a/plant-eyes/textures/earth-side.png
+++ b/plant-eyes/textures/earth-side.png
--- a/plant-eyes/textures/earth-top.png
+++ b/plant-eyes/textures/earth-top.png
--- a/plant-eyes/textures/floor.png
+++ b/plant-eyes/textures/floor.png
--- a/plant-eyes/textures/grid.png
+++ b/plant-eyes/textures/grid.png
--- a/plant-eyes/textures/root2.png
+++ b/plant-eyes/textures/root2.png
--- a/plant-eyes/textures/sky-side.png
+++ b/plant-eyes/textures/sky-side.png
--- a/plant-eyes/textures/sky-top.png
+++ b/plant-eyes/textures/sky-top.png
--- a/plant-eyes/textures/v5roots.png
+++ b/plant-eyes/textures/v5roots.png
--- a/plant-eyes/textures/v5roots2.png
+++ b/plant-eyes/textures/v5roots2.png
--- a/roots/roots.scm
+++ b/roots/roots.scm
@ -8,16 +8,16 @@
        (vector x y 0)))

 (define (build-ellipse rmin rmaj num-verts)
-    (define p (build-polygons (* 3 num-verts) 'triangle-list))
+    (define p (build-polygons num-verts 'polygon))
    (with-primitive p
-        (for ([i (in-range 0 (* 3 num-verts) 3) ])
-            (pdata-set! "p" i (vector 0 0 0))
-            (pdata-set! "n" i (vector 0 0 1))
-            (pdata-set! "p" (+ i 1) (calc-xyz (/ i 3) num-verts rmin))
-            (pdata-set! "n" (+ i 1) (vnormalise (calc-xyz (/ i 3) num-verts rmin)))
-            (pdata-set! "p" (+ i 2) (calc-xyz (+ (/ i 3) 1) num-verts rmin))
-            (pdata-set! "n" (+ i 2) (vnormalise (calc-xyz (+ (/ i 3) 1) num-verts rmin))))
-        (poly-convert-to-indexed))
+        (for ([i (in-range 0 num-verts)])
+            ;(pdata-set! "p" i (vector 0 0 0))
+            ;(pdata-set! "n" i (vector 0 0 1))
+            (pdata-set! "p" i (calc-xyz i num-verts rmin))
+            #;(pdata-set! "n" i (vnormalise (calc-xyz i num-verts rmin)))
+            ;(pdata-set! "p" (+ i 2) (calc-xyz (+ (/ i 3) 1) num-verts rmin))
+            #;(pdata-set! "n" (+ i 2) (vnormalise (calc-xyz (+ (/ i 3) 1) num-verts rmin))))
+        #;(poly-convert-to-indexed))
    p)

 (define-struct stones ((pos-list #:mutable) size-list (root #:mutable) (obj-list #:mutable)))
@ -42,7 +42,7 @@
                    (parent root)
                    (map
                        (lambda (pos size)
-                            (if (and (< size 0.4) (zero? (random 3)))
+                            (if (and #f (< size 0.4) (zero? (random 3)))
                                (let ((o (with-state
                                                (hint-unlit)
                                                (scale 0.2)
@ -51,9 +51,13 @@
                                    (with-primitive o (apply-transform))
                                    o)
                                (with-state
-                                    ;(hint-unlit)
+                                    ;(hint-none)
+                                    (hint-wire)
+                                    (hint-unlit)
+                                    (line-width 2)
+                                    (wire-colour 0)
                                    (hint-ignore-depth)
-                                    (colour (hsv->rgb (vector (+ 0 (* 0.2 (rndf))) 0.5 (+ 0.1 (rndf)))))
+                                    (colour (hsv->rgb (vector (+ -0.1 (* 0.2 (rndf))) 0.5 (+ 0.1 (rndf)))))
                                    (translate pos)
                                    (build-ellipse size size 32))))
                        (stones-pos-list stones)
@ -146,12 +150,12 @@
 (light-diffuse 0 (vector 0.2 0.2 0.2))
 (light-diffuse l (vector 1 1 1))

-(define s (stones-build (stones-init 100 5 1)))
+(define s (stones-build (stones-init 1000 5 1)))

-(define roots (build-list 10 (lambda (_) (build-root (* 5 (crndf))))))
+#;(define roots (build-list 10 (lambda (_) (build-root (* 5 (crndf))))))

 (define (animate)
-    (for-each
+    #;(for-each
        (lambda (root)
            (with-primitive root
                (nudge s 0.01)