diff --git a/hayfever/hayfever.scm b/hayfever/hayfever.scm new file mode 100644 index 0000000..88acb9a --- /dev/null +++ b/hayfever/hayfever.scm @@ -0,0 +1,421 @@ +;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +(require scheme/class) +(require mzlib/string) + +(osc-destination "osc.udp://127.0.0.255:4001") +(osc-source "4002") + +;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +; pixel primitive things for getting connection points + +; 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)) + +;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +; a cache for the connection points - should save this out + +(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))))) + + +;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +; a plant component + +(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)) + (texture (load-texture (string-append "textures/comp-" id ".png"))) + (build-plane)))) + (make-component root '()))) + (else + (let* ((connection-list (get-connection-list id)) + (root (with-state + (translate (vector 0 0.5 (* 0.1 (rndf)))) + (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 + (parent root) + (translate (vadd connection (vector 0 0 (* 0.1 (rndf))))) + (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 (random-leaf component) + (cond + ((null? (component-children component)) component) + (else (random-leaf (choose (component-children component)))))) + + +(define (component-print component) + (printf "~a~n" (component-children component))) + +;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +; utils for building random plants + +(define (choose l) + (list-ref l (random (length l)))) + +(define (make-random-plant depth) + (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)) + (make-random-plant (+ depth 1))))) + ((eq? num-children 3) (list "3-0" (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)) + (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)))))))) + +;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +; the world things live in + +(define world% + (class object% + (init-field (size 1)) + + (field + (root 0) + (entity-list '()) + (id 0) + (pollen 0)) + + (define/public (init) + + (set! pollen (with-state + (translate (vector 0 0 0.1)) + (texture (load-texture "textures/pollen.png")) + (build-particles 300))) + + (with-primitive pollen + (hint-depth-sort) + (pdata-map! + (lambda (p) + (vmul (vector (crndf) (crndf) 0) 10)) + "p") + (pdata-map! + (lambda (c) + (vector (rndf) (rndf) (rndf) 0.5)) + "c") + (pdata-map! + (lambda (c) + (let ((s (* 0.1 (grndf)))) + (vector s s 1))) + "s")) + + + #;(set! root (with-state + (rotate (vector 90 0 0)) + (scale 100) + (build-plane))) + (with-state + (hint-depth-sort) + ; (parent root) + (with-state + (colour 0.5) + (scale (vector 20 13 1)) + (translate (vector 0 0.4 0)) + (rotate (vector 0 0 180)) + (texture (load-texture "textures/bg.png")) + (hint-unlit) + (build-plane)) + (with-state + (scale (vector 19 8 1)) + (translate (vector 0 0.2 1.5)) + (rotate (vector 0 0 180)) + (texture (load-texture "textures/mid.png")) + (hint-unlit) + (build-plane)))) + + (define (inc-id!) + (set! id (+ id 1))) + + (define/public (get-entity-list) + entity-list) + + (define/public (get-entity id) + (foldl + (lambda (entity ret) + (if (eq? (send entity get-id) id) + entity + ret)) + #f + entity-list)) + + (define/public (choose) + (list-ref entity-list (random (length entity-list)))) + + (define/public (add-entity entity) + (inc-id!) + (send entity set-id! id) + (set! entity-list (cons entity entity-list)) + id) + + (define/public (destroy-entity id) + (set! plants + (filter + (lambda (entity) + (cond ((eq? (send entity get-id) id) + (send entity destroy) + #f) + (else #t))) + entity-list))) + + (define/public (update) + (with-primitive pollen + (animate-pollen)) + (for-each + (lambda (entity) + (send entity update this)) + entity-list)) + + ; pollen stuff + + (define (animate-pollen) + (pdata-map! + (lambda (p) + (let* ((pp (vmul p 0.5)) + (v (vector (- (noise (vx pp) (vy pp) (time)) 0.5) + (- (noise (vx pp) (+ (vy pp) 112.3) (time)) 0.5) 0))) + (vadd (vadd p (vmul v 0.2)) + (vmul (vector (crndf) (crndf) 0) 0.01)))) + "p")) + + (define (cirndvec) + (let ((o (srndvec))) + (vector (vx o) (vy o) 0))) + + (define/public (puff-pollen pos col size np) + (with-primitive pollen + (for ((i (in-range 0 np))) + (let ((c (random (pdata-size)))) + (pdata-set! "p" c (vadd (vmul (cirndvec) size) pos)) + (pdata-set! "c" c (vadd col (vmul (grndvec) 0.2))))))) + + (super-new) + (init))) + +;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +; the entity base class + +(define entity% + (class object% + (init-field (id 0)) + + (define/public (get-id) + id) + + (define/public (set-id! s) + (set! id s)) + + (super-new))) + +;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +; finally, a plant... + +(define plant% + (class entity% + (init-field + (pos (vector 0 0 0)) + (col (vector 1 1 1)) + (plant-desc '())) + + (field + (root-component 0) + (spray-t 0)) + + (define/public (init) + (with-state + (hint-depth-sort) + ;(parent (send world get-root)) + ;(colour col) + (hint-unlit) + (translate pos) + (printf "building from:~a~n" plant-desc) + (set! root-component (build-component "1-0" plant-desc)))) + + (define/public (destroy-plant) + (destroy root)) + + (define/public (update world) + 0 + #;(with-primitive root + (colour col) + (when (> spray-t 1) + (set! spray-t (* spray-t 0.9)) + (colour spray-t)))) + + (define/public (spray world type) + (let ((pos (vtransform (vector 0 0 0) + (with-primitive (component-root (random-leaf root-component)) + (get-global-transform))))) + (send world puff-pollen pos (vector 1 1 1) 0.2 100))) + + (super-new) + (init))) + +;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +(define network-dispatch% + (class object% + +(define (stringify l) + (cond + ((null? l) l) + ((symbol? (car l)) + (cons (symbol->string (car l)) + (stringify (cdr l)))) + ((number? (car l)) + (cons (number->string (car l)) + (stringify (cdr l)))) + ((list? (car l)) + (cons (stringify (car l)) (stringify (cdr l)))) + (else (error "oops")))) + + + (define/public (dispatch world) + (cond + ((osc-msg "/add-plant") + (printf "add plant message recieved : ~a~n" (osc 6)) + (send world add-entity (make-object plant% + (vector (osc 0) (osc 1) (osc 2)) + (vector (osc 3) (osc 4) (osc 5)) + (stringify (eval-string (osc 6)))))) + ((osc-msg "/destroy-plant") + (printf "destroy plant message recieved...~n") + (send world destroy-entity (osc 0))) + ((osc-msg "/spray") + ; (printf "destroy plant message recieved...~n") + (send (send world get-entity (osc 0)) spray world (osc 1))))) + + (define/public (add-plant world) + (printf "sending add plant...~n") + + (let* ((pos (vector (* (crndf) 5) 2 1)) + (col (rndvec)) + (desc (list (make-random-plant 0))) + (desc-str (format "'~a" desc))) + (printf "sending:~a~n" desc-str) + (osc-send "/add-plant" "ffffffs" (list (vx pos) (vy pos) (vz pos) + (vx col) (vy col) (vz col) desc-str)) + (send world add-entity (make-object plant% pos col desc)))) + + (define/public (destroy-plant world id) + (printf "sending destroy plant...~n") + (osc-send "/destroy-plant" "i" (list id)) + (send world destroy-entity id)) + + (define/public (spray world id type) + ; (printf "sending destroy plant...~n") + (osc-send "/spray" "ii" (list id type)) + (send (send world get-entity id) spray world type)) + + (super-new))) + +;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +(clear) +(clear-colour 0) +(set-camera-transform (mtranslate (vector 0 -5 -10))) + +(define w (make-object world% 1)) +(define n (make-object network-dispatch%)) + + +(define (animate) + (when (key-pressed " ") (send n add-plant w)) + (send n dispatch w) + (send w update) + (when (and (zero? (random 50)) (not (null? (send w get-entity-list))) ) + (send n spray w (send (send w choose) get-id) 0))) + +(every-frame (animate)) + + diff --git a/hayfever/textures/bg.png b/hayfever/textures/bg.png new file mode 100644 index 0000000..f0c3430 Binary files /dev/null and b/hayfever/textures/bg.png differ diff --git a/hayfever/textures/comp-0.png b/hayfever/textures/comp-0.png new file mode 100644 index 0000000..4884f2e Binary files /dev/null and b/hayfever/textures/comp-0.png differ diff --git a/hayfever/textures/comp-1-0.png b/hayfever/textures/comp-1-0.png new file mode 100644 index 0000000..e707cb3 Binary files /dev/null and b/hayfever/textures/comp-1-0.png differ diff --git a/hayfever/textures/comp-1.png b/hayfever/textures/comp-1.png new file mode 100644 index 0000000..5418075 Binary files /dev/null and b/hayfever/textures/comp-1.png differ diff --git a/hayfever/textures/comp-10.png b/hayfever/textures/comp-10.png new file mode 100644 index 0000000..e4c2be7 Binary files /dev/null and b/hayfever/textures/comp-10.png differ diff --git a/hayfever/textures/comp-2-0.png b/hayfever/textures/comp-2-0.png new file mode 100644 index 0000000..315d931 Binary files /dev/null and b/hayfever/textures/comp-2-0.png differ diff --git a/hayfever/textures/comp-2.png b/hayfever/textures/comp-2.png new file mode 100644 index 0000000..28d635c Binary files /dev/null and b/hayfever/textures/comp-2.png differ diff --git a/hayfever/textures/comp-3-0.png b/hayfever/textures/comp-3-0.png new file mode 100644 index 0000000..453b630 Binary files /dev/null and b/hayfever/textures/comp-3-0.png differ diff --git a/hayfever/textures/comp-3.png b/hayfever/textures/comp-3.png new file mode 100644 index 0000000..30e6680 Binary files /dev/null and b/hayfever/textures/comp-3.png differ diff --git a/hayfever/textures/comp-4-0.png b/hayfever/textures/comp-4-0.png new file mode 100644 index 0000000..ae8d18f Binary files /dev/null and b/hayfever/textures/comp-4-0.png differ diff --git a/hayfever/textures/comp-4.png b/hayfever/textures/comp-4.png new file mode 100644 index 0000000..9d0e243 Binary files /dev/null and b/hayfever/textures/comp-4.png differ diff --git a/hayfever/textures/comp-5-0.png b/hayfever/textures/comp-5-0.png new file mode 100644 index 0000000..e4038d2 Binary files /dev/null and b/hayfever/textures/comp-5-0.png differ diff --git a/hayfever/textures/comp-5.png b/hayfever/textures/comp-5.png new file mode 100644 index 0000000..c9dc309 Binary files /dev/null and b/hayfever/textures/comp-5.png differ diff --git a/hayfever/textures/comp-6.png b/hayfever/textures/comp-6.png new file mode 100644 index 0000000..950d75f Binary files /dev/null and b/hayfever/textures/comp-6.png differ diff --git a/hayfever/textures/comp-7.png b/hayfever/textures/comp-7.png new file mode 100644 index 0000000..4a2dec4 Binary files /dev/null and b/hayfever/textures/comp-7.png differ diff --git a/hayfever/textures/comp-8.png b/hayfever/textures/comp-8.png new file mode 100644 index 0000000..dac8002 Binary files /dev/null and b/hayfever/textures/comp-8.png differ diff --git a/hayfever/textures/comp-9.png b/hayfever/textures/comp-9.png new file mode 100644 index 0000000..4feb191 Binary files /dev/null and b/hayfever/textures/comp-9.png differ diff --git a/hayfever/textures/comp-cp-1-0.png b/hayfever/textures/comp-cp-1-0.png new file mode 100644 index 0000000..bf452ba Binary files /dev/null and b/hayfever/textures/comp-cp-1-0.png differ diff --git a/hayfever/textures/comp-cp-2-0.png b/hayfever/textures/comp-cp-2-0.png new file mode 100644 index 0000000..be3f7e9 Binary files /dev/null and b/hayfever/textures/comp-cp-2-0.png differ diff --git a/hayfever/textures/comp-cp-3-0.png b/hayfever/textures/comp-cp-3-0.png new file mode 100644 index 0000000..6374eca Binary files /dev/null and b/hayfever/textures/comp-cp-3-0.png differ diff --git a/hayfever/textures/comp-cp-4-0.png b/hayfever/textures/comp-cp-4-0.png new file mode 100644 index 0000000..fe7a2b8 Binary files /dev/null and b/hayfever/textures/comp-cp-4-0.png differ diff --git a/hayfever/textures/comp-cp-5-0.png b/hayfever/textures/comp-cp-5-0.png new file mode 100644 index 0000000..8b57102 Binary files /dev/null and b/hayfever/textures/comp-cp-5-0.png differ diff --git a/hayfever/textures/mid.png b/hayfever/textures/mid.png new file mode 100644 index 0000000..24c7dbe Binary files /dev/null and b/hayfever/textures/mid.png differ diff --git a/hayfever/textures/particle.png b/hayfever/textures/particle.png new file mode 100644 index 0000000..8758f69 Binary files /dev/null and b/hayfever/textures/particle.png differ diff --git a/hayfever/textures/pollen.png b/hayfever/textures/pollen.png new file mode 100644 index 0000000..8758f69 Binary files /dev/null and b/hayfever/textures/pollen.png differ