diff --git a/plant-eyes/plant-eyes.scm b/plant-eyes/plant-eyes.scm index 8d39b32..63f8b12 100644 --- a/plant-eyes/plant-eyes.scm +++ b/plant-eyes/plant-eyes.scm @@ -1,5 +1,5 @@ -;#lang scheme/base -;(require fluxus-016/drflux) +#lang scheme/base +(require fluxus-016/drflux) (require scheme/class) ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -40,7 +40,7 @@ (define twig-jitter 0.1) (define branch-jitter 0.5) (define max-twig-points 10) -(define start-twig-width 0.1) +(define start-twig-width 0.2) (define default-max-twigs 10) (define default-scale-factor 1.05) (define default-grow-speed 1) @@ -963,7 +963,7 @@ (widths '())) (define/override (build) - (set! profile (build-circle-profile 5 1)) + (set! profile (build-circle-profile 7 1)) (set! path (build-list num-points (lambda (n) (vector 0 0 0)))) (set! widths (build-list num-points (lambda (n) (if (eq? n (- num-points 1)) 0 (* radius (- 1 (/ n num-points))))))) @@ -1139,10 +1139,12 @@ (define game-view% (class object% + (init-field + (controller #f)) + (field (plants '()) ; map of ids -> plants (pickups '()) ; map of ids -> pickups - (camera (build-locator)) (player-plant-id #f) (current-twig-id #f) (camera-dist 1) @@ -1178,11 +1180,7 @@ "s")) p))) - (define/public (setup) - (lock-camera camera) - (camera-lag 0.05) - (set-camera-position (vector 0 0 -1)) - + (define/public (setup) (let ((l (make-light 'point 'free))) (light-diffuse 0 (vector 0.5 0.5 0.5)) (light-diffuse l (vector 1 1 1)) @@ -1248,13 +1246,10 @@ (if current-twig-id (let ((twig (send (get-player) get-twig current-twig-id))) - (with-primitive camera - (identity) - (translate (vadd (send twig get-end-pos) + (send controller set-pos (vadd (send twig get-end-pos) (vmul (send twig get-dir) (* camera-dist -2)) - (vcross (send twig get-dir) (vector 0 1 0)))) - )) - (with-primitive camera (identity))) + (vcross (send twig get-dir) (vector 0 1 0))))) + (send controller set-pos (vector 0 0 0))) @@ -1363,14 +1358,72 @@ (super-new))) +;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +(define controller% + (class object% + (field + (fwd (vector 0 0 1)) + (up (vector 0 1 0)) + (pos (vector 0 0 0)) + (mtx (mident)) + (cam (build-locator)) + (tilt 0) + (yaw 0)) + + (define/public (get-cam-obj) + cam) + + (define/public (set-pos s) + (set! pos s)) + + (define/public (set-fwd s) + (set! fwd s)) + + (define/public (get-fwd) + fwd) + + (define/public (setup) + (lock-camera cam) + (camera-lag 0.1) + (clip 1 1000) + (set-camera-transform (mtranslate (vector 0 0 -1)))) + + (define/public (update) + (when (key-pressed "a") (set! yaw (+ yaw 1))) + (when (key-pressed "d") (set! yaw (- yaw 1))) + (when (key-pressed "w") (set! tilt (+ tilt 1))) + (when (key-pressed "s") (set! tilt (- tilt 1))) + + ; clamp tilt to prevent gimbal lock + (when (> tilt 88) (set! tilt 88)) + (when (< tilt -88) (set! tilt -88)) + + (set! fwd (vtransform (vector 0 0 1) + (mmul + (mrotate (vector 0 yaw 0)) + (mrotate (vector tilt 0 0))))) + + (let* ((side (vnormalise (vcross up fwd))) + (up (vnormalise (vcross fwd side)))) + + (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))))) + + (super-new))) ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ (clear) +(define c (make-object controller%)) (define gl (make-object game-logic%)) -(define gv (make-object game-view%)) +(define gv (make-object game-view% c)) +(send c setup) (send gv setup) (send gl setup) @@ -1395,7 +1448,7 @@ (define (animate) (when (and debounce (key-pressed " ")) (send plant1 add-twig (make-object twig-logic% 0 plant1 'root - (vtransform-rot (vector 0 0 -1) (minverse (get-camera-transform))) + (vmul (send c get-fwd) -1) start-twig-width max-twig-points 'extruded)) (set! tick-time 0) (set! debounce #f) @@ -1411,6 +1464,7 @@ (send gv update (pe-time) (pe-delta) (send gl update))) (send gv update (pe-time) (pe-delta) '()) + (send c update) (pt-update)) #;(for ((i (in-range 0 10000)))