plants added, worms better
|
@ -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%))
|
||||
|
|
BIN
hex-ornament/textures/comp-0.png
Normal file
After Width: | Height: | Size: 234 KiB |
BIN
hex-ornament/textures/comp-1-0.png
Normal file
After Width: | Height: | Size: 106 KiB |
BIN
hex-ornament/textures/comp-1-1.png
Normal file
After Width: | Height: | Size: 158 KiB |
BIN
hex-ornament/textures/comp-1.png
Normal file
After Width: | Height: | Size: 302 KiB |
BIN
hex-ornament/textures/comp-10.png
Normal file
After Width: | Height: | Size: 34 KiB |
BIN
hex-ornament/textures/comp-11.png
Normal file
After Width: | Height: | Size: 64 KiB |
BIN
hex-ornament/textures/comp-2-0.png
Normal file
After Width: | Height: | Size: 185 KiB |
BIN
hex-ornament/textures/comp-2-1.png
Normal file
After Width: | Height: | Size: 236 KiB |
BIN
hex-ornament/textures/comp-2.png
Normal file
After Width: | Height: | Size: 320 KiB |
BIN
hex-ornament/textures/comp-3-0.png
Normal file
After Width: | Height: | Size: 218 KiB |
BIN
hex-ornament/textures/comp-3-1.png
Normal file
After Width: | Height: | Size: 272 KiB |
BIN
hex-ornament/textures/comp-3-2.png
Normal file
After Width: | Height: | Size: 320 KiB |
BIN
hex-ornament/textures/comp-3.png
Normal file
After Width: | Height: | Size: 236 KiB |
BIN
hex-ornament/textures/comp-4-0.png
Normal file
After Width: | Height: | Size: 204 KiB |
BIN
hex-ornament/textures/comp-4.png
Normal file
After Width: | Height: | Size: 79 KiB |
BIN
hex-ornament/textures/comp-5-0.png
Normal file
After Width: | Height: | Size: 299 KiB |
BIN
hex-ornament/textures/comp-5.png
Normal file
After Width: | Height: | Size: 278 KiB |
BIN
hex-ornament/textures/comp-6.png
Normal file
After Width: | Height: | Size: 440 KiB |
BIN
hex-ornament/textures/comp-7.png
Normal file
After Width: | Height: | Size: 231 KiB |
BIN
hex-ornament/textures/comp-8.png
Normal file
After Width: | Height: | Size: 160 KiB |
BIN
hex-ornament/textures/comp-9.png
Normal file
After Width: | Height: | Size: 137 KiB |
BIN
hex-ornament/textures/comp-cp-1-0.png
Normal file
After Width: | Height: | Size: 2.2 KiB |
BIN
hex-ornament/textures/comp-cp-1-1.png
Normal file
After Width: | Height: | Size: 1.9 KiB |
BIN
hex-ornament/textures/comp-cp-2-0.png
Normal file
After Width: | Height: | Size: 2.7 KiB |
BIN
hex-ornament/textures/comp-cp-2-1.png
Normal file
After Width: | Height: | Size: 1.9 KiB |
BIN
hex-ornament/textures/comp-cp-3-0.png
Normal file
After Width: | Height: | Size: 2.8 KiB |
BIN
hex-ornament/textures/comp-cp-3-1.png
Normal file
After Width: | Height: | Size: 2 KiB |
BIN
hex-ornament/textures/comp-cp-3-2.png
Normal file
After Width: | Height: | Size: 1.9 KiB |
BIN
hex-ornament/textures/comp-cp-4-0.png
Normal file
After Width: | Height: | Size: 2.8 KiB |
BIN
hex-ornament/textures/comp-cp-5-0.png
Normal file
After Width: | Height: | Size: 3.1 KiB |
BIN
hex-ornament/textures/surface.png
Normal file
After Width: | Height: | Size: 62 KiB |
BIN
hex-ornament/textures/surface2.png
Normal file
After Width: | Height: | Size: 16 KiB |
Before Width: | Height: | Size: 8.2 KiB After Width: | Height: | Size: 8.9 KiB |