diff --git a/hex-ornament/hex-ornament.scm b/hex-ornament/hex-ornament.scm index 1fb4622..06af8b8 100644 --- a/hex-ornament/hex-ornament.scm +++ b/hex-ornament/hex-ornament.scm @@ -8,17 +8,17 @@ ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ; tweakables -(define num-insects 20) +(define num-insects 50) (define pickup-drop-probability 10) (define (vec3->vec4 v a) (vector (vx v) (vy v) (vz v) a)) -(define (bg-colour) (vector 0.2 0.2 0.1)) +(define (bg-colour) (vector 0.9 0.8 0.7)) (define (worm-colour) (hsv->rgb (vector 0.1 (rndf) 0.5))) (define (root-colour) (vector 0.6 0.5 0.5)) (define (pickup-colour) (hsv->rgb (vector 0.1 (rndf) 1))) -(define (absorb-colour) (vec3->vec4 (hsv->rgb (vector 0.1 (rndf) 1)) 0.2)) +(define (absorb-colour) (vec3->vec4 (hsv->rgb (vector (rndf) 0.2 (+ 0.6 (rndf)))) 0.2)) ;(define texpath "") (define texpath "textures/") @@ -133,7 +133,7 @@ (define-struct cell-update (pos code pickup upstream)) (define-struct insect-update (id pos dir t)) (define-struct absorb-event (cell-pos type)) -(define-struct plant-update (id desc)) +(define-struct plant-update (id desc pos)) (define comb-cell% (class object% @@ -244,7 +244,7 @@ (init-field (id 0) (cell 0) - (t (+ 0.5 (rndf)))) + (d (+ 5.5 (* 2 (rndf))))) (field (next-update 0)) @@ -265,9 +265,9 @@ (let ((m (move cell))) (when (zero? (random pickup-drop-probability)) (send cell set-pickup! 'default)) - (set! next-update (+ time t)) + (set! next-update (+ time d)) (set! cell (cadr m)) - (make-insect-update id (send cell get-pos) (car m) t))) + (make-insect-update id (send cell get-pos) (car m) d))) (else #f))) (super-new))) @@ -282,7 +282,7 @@ (field (update-me #t) - (desc (make-random-plant 3))) + (desc (make-random-plant 0))) (define/public (get-id) id) @@ -319,7 +319,8 @@ (lambda (plant r) (if (send (cadr plant) update-me?) (cons (make-plant-update (car plant) - (send (cadr plant) get-desc)) r) + (send (cadr plant) get-desc) + (send (cadr plant) get-pos)) r) r)) '() plants)) @@ -387,9 +388,6 @@ (append - ; get updates from the garden - (send garden update) - ; look for pickups over roots (foldl (lambda (cell r) @@ -417,7 +415,10 @@ (if upstream (send upstream get-pos) #f)) r)) r)) '() - cells))) + cells) + + ; get updates from the garden + (send garden update))) (super-new))) @@ -428,7 +429,7 @@ (define (direction-normal d) (let ((a (* 2 1.141 60))) - (vector (sin (* a d)) (cos (* a d)) 0))) + (vmul (vector (sin (* a d)) (cos (* a d)) 0) -1))) (define (build-ngon n) @@ -584,6 +585,7 @@ (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)) + ;(printf "~a:~a~n" id (length connections)) (destroy tex) connections))))) @@ -606,27 +608,30 @@ (build-plane)))) (make-component root col '()))) (else - (let* ((connection-list (get-connection-list id)) + (let ((connection-list (get-connection-list id)) (root (with-state (hint-depth-sort) (translate (vector 0 0.5 (* 0.01 (rndf)))) ; (rotate (vector 0 0 90)) (texture (load-texture (string-append "textures/comp-" id ".png"))) - (build-plane))) - (comp (make-component root col - (map - (lambda (child connection) - (with-state - (parent root) - (translate (vadd connection (vector 0 0 (* 0.01 (rndf))))) - (rotate (vector 0 0 (2dvec->angle - (vx connection) (- (vy connection) 0.5)))) - (rotate (vector 0 0 0)) - (build-component (car child) col (cadr child)))) - children - connection-list)))) - (with-primitive root (apply-transform)) - comp)))) + (build-plane)))) + (when (not (eq? (length connection-list) (length children))) + (printf "something wrong: ~a children:~a connections:~a~n" id (length children) (length connection-list) )) + + (let ((comp (make-component root col + (map + (lambda (child connection) + (with-state + (parent root) + (translate (vadd connection (vector 0 0 (* 0.01 (rndf))))) + (rotate (vector 0 0 (2dvec->angle + (vx connection) (- (vy connection) 0.5)))) + (rotate (vector 0 0 0)) + (build-component (car child) col (cadr child)))) + children + connection-list)))) + (with-primitive root (apply-transform)) + comp))))) (define (random-leaf component) (cond @@ -652,7 +657,8 @@ (class object% (field (root 0) - (root2 0) + (tile1 0) + (tile2 0) (pickup-root 0) (t 0) (pos '(0 0)) @@ -671,23 +677,24 @@ (define/public (get-root) root) + (define/public (get-tile) + tile1) + (define/public (get-pos) pos) (define/public (set-pos! s) (set! pos s)) - (define (build-prim code) + (define (build-prim code) (let ((p (with-state ;(hint-wire) - (parent owner) + (parent root) (hint-depth-sort) (opacity 0) (colour (root-colour)) (hint-unlit) - (when (odd? (cadr pos)) - (translate (vector 0.5 0 0))) - (translate (vector (car pos) (* 0.85 (cadr pos)) (* 0.001 (rndf)))) + (translate (vector 0 0 (* 0.001 (rndf)))) (scale 0.57) (rotate (vector 0 0 90)) (build-ngon 6)))) @@ -696,8 +703,15 @@ p)) (define/public (build code) - (set! root (build-prim code)) - (set! root2 (build-prim code))) + (set! root (with-state + (parent owner) + (when (odd? (cadr pos)) + (translate (vector 0.5 0 0))) + (translate (vector (car pos) (* 0.85 (cadr pos)) 0)) + (build-locator))) + + (set! tile1 (build-prim code)) + (set! tile2 (build-prim code))) (define (update-texture code) (texture (load-texture (string-append texpath "roots-ornate.png"))) @@ -709,10 +723,10 @@ "t" "tref")) (define/public (new-code code) - (when (not (zero? root2)) - (destroy root2) - (with-primitive root (opacity 1))) - (set! root2 (build-prim code)) + (when (not (zero? tile2)) + (destroy tile2) + (with-primitive tile1 (opacity 1))) + (set! tile2 (build-prim code)) (set! t 0)) (define/public (set-pickup! type) @@ -725,8 +739,7 @@ (set! pickup-root 0)) (set! pickup-root (with-state (colour (pickup-colour)) - (parent owner) - (translate (with-primitive root (vtransform (vector 0 0 0) (get-transform)))) + (parent root) (build-torus 0.03 0.2 10 10))))) (define/public (update time delta) @@ -737,19 +750,19 @@ (rotate (vector 0 2 0)))) (when (< t 1) - (with-primitive root + (with-primitive tile1 (opacity (- 1 t))) - (with-primitive root2 + (with-primitive tile2 (opacity t))) (when (> t 1) - (with-primitive root + (with-primitive tile1 (opacity 1)) - (when (not (zero? root2)) - (destroy root) - (set! root root2) - (set! root2 0)))) + (when (not (zero? tile2)) + (destroy tile1) + (set! tile1 tile2) + (set! tile2 0)))) (super-new))) @@ -806,10 +819,24 @@ (class insect-view% (inherit-field root from to from-dir to-dir t d) - (field (hidden #t)) + (field + (hidden #t) + (from2 (vector 0 0 0)) + (from-dir2 (vector 0 0 0))) + + (define/override (goto-cell cell dir dur) + (set! from2 from) + (set! from to) + (set! from-dir2 from-dir) + (set! from-dir to-dir) + (set! to (with-primitive (send cell get-root) + (vtransform (vector 0 0 0) (get-transform)))) + (set! to-dir (direction-normal dir)) + (set! t 0) + (set! d dur)) (define/override (build) - (set! root (build-ribbon 50)) + (set! root (build-ribbon 20)) (with-primitive root (hide 1) (translate (vector 0 0 -0.1)) @@ -817,7 +844,7 @@ (set! hidden #t) (colour (worm-colour)) (texture (load-texture (string-append texpath "worm.png"))) - (let ((width (+ 0.05 (* 0.1 (rndf))))) + (let ((width (+ 0.05 (* 0.05 (rndf))))) (pdata-index-map! (lambda (i w) width #;(+ 0.05 (* (abs (sin (* i 0.5))) 0.1))) @@ -828,29 +855,30 @@ "c"))) (define/override (update time delta) - (cond ((or (zero? d) (> t d) (equal? from (vector 0 0 0))) + (cond ((or (zero? d) (> t d) (equal? from2 (vector 0 0 0))) (set! hidden #t) (with-primitive root (hide 1))) (else - (with-primitive root - (when hidden - (set! hidden #f) - (pdata-map! - (lambda (p) - from) - "p")) - (hide 0) - ;(identity) - (let ((h (hermite-tangent (/ t d) from to (vmul from-dir 2) (vmul to-dir 2)))) - ;(translate (car h)) - (pdata-set! "p" (- (pdata-size) 1) (car h)) - - - (for ((i (in-range 0 (- (pdata-size) 1)))) - (pdata-set! "p" i (pdata-ref "p" (+ i 1)))))))) - (set! t (+ t delta))) + (let ((t (/ t d))) ; normalise time + (with-primitive root + (when hidden + (set! hidden #f) + (pdata-map! + (lambda (p) + from) + "p")) + (hide 0) + (pdata-index-map! + (lambda (i p) + (let ((st (- t (* i 0.05)))) + (if (< st 0) + (hermite (+ st 1) from2 from (vmul from-dir2 2) (vmul from-dir 2)) + (hermite st from to (vmul from-dir 2) (vmul to-dir 2))))) + "p"))))) - (super-new))) + (set! t (+ t delta))) + + (super-new))) ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -928,14 +956,20 @@ (root 0) (desc '())) - (define/public (set-desc! s) + (define/public (build s) (set! desc s) (when (not (zero? root)) (destroy root)) + (set! root (build-locator)) + ; build the plant - ) + (with-state + (parent root) + (hint-depth-sort) + (translate (vector 0.2 0.3 0.3)) + (build-component "1-1" (vector 1 1 1) (list desc)))) (super-new))) @@ -947,8 +981,12 @@ (field (plants '())) - (define/public (add-plant! id plant) - (set! plants (cons (list id plant) plants))) + (define/public (add-plant! id desc hex) + (let ((plant (make-object plant-view%))) + (with-state + (parent (send hex get-root)) + (send plant build desc) + (set! plants (cons (list id plant) plants))))) (super-new))) @@ -961,7 +999,7 @@ (cells '()) ; an associative list mapping position to cell-views (insects '()) ; an associative list mapping id to insect-views (absorb-list '()) ; just a list of absorb effects - (garden-view (make-object garden-view%))) + (garden (make-object garden-view%))) (define/public (init) (set! root (build-locator)) @@ -979,7 +1017,7 @@ (define (get-pos-from-prim p l) (cond ((null? l) #f) - ((eq? (send (cadr (car l)) get-root) p) (caar l)) + ((eq? (send (cadr (car l)) get-tile) p) (caar l)) (else (get-pos-from-prim p (cdr l))))) (define/public (get-cell-from-pos pos) @@ -1094,7 +1132,10 @@ (send a build root) (add-absorb! a))) ((plant-update? item) - (printf "got a plant update!~n")))) + (send garden add-plant! + (plant-update-id item) + (plant-update-desc item) + (get-cell-from-pos (plant-update-pos item)))))) update-list)) (super-new))) @@ -1106,7 +1147,7 @@ (clear-colour (bg-colour)) (clear-texture-cache) (show-axis 0) -(set-camera-transform (mtranslate (vector -10 -6 -8))) +(set-camera-transform (mtranslate (vector -10 -7 -8))) (define hc (make-object honey-comb%)) (define hcv (make-object honey-comb-view%)) diff --git a/hex-ornament/textures/comp-0.png b/hex-ornament/textures/comp-0.png new file mode 100644 index 0000000..4884f2e Binary files /dev/null and b/hex-ornament/textures/comp-0.png differ diff --git a/hex-ornament/textures/comp-1-0.png b/hex-ornament/textures/comp-1-0.png new file mode 100644 index 0000000..e707cb3 Binary files /dev/null and b/hex-ornament/textures/comp-1-0.png differ diff --git a/hex-ornament/textures/comp-1-1.png b/hex-ornament/textures/comp-1-1.png new file mode 100644 index 0000000..427fbb7 Binary files /dev/null and b/hex-ornament/textures/comp-1-1.png differ diff --git a/hex-ornament/textures/comp-1.png b/hex-ornament/textures/comp-1.png new file mode 100644 index 0000000..5418075 Binary files /dev/null and b/hex-ornament/textures/comp-1.png differ diff --git a/hex-ornament/textures/comp-10.png b/hex-ornament/textures/comp-10.png new file mode 100644 index 0000000..e4c2be7 Binary files /dev/null and b/hex-ornament/textures/comp-10.png differ diff --git a/hex-ornament/textures/comp-11.png b/hex-ornament/textures/comp-11.png new file mode 100644 index 0000000..837a4f7 Binary files /dev/null and b/hex-ornament/textures/comp-11.png differ diff --git a/hex-ornament/textures/comp-2-0.png b/hex-ornament/textures/comp-2-0.png new file mode 100644 index 0000000..315d931 Binary files /dev/null and b/hex-ornament/textures/comp-2-0.png differ diff --git a/hex-ornament/textures/comp-2-1.png b/hex-ornament/textures/comp-2-1.png new file mode 100644 index 0000000..44a889e Binary files /dev/null and b/hex-ornament/textures/comp-2-1.png differ diff --git a/hex-ornament/textures/comp-2.png b/hex-ornament/textures/comp-2.png new file mode 100644 index 0000000..28d635c Binary files /dev/null and b/hex-ornament/textures/comp-2.png differ diff --git a/hex-ornament/textures/comp-3-0.png b/hex-ornament/textures/comp-3-0.png new file mode 100644 index 0000000..453b630 Binary files /dev/null and b/hex-ornament/textures/comp-3-0.png differ diff --git a/hex-ornament/textures/comp-3-1.png b/hex-ornament/textures/comp-3-1.png new file mode 100644 index 0000000..ca6b0dd Binary files /dev/null and b/hex-ornament/textures/comp-3-1.png differ diff --git a/hex-ornament/textures/comp-3-2.png b/hex-ornament/textures/comp-3-2.png new file mode 100644 index 0000000..26a63ba Binary files /dev/null and b/hex-ornament/textures/comp-3-2.png differ diff --git a/hex-ornament/textures/comp-3.png b/hex-ornament/textures/comp-3.png new file mode 100644 index 0000000..30e6680 Binary files /dev/null and b/hex-ornament/textures/comp-3.png differ diff --git a/hex-ornament/textures/comp-4-0.png b/hex-ornament/textures/comp-4-0.png new file mode 100644 index 0000000..ae8d18f Binary files /dev/null and b/hex-ornament/textures/comp-4-0.png differ diff --git a/hex-ornament/textures/comp-4.png b/hex-ornament/textures/comp-4.png new file mode 100644 index 0000000..9d0e243 Binary files /dev/null and b/hex-ornament/textures/comp-4.png differ diff --git a/hex-ornament/textures/comp-5-0.png b/hex-ornament/textures/comp-5-0.png new file mode 100644 index 0000000..e4038d2 Binary files /dev/null and b/hex-ornament/textures/comp-5-0.png differ diff --git a/hex-ornament/textures/comp-5.png b/hex-ornament/textures/comp-5.png new file mode 100644 index 0000000..c9dc309 Binary files /dev/null and b/hex-ornament/textures/comp-5.png differ diff --git a/hex-ornament/textures/comp-6.png b/hex-ornament/textures/comp-6.png new file mode 100644 index 0000000..950d75f Binary files /dev/null and b/hex-ornament/textures/comp-6.png differ diff --git a/hex-ornament/textures/comp-7.png b/hex-ornament/textures/comp-7.png new file mode 100644 index 0000000..4a2dec4 Binary files /dev/null and b/hex-ornament/textures/comp-7.png differ diff --git a/hex-ornament/textures/comp-8.png b/hex-ornament/textures/comp-8.png new file mode 100644 index 0000000..dac8002 Binary files /dev/null and b/hex-ornament/textures/comp-8.png differ diff --git a/hex-ornament/textures/comp-9.png b/hex-ornament/textures/comp-9.png new file mode 100644 index 0000000..4feb191 Binary files /dev/null and b/hex-ornament/textures/comp-9.png differ diff --git a/hex-ornament/textures/comp-cp-1-0.png b/hex-ornament/textures/comp-cp-1-0.png new file mode 100644 index 0000000..bf452ba Binary files /dev/null and b/hex-ornament/textures/comp-cp-1-0.png differ diff --git a/hex-ornament/textures/comp-cp-1-1.png b/hex-ornament/textures/comp-cp-1-1.png new file mode 100644 index 0000000..95e80ef Binary files /dev/null and b/hex-ornament/textures/comp-cp-1-1.png differ diff --git a/hex-ornament/textures/comp-cp-2-0.png b/hex-ornament/textures/comp-cp-2-0.png new file mode 100644 index 0000000..be3f7e9 Binary files /dev/null and b/hex-ornament/textures/comp-cp-2-0.png differ diff --git a/hex-ornament/textures/comp-cp-2-1.png b/hex-ornament/textures/comp-cp-2-1.png new file mode 100644 index 0000000..3d94013 Binary files /dev/null and b/hex-ornament/textures/comp-cp-2-1.png differ diff --git a/hex-ornament/textures/comp-cp-3-0.png b/hex-ornament/textures/comp-cp-3-0.png new file mode 100644 index 0000000..6374eca Binary files /dev/null and b/hex-ornament/textures/comp-cp-3-0.png differ diff --git a/hex-ornament/textures/comp-cp-3-1.png b/hex-ornament/textures/comp-cp-3-1.png new file mode 100644 index 0000000..7d0fa1c Binary files /dev/null and b/hex-ornament/textures/comp-cp-3-1.png differ diff --git a/hex-ornament/textures/comp-cp-3-2.png b/hex-ornament/textures/comp-cp-3-2.png new file mode 100644 index 0000000..b92bc5f Binary files /dev/null and b/hex-ornament/textures/comp-cp-3-2.png differ diff --git a/hex-ornament/textures/comp-cp-4-0.png b/hex-ornament/textures/comp-cp-4-0.png new file mode 100644 index 0000000..fe7a2b8 Binary files /dev/null and b/hex-ornament/textures/comp-cp-4-0.png differ diff --git a/hex-ornament/textures/comp-cp-5-0.png b/hex-ornament/textures/comp-cp-5-0.png new file mode 100644 index 0000000..8b57102 Binary files /dev/null and b/hex-ornament/textures/comp-cp-5-0.png differ diff --git a/hex-ornament/textures/surface.png b/hex-ornament/textures/surface.png new file mode 100644 index 0000000..da236d7 Binary files /dev/null and b/hex-ornament/textures/surface.png differ diff --git a/hex-ornament/textures/surface2.png b/hex-ornament/textures/surface2.png new file mode 100644 index 0000000..b9750a0 Binary files /dev/null and b/hex-ornament/textures/surface2.png differ diff --git a/hex-ornament/textures/worm.png b/hex-ornament/textures/worm.png index d7fc55c..b0f69ae 100644 Binary files a/hex-ornament/textures/worm.png and b/hex-ornament/textures/worm.png differ