plants added, worms better

This commit is contained in:
Dave Griffiths 2009-06-10 12:45:37 +01:00
parent b1789e048b
commit e28bde30f0
34 changed files with 122 additions and 81 deletions

View file

@ -8,17 +8,17 @@
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; tweakables ; tweakables
(define num-insects 20) (define num-insects 50)
(define pickup-drop-probability 10) (define pickup-drop-probability 10)
(define (vec3->vec4 v a) (define (vec3->vec4 v a)
(vector (vx v) (vy v) (vz 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 (worm-colour) (hsv->rgb (vector 0.1 (rndf) 0.5)))
(define (root-colour) (vector 0.6 0.5 0.5)) (define (root-colour) (vector 0.6 0.5 0.5))
(define (pickup-colour) (hsv->rgb (vector 0.1 (rndf) 1))) (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 "")
(define texpath "textures/") (define texpath "textures/")
@ -133,7 +133,7 @@
(define-struct cell-update (pos code pickup upstream)) (define-struct cell-update (pos code pickup upstream))
(define-struct insect-update (id pos dir t)) (define-struct insect-update (id pos dir t))
(define-struct absorb-event (cell-pos type)) (define-struct absorb-event (cell-pos type))
(define-struct plant-update (id desc)) (define-struct plant-update (id desc pos))
(define comb-cell% (define comb-cell%
(class object% (class object%
@ -244,7 +244,7 @@
(init-field (init-field
(id 0) (id 0)
(cell 0) (cell 0)
(t (+ 0.5 (rndf)))) (d (+ 5.5 (* 2 (rndf)))))
(field (field
(next-update 0)) (next-update 0))
@ -265,9 +265,9 @@
(let ((m (move cell))) (let ((m (move cell)))
(when (zero? (random pickup-drop-probability)) (when (zero? (random pickup-drop-probability))
(send cell set-pickup! 'default)) (send cell set-pickup! 'default))
(set! next-update (+ time t)) (set! next-update (+ time d))
(set! cell (cadr m)) (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))) (else #f)))
(super-new))) (super-new)))
@ -282,7 +282,7 @@
(field (field
(update-me #t) (update-me #t)
(desc (make-random-plant 3))) (desc (make-random-plant 0)))
(define/public (get-id) (define/public (get-id)
id) id)
@ -319,7 +319,8 @@
(lambda (plant r) (lambda (plant r)
(if (send (cadr plant) update-me?) (if (send (cadr plant) update-me?)
(cons (make-plant-update (car plant) (cons (make-plant-update (car plant)
(send (cadr plant) get-desc)) r) (send (cadr plant) get-desc)
(send (cadr plant) get-pos)) r)
r)) r))
'() '()
plants)) plants))
@ -387,9 +388,6 @@
(append (append
; get updates from the garden
(send garden update)
; look for pickups over roots ; look for pickups over roots
(foldl (foldl
(lambda (cell r) (lambda (cell r)
@ -417,7 +415,10 @@
(if upstream (send upstream get-pos) #f)) r)) (if upstream (send upstream get-pos) #f)) r))
r)) r))
'() '()
cells))) cells)
; get updates from the garden
(send garden update)))
(super-new))) (super-new)))
@ -428,7 +429,7 @@
(define (direction-normal d) (define (direction-normal d)
(let ((a (* 2 1.141 60))) (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) (define (build-ngon n)
@ -584,6 +585,7 @@
(let* ((tex (load-primitive (string-append "textures/comp-cp-" id ".png"))) (let* ((tex (load-primitive (string-append "textures/comp-cp-" id ".png")))
(connections (with-primitive tex (convert-to-pos (find-centroids 0 '()))))) (connections (with-primitive tex (convert-to-pos (find-centroids 0 '())))))
(set! connection-cache (cons (cons id connections) connection-cache)) (set! connection-cache (cons (cons id connections) connection-cache))
;(printf "~a:~a~n" id (length connections))
(destroy tex) (destroy tex)
connections))))) connections)))))
@ -606,14 +608,17 @@
(build-plane)))) (build-plane))))
(make-component root col '()))) (make-component root col '())))
(else (else
(let* ((connection-list (get-connection-list id)) (let ((connection-list (get-connection-list id))
(root (with-state (root (with-state
(hint-depth-sort) (hint-depth-sort)
(translate (vector 0 0.5 (* 0.01 (rndf)))) (translate (vector 0 0.5 (* 0.01 (rndf))))
; (rotate (vector 0 0 90)) ; (rotate (vector 0 0 90))
(texture (load-texture (string-append "textures/comp-" id ".png"))) (texture (load-texture (string-append "textures/comp-" id ".png")))
(build-plane))) (build-plane))))
(comp (make-component root col (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 (map
(lambda (child connection) (lambda (child connection)
(with-state (with-state
@ -626,7 +631,7 @@
children children
connection-list)))) connection-list))))
(with-primitive root (apply-transform)) (with-primitive root (apply-transform))
comp)))) comp)))))
(define (random-leaf component) (define (random-leaf component)
(cond (cond
@ -652,7 +657,8 @@
(class object% (class object%
(field (field
(root 0) (root 0)
(root2 0) (tile1 0)
(tile2 0)
(pickup-root 0) (pickup-root 0)
(t 0) (t 0)
(pos '(0 0)) (pos '(0 0))
@ -671,6 +677,9 @@
(define/public (get-root) (define/public (get-root)
root) root)
(define/public (get-tile)
tile1)
(define/public (get-pos) (define/public (get-pos)
pos) pos)
@ -680,14 +689,12 @@
(define (build-prim code) (define (build-prim code)
(let ((p (with-state (let ((p (with-state
;(hint-wire) ;(hint-wire)
(parent owner) (parent root)
(hint-depth-sort) (hint-depth-sort)
(opacity 0) (opacity 0)
(colour (root-colour)) (colour (root-colour))
(hint-unlit) (hint-unlit)
(when (odd? (cadr pos)) (translate (vector 0 0 (* 0.001 (rndf))))
(translate (vector 0.5 0 0)))
(translate (vector (car pos) (* 0.85 (cadr pos)) (* 0.001 (rndf))))
(scale 0.57) (scale 0.57)
(rotate (vector 0 0 90)) (rotate (vector 0 0 90))
(build-ngon 6)))) (build-ngon 6))))
@ -696,8 +703,15 @@
p)) p))
(define/public (build code) (define/public (build code)
(set! root (build-prim code)) (set! root (with-state
(set! root2 (build-prim code))) (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) (define (update-texture code)
(texture (load-texture (string-append texpath "roots-ornate.png"))) (texture (load-texture (string-append texpath "roots-ornate.png")))
@ -709,10 +723,10 @@
"t" "tref")) "t" "tref"))
(define/public (new-code code) (define/public (new-code code)
(when (not (zero? root2)) (when (not (zero? tile2))
(destroy root2) (destroy tile2)
(with-primitive root (opacity 1))) (with-primitive tile1 (opacity 1)))
(set! root2 (build-prim code)) (set! tile2 (build-prim code))
(set! t 0)) (set! t 0))
(define/public (set-pickup! type) (define/public (set-pickup! type)
@ -725,8 +739,7 @@
(set! pickup-root 0)) (set! pickup-root 0))
(set! pickup-root (with-state (set! pickup-root (with-state
(colour (pickup-colour)) (colour (pickup-colour))
(parent owner) (parent root)
(translate (with-primitive root (vtransform (vector 0 0 0) (get-transform))))
(build-torus 0.03 0.2 10 10))))) (build-torus 0.03 0.2 10 10)))))
(define/public (update time delta) (define/public (update time delta)
@ -737,19 +750,19 @@
(rotate (vector 0 2 0)))) (rotate (vector 0 2 0))))
(when (< t 1) (when (< t 1)
(with-primitive root (with-primitive tile1
(opacity (- 1 t))) (opacity (- 1 t)))
(with-primitive root2 (with-primitive tile2
(opacity t))) (opacity t)))
(when (> t 1) (when (> t 1)
(with-primitive root (with-primitive tile1
(opacity 1)) (opacity 1))
(when (not (zero? root2)) (when (not (zero? tile2))
(destroy root) (destroy tile1)
(set! root root2) (set! tile1 tile2)
(set! root2 0)))) (set! tile2 0))))
(super-new))) (super-new)))
@ -806,10 +819,24 @@
(class insect-view% (class insect-view%
(inherit-field root from to from-dir to-dir t d) (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) (define/override (build)
(set! root (build-ribbon 50)) (set! root (build-ribbon 20))
(with-primitive root (with-primitive root
(hide 1) (hide 1)
(translate (vector 0 0 -0.1)) (translate (vector 0 0 -0.1))
@ -817,7 +844,7 @@
(set! hidden #t) (set! hidden #t)
(colour (worm-colour)) (colour (worm-colour))
(texture (load-texture (string-append texpath "worm.png"))) (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! (pdata-index-map!
(lambda (i w) (lambda (i w)
width #;(+ 0.05 (* (abs (sin (* i 0.5))) 0.1))) width #;(+ 0.05 (* (abs (sin (* i 0.5))) 0.1)))
@ -828,10 +855,11 @@
"c"))) "c")))
(define/override (update time delta) (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) (set! hidden #t)
(with-primitive root (hide 1))) (with-primitive root (hide 1)))
(else (else
(let ((t (/ t d))) ; normalise time
(with-primitive root (with-primitive root
(when hidden (when hidden
(set! hidden #f) (set! hidden #f)
@ -840,14 +868,14 @@
from) from)
"p")) "p"))
(hide 0) (hide 0)
;(identity) (pdata-index-map!
(let ((h (hermite-tangent (/ t d) from to (vmul from-dir 2) (vmul to-dir 2)))) (lambda (i p)
;(translate (car h)) (let ((st (- t (* i 0.05))))
(pdata-set! "p" (- (pdata-size) 1) (car h)) (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")))))
(for ((i (in-range 0 (- (pdata-size) 1))))
(pdata-set! "p" i (pdata-ref "p" (+ i 1))))))))
(set! t (+ t delta))) (set! t (+ t delta)))
(super-new))) (super-new)))
@ -928,14 +956,20 @@
(root 0) (root 0)
(desc '())) (desc '()))
(define/public (set-desc! s) (define/public (build s)
(set! desc s) (set! desc s)
(when (not (zero? root)) (when (not (zero? root))
(destroy root)) (destroy root))
(set! root (build-locator))
; build the plant ; 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))) (super-new)))
@ -947,8 +981,12 @@
(field (field
(plants '())) (plants '()))
(define/public (add-plant! id plant) (define/public (add-plant! id desc hex)
(set! plants (cons (list id plant) plants))) (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))) (super-new)))
@ -961,7 +999,7 @@
(cells '()) ; an associative list mapping position to cell-views (cells '()) ; an associative list mapping position to cell-views
(insects '()) ; an associative list mapping id to insect-views (insects '()) ; an associative list mapping id to insect-views
(absorb-list '()) ; just a list of absorb effects (absorb-list '()) ; just a list of absorb effects
(garden-view (make-object garden-view%))) (garden (make-object garden-view%)))
(define/public (init) (define/public (init)
(set! root (build-locator)) (set! root (build-locator))
@ -979,7 +1017,7 @@
(define (get-pos-from-prim p l) (define (get-pos-from-prim p l)
(cond (cond
((null? l) #f) ((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))))) (else (get-pos-from-prim p (cdr l)))))
(define/public (get-cell-from-pos pos) (define/public (get-cell-from-pos pos)
@ -1094,7 +1132,10 @@
(send a build root) (send a build root)
(add-absorb! a))) (add-absorb! a)))
((plant-update? item) ((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)) update-list))
(super-new))) (super-new)))
@ -1106,7 +1147,7 @@
(clear-colour (bg-colour)) (clear-colour (bg-colour))
(clear-texture-cache) (clear-texture-cache)
(show-axis 0) (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 hc (make-object honey-comb%))
(define hcv (make-object honey-comb-view%)) (define hcv (make-object honey-comb-view%))

Binary file not shown.

After

Width:  |  Height:  |  Size: 234 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 106 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 158 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 302 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 34 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 64 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 185 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 236 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 320 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 218 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 272 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 320 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 236 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 204 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 79 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 299 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 278 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 440 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 231 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 160 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 137 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 2.2 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.9 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 2.7 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.9 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 2.8 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 2 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.9 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 2.8 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 3.1 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 62 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 16 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 8.2 KiB

After

Width:  |  Height:  |  Size: 8.9 KiB