added smidgen of gameplay back in

plant-eyes/plant-eyes.scm

@@ -1,5 +1,5 @@
-#lang scheme/base
+;#lang scheme/base
-(require fluxus-016/drflux)
+;(require fluxus-016/drflux)
 (require scheme/class)
 
 ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -34,11 +34,11 @@
 
 (define debug-messages #f) ; prints out all the messages sent to the renderer
 
-(define branch-probability 2) ; as in one in branch-probability chance
+(define branch-probability 5) ; as in one in branch-probability chance
 (define branch-width-reduction 0.5)
 (define twig-jitter 0.5)
 (define branch-jitter 1)
-(define max-twig-points 20)
+(define max-twig-points 40)
 (define start-twig-width 0.1)
 
 ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -606,7 +606,8 @@
       (define/override (build)
         (set! root (let ((p (with-state
                        (translate pos)
-                       (hint-unlit)
+                       ;(hint-unlit)
+                       (colour (vector 0.8 1 0.6))
                        ;(concat (maim dir (vector 0 0 1)))
                        (build-ribbon num-points))))
                (with-primitive p
@@ -658,13 +659,16 @@
        (path '())
        (root 0)
        (v (vector 0 0 0))
-       (grow-speed 1))
+       (grow-speed 2)
+       (anim-t 0))
       
       (define/override (build)
        (set! profile (build-circle-profile 5 radius))
        (set! path (build-list num-points (lambda (_) (vector 0 0 0))))
        (set! root (let ((p (with-state
                        (translate pos)
+                       (colour (vector 0.8 1 0.6))
+                       (texture (load-texture "textures/skin.png")) 
                        ;(hint-unlit)
                        ;(concat (maim dir (vector 0 0 1)))
                        (build-partial-extrusion profile path))))
@@ -684,14 +688,14 @@
       
       (define/override (grow point)
         (set! path (list-set path (+ index 1) point))
-        (set! t 0)
+        (set! anim-t 0)
         (set! v (partial-extrude root index v profile path))
         (set! index (+ index 1)))
 
       (define/override (update t d)
-        (when (< t 1)
+        (when (< anim-t 1)
-            (set! v (partial-extrude root (+ (- index 1) t) v profile path)))
+            (set! v (partial-extrude root (+ (- index 1) anim-t) v profile path)))
-        (set! t (+ t (* d grow-speed))))
+        (set! anim-t (+ anim-t (* d grow-speed))))
       
       (define/public (get-end-pos)
         (with-primitive root
@@ -769,14 +773,95 @@
 
 ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
+(define (build-env-box top bottom left right front back)    
+  (hint-unlit)  
+  (scale 40)
+  (with-state
+        (texture (load-texture top))
+        (translate (vector 0 0.5 0))
+        (rotate (vector 90 0 0))
+        (build-plane))
+    
+    (with-state
+        (texture (load-texture left))
+        (translate (vector 0 0 -0.5))
+        (rotate (vector 0 0 0))
+        (build-plane))
+    
+    (with-state
+        (texture (load-texture back))
+        (translate (vector 0.5 0 0))
+        (rotate (vector 0 90 0))
+        (build-plane))
+    
+    (with-state
+        (texture (load-texture right))
+        (translate (vector 0 0 0.5))
+        (rotate (vector 0 0 0))
+        (build-plane))
+    
+    (with-state
+        (texture (load-texture front))
+        (translate (vector -0.5 0 0))
+        (rotate (vector 0 90 0))
+        (build-plane))
+    
+    (with-state
+        (texture (load-texture bottom))
+        (translate (vector 0 -0.5 0))
+        (rotate (vector 90 0 0))
+        (build-plane)))
+
 (define game-view%
   (class object%
     (field
      (plants '()) ; map of ids -> plants     
-     (camera (build-cube))
+     (camera (build-locator))
      (player-plant-id #f)
-     (current-twig-id #f))
+     (current-twig-id #f)
+     (upper-env (with-state
+                 (hint-depth-sort)
+                 (colour 2)
+                 (scale 5)                 
+                 (translate (vector 0 20.01 0))                 
+                 (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
+                (hint-depth-sort)
+                 (scale 4.9)                 
+                 (translate (vector 0 -20 0))
+                 (build-env-box "textures/bottom-trans.png" "textures/bottom.png" 
+                                "textures/sleft.png" "textures/sright.png"
+                                "textures/sfront.png" "textures/sback.png")))
+    (nutrients (let ((p (with-state
+                            (hint-depth-sort)
+                            (texture (load-texture "textures/particle.png"))
+                            (build-particles 5000))))
+                        (with-primitive p
+                            (pdata-map! 
+                                (lambda (p)
+                                    (vmul (vadd (crndvec) (vector 0 -1 0)) 90))
+                                "p")
+                            (pdata-map! 
+                                (lambda (s)
+                                    (vector 1 1 1))
+                                "s"))
+                        p)))
     
+    (define/public (setup)
+      (lock-camera camera)
+      (camera-lag 0.05)
+      
+      (let ((l (make-light 'point 'free)))
+      (light-diffuse 0 (vector 0 0 0))
+      (light-diffuse l (vector 1 1 1))
+      (light-position l (vector 10 50 -4)))
+
+      (clear-colour (vector 0.1 0.3 0.2))
+
+      (fog (vector 0.2 0.5 0.3) 0.01 1 100))
+
     (define/public (get-player)
       (get-plant player-plant-id))
     
@@ -884,36 +969,47 @@
 
     (super-new)))
 
+
+
 ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
     
 (clear)
 (define gl (make-object game-logic%))
 (define gv (make-object game-view%))
- 
+
+(send gv setup)
+
 (define plant1 (make-object plant-logic% "dave@fo.am" (vector 0 0 0)))
-(define plant2 (make-object plant-logic% "plant00001@fo.am" (vector 6 0 0)))
+(define plant2 (make-object plant-logic% "plant00001@fo.am" (vector 60 0 0)))
 
 (send gl add-player plant1)
 (send gl add-plant plant2)
 
-(send plant1 add-twig (make-object twig-logic% 0 plant1 'root (vector 0 -1 0) start-twig-width 10 'extruded))
+#;(send plant1 add-twig (make-object twig-logic% 0 plant1 'root (vector 0 -1 0) start-twig-width 10 'extruded))
 (send plant2 add-twig (make-object twig-logic% 0 plant2 'root (vector 0 -1 0) start-twig-width 10 'ribbon))
 
-(define t 0)
 (define tick-time 0)
 (define tick 0.5)
-(define d 0.02)
+(define debounce #t)
+(define debounce-time 0)
 
 (define (animate)
-  (when (< tick-time t)
+  (when (and debounce (key-pressed " "))
-    (set! tick-time (+ t tick))
+    (send plant1 add-twig (make-object twig-logic% 0 plant1 'root 
+                        (vtransform-rot (vector 0 0 -1) (minverse (get-camera-transform))) 
+                        start-twig-width 20 'extruded))
+    (set! debounce #f)
+    (set! debounce-time (+ (time) 0.2)))
+            
+  (when (> (time) debounce-time)
+    (set! debounce #t)) 
+    
+  (when (< tick-time (time))
+    (set! tick-time (+ (time) tick))
     (send plant1 grow)
     (send plant2 grow)
-    (send gv update t d (send gl update)))
+    (send gv update (time) (delta) (send gl update)))
-  (send gv update t d '())
-  (set! t (+ t d)))
 
-(for ((i (in-range 0 100)))
+  (send gv update (time) (delta) '()))
-     (animate))
 
-(every-frame (animate))
+(every-frame (animate))