diff --git a/plant-eyes/controller.ss b/plant-eyes/controller.ss index 0a936de..c9ec610 100644 --- a/plant-eyes/controller.ss +++ b/plant-eyes/controller.ss @@ -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)))) diff --git a/plant-eyes/jabberer.ss b/plant-eyes/jabberer.ss index eb228ce..719adf6 100644 --- a/plant-eyes/jabberer.ss +++ b/plant-eyes/jabberer.ss @@ -17,7 +17,7 @@ (incoming '()) (outgoing '()) (thr 0) - (debug-jab #t)) + (debug-jab #f)) (define/public (get-incoming) incoming) diff --git a/plant-eyes/logic.ss b/plant-eyes/logic.ss index 3d3a707..4f5774b 100644 --- a/plant-eyes/logic.ss +++ b/plant-eyes/logic.ss @@ -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% diff --git a/plant-eyes/view.ss b/plant-eyes/view.ss index fdad4e2..5ff410b 100644 --- a/plant-eyes/view.ss +++ b/plant-eyes/view.ss @@ -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