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

pickup dissolving and grow hud

Browse source
This commit is contained in:
Dave Griffiths 2009-10-06 08:43:13 +01:00
parent a7449695aa
commit 6c876382e1
3 changed files with 150 additions and 37 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

12
plant-eyes/scripts/controller.ss
View file

@ -34,7 +34,8 @@
(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)) (above-ground #f)
(cam-pos (vector 0 0 0)))
(define/public (set-player-plant s) (define/public (set-player-plant s)
(set! pos (send s get-pos)) (set! pos (send s get-pos))
@ -55,7 +56,8 @@
(define/public (setup) (define/public (setup)
(lock-camera cam) (lock-camera cam)
(camera-lag 0.2) (camera-lag 0)
(send game-view set-cam cam)
(set-camera-transform (mtranslate (vector 0 0 -4)))) (set-camera-transform (mtranslate (vector 0 0 -4))))
; moveme ; moveme
@ -82,6 +84,7 @@
(set! seed-return #f) (set! seed-return #f)
(set! debounce-space #f) (set! debounce-space #f)
(set! last-pos pos) (set! last-pos pos)
(send game-view set-grow-mode #t)
(cond (current-twig (cond (current-twig
(let ((new-twig (send player-plant add-sub-twig current-twig current-point (let ((new-twig (send player-plant add-sub-twig current-twig current-point
(vector 0 1 0) #;(vsub (send current-twig get-point current-point) (vector 0 1 0) #;(vsub (send current-twig get-point current-point)
@ -146,6 +149,7 @@
; if we are on a twig not growing ; if we are on a twig not growing
(when (and current-twig-growing (not (send current-twig growing?))) (when (and current-twig-growing (not (send current-twig growing?)))
(send game-view set-grow-mode #f)
(set! current-twig-growing #f) (set! current-twig-growing #f)
(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)))
@ -163,11 +167,13 @@
(let* ((side (vnormalise (vcross up fwd))) (let* ((side (vnormalise (vcross up fwd)))
(up (vnormalise (vcross fwd side)))) (up (vnormalise (vcross fwd side))))
(set! cam-pos (vlerp cam-pos pos 0.9))
(with-primitive cam (with-primitive cam
(identity) (identity)
(concat (vector (vx side) (vy side) (vz side) 0 (concat (vector (vx side) (vy side) (vz side) 0
(vx up) (vy up) (vz up) 0 (vx up) (vy up) (vz up) 0
(vx fwd) (vy fwd) (vz fwd) 0 (vx fwd) (vy fwd) (vz fwd) 0
(vx pos) (vy pos) (vz pos) 1))))) (vx cam-pos) (vy cam-pos) (vz cam-pos) 1)))))
(super-new))) (super-new)))

29
plant-eyes/scripts/logic.ss
View file

@ -143,7 +143,8 @@
(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
(pickedups '())) ; the pickups we've collected
(inherit send-message) (inherit send-message)
@ -281,6 +282,19 @@
(define/public (get-ornament point-index) (define/public (get-ornament point-index)
(cadr (assq point-index ornaments))) (cadr (assq point-index ornaments)))
(define/public (deal-with-pickups)
(for-each
(lambda (pu)
(let ((pickup (car pu))
(point (cadr pu)))
(send plant add-property (send pickup get-type))
(send-message 'pick-up-pickup
(list
(list 'pickup-id (send pickup get-id))
(list 'point point)))))
pickedups)
(set! pickedups '()))
; adds the ornament if it's close, and checks sub-twigs ; adds the ornament if it's close, and checks sub-twigs
; returns true if it's succeded ; returns true if it's succeded
@ -292,12 +306,11 @@
; 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))
10 #;(+ width (send pickup get-size)))) 10 #;(+ width (send pickup get-size))))
(send plant add-property (send pickup get-type)) (set! pickedups (cons (list pickup i) pickedups))
(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-highlight
(list (list (list 'pickup-id (send pickup get-id))))
(list 'pickup-id (send pickup get-id))))
#t) #t)
(else #f))) (else #f)))
#f #f
@ -313,7 +326,9 @@
twigs) twigs)
found))) found)))
(define/augment (update t d) (define/augment (update t d)
(when (and (not (null? pickedups)) (not (growing?)))
(deal-with-pickups))
(append (append
(map (map
(lambda (ornament) (lambda (ornament)

146
plant-eyes/scripts/view.ss
View file

@ -271,6 +271,7 @@
(define/override (update t d) (define/override (update t d)
(let ((nt (/ time tick))) ; normalise time (let ((nt (/ time tick))) ; normalise time
(when (< nt 1)
(with-primitive root (with-primitive root
(pdata-index-map! (pdata-index-map!
(lambda (i p) (lambda (i p)
@ -278,7 +279,7 @@
(if (< st 0) (if (< st 0)
(hermite from2 from (vmul from-dir2 2) (vmul from-dir 2) (+ st 1)) (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)))) (hermite from to (vmul from-dir 2) (vmul to-dir 2) st))))
"p"))) "p"))))
(set! time (+ time d))) (set! time (+ time d)))
@ -287,10 +288,15 @@
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
(define (build-squiggle x y) (define (build-squiggle x y)
(let ((p (build-ribbon 30)) (let ((p (build-ribbon 15))
(x (/ x 10)) (x (/ x 10))
(y (/ y 10))) (y (/ y 10)))
(with-primitive p (with-primitive p
(pdata-add "vel" "v")
(pdata-map!
(lambda (vel)
(vmul (srndvec) 0.1))
"vel")
(pdata-index-map! (pdata-index-map!
(lambda (i p) (lambda (i p)
(vector (cos (/ i x)) (sin (/ i y)) (/ i (pdata-size)))) (vector (cos (/ i x)) (sin (/ i y)) (/ i (pdata-size))))
@ -303,6 +309,7 @@
(lambda (c) (lambda (c)
(vector 1 1 1)) (vector 1 1 1))
"c") "c")
(pdata-copy "p" "pref")
(recalc-bb)) (recalc-bb))
p)) p))
@ -311,7 +318,8 @@
(init-field (init-field
(id -1) (id -1)
(type 'none) (type 'none)
(pos (vector 0 0 0))) (pos (vector 0 0 0))
(highlit #f))
(field (field
(rot (vmul (rndvec) 360)) (rot (vmul (rndvec) 360))
@ -333,10 +341,19 @@
(from pos) (from pos)
(destination (vector 0 0 0)) (destination (vector 0 0 0))
(speed 0.05) (speed 0.05)
(t -1)) (t -1)
(destroy-time -99)
(dissolve-time -99)
(delme #f))
(define/public (pick-up) (define/public (pick-up point)
(destroy root)) (set! destroy-time point))
(define/public (delme?)
delme)
(define/public (highlight)
(set! highlit #t))
(define/public (get-root) (define/public (get-root)
root) root)
@ -347,15 +364,33 @@
(set! destination s)) (set! destination s))
(define/public (update t d) (define/public (update t d)
(with-primitive root (with-primitive root
(rotate (vector (* d 10) 0 0))) (rotate (vector (* d (if highlit 50 10)) 0 0)))
#;(when (and (>= t 0) (< t 1))
(set! pos (vadd pos (vmul (vsub destination from) speed))) (when (and highlit (eq? dissolve-time -99))
(with-primitive root (with-primitive root
(identity) (pdata-map!
(translate pos) (lambda (p pref)
(rotate rot)) (vadd pref (vmul (srndvec) 0.1)))
(set! t (+ t speed)))) "p" "pref")))
(when (> destroy-time -99)
(set! destroy-time (- destroy-time (* d default-grow-speed 0.5)))
(when (< destroy-time 0)
(set! destroy-time -100)
(set! dissolve-time 4)))
(when (> dissolve-time -99)
(set! dissolve-time (- dissolve-time d))
(with-primitive root
(pdata-op "+" "p" "vel")
(pdata-op "*" "w" 0.95))
(when (< dissolve-time 0)
(destroy root)
(set! delme #t)))
(set! t (+ t speed)))
(super-new))) (super-new)))
@ -836,7 +871,7 @@
(dust (if is-player (with-state (dust (if is-player (with-state
(parent root) (parent root)
(make-object dust%)) #f)) (make-object dust%)) #f))
(nutrients (let ((p (with-state (nutrients (if is-player (let ((p (with-state
(hint-depth-sort) (hint-depth-sort)
(hint-unlit) (hint-unlit)
(parent root) (parent root)
@ -872,7 +907,7 @@
(lambda (s) (lambda (s)
(vmul (vector 1 1 1) (+ 0.1 (rndf)))) (vmul (vector 1 1 1) (+ 0.1 (rndf))))
"s")) "s"))
p))) p) #f)))
(define/public (get-id) (define/public (get-id)
id) id)
@ -948,16 +983,17 @@
twigs)) twigs))
(define/public (nutrient-absorb twig-id twig-point) (define/public (nutrient-absorb twig-id twig-point)
(with-primitive nutrients (when is-player
(with-primitive nutrients
(let ((p (random (pdata-size)))) (let ((p (random (pdata-size))))
(pdata-set! "twig" p twig-id) (pdata-set! "twig" p twig-id)
(pdata-set! "point" p twig-point) (pdata-set! "point" p twig-point)
(pdata-set! "p" p (send (get-twig twig-id) get-point twig-point)) (pdata-set! "p" p (send (get-twig twig-id) get-point twig-point))
(pdata-set! "offset" p (vmul (srndvec) ( (pdata-set! "offset" p (vmul (srndvec) (
send (get-twig twig-id) get-width twig-point)))))) send (get-twig twig-id) get-width twig-point)))))))
(define/public (update-nutrients t d) (define/public (update-nutrients t d)
(when (not (null? twigs)) (when (and is-player (not (null? twigs)))
(with-primitive nutrients (with-primitive nutrients
(pdata-index-map! (pdata-index-map!
(lambda (i p twig-id point offset speed) (lambda (i p twig-id point offset speed)
@ -1079,6 +1115,20 @@
(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)
(cam #f)
(hud (build-locator))
(grow-mode-hud
(let ((p (with-state
(parent hud)
(translate (vector 0 0 3))
(scale (vector 1.3 1 1))
(hint-depth-sort)
(texture (load-texture "textures/grow-mode-hud.png"))
(hint-unlit)
(build-plane))))
(with-primitive p (hide 1)) p))
(grow-mode-hud-state #f)
(grow-mode-hud-t 2)
(floor (let ((p (with-state (floor (let ((p (with-state
(hint-unlit) (hint-unlit)
(colour 0.2) (colour 0.2)
@ -1153,6 +1203,11 @@
p)) p))
(list-ref world-list 2)))) (list-ref world-list 2))))
(define/public (set-cam s)
(set! cam s)
(with-primitive hud
(parent cam)))
(define/public (above-ground) (define/public (above-ground)
(printf "above-ground~n") (printf "above-ground~n")
(for-each (for-each
@ -1184,7 +1239,7 @@
(set! ground-change-t (- ground-change-t d)) (set! ground-change-t (- ground-change-t d))
(let* ((t (/ ground-change-t ground-change-duration)) (let* ((t (/ ground-change-t ground-change-duration))
(anim-t (if going-up t (- 1 t)))) (anim-t (if going-up t (- 1 t))))
(clip 1 (lerp 100 500 anim-t)) (set-fov 53 0.1 (lerp 100 500 anim-t))
(clear-colour (vmix fog-col above-fog-col 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)))) (fog (vmix fog-col above-fog-col anim-t) (lerp 0.04 0.01 anim-t) 1 100))))
@ -1237,11 +1292,15 @@
(define/public (get-insect insect-id) (define/public (get-insect insect-id)
(cadr (assq insect-id insects))) (cadr (assq insect-id insects)))
(define/public (pick-up-pickup pickup-id) (define/public (pick-up-pickup pickup-id point)
(let ((pu (get-pickup pickup-id))) (let ((pu (get-pickup pickup-id)))
(when pu (when pu
(send (get-pickup pickup-id) pick-up) (send (get-pickup pickup-id) pick-up point))))
(set! pickups (assoc-remove pickup-id pickups)))))
(define/public (highlight-pickup pickup-id)
(let ((pu (get-pickup pickup-id)))
(when pu
(send (get-pickup pickup-id) highlight))))
(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)
@ -1255,12 +1314,34 @@
(for-each (for-each
(lambda (plant) (lambda (plant)
(send (cadr plant) set-excitations! a b)) (send (cadr plant) set-excitations! a b))
plants)) plants))
(define/public (set-grow-mode s)
(when s (with-primitive grow-mode-hud (hide 0) (opacity 0)))
(set! grow-mode-hud-state s)
(set! grow-mode-hud-t 0))
(define/public (update-grow-mode-hud t d)
(when (< grow-mode-hud-t 1)
(with-primitive grow-mode-hud
(opacity (if grow-mode-hud-state
(* grow-mode-hud-t 0.5)
(* (- 1 (* grow-mode-hud-t )) 0.5)))))
(when (and (> grow-mode-hud-t 1) (not grow-mode-hud-state))
(with-primitive grow-mode-hud (hide 1)))
(set! grow-mode-hud-t (+ grow-mode-hud-t d 0.02)))
(define/public (update-hud t d)
(update-grow-mode-hud t d))
(define/public (update t d messages) (define/public (update t d messages)
(update-ground-change t d) (update-ground-change t d)
(update-hud t d)
(for-each (for-each
(lambda (plant) (lambda (plant)
(send (cadr plant) update t d)) (send (cadr plant) update t d))
@ -1280,7 +1361,13 @@
(for-each (for-each
(lambda (msg) (lambda (msg)
(send msg print)) (send msg print))
messages)) messages))
(set! pickups (filter
(lambda (pickup)
(not (send (cadr pickup) delme?)))
pickups))
(for-each (for-each
(lambda (msg) (lambda (msg)
(cond (cond
@ -1353,6 +1440,11 @@
((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 'point)))
((eq? (send msg get-name) 'pick-up-highlight)
(highlight-pickup
(send msg get-data 'pickup-id))) (send msg get-data 'pickup-id)))
((eq? (send msg get-name) 'shrink-twig) ((eq? (send msg get-name) 'shrink-twig)