From f907549eb4d43a73fc9824576baef126ebd750a3 Mon Sep 17 00:00:00 2001 From: Dave Griffiths Date: Thu, 9 Jul 2009 12:52:56 +0100 Subject: [PATCH] steerable and navigatorable twigs --- hex-ornament/hex-ornament.scm | 4 +- plant-eyes/extrude.scm | 184 ++++++---------- plant-eyes/plant-eyes.scm | 396 +++++++++++----------------------- 3 files changed, 195 insertions(+), 389 deletions(-) diff --git a/hex-ornament/hex-ornament.scm b/hex-ornament/hex-ornament.scm index 1f1145f..14c45f0 100644 --- a/hex-ornament/hex-ornament.scm +++ b/hex-ornament/hex-ornament.scm @@ -1,8 +1,8 @@ -#lang scheme/base +;#lang scheme/base ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ; hex ornament/groworld game : fluxus version -(require fluxus-016/drflux) +;(require fluxus-016/drflux) (require scheme/class) ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ diff --git a/plant-eyes/extrude.scm b/plant-eyes/extrude.scm index 61c7ffb..e19ff82 100644 --- a/plant-eyes/extrude.scm +++ b/plant-eyes/extrude.scm @@ -1,5 +1,5 @@ -#lang scheme -(require fluxus-016/drflux) +;#lang scheme +;(require fluxus-016/drflux) ; extrusion code @@ -26,31 +26,20 @@ (vmul v 0.5))))) vd)) -(define (extrude-segment index profile path width lv up) +(define (extrude-segment index profile path width lv up size) (cond ((not (null? path)) (let ((v (path-vector (zero? index) path lv))) (draw-profile index (transform-profile profile (mmul (maim v up) (mrotate (vector 0 90 0)) - (mscale (vector (car width) (car width) (car width))))) - (car path)) - v)))) - -(define (extrude-segment-grow index profile path width lv up t) - (cond ((not (null? path)) - (let ((v (path-vector (zero? index) path lv))) - (draw-profile index (transform-profile profile - (mmul - (maim v up) - (mrotate (vector 0 90 0)) - (mscale (vmul (vector (car width) (car width) (car width)) t)))) + (mscale (vmul (vector (car width) (car width) (car width)) size)))) (car path)) v)))) (define (extrude index profile path width lv up) (cond ((not (null? path)) - (let ((v (extrude-segment index profile path width lv up))) + (let ((v (extrude-segment index profile path width lv up 1))) (extrude (+ index (length profile)) profile (cdr path) (cdr width) v up))))) (define (stitch-face index count profile-size in) @@ -76,11 +65,11 @@ in))))) (define (build-tex-coords profile-size path-size vscale) - (pdata-index-map! - (lambda (i t) - (vector (* vscale (/ (quotient i profile-size) path-size)) - (/ (modulo i profile-size) profile-size) 0)) - "t")) + (pdata-index-map! + (lambda (i t) + (vector (* vscale (/ (quotient i profile-size) path-size)) + (/ (modulo i profile-size) profile-size) 0)) + "t")) (define (build-extrusion profile path width tex-vscale up) (let ((p (build-polygons (* (length profile) (length path)) 'quad-list))) @@ -100,83 +89,45 @@ (build-tex-coords (length profile) (length path) tex-vscale)) p)) -(define (chop-front l n) - (cond ((null? l) l) - (else - (if (zero? n) (cons (car l) (chop-front (cdr l) n)) - (chop-front (cdr l) (- n 1)))))) - -(define (partial-extrude p t v profile path width up) - (with-primitive p 0 - - (let* ((T (floor t)) - (t (- t T)) - (seg-len (length profile)) - (start (* T seg-len)) - (end (* (length path) seg-len)) - (v (extrude-segment start profile - (chop-front path T) - (chop-front width T) v up))) - - (when (< T (- (length path) 1)) - ; extrude the next segment - (extrude-segment (+ start seg-len) profile - (chop-front path (+ T 1)) - (chop-front width (+ T 1)) v up) - - ; and now blend it back by using both segments to t - (for ((i (in-range (+ start seg-len) - (+ start (* 2 seg-len))))) - - (pdata-set! "p" i (vmix (pdata-ref "p" i) - (pdata-ref "p" (- i seg-len)) - - t))) - - - - ; collapse the yet un-extruded part into the last vert - (for ((i (in-range (+ start (* seg-len 2)) end))) - (pdata-set! "p" i (pdata-ref "p" (+ seg-len start))))) - - (recalc-normals 0) - v))) - -(define (partial-extrude-grow p t v profile path width up) - (with-primitive p 0 - - (let* ((T (floor t)) - (t (- t T)) - (seg-len (length profile)) - (start (* T seg-len)) - (end (* (length path) seg-len)) - (v (extrude-segment-grow start profile - (chop-front path T) - (chop-front width T) v up t))) - - (when (< T (- (length path) 1)) - ; extrude the next segment - (extrude-segment-grow (+ start seg-len) profile - (chop-front path (+ T 1)) - (chop-front width (+ T 1)) v up 0) - - ; and now blend it back by using both segments to t - (for ((i (in-range (+ start seg-len) - (+ start (* 2 seg-len))))) - - (pdata-set! "p" i (vmix (pdata-ref "p" i) - (pdata-ref "p" (- i seg-len)) - - t))) - - - - ; collapse the yet un-extruded part into the last vert - (for ((i (in-range (+ start (* seg-len 2)) end))) - (pdata-set! "p" i (pdata-ref "p" (+ seg-len start))))) - - (recalc-normals 0) - v))) +(define (partial-extrude t profile path width up grow) + (define (chop-front l n) + (cond ((null? l) l) + (else + (if (zero? n) (cons (car l) (chop-front (cdr l) n)) + (chop-front (cdr l) (- n 1)))))) + + (define (collapse-front) + (let ((start (* (floor t) (length profile)))) + (for ((i (in-range (+ start (* (length profile) 1)) (pdata-size)))) + (pdata-set! "p" i (pdata-ref "p" start))))) + + (define (scale-front) + (when (> t 1) + (let* ((start (* (floor t) (length profile))) + (from (list-ref path (- (inexact->exact (floor t)) 1))) + (to (list-ref path (+ (inexact->exact (floor t)) 0)))) + + (for ((i (in-range start (+ start (length profile))))) + (pdata-set! "p" i (vmix to from (- t (floor t)))))))) + + (define (_ t v g) + (cond + ((< t 1) (with-primitive p (recalc-normals 0)) v) + (else + (let ((start (* (floor t) (length profile)))) + (_ (- t 1) + (extrude-segment start profile + (chop-front path (floor t)) + (chop-front width (floor t)) v up + (if (< g 1) + (+ g (* (- t (floor t)) grow)) + g)) + (if (< g 1) + (+ g grow) + 1)))))) + (_ t (vector 0 0 0) 0) + (scale-front) + (collapse-front)) (define (build-circle-profile n r) (define (_ n c l) @@ -189,45 +140,46 @@ (clear) (clear-colour 0.5) - -(define l (make-light 'point 'free)) -(light-diffuse 0 (vector 0 0 0)) -(light-diffuse l (vector 1 1 1)) -(light-position l (vector 50 50 0)) -(light-specular l (vector 1 1 1)) - (define profile (build-circle-profile 12 0.5)) (define width (build-list 100 - (lambda (n) (* 0.5 (+ 1 (sin (* 0.3 n))))))) + (lambda (n) (* n 0.01 (+ 1.5 (cos (* 0.5 n))))))) (define path (build-list 100 - (lambda (n) (vmul (vector (sin (* 0.05 n)) 0 (cos (* 0.05 n))) (+ 0.5 (* 0.2 n)))))) + (lambda (n) (vmul (vector (sin (* 0.2 n)) 0 (cos (* 0.2 n))) (* 0.05 n))))) (define p (with-state -; (hint-wire) - (colour (vector 0 0.5 0.5)) + (wire-colour 0) +; (colour (vector 0.5 0.3 0.2)) + (colour (vector 1 1 1)) (specular (vector 1 1 1)) (shinyness 20) - (build-partial-extrusion profile path 1))) + (hint-wire) + (texture (load-texture "textures/root.png")) + (build-partial-extrusion profile path 10))) -(with-state +#;(with-state (wire-opacity 0.4) (translate (vector 0 0 0)) - (wire-colour (vector 0 0 1)) + (wire-colour (vector 0 0 1)) (hint-none) (hint-wire) -; (hint-normal) + ; (hint-normal) (backfacecull 1) (point-width 5) (build-extrusion profile path width 1 (vector 0 1 0))) -(define v (vector 0 0 0)) +(define t 0) (define (animate) - (set! v (partial-extrude-grow p (fmod (* 2 (flxtime)) (length path)) v profile path width (vector 0 1 0)))) - + (with-primitive p + (partial-extrude + (* (* 0.5 (+ 1 (sin (* 0.2 t)))) (length path)) + profile path width (vector 0 1 0) 0.05) + (set! t (+ t 0.01)))) (every-frame (animate)) +(end-framedump) +;(start-framedump "ext-" "jpg") \ No newline at end of file diff --git a/plant-eyes/plant-eyes.scm b/plant-eyes/plant-eyes.scm index 4234051..860002a 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) ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -35,16 +35,17 @@ (define debug-messages #f) ; prints out all the messages sent to the renderer (define logic-tick 1) ; time between logic updates -(define branch-probability 2) ; as in one in branch-probability chance +(define branch-probability 6) ; as in one in branch-probability chance (define branch-width-reduction 0.5) (define twig-jitter 0.1) (define branch-jitter 0.5) -(define max-twig-points 10) -(define start-twig-width 0.2) +(define max-twig-points 20) +(define start-twig-dist 0.3) +(define start-twig-width 0.3) (define default-max-twigs 10) (define default-scale-factor 1.05) (define default-grow-speed 1) -(define root-camera-time (* default-max-twigs logic-tick)) +(define root-camera-time (* max-twig-points logic-tick)) (define num-pickups 10) (define pickup-dist-radius 20) (define pickup-size 1) @@ -139,7 +140,7 @@ (width 0) ; the width of this root (num-points max-twig-points) ; number of points in this twig (render-type 'extruded) ; the way to tell the view to render this twig - (dist 1)) ; distance between points + (dist start-twig-dist)) ; distance between points (field (points '()) ; the 3d points for this twig @@ -167,7 +168,7 @@ width) (define/public (get-num-points) - num-points) + num-points) (define/public (get-render-type) render-type) @@ -181,18 +182,25 @@ (define/public (get-length) (length points)) + (define/public (get-end-pos) + (if (not (null? points)) + (list-ref points (- (get-length) 1)) + #f)) + (define/public (scale a) (set! width (* width a)) (set! dist (* dist a))) - (define/public (grow curly) + (define/public (grow ndir) (when (< (length points) num-points) (let ((new-point (if (zero? (length points)) ; first point should be at edge of the seed if we are a branch (if branch (vmul dir 1) (vector 0 0 0)) (vadd last-point (vmul dir dist))))) - (cond (curly + (set! dir (vmix dir ndir 0.5)) + + #;(cond (curly (set! dir (vtransform dir (mrotate curl))) (when (not branch) (set! curl (vmul curl 1.2)) @@ -219,7 +227,7 @@ dist)))) (for-each (lambda (twig) - (send (cadr twig) grow curly)) + (send (cadr twig) grow ndir)) twigs)) (define/public (add-twig point-index twig) @@ -369,7 +377,7 @@ (twigs '()) ; a assoc list map of ages to twigs (properties '()) ; a list of symbols - properties come from pickups (ornaments '()) ; map of ids to ornaments on the plant - (size 1) ; the age of this plant + (size 5) ; the age of this plant (max-twigs default-max-twigs) ; the maximum twigs allowed at any time - oldest removed first (next-twig-id 0) (next-ornament-id 0) @@ -383,12 +391,11 @@ (define/public (get-pos) pos) - (define/public (grow) - (let ((curly (list-contains 'curly properties))) + (define/public (grow dir) (for-each (lambda (twig) - (send twig grow curly)) - twigs))) + (send twig grow dir)) + twigs)) (define/public (add-property name) (set! properties (cons name properties))) @@ -456,6 +463,17 @@ (if (not (null? twigs)) (send (choose twigs) get-random-twig) #f)) + + (define/public (get-twig-from-dir dir) + (let ((dir (vnormalise dir))) + (cadr (foldl + (lambda (twig l) + (let ((d (vdot (vnormalise (send twig get-dir)) dir))) + (if (> d (car l)) + (list d twig) + l))) + (list -99 #f) + twigs)))) (define/augment (update) @@ -711,193 +729,6 @@ (super-new))) -;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - ; extrusion code - -(define (draw-profile index profile offset) - (cond ((not (null? profile)) - (pdata-set! "p" index (vadd (car profile) offset)) - (draw-profile (+ index 1) (cdr profile) offset)))) - - -(define (transform-profile profile m) - (cond - ((null? profile) '()) - (else - (cons (vtransform (car profile) m) - (transform-profile (cdr profile) m))))) - -; figures out the vector for rotation of the profile -(define (path-vector first-segment path lv) - (let* ((v (if (null? (cdr path)) ; last segment? - lv ; use the last vector used - (vsub (cadr path) (car path)))) ; use the next point - (vd (if first-segment v ; first segment? - (vadd (vmul lv 0.5) ; blend with the last vector - (vmul v 0.5))))) - vd)) - -(define (extrude-segment index profile path width lv up) - (cond ((not (null? path)) - (let ((v (path-vector (zero? index) path lv))) - (draw-profile index (transform-profile profile - (mmul - (maim v up) - (mrotate (vector 0 90 0)) - (mscale (vector (car width) (car width) (car width))))) - (car path)) - v)))) - -(define (extrude-segment-grow index profile path width lv up t) - (cond ((not (null? path)) - (let ((v (path-vector (zero? index) path lv))) - (draw-profile index (transform-profile profile - (mmul - (maim v up) - (mrotate (vector 0 90 0)) - (mscale (vmul (vector (car width) (car width) (car width)) t)))) - (car path)) - v)))) - -(define (extrude index profile path width lv up) - (cond ((not (null? path)) - (let ((v (extrude-segment index profile path width lv up))) - (extrude (+ index (length profile)) profile (cdr path) (cdr width) v up))))) - -(define (stitch-face index count profile-size in) - (cond - ((eq? 1 count) - (append in (list (+ (- index profile-size) 1) index (+ index profile-size) - (+ (- index profile-size) 1 profile-size)))) - (else - (append - (list (+ index 1) index - (+ index profile-size) (+ index profile-size 1)) - (stitch-face (+ index 1) (- count 1) profile-size in))))) - -(define (stitch-indices index profile-size path-size in) - (cond - ((eq? 1 path-size) in) - (else - (append - (stitch-face index profile-size profile-size '()) - (stitch-indices (+ index profile-size) - profile-size - (- path-size 1) - in))))) - -(define (build-tex-coords profile-size path-size vscale) - (pdata-index-map! - (lambda (i t) - (vector (* vscale (/ (quotient i profile-size) path-size)) - (/ (modulo i profile-size) profile-size) 0)) - "t")) - -(define (build-extrusion profile path width tex-vscale up) - (let ((p (build-polygons (* (length profile) (length path)) 'quad-list))) - (with-primitive p - (poly-set-index (stitch-indices 0 (length profile) (length path) '())) - (build-tex-coords (length profile) (length path) tex-vscale) - (extrude 0 profile path width (vector 0 0 0) up) - (recalc-normals 0)) - p)) - -; partial extrusions are for animating - -(define (build-partial-extrusion profile path tex-vscale) - (let ((p (build-polygons (* (length profile) (length path)) 'quad-list))) - (with-primitive p - (poly-set-index (stitch-indices 0 (length profile) (length path) '())) - (build-tex-coords (length profile) (length path) tex-vscale)) - p)) - -(define (chop-front l n) - (cond ((null? l) l) - (else - (if (zero? n) (cons (car l) (chop-front (cdr l) n)) - (chop-front (cdr l) (- n 1)))))) - -(define (partial-extrude p t v profile path width up) - (with-primitive p 0 - - (let* ((T (floor t)) - (t (- t T)) - (seg-len (length profile)) - (start (* T seg-len)) - (end (* (length path) seg-len)) - (v (extrude-segment start profile - (chop-front path T) - (chop-front width T) v up))) - - (when (< T (- (length path) 1)) - ; extrude the next segment - (extrude-segment (+ start seg-len) profile - (chop-front path (+ T 1)) - (chop-front width (+ T 1)) v up) - - ; and now blend it back by using both segments to t - (for ((i (in-range (+ start seg-len) - (+ start (* 2 seg-len))))) - - (pdata-set! "p" i (vmix (pdata-ref "p" i) - (pdata-ref "p" (- i seg-len)) - - t))) - - - - ; collapse the yet un-extruded part into the last vert - (for ((i (in-range (+ start (* seg-len 2)) end))) - (pdata-set! "p" i (pdata-ref "p" (+ seg-len start))))) - - (recalc-normals 0) - v))) - -(define (partial-extrude-grow p t v profile path width up) - (with-primitive p 0 - - (let* ((T (floor t)) - (t (- t T)) - (seg-len (length profile)) - (start (* T seg-len)) - (end (* (length path) seg-len)) - (v (extrude-segment-grow start profile - (chop-front path T) - (chop-front width T) v up t))) - - (when (< T (- (length path) 1)) - ; extrude the next segment - (extrude-segment-grow (+ start seg-len) profile - (chop-front path (+ T 1)) - (chop-front width (+ T 1)) v up 0) - - ; and now blend it back by using both segments to t - (for ((i (in-range (+ start seg-len) - (+ start (* 2 seg-len))))) - - (pdata-set! "p" i (vmix (pdata-ref "p" i) - (pdata-ref "p" (- i seg-len)) - - t))) - - - - ; collapse the yet un-extruded part into the last vert - (for ((i (in-range (+ start (* seg-len 2)) end))) - (pdata-set! "p" i (pdata-ref "p" (+ seg-len start))))) - - (recalc-normals 0) - v))) - -(define (build-circle-profile n r) - (define (_ n c l) - (cond ((zero? c) l) - (else - (let ((a (* (/ c n) (* 2 3.141)))) - (_ n (- c 1) - (cons (vmul (vector (sin a) (cos a) 0) r) l)))))) - (_ n n '())) - ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ (define ribbon-twig-view% @@ -962,7 +793,6 @@ (profile '()) (path '()) (root 0) - (v (vector 0 0 0)) (grow-speed default-grow-speed) (anim-t 0) (widths '())) @@ -970,10 +800,16 @@ (define/override (build) (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))))))) + (set! widths (build-list num-points (lambda (n) (let ((t (/ n num-points))) + (if (eq? n (- num-points 1)) 0 + (* radius + (if (zero? t) 1 + (+ (* t 0.5) + (* (- (/ 1 t) 1) 0.1))))))))) (set! root (let ((p (with-state - (backfacecull 1) + (backfacecull 0) + ;(hint-none) + ;(hint-wire) (translate pos) (texture (load-texture "textures/skin.png")) (opacity 0.6) @@ -995,16 +831,16 @@ (else (cons (car l) (list-set (cdr l) (- c 1) s))))) (define/augment (grow point) - (when (zero? index) (set! path (list-set path index point))) + #;(when (zero? index) (set! path (list-set path index point))) (set! path (list-set path (+ index 1) point)) (set! anim-t 0) - (set! v (partial-extrude-grow root index v profile path widths (vector 1 0 0))) (set! index (+ index 1))) (define/augment (update t d) (when (< anim-t 1) - (set! v (partial-extrude-grow root (+ (- index 1) anim-t) - v profile path widths (vector 1 0 0)))) + (with-primitive root + (partial-extrude (+ (- index 1) anim-t) + profile path widths (vector 1 0 0) 0.05))) (set! anim-t (+ anim-t (* d grow-speed)))) (define/public (get-end-pos) @@ -1043,7 +879,10 @@ id) (define/public (get-twig twig-id) - (cadr (assq twig-id twigs))) + (let ((l (assq twig-id twigs))) + (if l + (cadr (assq twig-id twigs)) + #f))) (define/public (add-branch-twig twig) ; attach to seed @@ -1144,18 +983,14 @@ (define game-view% (class object% - (init-field - (controller #f)) (field (plants '()) ; map of ids -> plants (pickups '()) ; map of ids -> pickups - (player-plant-id #f) - (current-twig-id #f) (camera-dist 1) (env-root (with-state (scale 20) (build-locator))) (root-camera-t 0) - (upper-env (with-state + #;(upper-env (with-state (parent env-root) (hint-depth-sort) (colour 2) @@ -1163,7 +998,7 @@ (build-env-box "textures/top.png" "textures/bottom-trans.png" "textures/left.png" "textures/right.png" "textures/front.png" "textures/back.png"))) - (lower-env (with-state + #;(lower-env (with-state (parent env-root) (hint-depth-sort) (translate (vector 0 -0.22001 0)) @@ -1195,21 +1030,14 @@ (fog (vector 0.5 0.3 0.2) 0.02 1 100) #;(fog (vector 0.2 0.5 0.3) 0.02 1 100)) - - (define/public (get-player) - (get-plant player-plant-id)) - (define/public (add-plant plant player) - (set! plants (cons (list (send plant get-id) plant) plants)) - (when player (set! player-plant-id (send plant get-id)))) + (define/public (add-plant plant) + (set! plants (cons (list (send plant get-id) plant) plants))) (define/public (get-plant plant-id) (cadr (assq plant-id plants))) (define/public (add-branch-twig plant-id twig) - (when (eq? plant-id player-plant-id) - (set! current-twig-id (send twig get-id)) - (set! root-camera-t 0)) (send (get-plant plant-id) add-branch-twig twig)) (define/public (destroy-branch-twig plant-id twig-id) @@ -1218,10 +1046,7 @@ (define/public (add-twig plant-id parent-twig-id point-index twig) (send (get-plant plant-id) add-twig parent-twig-id point-index twig)) - (define/public (grow-seed plant-id amount) - (when (eq? plant-id player-plant-id) - (set! camera-dist (* camera-dist amount)) - (with-primitive env-root (scale amount))) + (define/public (grow-seed plant-id amount) (send (get-plant plant-id) grow-seed amount)) (define/public (get-pickup pickup-id) @@ -1249,21 +1074,6 @@ (send (cadr pickup) update t d)) pickups) - (if current-twig-id - (let ((twig (send (get-player) get-twig current-twig-id))) - (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))))) - (send controller set-pos (vector 0 0 0))) - - - - (when (> root-camera-t root-camera-time) - ;(set-camera-position (vector 0 0 (- camera-dist))) - (set! current-twig-id #f)) - - (set! root-camera-t (+ root-camera-t d)) - (when debug-messages (for-each (lambda (msg) @@ -1272,15 +1082,15 @@ (for-each (lambda (msg) (cond - ((eq? (send msg get-name) 'player-plant) + ((eq? (send msg get-name) 'player-plant) ; not really any difference now (add-plant (make-object plant-view% (send msg get-data 'plant-id) - (send msg get-data 'pos)) #t)) + (send msg get-data 'pos)))) ((eq? (send msg get-name) 'new-plant) (add-plant (make-object plant-view% (send msg get-data 'plant-id) - (send msg get-data 'pos)) #f)) + (send msg get-data 'pos)))) ((eq? (send msg get-name) 'grow-seed) (grow-seed (send msg get-data 'plant-id) @@ -1366,15 +1176,25 @@ ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ (define controller% - (class object% + (class object% + (init-field + (game-view #f)) + (field (fwd (vector 0 0 1)) (up (vector 0 1 0)) (pos (vector 0 0 0)) (mtx (mident)) (cam (build-locator)) + (current-twig #f) + (current-twig-growing #f) + (current-point 0) (tilt 0) - (yaw 0)) + (yaw 0) + (player-plant #f)) + + (define/public (set-player-plant s) + (set! player-plant s)) (define/public (get-cam-obj) cam) @@ -1395,6 +1215,13 @@ (set-camera-transform (mtranslate (vector 0 0 -1)))) (define/public (update) + (when (key-pressed-this-frame " ") + (set! current-twig (make-object twig-logic% 0 player-plant 'root + (vmul fwd -1) + start-twig-width max-twig-points 'extruded)) + (send player-plant add-twig current-twig) + (set! current-twig-growing #t)) + (when (or (key-pressed "a") (key-special-pressed 100)) (set! yaw (+ yaw 1))) (when (or (key-pressed "d") (key-special-pressed 102)) (set! yaw (- yaw 1))) (when (or (key-pressed "w") (key-special-pressed 101)) (set! tilt (+ tilt 1))) @@ -1404,10 +1231,47 @@ (when (> tilt 88) (set! tilt 88)) (when (< tilt -88) (set! tilt -88)) - (set! fwd (vtransform (vector 0 0 1) - (mmul + (when (key-pressed-this-frame "q") + (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-this-frame "z") + (cond (current-twig + (set! current-point (- current-point 1)) + (when (< current-point 2) + (set! current-twig #f) + (set! pos (vector 0 0 0)) + (set-camera-transform (mtranslate (vector 0 0 -1))))))) + + ; if we are on a twig not growing + (cond ((and current-twig (not current-twig-growing)) + (set! pos (send current-twig get-point current-point)) + (when (> current-point 0) + (set! fwd (vnormalise (vsub (send current-twig get-point (- current-point 1)) + pos))))) + + (else + (when current-twig-growing + (set-camera-transform (mtranslate (vector 0 0 0))) + (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 (vsub (send twig-view get-end-pos) + (vmul (send current-twig get-dir) 5))))) + (when (eq? (send current-twig get-num-points) + (send current-twig get-length)) + (set! current-twig-growing #f) + (set! current-twig #f))) + + ; get camera fwd vector from key-presses + (set! fwd (vtransform (vector 0 0 1) + (mmul (mrotate (vector 0 yaw 0)) - (mrotate (vector tilt 0 0))))) + (mrotate (vector tilt 0 0))))))) (let* ((side (vnormalise (vcross up fwd))) (up (vnormalise (vcross fwd side)))) @@ -1424,9 +1288,9 @@ ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ (clear) -(define c (make-object controller%)) (define gl (make-object game-logic%)) -(define gv (make-object game-view% c)) +(define gv (make-object game-view%)) +(define c (make-object controller% gv)) (send c setup) (send gv setup) @@ -1435,14 +1299,14 @@ (define plant1 (make-object plant-logic% "dave@fo.am" (vector 0 0 0))) (define plant2 (make-object plant-logic% "plant00001@fo.am" (vector 0 0 9))) -(send gl add-player plant1) +(send c set-player-plant plant1) + +(send gl add-plant plant1) (send gl add-plant plant2) (send plant2 add-twig (make-object twig-logic% 0 plant2 'root (vector 0 -1 0) start-twig-width 10 'ribbon)) (define tick-time 0) -(define debounce #t) -(define debounce-time 0) (define pt 0) (define pd 0.02) @@ -1451,21 +1315,11 @@ (define (pt-update) (set! pt (+ pt pd))) (define (animate) - (when (and debounce (key-pressed " ")) - (send plant1 add-twig (make-object twig-logic% 0 plant1 'root - (vmul (send c get-fwd) -1) - start-twig-width max-twig-points 'extruded)) - (set! tick-time 0) - (set! debounce #f) - (set! debounce-time (+ (pe-time) 0.2))) - - (when (> (pe-time) debounce-time) - (set! debounce #t)) (when (< tick-time (pe-time)) (set! tick-time (+ (pe-time) logic-tick)) - (send plant1 grow) - (send plant2 grow) + (send plant1 grow (vmul (send c get-fwd) -1)) + (send plant2 grow (vector 0 -1 0)) (send gv update (pe-time) (pe-delta) (send gl update))) (send gv update (pe-time) (pe-delta) '())