pickup dissolving and grow hud

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

View file

@ -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)))

View file

@ -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)

View file

@ -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)