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

nutrients add to the length you can grow

Browse source
This commit is contained in:
Dave Griffiths 2009-08-21 16:03:36 +01:00
parent 1d040a0c36
commit 0f28887cbf
5 changed files with 79 additions and 227 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
plant-eyes/controller.ss
View file

@ -49,7 +49,7 @@
(define/public (setup) (define/public (setup)
(lock-camera cam) (lock-camera cam)
(camera-lag 0.2) (camera-lag 0.2)
(clip 1 1000) (clip 1 100)
(set-camera-transform (mtranslate (vector 0 0 -4)))) (set-camera-transform (mtranslate (vector 0 0 -4))))
; moveme ; moveme
@ -86,7 +86,7 @@
(else (else
(set! current-twig (make-object twig-logic% (vector 0 0 0) 0 player-plant 'root (set! current-twig (make-object twig-logic% (vector 0 0 0) 0 player-plant 'root
(vmul fwd -1) (vmul fwd -1)
start-twig-width max-twig-points 'extruded)) start-twig-width (send player-plant get-twig-size) 'extruded))
(send player-plant add-twig current-twig) (send player-plant add-twig current-twig)
(set! current-twig-growing #t)))) (set! current-twig-growing #t))))

197
plant-eyes/logic.ss
View file

@ -6,10 +6,10 @@
(define branch-width-reduction 0.5) (define branch-width-reduction 0.5)
(define twig-jitter 0.1) (define twig-jitter 0.1)
(define branch-jitter 0.5) (define branch-jitter 0.5)
(define max-twig-points 10) (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 10) (define default-max-twigs 5)
(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)
@ -18,8 +18,7 @@
(define curl-amount 40) (define curl-amount 40)
(define start-size 50) (define start-size 50)
(define max-ornaments 10) ; per twig (define max-ornaments 10) ; per twig
(define twig-energy-loss 0.01) (define nutrient-twig-size-increase 4)
(define nutrient-field-deplete-loss 0.01)
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; the base class logic object - all logic side objects can ; the base class logic object - all logic side objects can
@ -64,7 +63,7 @@
(type 'root) ; or 'shoot (type 'root) ; or 'shoot
(dir (vector 0 1 0)) ; the general direction we are pointing in (dir (vector 0 1 0)) ; the general direction we are pointing in
(width 0) ; the width of this root (width 0) ; the width of this root
(num-points max-twig-points) ; number of points in this twig (num-points start-twig-points) ; number of points in this twig
(render-type 'extruded) ; the way to tell the view to render this twig (render-type 'extruded) ; the way to tell the view to render this twig
(dist start-twig-dist) ; distance between points (dist start-twig-dist) ; distance between points
(parent-twig-id -1) (parent-twig-id -1)
@ -76,8 +75,7 @@
(twigs '()) ; children are stored with the point number they are connected to. (twigs '()) ; children are stored with the point number they are connected to.
(ornaments '()) ; the things attached to this twig, an assoc list with point index (ornaments '()) ; the things attached to this twig, an assoc list with point index
(w 0) ; the width of this segment (w 0) ; the width of this segment
(curl (vmul (crndvec) curl-amount)) ; the angles to turn each point, if curly (curl (vmul (crndvec) curl-amount))) ; the angles to turn each point, if curly
(energy-level 1)) ; starting energy level
(inherit send-message) (inherit send-message)
@ -86,9 +84,6 @@
(define/public (set-id! s) (define/public (set-id! s)
(set! id s)) (set! id s))
(define/public (get-energy-level)
energy-level)
(define/public (get-type) (define/public (get-type)
type) type)
@ -135,7 +130,8 @@
pos))) pos)))
(set! w (* width (- 1 (/ (length points) (- num-points 2))))) (set! w (if (zero? (- num-points 2)) width
(+ 0.1 (* width (- 1 (/ (length points) (- num-points 2)))))))
(set! last-point new-point) (set! last-point new-point)
(set! points (append points (list new-point))) (set! points (append points (list new-point)))
(set! widths (append widths (list w))) (set! widths (append widths (list w)))
@ -143,11 +139,7 @@
(list 'plant-id (send plant get-id)) (list 'plant-id (send plant get-id))
(list 'twig-id id) (list 'twig-id id)
(list 'point new-point) (list 'point new-point)
(list 'width w)))) (list 'width w))))))
#;(for-each
(lambda (twig)
(send (cadr twig) grow ndir))
twigs)))
(define/public (get-desc-list) (define/public (get-desc-list)
(list (list
@ -225,10 +217,10 @@
(let* ((i -1) (found (foldl (let* ((i -1) (found (foldl
(lambda (point found) (lambda (point found)
(set! i (+ i 1)) (set! i (+ i 1))
; if we havent found anything yet and it's intersecting ; if we havent found anything yet and it's intersecting
(cond ((and (not found) (< (vdist (vadd (send plant get-pos) point) (cond ((and (not found) (< (vdist (vadd (send plant get-pos) point)
(send pickup get-pos)) (send pickup get-pos))
(+ width (send pickup get-size)))) 10 #;(+ width (send pickup get-size))))
(send plant add-property (send pickup get-type)) (send plant add-property (send pickup get-type))
(send pickup pick-up) ; this will remove the pickup for us (send pickup pick-up) ; this will remove the pickup for us
(send-message 'pick-up-pickup (send-message 'pick-up-pickup
@ -248,50 +240,8 @@
#f #f
twigs) twigs)
found))) found)))
; returns true if it's succeded
(define/public (check-nutrient nutrient)
; check each point in our twig
(let* ((i -1) (found (foldl
(lambda (point found)
(set! i (+ i 1))
; if we havent found anything yet and it's intersecting
(cond ((and (not found) (< (vdist (vadd (send plant get-pos) point)
(send nutrient get-pos))
(+ width (send nutrient get-size))))
(set! energy-level (+ energy-level 1))
(send nutrient deplete)
(send-message 'deplete-nutrient
(list
(list 'plant-id (send plant get-id))
(list 'nutrient-id (send nutrient get-id))
(list 'amount nutrient-field-deplete-loss)
(list 'twig-id id)
(list 'twig-point i)))
#t)
(else #f)))
#f
points)))
; now check each sub-twig
(if (not found)
(foldl
(lambda (twig found)
(if (not found)
(send (cadr twig) check-nutrient nutrient)
#f))
#f
twigs)
found)))
(define/augment (update) (define/augment (update)
(set! energy-level (- energy-level twig-energy-loss))
(printf "~a~n" energy-level)
(when (< energy-level 0)
(printf "sending~n")
(send-message 'shrink-twig
(list (list 'plant-id (send plant get-id))
(list 'twig-id id))))
(append (append
(map (map
(lambda (ornament) (lambda (ornament)
@ -361,30 +311,6 @@
(super-new))) (super-new)))
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; nutrient fields are areas where nutrients exist
(define nutrient-logic%
(class game-logic-object%
(init-field
(id #f)
(pos (vector 0 0 0))
(size 0))
(define/public (get-id)
id)
(define/public (get-pos)
pos)
(define/public (deplete)
(set! size (- size nutrient-field-deplete-loss)))
(define/public (get-size)
size)
(super-new)))
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
(define plant-logic% (define plant-logic%
@ -398,13 +324,14 @@
(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 '(horn inflatoe)) ; a list of symbols - properties come from pickups (properties '()) ; 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))
(inherit send-message) (inherit send-message)
@ -422,6 +349,9 @@
(define/public (get-tex) (define/public (get-tex)
tex) tex)
(define/public (get-twig-size)
twig-size)
(define/public (grow pos) (define/public (grow pos)
(when leader-twig (when leader-twig
@ -433,7 +363,9 @@
(set! leader-twig #f)))) (set! leader-twig #f))))
(define/public (add-property name) (define/public (add-property name)
(set! properties (cons name properties))) (if (eq? name 'nutrient)
(set! twig-size (+ twig-size nutrient-twig-size-increase))
(set! properties (cons name properties))))
; we need to maintain our list of twig ids here, for this plant ; we need to maintain our list of twig ids here, for this plant
(define/public (get-next-twig-id) (define/public (get-next-twig-id)
@ -448,23 +380,38 @@
next-ornament-id)) next-ornament-id))
(define/public (check-pickup pickup) (define/public (check-pickup pickup)
(foldl (when leader-twig
(send leader-twig check-pickup pickup))
#;(foldl
(lambda (twig found) (lambda (twig found)
(if (not found) (if (not found)
(send (cadr twig) check-pickup pickup) (when (send (cadr twig) growing?)
(send (cadr twig) check-pickup pickup))
#f)) #f))
#f #f
twigs)) twigs))
(define/public (destroy-twig twig)
(send-message 'shrink-twig
(list (list 'plant-id id)
(list 'twig-id (send (cadr twig) get-id))))
#;(send-message 'destroy-branch-twig (list
(list 'plant-id id)
(list 'twig-id (send (cadr twig) get-id))
)))
(define/public (check-nutrient nutrient) ; a util to keep a fixed size list of twigs, calling destroy twig when needed.
(foldl (define (cons-twig thing in count out)
(lambda (twig found) (cond
(if (not found) ((null? in)
(send (cadr twig) check-nutrient nutrient) (cons thing out))
#f)) ((zero? count)
#f (destroy-twig (car in))
twigs)) (cons thing out))
(else (cons-twig thing (cdr in) (- count 1) (append out (list (car in)))))))
(define/public (add-twig twig) (define/public (add-twig twig)
(send twig set-id! (get-next-twig-id)) (send twig set-id! (get-next-twig-id))
(set! size (* size grow-amount)) (set! size (* size grow-amount))
@ -474,7 +421,7 @@
(list 'plant-id id) (list 'plant-id id)
(list 'amount grow-amount))) (list 'amount grow-amount)))
(send-message 'new-twig (send twig get-desc-list)) (send-message 'new-twig (send twig get-desc-list))
(set! twigs (cons (list (send twig get-id) twig) twigs))) (set! twigs (cons-twig (list (send twig get-id) twig) twigs max-twigs '())))
(define/public (add-sub-twig ptwig point-index dir) (define/public (add-sub-twig ptwig point-index dir)
(set! leader-twig (send ptwig add-twig point-index dir)) (set! leader-twig (send ptwig add-twig point-index dir))
@ -514,7 +461,7 @@
; 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)))
(when (and twig (not (send twig growing?))) (when (and twig (> (send twig get-length) 3) (not (send twig growing?)))
(let (let
((property (choose properties)) ((property (choose properties))
(point-index (+ 1 (random (- (send twig get-length) 2))))) (point-index (+ 1 (random (- (send twig get-length) 2)))))
@ -534,15 +481,7 @@
twig twig
point-index)) point-index))
(else (else
(error "property not understood " property))))))))) (error "property not understood " property)))))))))
(for-each
(lambda (twig)
(when (< (send (cadr twig) get-energy-level) 0)
(set! twigs (assoc-remove (car twig) twigs))))
twigs)
(map (map
(lambda (twig) (lambda (twig)
(send (cadr twig) update)) (send (cadr twig) update))
@ -557,28 +496,19 @@
(field (field
(plants '()) (plants '())
(pickups '()) (pickups '())
(nutrients '())
(player #f)) (player #f))
(inherit send-message) (inherit send-message)
(define/public (setup world-list) (define/public (setup world-list)
(let ((pickups '() #;(list-ref world-list 1))) (let ((pickups (list-ref world-list 1)))
(let ((i 0)) (let ((i 0))
(for-each (for-each
(lambda (pickup) (lambda (pickup)
(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))))
(let ((i 0))
(for-each
(lambda (nutrient)
(add-nutrient (make-object nutrient-logic% i (list-ref nutrient 2)
(list-ref nutrient 3)))
(set! i (+ i 1)))
(list-ref world-list 2))))
(define/public (add-player plant) (define/public (add-player plant)
(printf "new player plant added ~a~n" (send plant get-id)) (printf "new player plant added ~a~n" (send plant get-id))
@ -607,14 +537,6 @@
(list 'type (send pickup get-type)) (list 'type (send pickup get-type))
(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-nutrient nutrient)
(send-message 'new-nutrient
(list
(list 'nutrient-id (send nutrient get-id))
(list 'pos (send nutrient get-pos))
(list 'size (send nutrient get-size))))
(set! nutrients (cons nutrient nutrients)))
(define/public (serialise) (define/public (serialise)
(send player serialise)) (send player serialise))
@ -630,29 +552,16 @@
(send plant check-pickup pickup)) (send plant check-pickup pickup))
plants)) plants))
pickups) pickups)
(for-each
(lambda (nutrient)
(for-each
(lambda (plant)
(send plant check-nutrient nutrient))
plants))
nutrients)
; remove the pickups that have been 'picked up' ; remove the pickups that have been 'picked up'
(set! pickups (filter (set! pickups (filter
(lambda (pickup) (lambda (pickup)
(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))
plants) plants))
(map
(lambda (nutrient)
(send nutrient update))
nutrients)))
(super-new))) (super-new)))

79
plant-eyes/view.ss
View file

@ -4,7 +4,7 @@
; 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 #t) ; prints out all the messages sent to the renderer (define debug-messages #f) ; prints out all the messages sent to the renderer
(define audio-on #t) (define audio-on #t)
(define (ornament-colour) (vector 0.5 1 0.4)) (define (ornament-colour) (vector 0.5 1 0.4))
@ -14,7 +14,7 @@
(define wire-mode #f) (define wire-mode #f)
(define fog-col (earth-colour)) (define fog-col (earth-colour))
(define fog-strength 0.001) (define fog-strength 0.01)
(define default-grow-speed 0.5) (define default-grow-speed 0.5)
(define grow-overshoot 10) (define grow-overshoot 10)
@ -203,6 +203,8 @@
(rotate rot) (rotate rot)
(colour (pickup-colour)) (colour (pickup-colour))
(scale 0.3) (scale 0.3)
(shader "shaders/textoon.vert.glsl" "shaders/textoon.frag.glsl")
(scale 5)
(hint-frustum-cull) (hint-frustum-cull)
;(shader "shaders/textoon.vert.glsl" "shaders/textoon.frag.glsl") ;(shader "shaders/textoon.vert.glsl" "shaders/textoon.frag.glsl")
(texture (texture
@ -210,13 +212,18 @@
((eq? type 'wiggle) (load-texture "textures/wiggle.png")) ((eq? type 'wiggle) (load-texture "textures/wiggle.png"))
((eq? type 'leaf) (load-texture "textures/leaf.png")) ((eq? type 'leaf) (load-texture "textures/leaf.png"))
((eq? type 'curly) (load-texture "textures/curl.png")) ((eq? type 'curly) (load-texture "textures/curl.png"))
((eq? type 'inflatoe) (load-texture "textures/wiggle.png"))
(else 0))) (else 0)))
(cond (cond
((eq? type 'wiggle) (load-primitive "meshes/pickup.obj")) ((eq? type 'wiggle) (load-primitive "meshes/pickup.obj"))
((eq? type 'leaf) (load-primitive "meshes/leaf.obj")) ((eq? type 'leaf) (load-primitive "meshes/leaf.obj"))
((eq? type 'curly) (load-primitive "meshes/pickup.obj")) ((eq? type 'curly) (load-primitive "meshes/pickup.obj"))
((eq? type 'horn) (backfacecull 0) (scale 5) (load-primitive "meshes/horn.obj")) ((eq? type 'nutrient) (load-primitive "meshes/nutrient.obj"))
((eq? type 'inflatoe) (backfacecull 0) (scale 5) (load-primitive "meshes/inflatoe.obj"))))) ((eq? type 'horn)
(backfacecull 0)
(load-primitive "meshes/horn.obj"))
((eq? type 'inflatoe)
(load-primitive "meshes/inflatoe-full.obj")))))
(from pos) (from pos)
(destination (vector 0 0 0)) (destination (vector 0 0 0))
(speed 0.05) (speed 0.05)
@ -245,34 +252,6 @@
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
(define nutrient-view%
(class object%
(init-field
(id -1)
(pos (vector 0 0 0))
(size 0))
(field
(root (with-state
(translate pos)
(scale size)
(build-sphere 10 10))))
(define/public (deplete amount)
(when (> size 0)
(set! size (- size amount))
(with-primitive root
(identity)
(translate pos)
(scale size))))
(define/public (update t d)
0)
(super-new)))
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
(define twig-view% (define twig-view%
(class object% (class object%
(init-field (init-field
@ -350,7 +329,7 @@
(set! markers (cons (build-locator) markers))) (set! markers (cons (build-locator) markers)))
(define/public (start-shrinking) (define/public (start-shrinking)
(set! shrink-t (if (growing?) grow-t 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)
(play-sound "snd/event01.wav" point (+ 0.1 (rndf)) 0.3) (play-sound "snd/event01.wav" point (+ 0.1 (rndf)) 0.3)
@ -789,7 +768,6 @@
(field (field
(plants '()) ; map of ids -> plants (plants '()) ; map of ids -> plants
(pickups '()) ; map of ids -> pickups (pickups '()) ; map of ids -> pickups
(nutrients '()) ; map of ids -> nutrients
(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)
@ -836,7 +814,6 @@
(light-position l (vector 10 50 -4))) (light-position l (vector 10 50 -4)))
(clear-colour fog-col) (clear-colour fog-col)
(clip 1 2000)
(fog fog-col fog-strength 1 100) (fog fog-col fog-strength 1 100)
(set! stones (set! stones
@ -853,7 +830,7 @@
(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 3)))) (list-ref world-list 2))))
(define/public (get-stones) (define/public (get-stones)
stones) stones)
@ -884,25 +861,14 @@
(define/public (get-pickup pickup-id) (define/public (get-pickup pickup-id)
(cadr (assq pickup-id pickups))) (cadr (assq pickup-id pickups)))
(define/public (get-nutrient nutrient-id)
(cadr (assq nutrient-id nutrients)))
(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-nutrient nutrient-id pos size)
(set! nutrients (cons (list nutrient-id (make-object nutrient-view% nutrient-id pos size)) nutrients)))
(define/public (pick-up-pickup pickup-id) (define/public (pick-up-pickup pickup-id)
(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 (deplete-nutrient nutrient-id amount plant-id twig-id twig-point)
(send (get-nutrient nutrient-id) deplete amount)
(when (get-plant plant-id)
(send (get-plant plant-id) nutrient-absorb twig-id twig-point)))
(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)
(send (get-plant plant-id) add-ornament twig-id point-index property))) (send (get-plant plant-id) add-ornament twig-id point-index property)))
@ -1001,27 +967,12 @@
(send msg get-data 'pickup-id) (send msg get-data 'pickup-id)
(send msg get-data 'type) (send msg get-data 'type)
(send msg get-data 'pos))) (send msg get-data 'pos)))
((eq? (send msg get-name) 'new-nutrient)
(add-nutrient
(send msg get-data 'nutrient-id)
(send msg get-data 'pos)
(send msg get-data 'size)))
((eq? (send msg get-name) 'pick-up-pickup) ((eq? (send msg get-name) 'pick-up-pickup)
(pick-up-pickup (pick-up-pickup
(send msg get-data 'pickup-id))) (send msg get-data 'pickup-id)))
((eq? (send msg get-name) 'deplete-nutrient)
(deplete-nutrient
(send msg get-data 'nutrient-id)
(send msg get-data 'amount)
(send msg get-data 'plant-id)
(send msg get-data 'twig-id)
(send msg get-data 'twig-point)))
((eq? (send msg get-name) 'shrink-twig) ((eq? (send msg get-name) 'shrink-twig)
(printf "hello~n")
(shrink-twig (shrink-twig
(send msg get-data 'plant-id) (send msg get-data 'plant-id)
(send msg get-data 'twig-id))) (send msg get-data 'twig-id)))

24
plant-eyes/world-build.scm
View file

@ -9,7 +9,8 @@
(define pickup-models (list (define pickup-models (list
(list 'leaf "meshes/leaf.obj") (list 'leaf "meshes/leaf.obj")
(list 'horn "meshes/horn.obj") (list 'horn "meshes/horn.obj")
(list 'inflatoe "meshes/inflatoe-full.obj"))) (list 'inflatoe "meshes/inflatoe-full.obj")
(list 'nutrient "meshes/nutrient.obj")))
(define (extract-list t l) (define (extract-list t l)
(foldl (foldl
@ -28,7 +29,6 @@
(let ((f (open-output-file fn))) (let ((f (open-output-file fn)))
(write (extract-list 'seed s) f) (write (extract-list 'seed s) f)
(write (extract-list 'pickup s) f) (write (extract-list 'pickup s) f)
(write (extract-list 'nutrients s) f)
(write (extract-list 'stone s) f) (write (extract-list 'stone s) f)
(close-output-port f))) (close-output-port f)))
@ -36,7 +36,7 @@
(list-ref l (random (length l)))) (list-ref l (random (length l))))
(define (init num-seeds num-pickups num-nutrients num-stones area size) (define (init num-seeds num-pickups num-stones area size)
(append (append
(build-list num-seeds (build-list num-seeds
(lambda (_) (lambda (_)
@ -52,20 +52,13 @@
(vmul (srndvec) (* 150 area)) (vmul (srndvec) (* 150 area))
0.5 0.5
(vmul (rndvec) 360) 0)))) (vmul (rndvec) 360) 0))))
(build-list num-nutrients
(lambda (_)
(make-ob 'nutrients 'nutrients "meshes/seed.obj"
(vmul (srndvec) (* 150 area))
(* (rndf) 10)
(vmul (rndvec) 0) 0)))
(build-list num-stones (build-list num-stones
(lambda (_) (lambda (_)
(make-ob 'stone 'stone (choose stone-models) (make-ob 'stone 'stone (choose stone-models)
(vmul (srndvec) area) (vmul (srndvec) area)
(* size (- 1 (expt (rndf) 2))) (* size 2 (- 1 (expt (rndf) 2)))
(vmul (rndvec) 360) 0))))) (vmul (rndvec) 360) 0)))))
@ -76,10 +69,9 @@
(cond (cond
((eq? (ob-type ob) 'seed) (colour (vector 0 1 0))) ((eq? (ob-type ob) 'seed) (colour (vector 0 1 0)))
((eq? (ob-type ob) 'pickup) (backfacecull 0) (hint-unlit) (colour (vector 1 1 0))) ((eq? (ob-type ob) 'pickup) (backfacecull 0) (hint-unlit) (colour (vector 1 1 0)))
((eq? (ob-type ob) 'stone) (colour (vector 1 0.5 0))) ((eq? (ob-type ob) 'stone) (colour (vector 1 0.5 0))))
((eq? (ob-type ob) 'nutrients) (hint-unlit) (colour (vector 1 1 1))))
(load-primitive (ob-mesh ob)))) (load-primitive (ob-mesh ob))))
(when (eq? (ob-type ob) 'stone) (with-primitive (ob-root ob) (hide 1)))) #;(when (eq? (ob-type ob) 'stone) (with-primitive (ob-root ob) (hide 1))))
l)) l))
(define (relax l amount) (define (relax l amount)
@ -87,7 +79,7 @@
(lambda (ob) (lambda (ob)
(set-ob-pos! ob (foldl (set-ob-pos! ob (foldl
(lambda (other r) (lambda (other r)
(cond ((< (vdist (ob-pos ob) (ob-pos other)) (* 5 (+ (ob-size ob) (ob-size other)))) (cond ((< (vdist (ob-pos ob) (ob-pos other)) (* 2 (+ (ob-size ob) (ob-size other))))
(vadd r (vmul (vnormalise (vsub (ob-pos ob) (ob-pos other))) amount))) (vadd r (vmul (vnormalise (vsub (ob-pos ob) (ob-pos other))) amount)))
(else r))) (else r)))
(cond ((> (vy (ob-pos ob)) 0) (cond ((> (vy (ob-pos ob)) 0)
@ -109,7 +101,7 @@
(clear) (clear)
(clear-colour 0) (clear-colour 0)
(define s (init 5 200 100 100 1 10)) (define s (init 5 200 100 1 10))
(build s) (build s)
(define l (make-light 'spot 'free)) (define l (make-light 'spot 'free))

2
plant-eyes/world.txt
View file

File diff suppressed because one or more lines are too long