FoAM/groworld
12
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

butterflies, spiders, pretty twiglets, new pickups

Browse source
This commit is contained in:
Dave Griffiths 2009-09-25 17:19:48 +01:00
parent be2bd4ba1f
commit dca225bc0a
12 changed files with 1083 additions and 287 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

14
plant-eyes/controller.ss
View file

@ -27,7 +27,8 @@
(seed-return #f) (seed-return #f)
(seed-return-timer 0) (seed-return-timer 0)
(seed-return-secs-per-point 3) (seed-return-secs-per-point 3)
(twig-stack '())) (twig-stack '())
(above-ground #f))
(define/public (set-player-plant s) (define/public (set-player-plant s)
(set! pos (send s get-pos)) (set! pos (send s get-pos))
@ -49,7 +50,6 @@
(define/public (setup) (define/public (setup)
(lock-camera cam) (lock-camera cam)
(camera-lag 0.2) (camera-lag 0.2)
(clip 1 300)
(set-camera-transform (mtranslate (vector 0 0 -4)))) (set-camera-transform (mtranslate (vector 0 0 -4))))
; moveme ; moveme
@ -144,6 +144,16 @@
(set! seed-return #t) (set! seed-return #t)
(set! current-point (- (send current-twig get-num-points) 1))) (set! current-point (- (send current-twig get-num-points) 1)))
(cond
((and (not above-ground) (> (vy (vadd player-pos pos)) 0))
(set! above-ground #t)
(send game-view above-ground)
(printf "up~n"))
((and above-ground (< (vy (vadd player-pos pos)) 0))
(set! above-ground #f)
(send game-view below-ground)
(printf "down~n")))
(let* ((side (vnormalise (vcross up fwd))) (let* ((side (vnormalise (vcross up fwd)))
(up (vnormalise (vcross fwd side)))) (up (vnormalise (vcross fwd side))))

32
plant-eyes/game-modes.ss
View file

@ -13,19 +13,19 @@
(players (list (players (list
(make-player-info "plant0000001@fo.am" "plant0000001" (make-player-info "plant0000001@fo.am" "plant0000001"
"textures/plant0000001.png" (list-ref (list-ref seed-obs 0) 2) "textures/plant0000001.png" (list-ref (list-ref seed-obs 0) 2)
(vector 0.5 1 0.5)) (vector 0.5 0.5 0.5))
(make-player-info "plant0000002@fo.am" "plant0000002" (make-player-info "plant0000002@fo.am" "plant0000002"
"textures/plant0000002.png" (list-ref (list-ref seed-obs 1) 2) "textures/plant0000002.png" (list-ref (list-ref seed-obs 1) 2)
(vector 0.5 1 0)) (vector 0.25 0.25 0.25))
(make-player-info "plant0000003@fo.am" "plant0000003" (make-player-info "plant0000003@fo.am" "plant0000003"
"textures/plant0000003.png" (list-ref (list-ref seed-obs 2) 2) "textures/plant0000003.png" (list-ref (list-ref seed-obs 2) 2)
(vector 0 1 0.5)) (vector 0.7 0.7 0.7))
(make-player-info "plant0000004@fo.am" "plant0000004" (make-player-info "plant0000004@fo.am" "plant0000004"
"textures/plant0000004.png" (list-ref (list-ref seed-obs 3) 2) "textures/plant0000004.png" (list-ref (list-ref seed-obs 3) 2)
(vector 0.75 1 0.5)) (vector 0.75 0.75 0.75))
(make-player-info "plant0000005@fo.am" "plant0000005" (make-player-info "plant0000005@fo.am" "plant0000005"
"textures/plant0000005.png" (list-ref (list-ref seed-obs 4) 2) "textures/plant0000005.png" (list-ref (list-ref seed-obs 4) 2)
(vector 0.5 1 0.75)) (vector 0.1 0.1 0.1))
)) ))
(seeds '()) (seeds '())
(clicked -1)) (clicked -1))
@ -33,6 +33,9 @@
(define/public (get-player-info) (define/public (get-player-info)
(list-ref players clicked)) (list-ref players clicked))
(define/public (get-players)
players)
(define/public (setup) (define/public (setup)
(let ((c 0)) (let ((c 0))
(set! seeds (map (set! seeds (map
@ -87,15 +90,28 @@
(player #f) (player #f)
(logic-tick 0.5)) ; time between logic updates (logic-tick 0.5)) ; time between logic updates
(define/public (setup pi) (define/public (setup pi players)
(set! cl (make-object client% (player-info-jid pi) (player-info-pass pi))) (set! cl (make-object client% (player-info-jid pi) (player-info-pass pi)))
(set! player (make-object plant-logic% (set! player (make-object plant-logic%
(player-info-jid pi) (player-info-jid pi)
(player-info-pos pi) (player-info-pos pi)
(player-info-col pi) (player-info-col pi)
(player-info-tex pi))) (player-info-tex pi)
#t))
(send c set-player-plant player) (send c set-player-plant player)
(send gl add-player player) (send gl add-player player)
; add the other players...
(for-each
(lambda (player)
(when (not (eq? player pi))
(send gl add-plant (make-object plant-logic%
(player-info-jid player)
(player-info-pos player)
(player-info-col player)
(player-info-tex player)))))
players)
(send c setup) (send c setup)
(send gv setup world-list) (send gv setup world-list)
(send gl setup world-list) (send gl setup world-list)
@ -105,7 +121,7 @@
(when (< tick-time t) (when (< tick-time t)
(let ((messages (send gl update))) (let ((messages (send gl update t d)))
; pass the messages to the network client ; pass the messages to the network client
(send gv update t d (send cl update messages gl))) ; and the game view (send gv update t d (send cl update messages gl))) ; and the game view

12
plant-eyes/jabberer.ss
View file

@ -1,5 +1,5 @@
#lang scheme/base #lang scheme/base
(require scheme/class openssl (prefix-in xmpp: "xmpp.ss")) (require scheme/class); openssl (prefix-in xmpp: "xmpp.ss"))
(provide (all-defined-out)) (provide (all-defined-out))
; a class which wraps the xmpp in a thread and allows messages to be picked up ; a class which wraps the xmpp in a thread and allows messages to be picked up
@ -36,9 +36,9 @@
(define/public (send-msg to msg) (define/public (send-msg to msg)
(set! outgoing (append outgoing (list (list to msg))))) (set! outgoing (append outgoing (list (list to msg)))))
(define (message-handler sz) (define (message-handler sz) 0)
(when debug-jab (printf "rx <---- ~a ~a~n" (xmpp:message-from sz) (xmpp:message-body sz))) ; (when debug-jab (printf "rx <---- ~a ~a~n" (xmpp:message-from sz) (xmpp:message-body sz)))
(set! incoming (cons (list (xmpp:message-from sz) (xmpp:message-body sz)) incoming))) ;(set! incoming (cons (list (xmpp:message-from sz) (xmpp:message-body sz)) incoming)))
(define/public (start) (define/public (start)
(set! thr (thread run))) (set! thr (thread run)))
@ -46,8 +46,8 @@
(define/public (stop) (define/public (stop)
(kill-thread thr)) (kill-thread thr))
(define (run) (define (run) 0
(xmpp:with-xmpp-session jid pass #;(xmpp:with-xmpp-session jid pass
(xmpp:set-xmpp-handler 'message message-handler) (xmpp:set-xmpp-handler 'message message-handler)
(let loop () (let loop ()
(when debug-netloop (printf ".~n")) (when debug-netloop (printf ".~n"))

161
plant-eyes/logic.ss
View file

@ -9,7 +9,7 @@
(define start-twig-points 15) (define start-twig-points 15)
(define start-twig-dist 0.05) (define start-twig-dist 0.05)
(define start-twig-width 0.1) (define start-twig-width 0.1)
(define default-max-twigs 5) (define default-max-twigs 2)
(define default-scale-factor 1.05) (define default-scale-factor 1.05)
(define num-pickups 10) (define num-pickups 10)
(define pickup-dist-radius 200) (define pickup-dist-radius 200)
@ -19,6 +19,12 @@
(define start-size 50) (define start-size 50)
(define max-ornaments 10) ; per twig (define max-ornaments 10) ; per twig
(define nutrient-twig-size-increase 2) (define nutrient-twig-size-increase 2)
(define num-worms 10)
(define num-spiders 10)
(define num-butterflies 10)
(define auto-twig-var 5)
(define auto-time 5)
(define pickup-check-prob 20)
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; the base class logic object - all logic side objects can ; the base class logic object - all logic side objects can
@ -41,8 +47,8 @@
((list? (car l)) (append (flatten (car l)) (flatten (cdr l)))) ((list? (car l)) (append (flatten (car l)) (flatten (cdr l))))
(else (cons (car l) (flatten (cdr l)))))) (else (cons (car l) (flatten (cdr l))))))
(define/pubment (update) ; need to augement this if we have child logic objects, (define/pubment (update t d) ; need to augement this if we have child logic objects,
(let ((l (inner '() update)) ; and call update on them too. (let ((l (inner '() update t d)) ; and call update on them too.
(m messages)) (m messages))
(set! messages '()) (set! messages '())
(append (append
@ -51,6 +57,62 @@
(super-new))) (super-new)))
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
(define insect-logic%
(class game-logic-object%
(init-field
(id 0)
(pos 0)
(type 'none)
(d (if (eq? type 'worm) (+ 20 (* 20 (rndf)))
(+ 10 (* 2 (rndf)))))) ; time to get from one place to another
(field
(next-update 0)
(centre (vector 0 0 0)))
(inherit send-message)
(define/public (get-id)
id)
(define/public (get-pos)
pos)
(define/public (get-type)
type)
(define/public (set-centre s)
(set! centre s))
(define (move)
; todo check stones
(let ((speed (if (eq? type 'worm) 5 50)))
(if (> (vdist pos centre) 100)
(set! pos (vadd pos (vmul (vnormalise (vsub centre pos)) speed)))
(set! pos (vadd pos (vmul (srndvec) speed))))
;(when (< (vdist pos centre) 12) (move))
(when (and (or (eq? type 'spider) (eq? type 'worm)) (> (vy pos) 0))
(set! pos (vector (vx pos) 0 (vz pos))))
(when (and (eq? type 'butterfly) (< (vy pos) 50))
(set! pos (vector (vx pos) 50 (vz pos))))))
(define/augment (update time delta)
(cond ((> time next-update)
(move)
; todo: drop stuff
;(when (zero? (random pickup-drop-probability))
; (send cell set-pickup! 'default))
(set! next-update (+ time d))
(send-message 'insect-move (list
(list 'insect-id id)
(list 'pos pos)
(list 'duration d)))))
'())
(super-new)))
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; a twig, which can contain other twigs things. ; a twig, which can contain other twigs things.
; (roots and shoots are both twigs) ; (roots and shoots are both twigs)
@ -245,15 +307,15 @@
twigs) twigs)
found))) found)))
(define/augment (update) (define/augment (update t d)
(append (append
(map (map
(lambda (ornament) (lambda (ornament)
(send (cadr ornament) update)) (send (cadr ornament) update t d))
ornaments) ornaments)
(map (map
(lambda (twig) (lambda (twig)
(send (cadr twig) update)) (send (cadr twig) update t d))
twigs))) twigs)))
(super-new))) (super-new)))
@ -323,19 +385,25 @@
(id #f) (id #f)
(pos (vector 0 0 0)) (pos (vector 0 0 0))
(col (vector 1 1 1)) (col (vector 1 1 1))
(tex "fff")) (tex "fff")
(is-player #f))
(field (field
(twigs '()) ; a assoc list map of ids to twigs (twigs '()) ; a assoc list map of ids to twigs
(leader-twig #f) ; the temporary twig controlled by the player (leader-twig #f) ; the temporary twig controlled by the player
(properties '()) ; a list of symbols - properties come from pickups (properties '(flower)) ; a list of symbols - properties come from pickups
(ornaments '()) ; map of ids to ornaments on the plant (ornaments '()) ; map of ids to ornaments on the plant
(size start-size) ; the age of this plant (size start-size) ; the age of this plant
(max-twigs default-max-twigs) ; the maximum twigs allowed at any time - oldest removed first (max-twigs default-max-twigs) ; the maximum twigs allowed at any time - oldest removed first
(next-twig-id 0) (next-twig-id 0)
(next-ornament-id 0) (next-ornament-id 0)
(grow-amount default-scale-factor) (grow-amount default-scale-factor)
(twig-size start-twig-points)) (twig-size start-twig-points)
(auto-pilot-t 0)
(auto-pilot-d (* (+ 1 (rndf)) auto-time))
(auto-twig #f)
(auto-twig-dir (hsrndvec))
(auto-twig-pos (vector 0 0 0)))
(inherit send-message) (inherit send-message)
@ -384,6 +452,7 @@
next-ornament-id)) next-ornament-id))
(define/public (check-pickup pickup) (define/public (check-pickup pickup)
(when (or is-player (random pickup-check-prob)) ; reduce the frequency for non-player plants
(when leader-twig (when leader-twig
(send leader-twig check-pickup pickup)) (send leader-twig check-pickup pickup))
@ -394,7 +463,7 @@
(send (cadr twig) check-pickup pickup)) (send (cadr twig) check-pickup pickup))
#f)) #f))
#f #f
twigs)) twigs)))
(define/public (destroy-twig twig) (define/public (destroy-twig twig)
(send-message 'shrink-twig (send-message 'shrink-twig
@ -461,7 +530,24 @@
(send (cadr twig) serialise)) (send (cadr twig) serialise))
twigs)))) twigs))))
(define/augment (update) (define/public (run-auto-pilot t d)
(when (> t auto-pilot-t)
(set! auto-pilot-t (+ t auto-pilot-d))
(when (or (not auto-twig) (not (send auto-twig growing?)))
(set! auto-twig (make-object twig-logic% (vector 0 0 0) 0 this 'root
auto-twig-dir
start-twig-width
twig-size
'ribbon))
(set! auto-twig-dir (hsrndvec))
(set! auto-twig-pos auto-twig-dir)
(add-twig auto-twig))
(set! auto-twig-dir (vmul (vnormalise (vadd auto-twig-dir (vmul (srndvec) auto-twig-var)))
(send auto-twig get-dist)))
(set! auto-twig-pos (vadd auto-twig-pos auto-twig-dir))
(grow auto-twig-pos)))
(define/augment (update t d)
; grow a new ornament? ; grow a new ornament?
(when (and (not (null? properties)) (zero? (random ornament-grow-probability))) (when (and (not (null? properties)) (zero? (random ornament-grow-probability)))
(let ((twig (get-random-twig))) (let ((twig (get-random-twig)))
@ -479,7 +565,7 @@
point-index)))))) point-index))))))
(map (map
(lambda (twig) (lambda (twig)
(send (cadr twig) update)) (send (cadr twig) update t d))
twigs)) twigs))
(super-new))) (super-new)))
@ -491,7 +577,8 @@
(field (field
(plants '()) (plants '())
(pickups '()) (pickups '())
(player #f)) (player #f)
(insects '()))
(inherit send-message) (inherit send-message)
@ -503,10 +590,16 @@
(add-pickup (make-object pickup-logic% i (list-ref pickup 0) (add-pickup (make-object pickup-logic% i (list-ref pickup 0)
(list-ref pickup 2))) (list-ref pickup 2)))
(set! i (+ i 1))) (set! i (+ i 1)))
pickups)))) pickups)
(for ((id (in-range 0 num-worms)))
(add-insect (make-object insect-logic% id (vmul (srndvec) 100) 'worm)))
(for ((id (in-range 0 num-spiders)))
(add-insect (make-object insect-logic% (+ id num-worms) (vmul (srndvec) 100) 'spider)))
(for ((id (in-range 0 num-butterflies)))
(add-insect (make-object insect-logic% (+ id num-worms num-butterflies) (vmul (srndvec) 100) 'butterfly)))
)))
(define/public (add-player plant) (define/public (add-player plant)
(printf "new player plant added ~a~n" (send plant get-id))
(send-message 'player-plant (list (send-message 'player-plant (list
(list 'plant-id (send plant get-id)) (list 'plant-id (send plant get-id))
(list 'pos (send plant get-pos)) (list 'pos (send plant get-pos))
@ -514,7 +607,12 @@
(list 'col (send plant get-col)) (list 'col (send plant get-col))
(list 'tex (send plant get-tex)))) (list 'tex (send plant get-tex))))
(set! player plant) (set! player plant)
(set! plants (cons plant plants))) (set! plants (cons plant plants))
(for-each
(lambda (insect)
(send insect set-centre (send plant get-pos)))
insects))
(define/public (add-plant plant) (define/public (add-plant plant)
(send-message 'new-plant (list (send-message 'new-plant (list
@ -533,13 +631,33 @@
(list 'pos (send pickup get-pos)))) (list 'pos (send pickup get-pos))))
(set! pickups (cons pickup pickups))) (set! pickups (cons pickup pickups)))
(define/public (add-insect insect)
(send-message 'new-insect (list
(list 'insect-id (send insect get-id))
(list 'pos (send insect get-pos))
(list 'type (send insect get-type))))
(send insect set-centre (send player get-pos))
(set! insects (cons insect insects)))
(define/public (serialise) (define/public (serialise)
(send player serialise)) (send player serialise))
(define/public (run-auto-pilot t d)
(for-each
(lambda (plant)
(when (not (eq? plant player))
(send plant run-auto-pilot t d)))
plants))
; todo - distribute the checking of stuff like ; todo - distribute the checking of stuff like
; this to a random selection of pickups/plants ; this to a random selection of pickups/plants
; to distribute the cpu load ; to distribute the cpu load
(define/augment (update) (define/augment (update t d)
(run-auto-pilot t d)
(for-each (for-each
(lambda (pickup) (lambda (pickup)
(for-each (for-each
@ -554,9 +672,14 @@
(not (send pickup picked-up?))) (not (send pickup picked-up?)))
pickups)) pickups))
(append
(map (map
(lambda (plant) (lambda (plant)
(send plant update)) (send plant update t d))
plants)) plants)
(map
(lambda (insect)
(send insect update t d))
insects)))
(super-new))) (super-new)))

BIN
plant-eyes/meshes/butterfly.blend Normal file
View file

Binary file not shown.

103
plant-eyes/meshes/butterfly.obj Normal file
View file

@ -0,0 +1,103 @@
# Blender3D v245 OBJ File: butterfly.blend
# www.blender3d.org
o butterfly_Mesh
v 0.022483 0.000002 -0.790792
v 0.286519 0.000002 -0.808224
v 0.569586 0.000002 -0.813275
v 1.053234 0.000002 -0.802641
v 1.513902 0.000002 -0.768308
v 1.995211 0.000002 -0.662639
v 2.293338 0.000002 -0.513493
v 2.242126 0.000002 -0.382030
v 2.075995 0.000002 -0.176237
v 1.843004 0.000002 -0.029013
v 1.573859 0.000002 0.086073
v 1.118858 0.000002 0.190916
v 0.741962 0.000002 0.295921
v 0.771135 0.000002 0.497448
v 0.756951 0.000002 0.640671
v 0.596358 0.000002 0.745205
v 0.434684 0.000002 0.768079
v 0.244420 0.000002 0.751611
v 0.089934 0.000002 0.663155
v 0.042516 0.000002 0.533723
v 0.014988 0.000002 0.400845
vt 0.455701 0.993275 0.0
vt 0.243421 1.000000 0.0
vt 0.119179 0.996805 0.0
vt 0.119179 0.996805 0.0
vt 0.003289 0.985782 0.0
vt 0.455701 0.993275 0.0
vt 0.455701 0.993275 0.0
vt 0.003289 0.985782 0.0
vt 0.689145 0.995001 0.0
vt 0.837582 0.995001 0.0
vt 0.003289 0.985782 0.0
vt 0.011719 0.552540 0.0
vt 1.001961 0.943805 0.0
vt 0.837582 0.995001 0.0
vt 0.011719 0.552540 0.0
vt 1.000000 0.810426 0.0
vt 1.001961 0.943805 0.0
vt 0.011719 0.552540 0.0
vt 1.004866 0.699950 0.0
vt 1.000000 0.810426 0.0
vt 0.011719 0.552540 0.0
vt 1.002261 0.585438 0.0
vt 1.004866 0.699950 0.0
vt 0.011719 0.552540 0.0
vt 1.001561 0.484525 0.0
vt 1.002261 0.585438 0.0
vt 0.011719 0.552540 0.0
vt 0.996710 0.400030 0.0
vt 1.001561 0.414213 0.0
vt 0.972656 0.439259 0.0
vt 0.988410 0.279043 0.0
vt 0.996710 0.400030 0.0
vt 0.964844 0.361134 0.0
vt 0.998766 0.161859 0.0
vt 0.992316 0.173574 0.0
vt 0.937500 0.251759 0.0
vt 0.777196 0.206295 0.0
vt 0.600329 0.755609 0.0
vt 0.015625 0.501759 0.0
vt 0.777196 0.206295 0.0
vt 0.007812 0.540821 0.0
vt 0.008176 0.464606 0.0
vt 0.657689 0.072756 0.0
vt 0.777196 0.206295 0.0
vt 0.008176 0.464606 0.0
vt 0.657689 0.072756 0.0
vt 0.008176 0.464606 0.0
vt 0.028988 0.304632 0.0
vt 0.505172 0.010559 0.0
vt 0.657689 0.072756 0.0
vt 0.025082 0.304632 0.0
vt 0.505172 0.010559 0.0
vt 0.021176 0.304632 0.0
vt 0.030388 0.026039 0.0
vt 0.438117 0.003906 0.0
vt 0.665328 0.002746 0.0
vt 0.100701 0.010414 0.0
vn 0.000000 1.000000 -0.000000
usemtl None_butterfly.png
s off
f 4/1/1 3/2/1 2/3/1
f 2/4/1 1/5/1 4/6/1
f 4/7/1 1/8/1 5/9/1
f 5/10/1 1/11/1 21/12/1
f 6/13/1 5/14/1 21/15/1
f 7/16/1 6/17/1 21/18/1
f 8/19/1 7/20/1 21/21/1
f 9/22/1 8/23/1 21/24/1
f 10/25/1 9/26/1 21/27/1
f 11/28/1 10/29/1 21/30/1
f 12/31/1 11/32/1 21/33/1
f 13/34/1 12/35/1 21/36/1
f 14/37/1 13/38/1 21/39/1
f 14/40/1 21/41/1 20/42/1
f 15/43/1 14/44/1 20/45/1
f 15/46/1 20/47/1 19/48/1
f 16/49/1 15/50/1 19/51/1
f 16/52/1 19/53/1 18/54/1
f 17/55/1 16/56/1 18/57/1

69
plant-eyes/meshes/butterfly.svg Normal file
View file

@ -0,0 +1,69 @@
<?xml version="1.0" encoding="UTF-8" standalone="no"?>
<!-- Created with Inkscape (http://www.inkscape.org/) -->
<svg
xmlns:dc="http://purl.org/dc/elements/1.1/"
xmlns:cc="http://creativecommons.org/ns#"
xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
xmlns:svg="http://www.w3.org/2000/svg"
xmlns="http://www.w3.org/2000/svg"
xmlns:sodipodi="http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd"
xmlns:inkscape="http://www.inkscape.org/namespaces/inkscape"
width="744.09448819"
height="1052.3622047"
id="svg2"
sodipodi:version="0.32"
inkscape:version="0.46"
sodipodi:docname="butterfly.svg"
inkscape:output_extension="org.inkscape.output.svg.inkscape">
<defs
id="defs4">
<inkscape:perspective
sodipodi:type="inkscape:persp3d"
inkscape:vp_x="0 : 526.18109 : 1"
inkscape:vp_y="0 : 1000 : 0"
inkscape:vp_z="744.09448 : 526.18109 : 1"
inkscape:persp3d-origin="372.04724 : 350.78739 : 1"
id="perspective10" />
</defs>
<sodipodi:namedview
id="base"
pagecolor="#ffffff"
bordercolor="#666666"
borderopacity="1.0"
gridtolerance="10000"
guidetolerance="10"
objecttolerance="10"
inkscape:pageopacity="0.0"
inkscape:pageshadow="2"
inkscape:zoom="0.7"
inkscape:cx="375"
inkscape:cy="520"
inkscape:document-units="px"
inkscape:current-layer="layer1"
showgrid="false"
inkscape:window-width="645"
inkscape:window-height="717"
inkscape:window-x="0"
inkscape:window-y="25" />
<metadata
id="metadata7">
<rdf:RDF>
<cc:Work
rdf:about="">
<dc:format>image/svg+xml</dc:format>
<dc:type
rdf:resource="http://purl.org/dc/dcmitype/StillImage" />
</cc:Work>
</rdf:RDF>
</metadata>
<g
inkscape:label="Layer 1"
inkscape:groupmode="layer"
id="layer1">
<path
style="fill:none;fill-rule:evenodd;stroke:#000000;stroke-width:1px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1"
d="M 235.71428,273.79076 C 254.90915,270.64427 315.96816,269.50504 340,269.50504 C 421.01141,269.11452 444.82891,272.44383 520,278.07647 C 575.79111,290.85363 659.33671,302.82084 668.57143,326.64789 C 671.77064,334.64592 653.15086,364.04446 627.14286,390.93361 C 594.26,410.92531 573.50029,429.10984 531.42857,440.93361 C 482.10711,455.49717 402.32808,466.32873 372.85715,480.93361 C 374.52787,514.27008 385.06319,528.12923 375.71428,546.64789 C 355.38533,569.88117 334.88967,568.45444 314.28571,570.93362 C 292.75817,575.1478 261.00591,565.01549 248.57143,550.93361 C 238.33599,532.98879 239.46617,519.75441 234.28571,500.93361"
id="path2383"
sodipodi:nodetypes="ccccccccccc" />
</g>
</svg>
Side by side

After

Width:  |  Height:  |  Size: 2.7 KiB

3
plant-eyes/plant-eyes.scm
View file

@ -44,6 +44,7 @@
(clear) (clear)
(clear-shader-cache) (clear-shader-cache)
(clear-texture-cache)
(define mode 'gui) (define mode 'gui)
(define gui (make-object gui-game-mode% (list-ref world-list 0))) (define gui (make-object gui-game-mode% (list-ref world-list 0)))
@ -60,7 +61,7 @@
(cond (cond
((eq? mode 'gui) ((eq? mode 'gui)
(when (send gui update (flxtime) (delta)) (when (send gui update (flxtime) (delta))
(send game setup (send gui get-player-info)) (send game setup (send gui get-player-info) (send gui get-players))
(set! mode 'game))) (set! mode 'game)))
((eq? mode 'game) ((eq? mode 'game)
(send game update (flxtime) (delta)))) (send game update (flxtime) (delta))))

BIN
plant-eyes/textures/butterfly.png Normal file
View file

Binary file not shown.
Side by side

After

Width:  |  Height:  |  Size: 15 KiB

BIN
plant-eyes/textures/ribbon-twig.png Normal file
View file

Binary file not shown.
Side by side

After

Width:  |  Height:  |  Size: 1.8 KiB

BIN
plant-eyes/textures/root-norm.png
View file

Binary file not shown.
Side by side Swipe Overlay

Before

Width:  |  Height:  |  Size: 398 KiB

After

Width:  |  Height:  |  Size: 88 KiB

700
plant-eyes/view.ss
View file

@ -1,19 +1,22 @@
#lang scheme/base #lang scheme/base
(require scheme/class fluxus-016/fluxus "sound.ss" "message.ss" "list-utils.ss" "ornament-views.ss") (require scheme/class fluxus-016/fluxus fluxus-016/shapes "sound.ss" "message.ss" "list-utils.ss" "ornament-views.ss")
(provide (all-defined-out)) (provide (all-defined-out))
; the fluxus code to make things look the way they do ; the fluxus code to make things look the way they do
(define debug-messages #f) ; prints out all the messages sent to the renderer (define debug-messages #f) ; prints out all the messages sent to the renderer
(define (ornament-colour) (vector 0.5 1 0.4)) (define (ornament-colour) (vector 0.7 0.7 0.7))
(define (pickup-colour) (vector 1 1 0.5)) (define (pickup-colour) (vector 1 1 1))
(define (earth-colour) (vector 0.2 0.1 0)) (define (earth-colour) (vector 0.1 0.1 0.1))
(define (stones-colour) (vmul (earth-colour) (+ 0.5 (* (rndf) 0.5)))) (define (dust-colour) (vmul (vector 0.05 0.05 0.05) (* 2 (rndf))))
(define (stones-colour) (vmul (vector 0.5 0.5 0.5) (* (crndf) 0.5)))
(define (alive-colour) (vmul (vector 1 1 1) (+ 0.5 (* (rndf) 0.5))))
(define (worm-colour) (vmul (vector 0.8 0.8 0.8) (+ 0.5 (* (rndf) 0.5))))
(define wire-mode #f) (define wire-mode #f)
(define fog-col (earth-colour)) (define fog-col (earth-colour))
(define fog-strength 0.01) (define fog-strength 0.1)
(define default-grow-speed 0.5) (define default-grow-speed 0.5)
(define grow-overshoot 10) (define grow-overshoot 10)
@ -22,6 +25,10 @@
(define fin-grow-prob 200) (define fin-grow-prob 200)
(define max-fins-per-twig 5) (define max-fins-per-twig 5)
(define above-fog-col (vector 1 1 1))
(define above-fog-strength 0.01)
(define ground-change-duration 4)
(define (pre-ripple) (define (pre-ripple)
(when (not (pdata-exists? "rip-pref")) (when (not (pdata-exists? "rip-pref"))
(pdata-copy "p" "rip-pref"))) (pdata-copy "p" "rip-pref")))
@ -36,8 +43,260 @@
(vector 0 0 0)))))))))) (vector 0 0 0))))))))))
"p" "rip-pref")) "p" "rip-pref"))
(define (fract n)
(- n (floor n)))
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
(define dust%
(class object%
(field
(rate 1)
(above-ground #f)
(next-p 0)
(root (let ((p (with-state
(colour 0)
(hint-depth-sort)
(texture (load-texture "textures/particle.png"))
(build-particles 1000))))
(with-primitive p
(pdata-map!
(lambda (c)
(vector 0 0 0 0.01))
"c")
(pdata-map!
(lambda (p)
(vmul (srndvec) 100))
"p")
(pdata-map!
(lambda (s)
(let ((s (* 4 (rndf))))
(vector s s s)))
"s")) p))
(emitter (with-state (build-locator)))
(pos (with-primitive root (vtransform (vector 0 0 0) (get-global-transform)))))
(define/public (set-above-ground s)
(set! above-ground s)
(with-primitive root
(colour (if s 1 0))
(pdata-map!
(lambda (c)
(if s (vector 1 1 1 0.01) (vector 0 0 0 0.01)))
"c")))
(define/public (update t d)
(let ((emitter-pos (with-primitive emitter
(identity)
(translate (vmul pos -1)) ; makes the particles relative to the centre of the plant
(concat (get-locked-matrix)) ; which makes the depth sorting work better
(translate (vector 0 0 -10))
(vtransform (vector 0 0 0) (get-transform)))))
(with-primitive root
(for ((i (in-range 0 rate)))
(pdata-set! "p" next-p (vadd emitter-pos (vmul (srndvec) 10)))
(pdata-set! "c" next-p (if above-ground (vector 1 1 1 0.01) (vector 0 0 0 0.01)))
(pdata-set! "s" next-p (let ((s (* 4 (rndf)))) (vector s s s)))
(set! next-p (+ next-p 1)))
(pdata-op "*" "c" 1.04)
(pdata-op "*" "s" 0.995))))
(super-new)))
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
(define insect-view%
(class object%
(init-field
(id 0)
(from (vector 0 0 0))
(type 'none))
(field
(to (vector 0 0 0))
(from-dir (vector 1 0 0))
(to-dir (vector 1 0 0))
(time 0)
(tick 1))
(define/public (move pos dur)
(set! from to)
(set! from-dir to-dir)
(set! to pos)
(set! to-dir (vnormalise (vsub from to)))
(set! time 0)
(set! tick dur))
(define/public (update t d)
(set! time (+ time d)))
(define/public (do-tx t d)
(let* ((t (min (/ time tick) 1))
(h (hermite-tangent from to (vmul from-dir 2) (vmul to-dir 2) t)))
(translate (car h))
(concat (maim (vector 0 0 1) (vnormalise (cadr h)))))
(set! time (+ time d)))
(super-new)))
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
(define (add-blendshape key model)
(let ((b (load-primitive model))
(pname (string-append "p" (number->string key))))
(pdata-add pname "v")
(pdata-index-map!
(lambda (i p)
(with-primitive b (pdata-ref "p" i)))
pname)
(destroy b)))
(define (set-blendshape key)
(pdata-copy (string-append "p" (number->string key)) "p"))
(define spider-insect-view%
(class insect-view%
(inherit-field from to from-dir to-dir time tick)
(inherit do-tx)
(field
(root (let ((p (with-state
(hint-unlit)
(colour (vector 0 0 0))
(load-primitive "meshes/spider-1.obj"))))
(with-primitive p
(pdata-copy "p" "p0")
(add-blendshape 1 "meshes/spider-2.obj")
(add-blendshape 2 "meshes/spider-3.obj") p)))
(anim-t 0)
(anim-d (* 0.2 (rndf)))
(blendshape 0))
(define/override (update t d)
(with-primitive root
(when (> anim-t anim-d)
(set! anim-t 0)
(set! blendshape (modulo (+ blendshape 1) 3))
(set-blendshape blendshape))
(identity)
(do-tx t d)
(scale 1))
(set! anim-t (+ anim-t d)))
(super-new)))
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
(define butterfly-insect-view%
(class insect-view%
(inherit-field from to from-dir to-dir time tick)
(inherit do-tx)
(field
(root (let ((p (build-locator)))
(with-state
(colour (rndvec))
(parent p)
(hint-depth-sort)
(hint-unlit)
(backfacecull 0)
(texture (load-texture "textures/butterfly.png"))
(load-primitive "meshes/butterfly.obj")
(translate (vector 0 0.001 0))
(load-primitive "meshes/butterfly.obj")) p)))
(define/override (update t d)
(with-primitive root
(let ((a (* 90 (rndf))))
(with-primitive (car (get-children))
(rotate (vector 0 0 a)))
(with-primitive (cadr (get-children))
(rotate (vector 0 0 (- a)))))
(identity)
(do-tx t d)
(scale 1))
(set! time (+ time d)))
(super-new)))
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
(define worm-insect-view%
(class insect-view%
(inherit-field from to from-dir to-dir time tick)
(field
(hidden #t)
(from2 (vector 0 0 0))
(from-dir2 (vector 0 0 0))
(root (let ((p (build-ribbon 20)))
(with-primitive p
(translate (vector 0 0 -0.1))
(hint-depth-sort)
;(hint-unlit)
(colour (worm-colour))
(texture (load-texture "textures/worm.png"))
(let ((width (+ 0.5 (* 0.5 (rndf)))))
(pdata-index-map!
(lambda (i w)
width #;(+ 0.05 (* (abs (sin (* i 0.5))) 0.1)))
"w"))
#;(pdata-map!
(lambda (c)
(vector 1 1 1))
"c"))
p)))
(define/override (move pos dur)
(set! from2 from)
(set! from to)
(set! from-dir2 from-dir)
(set! from-dir to-dir)
(set! to pos)
(set! to-dir (vmul (vsub to from) 5))
(set! time 0)
(set! tick dur))
(define/override (update t d)
(let ((nt (/ time tick))) ; normalise time
(with-primitive root
(pdata-index-map!
(lambda (i p)
(let ((st (- nt (* i 0.05))))
(if (< st 0)
(hermite from2 from (vmul from-dir2 2) (vmul from-dir 2) (+ st 1))
(hermite from to (vmul from-dir 2) (vmul to-dir 2) st))))
"p")))
(set! time (+ time d)))
(super-new)))
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
(define (build-squiggle x y)
(let ((p (build-ribbon 30))
(x (/ x 10))
(y (/ y 10)))
(with-primitive p
(pdata-index-map!
(lambda (i p)
(vector (cos (/ i x)) (sin (/ i y)) (/ i (pdata-size))))
"p")
(pdata-index-map!
(lambda (i p)
(* 0.1 (sin (* 3.141 (/ i (pdata-size))))))
"w")
(pdata-map!
(lambda (c)
(vector 1 1 1))
"c")
(recalc-bb))
p))
(define pickup-view% (define pickup-view%
(class object% (class object%
(init-field (init-field
@ -51,20 +310,17 @@
(translate pos) (translate pos)
(rotate rot) (rotate rot)
(colour (pickup-colour)) (colour (pickup-colour))
(shader "shaders/textoon.vert.glsl" "shaders/textoon.frag.glsl") (emissive (pickup-colour))
(hint-frustum-cull) (hint-frustum-cull)
(texture (load-texture "textures/wiggle.png")) (cond ; 0127461816
(cond ((eq? type 'wiggle) (build-squiggle 4 2))
((eq? type 'wiggle) (load-primitive "meshes/pickup.obj")) ((eq? type 'leaf) (build-squiggle 2 4))
((eq? type 'leaf) ((eq? type 'curly) (build-squiggle 4 6))
(texture (load-texture "textures/leaf.png")) ((eq? type 'nutrient) (build-squiggle 2 2))
(load-primitive "meshes/leaf.obj")) ((eq? type 'horn) (build-squiggle 3 4))
((eq? type 'curly) (load-primitive "meshes/pickup.obj")) ((eq? type 'inflatoe) (build-squiggle 4 5))
((eq? type 'nutrient) (load-primitive "meshes/nutrient.obj")) ((eq? type 'fork) (build-squiggle 5 2))
((eq? type 'horn) (load-primitive "meshes/horn.obj")) ((eq? type 'flower) (build-squiggle 4 3)))))
((eq? type 'inflatoe) (load-primitive "meshes/inflatoe-full.obj"))
((eq? type 'fork) (load-primitive "meshes/fork.obj"))
((eq? type 'flower) (load-primitive "meshes/flower.obj")))))
(from pos) (from pos)
(destination (vector 0 0 0)) (destination (vector 0 0 0))
(speed 0.05) (speed 0.05)
@ -73,6 +329,9 @@
(define/public (pick-up) (define/public (pick-up)
(destroy root)) (destroy root))
(define/public (get-root)
root)
(define/public (move-to s) (define/public (move-to s)
(set! t 0) (set! t 0)
(set! from pos) (set! from pos)
@ -92,6 +351,7 @@
(super-new))) (super-new)))
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
(define twig-view% (define twig-view%
(class object% (class object%
@ -111,53 +371,30 @@
(col (vector 1 1 1)) (col (vector 1 1 1))
(tex "") (tex "")
(markers '()) (markers '())
(shrink-t 0)
(grow-t -1) (grow-t -1)
(marker-destroy-t 0) (marker-destroy-t 0)
(grow-speed default-grow-speed) (grow-speed default-grow-speed)
(shrink-t 0)
(delme #f)) (delme #f))
(define/public (get-id) (define/public (get-id) id)
id) (define/public (delme?) delme)
(define/public (get-dir) dir)
(define/public (delme?) (define/public (set-dir! s) (set! dir s))
delme) (define/public (set-col! s) (set! col s))
(define/public (set-tex! s) (set! tex s))
(define/public (get-dir) (define/public (get-pos) pos)
dir) (define/public (build) 0)
(define/public (get-num-points) index)
(define/public (set-col! s) (define/public (get-grow-t) grow-t)
(set! col s)) (define/public (set-pos! s) (set! pos s))
(define/public (get-child-twig-ids) child-twig-ids)
(define/public (set-tex! s) (define/public (get-root) (error "need to overide this"))
(set! tex s)) (define/public (destroy-twig) (destroy (get-root)))
(define/public (set-parent-twig-id s) (set! parent-twig-id s))
(define/public (build) (define/public (get-point point-index) (error "need to overide this"))
0) (define/public (get-width point-index) (error "need to overide this"))
(define/public (set-grow-speed s) (set! grow-speed s))
(define/public (get-num-points)
index)
(define/public (set-pos! s)
(set! pos s))
(define/public (get-child-twig-ids)
child-twig-ids)
(define/public (get-root)
(error "need to overide this"))
(define/public (destroy-twig)
(destroy (get-root)))
(define/public (set-parent-twig-id s)
(set! parent-twig-id s))
(define/public (get-point point-index)
(error "need to overide this"))
(define/public (get-width point-index)
(error "need to overide this"))
(define/public (add-child-twig-id twig-id) (define/public (add-child-twig-id twig-id)
(set! child-twig-ids (cons twig-id child-twig-ids))) (set! child-twig-ids (cons twig-id child-twig-ids)))
@ -172,17 +409,18 @@
(define/public (start-shrinking) (define/public (start-shrinking)
(set! shrink-t (if (growing?) grow-t (+ num-points grow-overshoot)))) (set! shrink-t (if (growing?) grow-t (+ num-points grow-overshoot))))
(define/pubment (add-point point width) (define/pubment (add-point point width make-marker)
(play-sound "snd/event01.wav" point (+ 0.1 (rndf)) 0.3) (play-sound "snd/event01.wav" point (+ 0.1 (rndf)) 0.3)
(when make-marker
(set! markers (append markers (list (with-state (set! markers (append markers (list (with-state
(parent (get-root)) (parent (get-root))
(translate point) (translate point)
(scale 0.1) (scale 0.1)
(shader "shaders/toon.vert.glsl" "shaders/toon.frag.glsl") (shader "shaders/toon.vert.glsl" "shaders/toon.frag.glsl")
(colour col) (colour col)
(build-sphere 8 8))))) (build-sphere 8 8))))))
(inner (void) add-point point width)) (inner (void) add-point point width make-marker))
(define/public (add-ornament point-index property) (define/public (add-ornament point-index property)
(when (< point-index grow-t) (when (< point-index grow-t)
@ -195,11 +433,12 @@
(vnormalise (vsub (get-point point-index) (get-point (- point-index 1)))) (vnormalise (vsub (get-point point-index) (get-point (- point-index 1))))
col))) col)))
; check above ground ; check above ground
(let ((pos (with-primitive (get-root) (vtransform (vector 0 0 0) (get-global-transform)))))
(if (not (and (send ornament above-ground-only?) (if (not (and (send ornament above-ground-only?)
(< (vy (get-point point-index)) 1))) (< (vy (vadd pos (get-point point-index))) 1)))
; todo - delete existing ornaments here ; todo - delete existing ornaments here
(set! ornaments (cons (list point-index ornament) ornaments)) (set! ornaments (cons (list point-index ornament) ornaments))
(send ornament destroy-ornament)))))) (send ornament destroy-ornament)))))))
(define/pubment (set-excitations! a b) (define/pubment (set-excitations! a b)
(for-each (for-each
@ -239,16 +478,21 @@
(define ribbon-twig-view% (define ribbon-twig-view%
(class twig-view% (class twig-view%
(inherit-field pos radius num-points index col tex) (inherit-field pos radius num-points index col tex grow-t)
(field (field
(root 0)) (root 0)
(widths '())
(points '())
(global-growth 0)
(global-growth-time 20))
(define/override (build) (define/override (build)
(set! root (let ((p (with-state (set! root (let ((p (with-state
(translate pos) (translate pos)
(colour col) (colour (vmul col 0.2))
(texture (load-texture tex)) (hint-unlit)
(texture (load-texture "textures/ribbon-twig.png"))
(build-ribbon num-points)))) (build-ribbon num-points))))
(with-primitive p (with-primitive p
(pdata-map! (pdata-map!
@ -262,35 +506,124 @@
(define/override (get-root) (define/override (get-root)
root) root)
(define/override (get-point point-index) #;(define/override (get-point point-index)
(with-primitive root (with-primitive root
(pdata-ref "p" point-index))) (pdata-ref "p" point-index)))
(define/override (get-width point-index) #;(define/override (get-width point-index)
(with-primitive root (with-primitive root
(pdata-ref "w" point-index))) (pdata-ref "w" point-index)))
(define/augment (add-point point width) (define/override (get-point point-index)
(with-primitive root (list-ref points point-index))
(define/override (get-width point-index)
(list-ref widths point-index))
(define/augment (add-point point width make-marker)
#;(with-primitive root
(pdata-index-map! ; set all the remaining points to the end (pdata-index-map! ; set all the remaining points to the end
(lambda (i p) ; in order to hide them (lambda (i p) ; in order to hide them
(if (< i index) (if (< i index)
p p
point)) point))
"p") "p"))
(pdata-index-map! ; do a similar thing with the width (set! widths (append widths (list width)))
(lambda (i w) (set! points (append points (list point)))
(if (< i (+ index 1))
w
width))
"w"))
(set! index (+ index 1))) (set! index (+ index 1)))
(define/augment (update t d) (define/augment (update t d)
0) (when (and (> grow-t 0) (< grow-t (+ (length points) 10)))
(with-primitive root
(pdata-index-map!
(lambda (i w)
(* (/ global-growth global-growth-time)
(cond ((< i (- grow-t 1))
(list-ref widths i))
((< i grow-t)
(* (list-ref widths i) (fract grow-t)))
(else
0))))
"w")
(pdata-index-map!
(lambda (i p)
(cond ((< i (- grow-t 1))
(list-ref points i))
((equal? i (inexact->exact (floor (+ grow-t 1))))
(vmix
(list-ref points i)
(list-ref points (- i 1)) (fract grow-t)))
(else
(list-ref points i))))
"p")))
(when (< global-growth global-growth-time)
(set! global-growth (+ global-growth d))))
(super-new))) (super-new)))
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; bunches of ribbon twigs
(define twiglets%
(class object%
(init-field
(par 0))
(field
(twigs '()))
(define/public (build pos dir width length)
(set! twigs (list (build-tree pos dir width length))))
(define (build-tree pos dir width length)
(let ((t (make-object ribbon-twig-view% 0 pos 'ribbon
dir
(* width (+ 0.5 (rndf))) length)))
(send t set-grow-speed 0.1)
(with-state
(parent par)
(send t build))
(let ((m (mrotate (vmul (srndvec) 45)))
(ppos (vector 0 0 0)))
(for ((i (in-range 0 length)))
(let ((dir (vtransform (send t get-dir) m))
(width (if (eq? i (- length 1)) 0 (/ width (+ i 1)))))
(send t set-dir! dir)
(send t add-point ppos width #f)
(set! ppos (vadd ppos (vmul dir (* 5 width)))))))
(send t start-growing)
t))
(define/public (update t d)
(for-each
(lambda (twig)
(send twig update t d)
(when (and
(< (length twigs) 50)
(> (send twig get-num-points) 2)
(zero? (random 20)))
(let ((pi (inexact->exact (floor (send twig get-grow-t)))))
(when (< pi (send twig get-num-points))
(with-state
(translate (vadd (send twig get-pos) (send twig get-point pi)))
(build-sphere 5 5))
(set! twigs (cons
(build-tree
(vadd (send twig get-pos) (send twig get-point pi))
(send twig get-dir)
(/ (send twig get-width pi) 1.4)
(/ (send twig get-num-points) 2))
twigs))))))
twigs))
(super-new)))
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
(define fin% (define fin%
@ -353,10 +686,11 @@
(path '()) (path '())
(root 0) (root 0)
(widths '()) (widths '())
(fins '())) (fins '())
(twiglets '()))
(define/override (build) (define/override (build)
(set! profile (build-circle-profile 12 1)) (set! profile (build-circle-points 12 1))
(set! path (build-list num-points (lambda (_) (vector 0 0 0)))) (set! path (build-list num-points (lambda (_) (vector 0 0 0))))
(set! widths (build-list num-points (lambda (_) 1))) (set! widths (build-list num-points (lambda (_) 1)))
(set! root (let ((p (with-state (set! root (let ((p (with-state
@ -364,14 +698,20 @@
(when wire-mode (when wire-mode
(hint-none) (hint-none)
(hint-wire)) (hint-wire))
(shader "shaders/toon.vert.glsl" "shaders/toon.frag.glsl") (shader "shaders/twig.vert.glsl" "shaders/twig.frag.glsl")
;(shader "shaders/frtrans.vert.glsl" "shaders/frtrans.frag.glsl") ;(shader "shaders/toon.vert.glsl" "shaders/toon.frag.glsl")
(texture (load-texture tex)) (texture (load-texture "textures/cells-1.png"))
(multitexture 1 (load-texture "textures/cells-2.png"))
(multitexture 2 (load-texture "textures/cells-3.png"))
(multitexture 3 (load-texture "textures/root-norm.png"))
(opacity 0.6) (opacity 0.6)
(colour col) (colour col)
#;(colour (vector 1 1 1)) #;(colour (vector 1 1 1))
#;(texture (load-texture "textures/root.png")) #;(texture (load-texture "textures/root.png"))
(build-partial-extrusion profile path 3)))) (build-partial-extrusion profile path 3))))
(with-primitive p
(shader-set! (list "Maps" (list 0 1 2) "NormalMap" 3)))
p))) p)))
(define/override (get-root) (define/override (get-root)
@ -388,13 +728,21 @@
((zero? c) (cons s (list-set (cdr l) (- c 1) s))) ((zero? c) (cons s (list-set (cdr l) (- c 1) s)))
(else (cons (car l) (list-set (cdr l) (- c 1) s))))) (else (cons (car l) (list-set (cdr l) (- c 1) s)))))
(define/augment (add-point point width) (define/augment (add-point point width make-marker)
(set! path (list-set path index point)) (set! path (list-set path index point))
(set! widths (list-set widths index width)) (set! widths (list-set widths index width))
(set! index (+ index 1))) (set! index (+ index 1)))
(define/augment (update t d) (define/augment (update t d)
(when (and (zero? (random fin-grow-prob)) (with-primitive root
(shader-set! (list "Time" t))
#;(let ((t (inexact->exact (round (fmod (* 5 t) 3)))))
(cond
((eq? t 0) (texture (load-texture "textures/cells-1.png")))
((eq? t 1) (texture (load-texture "textures/cells-2.png")))
((eq? t 2) (texture (load-texture "textures/cells-3.png"))))))
#;(when (and (zero? (random fin-grow-prob))
(< (length fins) max-fins-per-twig) (< (length fins) max-fins-per-twig)
(not (growing?)) (not (growing?))
(> (length path) 1)) (> (length path) 1))
@ -409,7 +757,19 @@
(send fin update t d)) (send fin update t d))
fins) fins)
(for-each
(lambda (twiglet)
(send twiglet update t d))
twiglets)
(when (and (not (eq? grow-t -1)) (not (eq? grow-t 999))) (when (and (not (eq? grow-t -1)) (not (eq? grow-t 999)))
; randomly add twiglets as we are growing
(when (and (zero? (random 400)) (< grow-t num-points))
(printf "~a~n" (length twiglets))
(let ((t (make-object twiglets% (get-root)))
(pi (inexact->exact (floor grow-t))))
(send t build (get-point pi) dir (/ (get-width pi) 2) 20)
(set! twiglets (cons t twiglets))))
(with-primitive root (with-primitive root
(partial-extrude grow-t profile path widths (vector 1 0 0) 0.05))) (partial-extrude grow-t profile path widths (vector 1 0 0) 0.05)))
@ -438,7 +798,8 @@
(pos (vector 0 0 0)) (pos (vector 0 0 0))
(size 0) (size 0)
(col (vector 1 1 1)) (col (vector 1 1 1))
(tex "")) (tex "")
(is-player #f))
(field (field
(twigs '()) ; a assoc list map between ids and twigs stored flat here, (twigs '()) ; a assoc list map between ids and twigs stored flat here,
@ -446,27 +807,36 @@
(root (with-state (root (with-state
(translate pos) (translate pos)
(build-locator))) (build-locator)))
(seed (with-state (seed (let ((p (with-state
(parent root) (parent root)
(shader "shaders/toon.vert.glsl" "shaders/toon.frag.glsl") (shader "shaders/twig.vert.glsl" "shaders/twig.frag.glsl")
;(shader "shaders/frtrans.vert.glsl" "shaders/frtrans.frag.glsl") ;(shader "shaders/toon.vert.glsl" "shaders/toon.frag.glsl")
(texture (load-texture tex)) (texture (load-texture "textures/cells-1.png"))
(multitexture 1 (load-texture "textures/cells-2.png"))
(multitexture 2 (load-texture "textures/cells-3.png"))
(multitexture 3 (load-texture "textures/root-norm.png"))
(backfacecull 0) (backfacecull 0)
(opacity 0.6) (opacity 0.75)
(colour col) (colour col)
(hint-depth-sort) (hint-depth-sort)
(scale (* 0.12 size)) (scale (* 0.06 size))
(when wire-mode (when wire-mode
(hint-none) (hint-none)
(hint-wire)) (hint-wire))
;(hint-unlit) ;(hint-unlit)
(load-primitive "meshes/seed.obj"))) (load-primitive "meshes/seed.obj"))))
(with-primitive p
(shader-set! (list "Maps" (list 0 1 2) "NormalMap" 3)))
p))
(dust (if is-player (with-state
(parent root)
(make-object dust%)) #f))
(nutrients (let ((p (with-state (nutrients (let ((p (with-state
(hint-depth-sort) (hint-depth-sort)
(hint-unlit) (hint-unlit)
(parent root) (parent root)
(blend-mode 'src-alpha 'one) (blend-mode 'src-alpha 'one)
(texture (load-texture "textures/star.png")) (texture (load-texture "textures/smoke.png"))
(build-particles 100)))) (build-particles 100))))
(with-primitive p (with-primitive p
(pdata-add "twig" "f") (pdata-add "twig" "f")
@ -487,7 +857,7 @@
"offset") "offset")
(pdata-map! (pdata-map!
(lambda (c) (lambda (c)
(vector 0 (rndf) (rndf))) (vector 1 1 1))
"c") "c")
(pdata-map! (pdata-map!
(lambda (p) (lambda (p)
@ -553,7 +923,7 @@
(define/public (add-twig-point twig-id point width) (define/public (add-twig-point twig-id point width)
(when (get-twig twig-id) (when (get-twig twig-id)
(send (get-twig twig-id) add-point point width))) (send (get-twig twig-id) add-point point width is-player)))
(define/public (start-twig-growing twig-id) (define/public (start-twig-growing twig-id)
(when (get-twig twig-id) (when (get-twig twig-id)
@ -605,8 +975,24 @@
(vadd p (vmul (vnormalise (vsub (vadd (send twig get-point point) offset) p)) (* speed d))))))) (vadd p (vmul (vnormalise (vsub (vadd (send twig get-point point) offset) p)) (* speed d)))))))
"p" "twig" "point" "offset" "speed")))) "p" "twig" "point" "offset" "speed"))))
(define/public (above-ground)
(when dust (send dust set-above-ground #t)))
(define/public (below-ground)
(when dust (send dust set-above-ground #f)))
(define/public (update t d) (define/public (update t d)
(when dust (send dust update t d))
(with-primitive seed
(shader-set! (list "Time" t))
#;(let ((t (inexact->exact (round (fmod (* 5 t) 3)))))
(cond
((eq? t 0) (texture (load-texture "textures/cells-1.png")))
((eq? t 1) (texture (load-texture "textures/cells-2.png")))
((eq? t 2) (texture (load-texture "textures/cells-3.png"))))))
(update-nutrients t d) (update-nutrients t d)
(with-primitive seed (with-primitive seed
(scale (+ 1 (* 0.001 (sin (* 2 t)))))) (scale (+ 1 (* 0.001 (sin (* 2 t))))))
@ -683,10 +1069,26 @@
(field (field
(plants '()) ; map of ids -> plants (plants '()) ; map of ids -> plants
(pickups '()) ; map of ids -> pickups (pickups '()) ; map of ids -> pickups
(insects '()) ; map of ids -> insects
(camera-dist 1) (camera-dist 1)
(env-root (with-state (scale 1000) (build-locator))) (env-root (with-state (scale 1000) (build-locator)))
(root-camera-t 0) (root-camera-t 0)
(num-msgs 0) (num-msgs 0)
(floor (let ((p (with-state
(hint-unlit)
(colour 0.2)
(texture (load-texture "textures/stone.png"))
(translate (vector 0 -0.5 0))
(rotate (vector 90 0 0))
(scale 1000)
(backfacecull 0)
(build-seg-plane 10 10))))
(with-primitive p
(pdata-map!
(lambda (t)
(vmul t 10))
"t")) p))
#;(upper-env (with-state #;(upper-env (with-state
(parent env-root) (parent env-root)
(hint-depth-sort) (hint-depth-sort)
@ -702,7 +1104,7 @@
(build-env-box "textures/bottom-trans.png" "textures/bottom.png" (build-env-box "textures/bottom-trans.png" "textures/bottom.png"
"textures/sleft.png" "textures/sright.png" "textures/sleft.png" "textures/sright.png"
"textures/sfront.png" "textures/sback.png"))) "textures/sfront.png" "textures/sback.png")))
(upper-env (with-state #;(upper-env (with-state
(parent env-root) (parent env-root)
;(hint-depth-sort) ;(hint-depth-sort)
(hint-unlit) (hint-unlit)
@ -710,7 +1112,7 @@
(build-env-box "textures/sky-top.png" "textures/floor.png" (build-env-box "textures/sky-top.png" "textures/floor.png"
"textures/sky-side.png" "textures/sky-side.png" "textures/sky-side.png" "textures/sky-side.png"
"textures/sky-side.png" "textures/sky-side.png" #f))) "textures/sky-side.png" "textures/sky-side.png" #f)))
(lower-env (with-state #;(lower-env (with-state
(parent env-root) (parent env-root)
;(hint-depth-sort) ;(hint-depth-sort)
(hint-unlit) (hint-unlit)
@ -720,33 +1122,67 @@
"textures/earth-side.png" "textures/earth-side.png" "textures/earth-side.png" "textures/earth-side.png"
"textures/earth-side.png" "textures/earth-side.png" #t))) "textures/earth-side.png" "textures/earth-side.png" #t)))
(stones '())) (stones '())
(ground-change-t 0)
(going-up #f))
(define/public (setup world-list) (define/public (setup world-list)
(let ((l (make-light 'point 'free))) (let ((l (make-light 'point 'free)))
(light-diffuse 0 (vector 0.5 0.5 0.5)) (light-diffuse 0 (vector 0.5 0.5 0.5))
(light-diffuse l (vector 1 1 1)) (light-diffuse l (vector 1 1 1))
(light-position l (vector 10 50 -4))) (light-position l (vector 10 50 -4)))
(below-ground)
(clear-colour fog-col)
(fog fog-col fog-strength 1 100)
(set! stones (set! stones
(map (map
(lambda (stone) (lambda (stone)
(let ((p (with-state (let ((p (with-state
(hint-frustum-cull) (hint-frustum-cull)
(shader "shaders/toon.vert.glsl" "shaders/toon.frag.glsl") ;(shader "shaders/toon.vert.glsl" "shaders/toon.frag.glsl")
(colour (stones-colour)) (colour (stones-colour))
(translate (list-ref stone 2)) (translate (list-ref stone 2))
(scale (list-ref stone 3)) (scale (list-ref stone 3))
(rotate (list-ref stone 4)) (rotate (list-ref stone 4))
(texture (load-texture "textures/quartz.png")) (texture (load-texture "textures/stone.png"))
(load-primitive (list-ref stone 1))))) (load-primitive (list-ref stone 1)))))
(with-primitive p (apply-transform) (recalc-bb)) ; apply the transform to speed up the ray tracing, don't have to tranform the ray into object space (with-primitive p (apply-transform) (recalc-bb)) ; apply the transform to speed up the ray tracing, don't have to tranform the ray into object space
p)) p))
(list-ref world-list 2)))) (list-ref world-list 2))))
(define/public (above-ground)
(printf "above-ground~n")
(for-each
(lambda (plant)
(send (cadr plant) above-ground))
plants)
(for-each
(lambda (pickup)
(with-primitive (send (cadr pickup) get-root) (hide 1)))
pickups)
(set! going-up #t)
(set! ground-change-t ground-change-duration))
(define/public (below-ground)
(printf "below-ground~n")
(for-each
(lambda (plant)
(send (cadr plant) below-ground))
plants)
(for-each
(lambda (pickup)
(with-primitive (send (cadr pickup) get-root) (hide 0)))
pickups)
(set! going-up #f)
(set! ground-change-t ground-change-duration))
(define/public (update-ground-change t d)
(when (> ground-change-t 0)
(set! ground-change-t (- ground-change-t d))
(let* ((t (/ ground-change-t ground-change-duration))
(anim-t (if going-up t (- 1 t))))
(clip 1 (lerp 100 500 anim-t))
(clear-colour (vmix fog-col above-fog-col anim-t))
(fog (vmix fog-col above-fog-col anim-t) (lerp 0.04 0.01 anim-t) 1 100))))
(define/public (get-stones) (define/public (get-stones)
stones) stones)
@ -775,14 +1211,32 @@
(send (get-plant plant-id) grow-seed amount))) (send (get-plant plant-id) grow-seed amount)))
(define/public (get-pickup pickup-id) (define/public (get-pickup pickup-id)
(cadr (assq pickup-id pickups))) (let ((p (assq pickup-id pickups)))
(if p (cadr p) #f)))
(define/public (add-pickup pickup-id type pos) (define/public (add-pickup pickup-id type pos)
(set! pickups (cons (list pickup-id (make-object pickup-view% pickup-id type pos)) pickups))) (set! pickups (cons (list pickup-id (make-object pickup-view% pickup-id type pos)) pickups)))
(define/public (add-insect insect-id pos type)
(cond
((eq? type 'worm)
(set! insects (cons (list insect-id
(make-object worm-insect-view% insect-id pos type)) insects)))
((eq? type 'spider)
(set! insects (cons (list insect-id
(make-object spider-insect-view% insect-id pos type)) insects)))
((eq? type 'butterfly)
(set! insects (cons (list insect-id
(make-object butterfly-insect-view% insect-id pos type)) insects)))))
(define/public (get-insect insect-id)
(cadr (assq insect-id insects)))
(define/public (pick-up-pickup pickup-id) (define/public (pick-up-pickup pickup-id)
(let ((pu (get-pickup pickup-id)))
(when pu
(send (get-pickup pickup-id) pick-up) (send (get-pickup pickup-id) pick-up)
(set! pickups (assoc-remove pickup-id pickups))) (set! pickups (assoc-remove pickup-id pickups)))))
(define/public (add-ornament plant-id twig-id point-index property) (define/public (add-ornament plant-id twig-id point-index property)
(when (get-plant plant-id) (when (get-plant plant-id)
@ -800,6 +1254,8 @@
(define/public (update t d messages) (define/public (update t d messages)
(update-ground-change t d)
(for-each (for-each
(lambda (plant) (lambda (plant)
(send (cadr plant) update t d)) (send (cadr plant) update t d))
@ -810,6 +1266,11 @@
(send (cadr pickup) update t d)) (send (cadr pickup) update t d))
pickups) pickups)
(for-each
(lambda (insect)
(send (cadr insect) update t d))
insects)
(when debug-messages (when debug-messages
(for-each (for-each
(lambda (msg) (lambda (msg)
@ -818,13 +1279,14 @@
(for-each (for-each
(lambda (msg) (lambda (msg)
(cond (cond
((eq? (send msg get-name) 'player-plant) ; not really any difference now ((eq? (send msg get-name) 'player-plant)
(printf "adding player plant to view ~a~n" (send msg get-data 'plant-id))
(add-plant (make-object plant-view% (add-plant (make-object plant-view%
(send msg get-data 'plant-id) (send msg get-data 'plant-id)
(send msg get-data 'pos) (send msg get-data 'pos)
(send msg get-data 'size) (send msg get-data 'size)
(send msg get-data 'col) (send msg get-data 'col)
(send msg get-data 'tex)))) (send msg get-data 'tex) #t)))
((eq? (send msg get-name) 'new-plant) ((eq? (send msg get-name) 'new-plant)
(printf "adding new plant to view ~a~n" (send msg get-data 'plant-id)) (printf "adding new plant to view ~a~n" (send msg get-data 'plant-id))
@ -835,6 +1297,7 @@
(send msg get-data 'col) (send msg get-data 'col)
(send msg get-data 'tex)))) (send msg get-data 'tex))))
((eq? (send msg get-name) 'grow-seed) ((eq? (send msg get-name) 'grow-seed)
(grow-seed (send msg get-data 'plant-id) (grow-seed (send msg get-data 'plant-id)
(send msg get-data 'amount))) (send msg get-data 'amount)))
@ -911,6 +1374,17 @@
(colour (send msg get-data 'amount)))) (colour (send msg get-data 'amount))))
upper-env)) upper-env))
((eq? (send msg get-name) 'new-insect)
(add-insect
(send msg get-data 'insect-id)
(send msg get-data 'pos)
(send msg get-data 'type)))
((eq? (send msg get-name) 'insect-move)
(send (get-insect (send msg get-data 'insect-id)) move
(send msg get-data 'pos)
(send msg get-data 'duration)))
)) ))
messages)) messages))