From 6c876382e148e3bb327a140f31f80599031725b7 Mon Sep 17 00:00:00 2001 From: Dave Griffiths Date: Tue, 6 Oct 2009 08:43:13 +0100 Subject: [PATCH] pickup dissolving and grow hud --- plant-eyes/scripts/controller.ss | 12 ++- plant-eyes/scripts/logic.ss | 29 ++++-- plant-eyes/scripts/view.ss | 146 +++++++++++++++++++++++++------ 3 files changed, 150 insertions(+), 37 deletions(-) diff --git a/plant-eyes/scripts/controller.ss b/plant-eyes/scripts/controller.ss index 31665c5..c2f1d22 100644 --- a/plant-eyes/scripts/controller.ss +++ b/plant-eyes/scripts/controller.ss @@ -34,7 +34,8 @@ (seed-return-timer 0) (seed-return-secs-per-point 3) (twig-stack '()) - (above-ground #f)) + (above-ground #f) + (cam-pos (vector 0 0 0))) (define/public (set-player-plant s) (set! pos (send s get-pos)) @@ -55,7 +56,8 @@ (define/public (setup) (lock-camera cam) - (camera-lag 0.2) + (camera-lag 0) + (send game-view set-cam cam) (set-camera-transform (mtranslate (vector 0 0 -4)))) ; moveme @@ -82,6 +84,7 @@ (set! seed-return #f) (set! debounce-space #f) (set! last-pos pos) + (send game-view set-grow-mode #t) (cond (current-twig (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) @@ -146,6 +149,7 @@ ; if we are on a twig not growing (when (and current-twig-growing (not (send current-twig growing?))) + (send game-view set-grow-mode #f) (set! current-twig-growing #f) (set! seed-return #t) (set! current-point (- (send current-twig get-num-points) 1))) @@ -163,11 +167,13 @@ (let* ((side (vnormalise (vcross up fwd))) (up (vnormalise (vcross fwd side)))) + (set! cam-pos (vlerp cam-pos pos 0.9)) + (with-primitive cam (identity) (concat (vector (vx side) (vy side) (vz side) 0 (vx up) (vy up) (vz up) 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))) diff --git a/plant-eyes/scripts/logic.ss b/plant-eyes/scripts/logic.ss index 1439e4a..6305bca 100644 --- a/plant-eyes/scripts/logic.ss +++ b/plant-eyes/scripts/logic.ss @@ -143,7 +143,8 @@ (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 + (curl (vmul (crndvec) curl-amount)) ; the angles to turn each point, if curly + (pickedups '())) ; the pickups we've collected (inherit send-message) @@ -281,6 +282,19 @@ (define/public (get-ornament point-index) (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 ; returns true if it's succeded @@ -292,12 +306,11 @@ ; 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)) - 10 #;(+ width (send pickup get-size)))) - (send plant add-property (send pickup get-type)) + 10 #;(+ width (send pickup get-size)))) + (set! pickedups (cons (list pickup i) pickedups)) (send pickup pick-up) ; this will remove the pickup for us - (send-message 'pick-up-pickup - (list - (list 'pickup-id (send pickup get-id)))) + (send-message 'pick-up-highlight + (list (list 'pickup-id (send pickup get-id)))) #t) (else #f))) #f @@ -313,7 +326,9 @@ twigs) found))) - (define/augment (update t d) + (define/augment (update t d) + (when (and (not (null? pickedups)) (not (growing?))) + (deal-with-pickups)) (append (map (lambda (ornament) diff --git a/plant-eyes/scripts/view.ss b/plant-eyes/scripts/view.ss index 5ffa8f7..9f7b4e1 100644 --- a/plant-eyes/scripts/view.ss +++ b/plant-eyes/scripts/view.ss @@ -271,6 +271,7 @@ (define/override (update t d) (let ((nt (/ time tick))) ; normalise time + (when (< nt 1) (with-primitive root (pdata-index-map! (lambda (i p) @@ -278,7 +279,7 @@ (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"))) + "p")))) (set! time (+ time d))) @@ -287,10 +288,15 @@ ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ (define (build-squiggle x y) - (let ((p (build-ribbon 30)) + (let ((p (build-ribbon 15)) (x (/ x 10)) (y (/ y 10))) (with-primitive p + (pdata-add "vel" "v") + (pdata-map! + (lambda (vel) + (vmul (srndvec) 0.1)) + "vel") (pdata-index-map! (lambda (i p) (vector (cos (/ i x)) (sin (/ i y)) (/ i (pdata-size)))) @@ -303,6 +309,7 @@ (lambda (c) (vector 1 1 1)) "c") + (pdata-copy "p" "pref") (recalc-bb)) p)) @@ -311,7 +318,8 @@ (init-field (id -1) (type 'none) - (pos (vector 0 0 0))) + (pos (vector 0 0 0)) + (highlit #f)) (field (rot (vmul (rndvec) 360)) @@ -333,10 +341,19 @@ (from pos) (destination (vector 0 0 0)) (speed 0.05) - (t -1)) + (t -1) + (destroy-time -99) + (dissolve-time -99) + (delme #f)) - (define/public (pick-up) - (destroy root)) + (define/public (pick-up point) + (set! destroy-time point)) + + (define/public (delme?) + delme) + + (define/public (highlight) + (set! highlit #t)) (define/public (get-root) root) @@ -347,15 +364,33 @@ (set! destination s)) (define/public (update t d) + (with-primitive root - (rotate (vector (* d 10) 0 0))) - #;(when (and (>= t 0) (< t 1)) - (set! pos (vadd pos (vmul (vsub destination from) speed))) - (with-primitive root - (identity) - (translate pos) - (rotate rot)) - (set! t (+ t speed)))) + (rotate (vector (* d (if highlit 50 10)) 0 0))) + + (when (and highlit (eq? dissolve-time -99)) + (with-primitive root + (pdata-map! + (lambda (p pref) + (vadd pref (vmul (srndvec) 0.1))) + "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))) @@ -836,7 +871,7 @@ (dust (if is-player (with-state (parent root) (make-object dust%)) #f)) - (nutrients (let ((p (with-state + (nutrients (if is-player (let ((p (with-state (hint-depth-sort) (hint-unlit) (parent root) @@ -872,7 +907,7 @@ (lambda (s) (vmul (vector 1 1 1) (+ 0.1 (rndf)))) "s")) - p))) + p) #f))) (define/public (get-id) id) @@ -948,16 +983,17 @@ twigs)) (define/public (nutrient-absorb twig-id twig-point) - (with-primitive nutrients + (when is-player + (with-primitive nutrients (let ((p (random (pdata-size)))) (pdata-set! "twig" p twig-id) (pdata-set! "point" p twig-point) (pdata-set! "p" p (send (get-twig twig-id) get-point twig-point)) (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) - (when (not (null? twigs)) + (when (and is-player (not (null? twigs))) (with-primitive nutrients (pdata-index-map! (lambda (i p twig-id point offset speed) @@ -1079,6 +1115,20 @@ (env-root (with-state (scale 1000) (build-locator))) (root-camera-t 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 (hint-unlit) (colour 0.2) @@ -1153,6 +1203,11 @@ p)) (list-ref world-list 2)))) + (define/public (set-cam s) + (set! cam s) + (with-primitive hud + (parent cam))) + (define/public (above-ground) (printf "above-ground~n") (for-each @@ -1184,7 +1239,7 @@ (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)) + (set-fov 53 0.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)))) @@ -1237,11 +1292,15 @@ (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 point) (let ((pu (get-pickup pickup-id))) (when pu - (send (get-pickup pickup-id) pick-up) - (set! pickups (assoc-remove pickup-id pickups))))) + (send (get-pickup pickup-id) pick-up point)))) + + (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) (when (get-plant plant-id) @@ -1255,12 +1314,34 @@ (for-each (lambda (plant) (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) (update-ground-change t d) - + (update-hud t d) + (for-each (lambda (plant) (send (cadr plant) update t d)) @@ -1280,7 +1361,13 @@ (for-each (lambda (msg) (send msg print)) - messages)) + messages)) + + (set! pickups (filter + (lambda (pickup) + (not (send (cadr pickup) delme?))) + pickups)) + (for-each (lambda (msg) (cond @@ -1353,6 +1440,11 @@ ((eq? (send msg get-name) '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))) ((eq? (send msg get-name) 'shrink-twig)