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

auto seed return - removed z and x key control

Browse source
This commit is contained in:
Dave Griffiths 2009-08-19 14:41:02 +01:00
parent c9c24c7b8d
commit 03d4bc8c0b
4 changed files with 91 additions and 43 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

66
plant-eyes/controller.ss
View file

@ -23,7 +23,11 @@
(player-plant #f)
(player-pos (vector 0 0 0))
(last-pos (vector 0 0 0))
(debounce-space #t))
(debounce-space #t)
(seed-return #f)
(seed-return-timer 0)
(seed-return-secs-per-point 3)
(twig-stack '()))
(define/public (set-player-plant s)
(set! pos (send s get-pos))
@ -69,6 +73,7 @@
(define/public (update t d)
(when (and (key-pressed " ") debounce-space (not current-twig-growing))
(set! seed-return #f)
(set! debounce-space #f)
(set! last-pos pos)
(cond (current-twig
@ -76,6 +81,7 @@
(vector 0 1 0) #;(vsub (send current-twig get-point current-point)
(send current-twig get-point (- current-point 1))))))
(set! current-twig-growing #t)
(set! twig-stack (cons (list current-point current-twig) twig-stack))
(set! current-twig new-twig)))
(else
(set! current-twig (make-object twig-logic% (vector 0 0 0) 0 player-plant 'root
@ -104,23 +110,26 @@
; clamp tilt to prevent gimbal lock
(when (> tilt 88) (set! tilt 88))
(when (< tilt -88) (set! tilt -88))
(when (not current-twig-growing)
(when (key-pressed "x")
(cond ((not current-twig)
(set! current-twig (send player-plant get-twig-from-dir (vmul fwd -1)))
(set! current-point 2))
(else
(when (< current-point (- (send current-twig get-num-points) 1))
(set! current-point (+ current-point 1))))))
(when (key-pressed "z")
(cond (current-twig
(set! current-point (- current-point 1))
(when (< current-point 2)
(set! current-twig #f)
(set! pos player-pos)
#;(set-camera-transform (mtranslate (vector 0 0 -1))))))))
(when seed-return
(cond ((< current-point 2)
(cond ((null? twig-stack)
(set! current-twig #f)
(set! pos player-pos)
(set! seed-return #f))
(else
(set! current-point (car (car twig-stack)))
(set! current-twig (cadr (car twig-stack)))
(set! twig-stack (cdr twig-stack)))))
(else
(set! seed-return-timer (- seed-return-timer d))
(set! pos (vadd player-pos (vmix (send current-twig get-point current-point)
(send current-twig get-point (- current-point 1))
(/ seed-return-timer seed-return-secs-per-point))))
(when (< seed-return-timer 0)
(set! seed-return-timer seed-return-secs-per-point)
(set! current-point (- current-point 1))))))
; get camera fwd vector from key-presses
(set! fwd (vtransform (vector 0 0 1)
@ -130,23 +139,10 @@
; if we are on a twig not growing
(cond ((and current-twig (not current-twig-growing))
(set! pos (vadd player-pos (send current-twig get-point current-point)))
#;(when (> current-point 0)
(set! fwd (vmix fwd (vnormalise (vsub (send current-twig get-point
(- current-point 1))
pos)) 0.5))))
(else
(when current-twig-growing
#;(let ((twig-view (send (send game-view get-plant (send player-plant get-id))
get-twig (send current-twig get-id))))
(when twig-view
(set! pos (vadd player-pos (vsub (send twig-view get-end-pos)
(vmul (send current-twig get-dir) 1))))))
(when (not (send current-twig growing?))
(set! current-twig-growing #f)
(set! current-point (- (send current-twig get-num-points) 1))))))
(when (and current-twig-growing (not (send current-twig growing?)))
(set! current-twig-growing #f)
(set! seed-return #t)
(set! current-point (- (send current-twig get-num-points) 1)))
(let* ((side (vnormalise (vcross up fwd)))
(up (vnormalise (vcross fwd side))))

2
plant-eyes/jabberer.ss
View file

@ -17,7 +17,7 @@
(incoming '())
(outgoing '())
(thr 0)
(debug-jab #t))
(debug-jab #f))
(define/public (get-incoming)
incoming)

54
plant-eyes/logic.ss
View file

@ -18,6 +18,8 @@
(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)
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; the base class logic object - all logic side objects can
@ -73,7 +75,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
(energy-level 1)) ; starting energy level
(inherit send-message)
@ -241,8 +244,35 @@
#f
twigs)
found)))
; returns true if it's succeded
(define/public (check-nutrient nutrient)
; check each point in our twig
(let* ((found (foldl
(lambda (point found)
; 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)
#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))
(append
(map
(lambda (ornament)
@ -312,6 +342,26 @@
(super-new)))
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; nutrient fields are areas where nutrients exist
(define nutrient-field-logic%
(class game-logic-object%
(init-field
(pos (vector 0 0 0))
(size 0))
(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%

12
plant-eyes/view.ss
View file

@ -611,7 +611,7 @@
(define/public (add-twig-point twig-id point width)
(when (get-twig twig-id)
(send (get-twig twig-id) add-point point width)))
(send (get-twig twig-id) add-point point width)))
(define/public (start-twig-growing twig-id)
(when (get-twig twig-id)
@ -906,14 +906,16 @@
(send msg get-data 'num-points))))))
((eq? (send msg get-name) 'add-twig-point)
(send (get-plant (send msg get-data 'plant-id)) add-twig-point
(when (get-plant (send msg get-data 'plant-id))
(send (get-plant (send msg get-data 'plant-id)) add-twig-point
(send msg get-data 'twig-id)
(send msg get-data 'point)
(send msg get-data 'width)))
(send msg get-data 'width))))
((eq? (send msg get-name) 'start-growing)
(send (get-plant (send msg get-data 'plant-id)) start-twig-growing
(send msg get-data 'twig-id)))
(when (get-plant (send msg get-data 'plant-id))
(send (get-plant (send msg get-data 'plant-id)) start-twig-growing
(send msg get-data 'twig-id))))
((eq? (send msg get-name) 'new-pickup)
(add-pickup