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
(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%))

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