added

hayfever/hayfever.scm

@@ -140,15 +140,15 @@
     (let ((num-children (if (> depth 3) 0 (choose (list 0 1 2 3)))))
         (cond 
             ((eq? num-children 0) (list (choose (list "2" "3" "4" "5" "6" "7" "8" "9" "10")) (list)))
-            ((eq? num-children 1) (list "1-0" (list (make-random-plant (+ depth 1)))))
-            ((eq? num-children 2) (list "2-0" (list (make-random-plant (+ depth 1))
+            ((eq? num-children 1) (list "1-1" (list (make-random-plant (+ depth 1)))))
+            ((eq? num-children 2) (list "2-1" (list (make-random-plant (+ depth 1))
                         (make-random-plant (+ depth 1)))))
-            ((eq? num-children 3) (list "3-0" (list (make-random-plant (+ depth 1))
+            ((eq? num-children 3) (list "3-1" (list (make-random-plant (+ depth 1))
                         (make-random-plant (+ depth 1)) (make-random-plant (+ depth 1)))))
-            ((eq? num-children 4) (list "4-0" (list (make-random-plant (+ depth 1))
+            ((eq? num-children 4) (list "4-1" (list (make-random-plant (+ depth 1))
                         (make-random-plant (+ depth 1)) (make-random-plant (+ depth 1)) 
                         (make-random-plant (+ depth 1)))))
-            ((eq? num-children 5) (list "5-0" (list (make-random-plant (+ depth 1))
+            ((eq? num-children 5) (list "5-1" (list (make-random-plant (+ depth 1))
                         (make-random-plant (+ depth 1)) (make-random-plant (+ depth 1))
                         (make-random-plant (+ depth 1)) (make-random-plant (+ depth 1))))))))
 
@@ -275,9 +275,10 @@
         (define/public (puff-pollen pos col size np)
             (with-primitive pollen
                 (for ((i (in-range 0 np)))
-                    (let ((c (random (pdata-size))))
+                    (let ((c (random (pdata-size)))
+                          (cc (vadd col (vmul (grndvec) 0.2))))
                         (pdata-set! "p" c (vadd (vmul (cirndvec) size) pos))
-                        (pdata-set! "c" c (vadd col (vmul (grndvec) 0.2)))))))
+                        (pdata-set! "c" c (vector (vx cc) (vy cc) (vz cc) 0.5))))))
         
         (super-new)
         (init)))
@@ -346,7 +347,7 @@
 (define network-dispatch%
     (class object%
         
-(define (stringify l)
+        (define (stringify l)
             (cond 
                 ((null? l) l)
                 ((symbol? (car l))

pluggable/pluggable.scm

@@ -0,0 +1,158 @@
+; converts a 2D vector into an angle, with some dodgy dave maths
+(define (2dvec->angle x y)
+    (let ((q (/ 3.141 2)))
+        (when (zero? y) (set! y 0.0001))
+        (cond 
+            ((>= y 0)
+                (fmod (* (+ q q q (- q (atan (/ x y)))) 57.2957795) 360))
+            (else
+                (fmod (* (+ q (- q (atan (/ x y)))) 57.2957795) 360)))))
+
+(define (i->pos i)
+    (vector (modulo i (pixels-width)) 
+        (quotient i (pixels-width)) 0))
+
+(define (pos->i pos)
+    (+ (* (round (vy pos)) (pixels-width)) (round (vx pos))))
+
+(define (pixels-ref name pos)
+    (pdata-ref name (pos->i pos)))
+
+(define (pixels-set! name pos s)
+    (pdata-set! name (pos->i pos) s))
+
+(define (search i)
+    (cond
+        ((eq? i (pdata-size)) i)
+        ((< (vr (pdata-ref "c" i)) 0.5) i)
+        (else (search (+ i 1)))))
+
+(define (flood pos tc av)
+    (define (rec-flood pos)
+        (pixels-set! "c" pos (vector 1 0 1))
+        (set! tc (+ tc 1))
+        (set! av (vadd av pos))
+        (when (< (vr (pixels-ref "c" (vadd pos (vector -1 0 0)))) 0.5)
+            (rec-flood (vadd pos (vector -1 0 0))))
+        (when (< (vr (pixels-ref "c" (vadd pos (vector 1 0 0)))) 0.5)
+            (rec-flood (vadd pos (vector 1 0 0))))
+        (when (< (vr (pixels-ref "c" (vadd pos (vector 0 1 0)))) 0.5)
+            (rec-flood (vadd pos (vector 0 1 0))))
+        (when (< (vr (pixels-ref "c" (vadd pos (vector 0 -1 0)))) 0.5)
+            (rec-flood (vadd pos (vector 0 -1 0)))))
+    (rec-flood pos)
+    (vmul av (/ 1 tc)))
+
+(define (find-centroids pos l)
+    (let ((i (search pos)))
+        (cond ((eq? i (pdata-size)) l)
+            (else
+                (find-centroids i 
+                    (cons (flood (i->pos i) 0 (vector 0 0 0)) l))))))
+
+(define (convert-to-pos l)
+    (map 
+        (lambda (cp)
+            (vector (- (- (/ (vx cp) (pixels-width)) 0.5))
+                (- 1 (/ (vy cp) (pixels-height))) 0))
+        l))
+
+;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+(define connection-cache '())
+
+(define (get-connection-list id)
+    (let ((ret (assoc id connection-cache)))
+        (cond 
+            (ret (cdr ret))
+            (else
+                (let* ((tex (load-primitive (string-append "textures/comp-cp-" id ".png")))
+                        (connections (with-primitive tex (convert-to-pos (find-centroids 0 '())))))
+                    (set! connection-cache (cons (cons id connections) connection-cache))
+                    (destroy tex)
+                    connections)))))
+
+
+;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+(define-struct component (root children))
+
+(define (build-component id children)
+    (cond 
+        ((null? children) 
+            (let ((root (with-state
+                            (translate (vector 0 0.5 0))
+                            (rotate (vector 0 0 180))
+                            (hint-ignore-depth)
+                            (texture (load-texture (string-append "textures/comp-" id ".png")))
+                            (build-plane))))
+                (with-primitive root (apply-transform))
+                (make-component root '())))
+        (else
+            (let* ((connection-list (get-connection-list id))
+                    (root (with-state
+                            (translate (vector 0 0.5 0))
+                            (rotate (vector 0 0 180))
+                            (texture (load-texture (string-append "textures/comp-" id ".png")))
+                            (build-plane)))
+                    (comp (make-component root
+                            (map
+                                (lambda (child connection)
+                                    (with-state                                        
+                            (hint-ignore-depth)
+                                        (parent root)
+                                        (translate (vector 0 0 -0.01))
+                                        (printf "~a~n" connection)
+                                        (translate connection)
+                                        (scale 0.8)
+                                        (rotate (vector 0 0 (2dvec->angle 
+                                                    (vx connection) (- (vy connection) 0.5))))
+                                        (rotate (vector 0 0 0))
+                                        (build-component (car child) (cadr child))))
+                                children
+                                connection-list))))
+                (with-primitive root (apply-transform))
+                comp))))
+
+(define (component-print component)
+    (printf "~a~n" (component-children component)))
+
+;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+(define (choose l)
+    (list-ref l (random (length l))))
+
+(define (make-random-plant depth)
+    (let ((num-children (if (> depth 10) 0 (choose (list 0 1 2 3)))))
+        (cond 
+            ((eq? num-children 0) (list (choose (list "0" "0")) (list)))
+            ((eq? num-children 1) (list "1-1" (list (make-random-plant (+ depth 1)))))
+            ((eq? num-children 2) (list "2-1" (list (make-random-plant (+ depth 1))
+                        (make-random-plant (+ depth 1)))))
+            ((eq? num-children 3) (list (string-append "3-" (choose (list "1" "2")))
+                        (list (make-random-plant (+ depth 1))
+                        (make-random-plant (+ depth 1)) (make-random-plant (+ depth 1)))))
+            ((eq? num-children 4) (list "4-1" (list (make-random-plant (+ depth 1))
+                        (make-random-plant (+ depth 1)) (make-random-plant (+ depth 1)) 
+                        (make-random-plant (+ depth 1)))))
+            ((eq? num-children 5) (list "5-0" (list (make-random-plant (+ depth 1))
+                        (make-random-plant (+ depth 1)) (make-random-plant (+ depth 1))
+                        (make-random-plant (+ depth 1)) (make-random-plant (+ depth 1))))))))
+
+(clear)
+(clear-colour (vector 1 1 1))
+(clear-geometry-cache)
+(clear-texture-cache)
+(hint-unlit)
+;(opacity 0.5)
+(define p (make-random-plant 0))
+(display p) (newline)
+
+(define c (build-component "1-1" (list p)))
+
+
+
+
+
+
+