nutrients add to the length you can grow
This commit is contained in:
Dave Griffiths
parent
1d040a0c36
commit
0f28887cbf
5 changed files with 79 additions and 227 deletions
|
|
@ -49,7 +49,7 @@
|
|||
(define/public (setup)
|
||||
(lock-camera cam)
|
||||
(camera-lag 0.2)
|
||||
(clip 1 1000)
|
||||
(clip 1 100)
|
||||
(set-camera-transform (mtranslate (vector 0 0 -4))))
|
||||
|
||||
; moveme
|
||||
|
|
@ -86,7 +86,7 @@
|
|||
(else
|
||||
(set! current-twig (make-object twig-logic% (vector 0 0 0) 0 player-plant 'root
|
||||
(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)
|
||||
(set! current-twig-growing #t))))
|
||||
|
||||
|
|
|
|||
|
|
@ -6,10 +6,10 @@
|
|||
(define branch-width-reduction 0.5)
|
||||
(define twig-jitter 0.1)
|
||||
(define branch-jitter 0.5)
|
||||
(define max-twig-points 10)
|
||||
(define start-twig-points 15)
|
||||
(define start-twig-dist 0.05)
|
||||
(define start-twig-width 0.1)
|
||||
(define default-max-twigs 10)
|
||||
(define default-max-twigs 5)
|
||||
(define default-scale-factor 1.05)
|
||||
(define num-pickups 10)
|
||||
(define pickup-dist-radius 200)
|
||||
|
|
@ -18,8 +18,7 @@
|
|||
(define curl-amount 40)
|
||||
(define start-size 50)
|
||||
(define max-ornaments 10) ; per twig
|
||||
(define twig-energy-loss 0.01)
|
||||
(define nutrient-field-deplete-loss 0.01)
|
||||
(define nutrient-twig-size-increase 4)
|
||||
|
||||
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||||
; the base class logic object - all logic side objects can
|
||||
|
|
@ -64,7 +63,7 @@
|
|||
(type 'root) ; or 'shoot
|
||||
(dir (vector 0 1 0)) ; the general direction we are pointing in
|
||||
(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
|
||||
(dist start-twig-dist) ; distance between points
|
||||
(parent-twig-id -1)
|
||||
|
|
@ -76,8 +75,7 @@
|
|||
(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
|
||||
(w 0) ; the width of this segment
|
||||
(curl (vmul (crndvec) curl-amount)) ; the angles to turn each point, if curly
|
||||
(energy-level 1)) ; starting energy level
|
||||
(curl (vmul (crndvec) curl-amount))) ; the angles to turn each point, if curly
|
||||
|
||||
(inherit send-message)
|
||||
|
||||
|
|
@ -86,9 +84,6 @@
|
|||
|
||||
(define/public (set-id! s)
|
||||
(set! id s))
|
||||
|
||||
(define/public (get-energy-level)
|
||||
energy-level)
|
||||
|
||||
(define/public (get-type)
|
||||
type)
|
||||
|
|
@ -135,7 +130,8 @@
|
|||
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! points (append points (list new-point)))
|
||||
(set! widths (append widths (list w)))
|
||||
|
|
@ -143,11 +139,7 @@
|
|||
(list 'plant-id (send plant get-id))
|
||||
(list 'twig-id id)
|
||||
(list 'point new-point)
|
||||
(list 'width w))))
|
||||
#;(for-each
|
||||
(lambda (twig)
|
||||
(send (cadr twig) grow ndir))
|
||||
twigs)))
|
||||
(list 'width w))))))
|
||||
|
||||
(define/public (get-desc-list)
|
||||
(list
|
||||
|
|
@ -225,10 +217,10 @@
|
|||
(let* ((i -1) (found (foldl
|
||||
(lambda (point found)
|
||||
(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)
|
||||
(send pickup get-pos))
|
||||
(+ width (send pickup get-size))))
|
||||
10 #;(+ width (send pickup get-size))))
|
||||
(send plant add-property (send pickup get-type))
|
||||
(send pickup pick-up) ; this will remove the pickup for us
|
||||
(send-message 'pick-up-pickup
|
||||
|
|
@ -248,50 +240,8 @@
|
|||
#f
|
||||
twigs)
|
||||
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)
|
||||
(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))))
|
||||
|
||||
(define/augment (update)
|
||||
(append
|
||||
(map
|
||||
(lambda (ornament)
|
||||
|
|
@ -361,30 +311,6 @@
|
|||
|
||||
(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%
|
||||
|
|
@ -398,13 +324,14 @@
|
|||
(field
|
||||
(twigs '()) ; a assoc list map of ids to twigs
|
||||
(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
|
||||
(size start-size) ; the age of this plant
|
||||
(max-twigs default-max-twigs) ; the maximum twigs allowed at any time - oldest removed first
|
||||
(next-twig-id 0)
|
||||
(next-ornament-id 0)
|
||||
(grow-amount default-scale-factor))
|
||||
(grow-amount default-scale-factor)
|
||||
(twig-size start-twig-points))
|
||||
|
||||
(inherit send-message)
|
||||
|
||||
|
|
@ -422,6 +349,9 @@
|
|||
|
||||
(define/public (get-tex)
|
||||
tex)
|
||||
|
||||
(define/public (get-twig-size)
|
||||
twig-size)
|
||||
|
||||
(define/public (grow pos)
|
||||
(when leader-twig
|
||||
|
|
@ -433,7 +363,9 @@
|
|||
(set! leader-twig #f))))
|
||||
|
||||
(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
|
||||
(define/public (get-next-twig-id)
|
||||
|
|
@ -448,23 +380,38 @@
|
|||
next-ornament-id))
|
||||
|
||||
(define/public (check-pickup pickup)
|
||||
(foldl
|
||||
(when leader-twig
|
||||
(send leader-twig check-pickup pickup))
|
||||
|
||||
#;(foldl
|
||||
(lambda (twig found)
|
||||
(if (not found)
|
||||
(send (cadr twig) check-pickup pickup)
|
||||
(when (send (cadr twig) growing?)
|
||||
(send (cadr twig) check-pickup pickup))
|
||||
#f))
|
||||
#f
|
||||
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)
|
||||
(foldl
|
||||
(lambda (twig found)
|
||||
(if (not found)
|
||||
(send (cadr twig) check-nutrient nutrient)
|
||||
#f))
|
||||
#f
|
||||
twigs))
|
||||
|
||||
; a util to keep a fixed size list of twigs, calling destroy twig when needed.
|
||||
(define (cons-twig thing in count out)
|
||||
(cond
|
||||
((null? in)
|
||||
(cons thing out))
|
||||
((zero? count)
|
||||
(destroy-twig (car in))
|
||||
(cons thing out))
|
||||
(else (cons-twig thing (cdr in) (- count 1) (append out (list (car in)))))))
|
||||
|
||||
|
||||
(define/public (add-twig twig)
|
||||
(send twig set-id! (get-next-twig-id))
|
||||
(set! size (* size grow-amount))
|
||||
|
|
@ -474,7 +421,7 @@
|
|||
(list 'plant-id id)
|
||||
(list 'amount grow-amount)))
|
||||
(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)
|
||||
(set! leader-twig (send ptwig add-twig point-index dir))
|
||||
|
|
@ -514,7 +461,7 @@
|
|||
; grow a new ornament?
|
||||
(when (and (not (null? properties)) (zero? (random ornament-grow-probability)))
|
||||
(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
|
||||
((property (choose properties))
|
||||
(point-index (+ 1 (random (- (send twig get-length) 2)))))
|
||||
|
|
@ -534,15 +481,7 @@
|
|||
twig
|
||||
point-index))
|
||||
(else
|
||||
(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)
|
||||
|
||||
(error "property not understood " property)))))))))
|
||||
(map
|
||||
(lambda (twig)
|
||||
(send (cadr twig) update))
|
||||
|
|
@ -557,28 +496,19 @@
|
|||
(field
|
||||
(plants '())
|
||||
(pickups '())
|
||||
(nutrients '())
|
||||
(player #f))
|
||||
|
||||
(inherit send-message)
|
||||
|
||||
(define/public (setup world-list)
|
||||
(let ((pickups '() #;(list-ref world-list 1)))
|
||||
(let ((pickups (list-ref world-list 1)))
|
||||
(let ((i 0))
|
||||
(for-each
|
||||
(lambda (pickup)
|
||||
(add-pickup (make-object pickup-logic% i (list-ref pickup 0)
|
||||
(list-ref pickup 2)))
|
||||
(set! i (+ i 1)))
|
||||
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))))
|
||||
pickups))))
|
||||
|
||||
(define/public (add-player plant)
|
||||
(printf "new player plant added ~a~n" (send plant get-id))
|
||||
|
|
@ -607,14 +537,6 @@
|
|||
(list 'type (send pickup get-type))
|
||||
(list 'pos (send pickup get-pos))))
|
||||
(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)
|
||||
(send player serialise))
|
||||
|
|
@ -630,29 +552,16 @@
|
|||
(send plant check-pickup pickup))
|
||||
plants))
|
||||
pickups)
|
||||
|
||||
(for-each
|
||||
(lambda (nutrient)
|
||||
(for-each
|
||||
(lambda (plant)
|
||||
(send plant check-nutrient nutrient))
|
||||
plants))
|
||||
nutrients)
|
||||
|
||||
|
||||
; remove the pickups that have been 'picked up'
|
||||
(set! pickups (filter
|
||||
(lambda (pickup)
|
||||
(not (send pickup picked-up?)))
|
||||
pickups))
|
||||
|
||||
(append
|
||||
(map
|
||||
(lambda (plant)
|
||||
(send plant update))
|
||||
plants)
|
||||
(map
|
||||
(lambda (nutrient)
|
||||
(send nutrient update))
|
||||
nutrients)))
|
||||
plants))
|
||||
|
||||
(super-new)))
|
||||
|
|
|
|||
|
|
@ -4,7 +4,7 @@
|
|||
|
||||
; 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 (ornament-colour) (vector 0.5 1 0.4))
|
||||
|
|
@ -14,7 +14,7 @@
|
|||
|
||||
(define wire-mode #f)
|
||||
(define fog-col (earth-colour))
|
||||
(define fog-strength 0.001)
|
||||
(define fog-strength 0.01)
|
||||
(define default-grow-speed 0.5)
|
||||
(define grow-overshoot 10)
|
||||
|
||||
|
|
@ -203,6 +203,8 @@
|
|||
(rotate rot)
|
||||
(colour (pickup-colour))
|
||||
(scale 0.3)
|
||||
(shader "shaders/textoon.vert.glsl" "shaders/textoon.frag.glsl")
|
||||
(scale 5)
|
||||
(hint-frustum-cull)
|
||||
;(shader "shaders/textoon.vert.glsl" "shaders/textoon.frag.glsl")
|
||||
(texture
|
||||
|
|
@ -210,13 +212,18 @@
|
|||
((eq? type 'wiggle) (load-texture "textures/wiggle.png"))
|
||||
((eq? type 'leaf) (load-texture "textures/leaf.png"))
|
||||
((eq? type 'curly) (load-texture "textures/curl.png"))
|
||||
((eq? type 'inflatoe) (load-texture "textures/wiggle.png"))
|
||||
(else 0)))
|
||||
(cond
|
||||
((eq? type 'wiggle) (load-primitive "meshes/pickup.obj"))
|
||||
((eq? type 'leaf) (load-primitive "meshes/leaf.obj"))
|
||||
((eq? type 'curly) (load-primitive "meshes/pickup.obj"))
|
||||
((eq? type 'horn) (backfacecull 0) (scale 5) (load-primitive "meshes/horn.obj"))
|
||||
((eq? type 'inflatoe) (backfacecull 0) (scale 5) (load-primitive "meshes/inflatoe.obj")))))
|
||||
((eq? type 'nutrient) (load-primitive "meshes/nutrient.obj"))
|
||||
((eq? type 'horn)
|
||||
(backfacecull 0)
|
||||
(load-primitive "meshes/horn.obj"))
|
||||
((eq? type 'inflatoe)
|
||||
(load-primitive "meshes/inflatoe-full.obj")))))
|
||||
(from pos)
|
||||
(destination (vector 0 0 0))
|
||||
(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%
|
||||
(class object%
|
||||
(init-field
|
||||
|
|
@ -350,7 +329,7 @@
|
|||
(set! markers (cons (build-locator) markers)))
|
||||
|
||||
(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)
|
||||
(play-sound "snd/event01.wav" point (+ 0.1 (rndf)) 0.3)
|
||||
|
|
@ -789,7 +768,6 @@
|
|||
(field
|
||||
(plants '()) ; map of ids -> plants
|
||||
(pickups '()) ; map of ids -> pickups
|
||||
(nutrients '()) ; map of ids -> nutrients
|
||||
(camera-dist 1)
|
||||
(env-root (with-state (scale 1000) (build-locator)))
|
||||
(root-camera-t 0)
|
||||
|
|
@ -836,7 +814,6 @@
|
|||
(light-position l (vector 10 50 -4)))
|
||||
|
||||
(clear-colour fog-col)
|
||||
(clip 1 2000)
|
||||
(fog fog-col fog-strength 1 100)
|
||||
|
||||
(set! stones
|
||||
|
|
@ -853,7 +830,7 @@
|
|||
(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
|
||||
p))
|
||||
(list-ref world-list 3))))
|
||||
(list-ref world-list 2))))
|
||||
|
||||
(define/public (get-stones)
|
||||
stones)
|
||||
|
|
@ -884,25 +861,14 @@
|
|||
|
||||
(define/public (get-pickup pickup-id)
|
||||
(cadr (assq pickup-id pickups)))
|
||||
|
||||
(define/public (get-nutrient nutrient-id)
|
||||
(cadr (assq nutrient-id nutrients)))
|
||||
|
||||
(define/public (add-pickup pickup-id type pos)
|
||||
(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)
|
||||
(send (get-pickup pickup-id) pick-up)
|
||||
(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)
|
||||
(when (get-plant plant-id)
|
||||
(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 'type)
|
||||
(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)
|
||||
(pick-up-pickup
|
||||
(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)
|
||||
(printf "hello~n")
|
||||
(shrink-twig
|
||||
(send msg get-data 'plant-id)
|
||||
(send msg get-data 'twig-id)))
|
||||
|
|
|
|||
|
|
@ -9,7 +9,8 @@
|
|||
(define pickup-models (list
|
||||
(list 'leaf "meshes/leaf.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)
|
||||
(foldl
|
||||
|
|
@ -28,7 +29,6 @@
|
|||
(let ((f (open-output-file fn)))
|
||||
(write (extract-list 'seed s) f)
|
||||
(write (extract-list 'pickup s) f)
|
||||
(write (extract-list 'nutrients s) f)
|
||||
(write (extract-list 'stone s) f)
|
||||
(close-output-port f)))
|
||||
|
||||
|
|
@ -36,7 +36,7 @@
|
|||
(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
|
||||
(build-list num-seeds
|
||||
(lambda (_)
|
||||
|
|
@ -52,20 +52,13 @@
|
|||
(vmul (srndvec) (* 150 area))
|
||||
0.5
|
||||
(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
|
||||
(lambda (_)
|
||||
(make-ob 'stone 'stone (choose stone-models)
|
||||
(vmul (srndvec) area)
|
||||
(* size (- 1 (expt (rndf) 2)))
|
||||
(* size 2 (- 1 (expt (rndf) 2)))
|
||||
(vmul (rndvec) 360) 0)))))
|
||||
|
||||
|
||||
|
|
@ -76,10 +69,9 @@
|
|||
(cond
|
||||
((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) 'stone) (colour (vector 1 0.5 0)))
|
||||
((eq? (ob-type ob) 'nutrients) (hint-unlit) (colour (vector 1 1 1))))
|
||||
((eq? (ob-type ob) 'stone) (colour (vector 1 0.5 0))))
|
||||
(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))
|
||||
|
||||
(define (relax l amount)
|
||||
|
|
@ -87,7 +79,7 @@
|
|||
(lambda (ob)
|
||||
(set-ob-pos! ob (foldl
|
||||
(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)))
|
||||
(else r)))
|
||||
(cond ((> (vy (ob-pos ob)) 0)
|
||||
|
|
@ -109,7 +101,7 @@
|
|||
|
||||
(clear)
|
||||
(clear-colour 0)
|
||||
(define s (init 5 200 100 100 1 10))
|
||||
(define s (init 5 200 100 1 10))
|
||||
(build s)
|
||||
|
||||
(define l (make-light 'spot 'free))
|
||||
|
|
|
|||
File diff suppressed because one or more lines are too long
Loading…
Reference in a new issue