auto seed return - removed z and x key control
This commit is contained in:
parent
c9c24c7b8d
commit
03d4bc8c0b
4 changed files with 91 additions and 43 deletions
|
@ -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))))
|
||||
|
|
|
@ -17,7 +17,7 @@
|
|||
(incoming '())
|
||||
(outgoing '())
|
||||
(thr 0)
|
||||
(debug-jab #t))
|
||||
(debug-jab #f))
|
||||
|
||||
(define/public (get-incoming)
|
||||
incoming)
|
||||
|
|
|
@ -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%
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue