groworld/plant-eyes/plant-eyes.scm

;#lang scheme/base
;(require fluxus-016/drflux)
(require scheme/class)
  

  ;=====================================================================
  
  (clear)
  
  (define (build-ring n sr er)
    (let ((p (build-polygons (+ (* n 2) 2) 'triangle-strip)))
      (with-primitive p
                      (pdata-index-map!
                       (lambda (i p)
                         (let ((a (* (/ (quotient i 2) n) (* 2 3.141)))
                               (s (* (if (odd? i) sr er) 5))) 
                           (vector (* (cos a) s) (* (sin a) s) (if (odd? i) 0 5 ))))
                       "p")
                      
                      (recalc-normals 1))
      p))
  
  (define camera (build-locator))
  
  (define twig%
    (class object%
      (init-field
       (size 100)
       (radius 1)
       (speed 0.2))
      (field
       (root (build-locator))
       (child-twigs '())
       (age 0)
       (tx (mident))  
       (next-ring-time 0))
      
      (define/public (build pos dir)
        (with-primitive root
                        (translate pos)
                        (cond (dir  
                               (concat (maim dir (vector 0 0 1)))       
                               (rotate (vector 0 -90 0)))
                              (else (rotate (vmul (crndvec) 20))))))
      
      (define/public (update t)
        
        (for-each 
         (lambda (child)
           (send child update t))
         child-twigs)
        
            (when (and (< age size) (< next-ring-time t))
                (set! next-ring-time (+ t speed))
                (let ((p (with-state
                                (parent root)
                                (hint-depth-sort) 
                                (colour (vector 0.8 1 0.6))
                                (texture (load-texture "textures/skin.png")) 
                                ;(hint-none)
                                ;(hint-wire)
                                (backfacecull 1)
                                (let* ((s (- size age))
                                        (sr (* radius (/ s size))) 
                                        (er (* radius (/ (- s 1) size))))
                                    (translate (vector 0 0 (* age 5)))
                                    (when (zero? (random 3))
                                        (with-state
                                            (identity)
                                            (set! child-twigs (cons 
                                                    (make-object twig% (/ size 2) sr speed) child-twigs))
                                            (send (car child-twigs) build (vector 0 0 (* age 5) ) #f)))
                                    
                                    (build-ring 5 sr er)))))
                    (with-primitive camera (parent p)))
                (set! age (+ age 1))))
        
        
        
        
        (super-new)))

(define pickup%
    (class object%
        (init-field 
            (pos (vector 0 0 0)))
        (field 
            (col (vmul (rndvec) 0.1))
            (root (let ((p (with-state                
                                (translate pos)
                                (hint-depth-sort)
                                (blend-mode 'src-alpha 'one)
                                (texture (load-texture "textures/particle.png"))
                                (build-particles 20))))
                    (with-primitive p
                        (pdata-add "vel" "v")                  
                        (pdata-map!
                            (lambda (vel)
                                (vmul (vector (crndf) (* 2 (rndf)) (crndf)) 0.02))
                            "vel")
                        (pdata-map!
                            (lambda (s)
                                (vector 2 2 2))
                            "s")
                        (pdata-map!
                            (lambda (c)
                                col)
                            "c"))
                    p)))
        
        (define/public (get-pos)
            pos)
        
        (define/public (update t)
            (with-primitive root
                (pdata-op "+" "p" "vel")
                (pdata-op "*" "c" 0.996)
                (pdata-op "*" "s" 1.005)
                (when (zero? (random 5))
                    (let ((reset (random (pdata-size))))
                        (pdata-set! "c" reset col)
                        (pdata-set! "p" reset (vector 0 0 0))
                        (pdata-set! "s" reset (vector 2 2 2))))))
        
        (super-new)))

(define seed%
    (class object%
        (field 
            (twigs '())
            (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))
            (pickups (build-list 1 (lambda (_) 
                        (make-object pickup% (vmul (vsub (crndvec) (vector 0 1 0)) 50)))))
            (indicator (let ((p (with-state    
                                (hint-depth-sort)
                                ;(blend-mode 'src-alpha 'one )
                                (texture (load-texture "textures/particle.png"))
                                (build-particles 200))))
                    (with-primitive p
                        (pdata-add "vel" "v")
                        (pdata-map! 
                            (lambda (vel)
                                (srndvec))
                            "vel")
                        (pdata-map! 
                            (lambda (c)
                                (vector 0 0 0.1))
                            "c")
                        
                        (pdata-map! 
                            (lambda (s)
                                (let ((sz (rndf)))
                                    (vector sz sz sz)))
                            "s"))
                    p))
            (debounce #t)
            (debounce-time 0)
            (pos (vector 0 0 0))
            (root (with-state
                    (scale 5)
                    (translate pos)
                    (texture (load-texture "textures/skin.png"))
                    (backfacecull 0)
                    (opacity 0.6)
                    (colour (vector 0.8 1 0.6))
                    (hint-depth-sort)
                    (hint-unlit)
                    (load-primitive "meshes/seed.obj"))))
        
        (define/public (add-twig dir)
            (let ((t (make-object twig% 10 0.2 2)))
                (set! twigs (cons (with-state
                            (colour (vector 0.3 0.8 0.4))
                            (send t build (vector 0 0 0) dir) t) twigs))))
        
        
        (define/public (update t)
            
            (let ((closest (foldl
                            (lambda (pickup r)
                                (if (< (vdist (send pickup get-pos) pos) 
                                        (vdist pos r)) 
                                    (send pickup get-pos) r))
                            (vector 999 999 999)
                            pickups)))
                
                (with-primitive indicator                    
                    (pdata-op "+" "p" "vel")
                    (when (< (sin (* 2 t)) 0) 
                        (let ((reset (random (pdata-size))))
                            (let ((pos (vmul (vnormalise (vsub closest pos)) 10)))
                                (pdata-set! "vel" reset (vadd (vmul (srndvec) 0.01)
                                        (vmul (vsub closest pos) (* (rndf) 0.01))))
                                (pdata-set! "p" reset pos))))))
            
            (with-primitive root
                (scale (+ 1 (* 0.001 (sin (* 2 t))))))
            
            (when (key-pressed "r") (with-primitive camera (parent 1)))
            
            (when (and debounce (key-pressed " "))
                (add-twig (vtransform-rot (vector 0 0 1) (minverse (get-camera-transform))))         
                (set! debounce #f)
                (set! debounce-time (+ t 1)))
            
            (when (> t debounce-time)
                (set! debounce #t)) 
            
            (for-each 
                (lambda (twig)
                    (send twig update t))
                twigs)
            (for-each 
                (lambda (pickup)
                    (send pickup update t))
                pickups))
        
        (super-new)))

; build world

(with-state
    (scale 5 )
    (translate (vector 0 0 0))
    
    (with-state
        (texture (load-texture "textures/top.png"))
        (translate (vector 0 20 0))
        (rotate (vector 90 0 0))
        (scale 40)
        (hint-unlit)
        (build-plane))
    
    (with-state
        (texture (load-texture "textures/left.png"))
        (translate (vector 0 0 -20))
        (rotate (vector 0 0 0))
        (scale 40)
        (hint-unlit)
        (build-plane))
    
    (with-state
        (texture (load-texture "textures/back.png"))
        (translate (vector 20 0 0))
        (rotate (vector 0 90 0))
        (scale 40)
        (hint-unlit)
        (build-plane))
    
    (with-state
        (texture (load-texture "textures/right.png"))
        (translate (vector 0 0 20))
        (rotate (vector 0 0 0))
        (scale 40)
        (hint-unlit)
        (build-plane))
    
    (with-state
        (texture (load-texture "textures/front.png"))
        (translate (vector -20 0 0))
        (rotate (vector 0 90 0))
        (scale 40)
        (hint-unlit)
        (build-plane))
    
    (with-state
        (texture (load-texture "textures/bottom.png"))
        (opacity 0.8)
        (hint-depth-sort) 
        (translate (vector 0 2 0))
        (rotate (vector 90 0 0))
        (scale 40)
        (hint-unlit)
        (build-plane))
    
    ; soil
    
    (with-state
        (texture (load-texture "textures/sback.png"))
        (translate (vector 0 -15 -19.99))
        (rotate (vector 0 0 0))
        (scale 40)
        (hint-unlit)
        (build-plane))
    
    (with-state
        (texture (load-texture "textures/sleft.png"))
        (translate (vector 19.9 -15 0))
        (rotate (vector 0 90 0))
        (scale 40)
        (hint-unlit)
        (build-plane))
    
    (with-state
        (texture (load-texture "textures/sfront.png"))
        (translate (vector 0 -15 19.9))
        (rotate (vector 0 0 0))
        (scale 40)
        (hint-unlit)
        (build-plane))
    
    (with-state
        (texture (load-texture "textures/sright.png"))
        (translate (vector -19.9 -15 0))
        (rotate (vector 0 90 0))
        (scale 40)
        (hint-unlit)
        (build-plane)))

(lock-camera camera)
(camera-lag 0.05)

(define 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 s (make-object seed%))

(define t 0)

(define (animate)
    (send s update t)
    (set! t (+ t 0.02)))

(every-frame (animate))