final fixes for v6 - new textures and camera changes
This commit is contained in:
Dave Griffiths
parent
cf6745c139
commit
fb334fe4eb
12 changed files with 170 additions and 123 deletions
|
|
@ -1,5 +1,5 @@
|
||||||
#lang scheme/base
|
;#lang scheme/base
|
||||||
(require fluxus-016/drflux)
|
;(require fluxus-016/drflux)
|
||||||
(require scheme/class)
|
(require scheme/class)
|
||||||
|
|
||||||
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||||||
|
|
@ -32,29 +32,35 @@
|
||||||
; * in the same way, the line segments can be created in any way by the logic
|
; * in the same way, the line segments can be created in any way by the logic
|
||||||
; side - eg. lsystem, or different methods per plant (or per twig even)
|
; side - eg. lsystem, or different methods per plant (or per twig even)
|
||||||
|
|
||||||
|
(define (ornament-colour) (vector 0.5 1 0.4))
|
||||||
|
(define (pickup-colour) (vector 1 1 1))
|
||||||
|
(define (earth-colour) (vector 0.2 0.1 0))
|
||||||
|
|
||||||
|
(define wire-mode #f)
|
||||||
|
(define fog-col (earth-colour))
|
||||||
|
(define fog-strength 0.001)
|
||||||
|
|
||||||
(define debug-messages #f) ; prints out all the messages sent to the renderer
|
(define debug-messages #f) ; prints out all the messages sent to the renderer
|
||||||
(define logic-tick 1) ; time between logic updates
|
(define logic-tick 0.5) ; time between logic updates
|
||||||
|
|
||||||
(define branch-probability 6) ; 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 branch-width-reduction 0.5)
|
||||||
(define twig-jitter 0.1)
|
(define twig-jitter 0.1)
|
||||||
(define branch-jitter 0.5)
|
(define branch-jitter 0.5)
|
||||||
(define max-twig-points 20)
|
(define max-twig-points 30)
|
||||||
(define start-twig-dist 0.3)
|
(define start-twig-dist 0.05)
|
||||||
(define start-twig-width 0.3)
|
(define start-twig-width 0.2)
|
||||||
(define default-max-twigs 10)
|
(define default-max-twigs 10)
|
||||||
(define default-scale-factor 1.05)
|
(define default-scale-factor 1.05)
|
||||||
(define default-grow-speed 1)
|
(define default-grow-speed (/ 1 logic-tick))
|
||||||
(define root-camera-time (* max-twig-points logic-tick))
|
(define root-camera-time (* max-twig-points logic-tick))
|
||||||
(define num-pickups 10)
|
(define num-pickups 10)
|
||||||
(define pickup-dist-radius 20)
|
(define pickup-dist-radius 200)
|
||||||
(define pickup-size 1)
|
(define pickup-size 1)
|
||||||
(define max-ornaments 2) ; per twig
|
(define max-ornaments 2) ; per twig
|
||||||
(define ornament-grow-probability 4)
|
(define ornament-grow-probability 4)
|
||||||
(define curl-amount 40)
|
(define curl-amount 40)
|
||||||
|
(define start-size 50)
|
||||||
(define (ornament-colour) (vector 0.5 1 0.4))
|
|
||||||
(define (pickup-colour) (vector 1 1 1))
|
|
||||||
|
|
||||||
(define (assoc-remove k l)
|
(define (assoc-remove k l)
|
||||||
(cond
|
(cond
|
||||||
|
|
@ -133,6 +139,7 @@
|
||||||
(define twig-logic%
|
(define twig-logic%
|
||||||
(class game-logic-object%
|
(class game-logic-object%
|
||||||
(init-field
|
(init-field
|
||||||
|
(last-point (vector 0 0 0))
|
||||||
(id #f) ; our id (for matching up with the renderer geometry)
|
(id #f) ; our id (for matching up with the renderer geometry)
|
||||||
(plant #f) ; the plant we belong to
|
(plant #f) ; the plant we belong to
|
||||||
(type 'root) ; or 'shoot
|
(type 'root) ; or 'shoot
|
||||||
|
|
@ -144,13 +151,17 @@
|
||||||
|
|
||||||
(field
|
(field
|
||||||
(points '()) ; the 3d points for this twig
|
(points '()) ; the 3d points for this twig
|
||||||
|
(widths '())
|
||||||
(twigs '()) ; children are stored with the point number they are connected to.
|
(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
|
(ornaments '()) ; the things attached to this twig, an assoc list with point index
|
||||||
(last-point (vector 0 0 0)) ; distance between points
|
|
||||||
(branch #f) ; are we a main branch twig?
|
(branch #f) ; are we a main branch twig?
|
||||||
|
(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
|
||||||
|
|
||||||
(inherit send-message)
|
(inherit send-message)
|
||||||
|
|
||||||
|
(define/public (set-pos s)
|
||||||
|
(set! last-point s))
|
||||||
|
|
||||||
(define/public (get-id)
|
(define/public (get-id)
|
||||||
id)
|
id)
|
||||||
|
|
@ -195,42 +206,41 @@
|
||||||
(when (< (length points) num-points)
|
(when (< (length points) num-points)
|
||||||
(let ((new-point (if (zero? (length points))
|
(let ((new-point (if (zero? (length points))
|
||||||
; first point should be at edge of the seed if we are a branch
|
; first point should be at edge of the seed if we are a branch
|
||||||
(if branch (vmul dir 1) (vector 0 0 0))
|
(if branch (vadd last-point (vmul dir dist))
|
||||||
|
last-point)
|
||||||
(vadd last-point (vmul dir dist)))))
|
(vadd last-point (vmul dir dist)))))
|
||||||
|
|
||||||
(set! dir (vmix dir ndir 0.5))
|
(set! dir ndir)
|
||||||
|
(set! w (* width (- 1 (/ (length points) num-points))))
|
||||||
#;(cond (curly
|
|
||||||
(set! dir (vtransform dir (mrotate curl)))
|
|
||||||
(when (not branch)
|
|
||||||
(set! curl (vmul curl 1.2))
|
|
||||||
(set! dist (* dist 0.9))))
|
|
||||||
(else
|
|
||||||
(set! dir (vadd dir (vmul (srndvec) twig-jitter)))))
|
|
||||||
|
|
||||||
(set! last-point new-point)
|
(set! last-point new-point)
|
||||||
(set! points (append points (list new-point)))
|
(set! points (append points (list new-point)))
|
||||||
|
(set! widths (append widths (list w)))
|
||||||
(send-message 'twig-grow (list
|
(send-message 'twig-grow (list
|
||||||
(list 'plant-id (send plant get-id))
|
(list 'plant-id (send plant get-id))
|
||||||
(list 'twig-id id)
|
(list 'twig-id id)
|
||||||
(list 'point new-point))))
|
(list 'point new-point)
|
||||||
(when (and (> (length points) 1) (> num-points 1)
|
(list 'width w)))
|
||||||
|
#;(when (and (> (length points) 1) (> num-points 1)
|
||||||
(zero? (random branch-probability)))
|
(zero? (random branch-probability)))
|
||||||
(add-twig (- (length points) 1)
|
(add-twig (- (length points) 1) (vadd dir (vmul (srndvec) branch-jitter))))))
|
||||||
(make-object twig-logic% (send plant get-next-twig-id)
|
|
||||||
plant
|
|
||||||
type
|
|
||||||
(vadd dir (vmul (srndvec) branch-jitter))
|
|
||||||
(* width branch-width-reduction)
|
|
||||||
(quotient num-points 2)
|
|
||||||
render-type
|
|
||||||
dist))))
|
|
||||||
(for-each
|
(for-each
|
||||||
(lambda (twig)
|
(lambda (twig)
|
||||||
(send (cadr twig) grow ndir))
|
(send (cadr twig) grow ndir))
|
||||||
twigs))
|
twigs))
|
||||||
|
|
||||||
(define/public (add-twig point-index twig)
|
(define/public (add-twig point-index dir)
|
||||||
|
(let ((twig (make-object twig-logic%
|
||||||
|
(get-point point-index)
|
||||||
|
(send plant get-next-twig-id)
|
||||||
|
plant
|
||||||
|
type
|
||||||
|
dir
|
||||||
|
(list-ref widths point-index)
|
||||||
|
(quotient num-points 2)
|
||||||
|
render-type
|
||||||
|
dist)))
|
||||||
|
|
||||||
(send-message 'new-twig (list
|
(send-message 'new-twig (list
|
||||||
(list 'plant-id (send plant get-id))
|
(list 'plant-id (send plant get-id))
|
||||||
(list 'parent-twig-id id)
|
(list 'parent-twig-id id)
|
||||||
|
|
@ -242,7 +252,8 @@
|
||||||
(list 'num-points (send twig get-num-points))
|
(list 'num-points (send twig get-num-points))
|
||||||
(list 'render-type (send twig get-render-type))
|
(list 'render-type (send twig get-render-type))
|
||||||
))
|
))
|
||||||
(set! twigs (cons (list point-index twig) twigs)))
|
(set! twigs (cons (list point-index twig) twigs))
|
||||||
|
twig))
|
||||||
|
|
||||||
(define/public (get-twig point-index)
|
(define/public (get-twig point-index)
|
||||||
(cadr (assq point-index twigs)))
|
(cadr (assq point-index twigs)))
|
||||||
|
|
@ -377,7 +388,7 @@
|
||||||
(twigs '()) ; a assoc list map of ages to twigs
|
(twigs '()) ; a assoc list map of ages to twigs
|
||||||
(properties '()) ; a list of symbols - properties come from pickups
|
(properties '()) ; a list of symbols - properties come from pickups
|
||||||
(ornaments '()) ; map of ids to ornaments on the plant
|
(ornaments '()) ; map of ids to ornaments on the plant
|
||||||
(size 5) ; the age of this plant
|
(size start-size) ; the age of this plant
|
||||||
(max-twigs default-max-twigs) ; the maximum twigs allowed at any time - oldest removed first
|
(max-twigs default-max-twigs) ; the maximum twigs allowed at any time - oldest removed first
|
||||||
(next-twig-id 0)
|
(next-twig-id 0)
|
||||||
(next-ornament-id 0)
|
(next-ornament-id 0)
|
||||||
|
|
@ -442,6 +453,7 @@
|
||||||
(set! size (* size grow-amount))
|
(set! size (* size grow-amount))
|
||||||
(send twig scale size)
|
(send twig scale size)
|
||||||
(send twig set-branch! #t)
|
(send twig set-branch! #t)
|
||||||
|
(send twig set-pos pos)
|
||||||
|
|
||||||
(send-message 'grow-seed (list
|
(send-message 'grow-seed (list
|
||||||
(list 'plant-id id)
|
(list 'plant-id id)
|
||||||
|
|
@ -702,10 +714,10 @@
|
||||||
(define/public (add-child-twig-id twig-id)
|
(define/public (add-child-twig-id twig-id)
|
||||||
(set! child-twig-ids (cons twig-id child-twig-ids)))
|
(set! child-twig-ids (cons twig-id child-twig-ids)))
|
||||||
|
|
||||||
(define/pubment (grow point)
|
(define/pubment (grow point width)
|
||||||
(let ((growing-noise (oa-load-sample (fullpath "snd/event01.wav"))))
|
(let ((growing-noise (oa-load-sample (fullpath "snd/event01.wav"))))
|
||||||
(oa-play growing-noise (vector 0 0 0) (rndf) 0.3))
|
(oa-play growing-noise (vector 0 0 0) (rndf) 0.3))
|
||||||
(inner (void) grow point))
|
(inner (void) grow point width))
|
||||||
|
|
||||||
(define/public (add-ornament point-index property)
|
(define/public (add-ornament point-index property)
|
||||||
(when (< (length ornaments) max-ornaments)
|
(when (< (length ornaments) max-ornaments)
|
||||||
|
|
@ -761,7 +773,7 @@
|
||||||
(with-primitive root
|
(with-primitive root
|
||||||
(pdata-ref "p" point-index)))
|
(pdata-ref "p" point-index)))
|
||||||
|
|
||||||
(define/augment (grow point)
|
(define/augment (grow point width)
|
||||||
(with-primitive root
|
(with-primitive root
|
||||||
(pdata-index-map! ; set all the remaining points to the end
|
(pdata-index-map! ; set all the remaining points to the end
|
||||||
(lambda (i p) ; in order to hide them
|
(lambda (i p) ; in order to hide them
|
||||||
|
|
@ -773,7 +785,7 @@
|
||||||
(lambda (i w)
|
(lambda (i w)
|
||||||
(if (< i (+ index 1))
|
(if (< i (+ index 1))
|
||||||
w
|
w
|
||||||
radius))
|
width))
|
||||||
"w"))
|
"w"))
|
||||||
(set! index (+ index 1)))
|
(set! index (+ index 1)))
|
||||||
|
|
||||||
|
|
@ -798,25 +810,20 @@
|
||||||
(widths '()))
|
(widths '()))
|
||||||
|
|
||||||
(define/override (build)
|
(define/override (build)
|
||||||
(set! profile (build-circle-profile 7 1))
|
(set! profile (build-circle-profile 12 1))
|
||||||
(set! path (build-list num-points (lambda (n) (vector 0 0 0))))
|
(set! path (build-list num-points (lambda (_) (vector 0 0 0))))
|
||||||
(set! widths (build-list num-points (lambda (n) (let ((t (/ n num-points)))
|
(set! widths (build-list num-points (lambda (_) 1)))
|
||||||
(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
|
(set! root (let ((p (with-state
|
||||||
(backfacecull 0)
|
(backfacecull 0)
|
||||||
;(hint-none)
|
(when wire-mode
|
||||||
;(hint-wire)
|
(hint-none)
|
||||||
(translate pos)
|
(hint-wire))
|
||||||
(texture (load-texture "textures/skin.png"))
|
(texture (load-texture "textures/root2.png"))
|
||||||
(opacity 0.6)
|
;(opacity 0.6)
|
||||||
(colour (vmul (vector 0.8 1 0.6) 2))
|
(colour (vmul (vector 0.8 1 0.6) 2))
|
||||||
#;(colour (vector 1 1 1))
|
#;(colour (vector 1 1 1))
|
||||||
#;(texture (load-texture "textures/root.png"))
|
#;(texture (load-texture "textures/root.png"))
|
||||||
(build-partial-extrusion profile path 6))))
|
(build-partial-extrusion profile path 3))))
|
||||||
p)))
|
p)))
|
||||||
|
|
||||||
(define/override (get-root)
|
(define/override (get-root)
|
||||||
|
|
@ -830,22 +837,21 @@
|
||||||
((zero? c) (cons s (list-set (cdr l) (- c 1) s)))
|
((zero? c) (cons s (list-set (cdr l) (- c 1) s)))
|
||||||
(else (cons (car l) (list-set (cdr l) (- c 1) s)))))
|
(else (cons (car l) (list-set (cdr l) (- c 1) s)))))
|
||||||
|
|
||||||
(define/augment (grow point)
|
(define/augment (grow point width)
|
||||||
#;(when (zero? index) (set! path (list-set path index point)))
|
(set! path (list-set path index point))
|
||||||
(set! path (list-set path (+ index 1) point))
|
(set! widths (list-set widths index width))
|
||||||
(set! anim-t 0)
|
(set! anim-t 0)
|
||||||
(set! index (+ index 1)))
|
(set! index (+ index 1)))
|
||||||
|
|
||||||
(define/augment (update t d)
|
(define/augment (update t d)
|
||||||
(when (< anim-t 1)
|
(when (< anim-t 1)
|
||||||
(with-primitive root
|
(with-primitive root
|
||||||
(partial-extrude (+ (- index 1) anim-t)
|
(partial-extrude (+ (- index 2) anim-t)
|
||||||
profile path widths (vector 1 0 0) 0.05)))
|
profile path widths (vector 1 0 0) 0.05)))
|
||||||
(set! anim-t (+ anim-t (* d grow-speed))))
|
(set! anim-t (+ anim-t (* d grow-speed))))
|
||||||
|
|
||||||
(define/public (get-end-pos)
|
(define/public (get-end-pos)
|
||||||
(with-primitive root
|
(with-primitive root (pdata-ref "p" (- (* index (length profile)) 1))))
|
||||||
(pdata-ref "p" (* index (length profile)))))
|
|
||||||
|
|
||||||
(super-new)))
|
(super-new)))
|
||||||
|
|
||||||
|
|
@ -866,13 +872,16 @@
|
||||||
(build-locator)))
|
(build-locator)))
|
||||||
(seed (with-state
|
(seed (with-state
|
||||||
(parent root)
|
(parent root)
|
||||||
(texture (load-texture "textures/skin.png"))
|
(texture (load-texture "textures/root2.png"))
|
||||||
(backfacecull 0)
|
(backfacecull 0)
|
||||||
(opacity 0.6)
|
(opacity 0.6)
|
||||||
(colour (vector 0.8 1 0.6))
|
(colour (vector 0.8 1 0.6))
|
||||||
(hint-depth-sort)
|
(hint-depth-sort)
|
||||||
(scale 0.5)
|
(scale (* 0.12 start-size))
|
||||||
(hint-unlit)
|
(when wire-mode
|
||||||
|
(hint-none)
|
||||||
|
(hint-wire))
|
||||||
|
;(hint-unlit)
|
||||||
(load-primitive "meshes/seed.obj"))))
|
(load-primitive "meshes/seed.obj"))))
|
||||||
|
|
||||||
(define/public (get-id)
|
(define/public (get-id)
|
||||||
|
|
@ -901,12 +910,12 @@
|
||||||
|
|
||||||
(define/public (add-twig parent-twig-id point-index twig)
|
(define/public (add-twig parent-twig-id point-index twig)
|
||||||
(let ((ptwig (get-twig parent-twig-id)))
|
(let ((ptwig (get-twig parent-twig-id)))
|
||||||
; attach to parent twig
|
; attach to parent twig
|
||||||
(with-primitive (send twig get-root)
|
|
||||||
(parent (send ptwig get-root)))
|
|
||||||
|
|
||||||
(send twig set-pos! (send ptwig get-point point-index))
|
(send twig set-pos! (send ptwig get-point point-index))
|
||||||
(send twig build)
|
(send twig build)
|
||||||
|
(with-primitive (send twig get-root)
|
||||||
|
(parent (send ptwig get-root)))
|
||||||
|
|
||||||
|
|
||||||
; tell the twigs about this relationship (might turn out to be overkill)
|
; tell the twigs about this relationship (might turn out to be overkill)
|
||||||
(send ptwig add-child-twig-id (send twig get-id))
|
(send ptwig add-child-twig-id (send twig get-id))
|
||||||
|
|
@ -914,8 +923,8 @@
|
||||||
|
|
||||||
(set! twigs (cons (list (send twig get-id) twig) twigs))))
|
(set! twigs (cons (list (send twig get-id) twig) twigs))))
|
||||||
|
|
||||||
(define/public (grow-twig twig-id point)
|
(define/public (grow-twig twig-id point width)
|
||||||
(send (get-twig twig-id) grow point))
|
(send (get-twig twig-id) grow point width))
|
||||||
|
|
||||||
(define/public (grow-seed amount)
|
(define/public (grow-seed amount)
|
||||||
(with-primitive seed (scale amount)))
|
(with-primitive seed (scale amount)))
|
||||||
|
|
@ -937,16 +946,22 @@
|
||||||
|
|
||||||
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||||||
|
|
||||||
(define (build-env-box top bottom left right front back)
|
(define (build-env-box top bottom left right front back lower)
|
||||||
(let ((p (build-locator)))
|
(let ((p (build-locator)))
|
||||||
(with-state
|
(with-state
|
||||||
(parent p)
|
(parent p)
|
||||||
(hint-unlit)
|
(hint-unlit)
|
||||||
(with-state
|
|
||||||
|
(let ((t (with-state
|
||||||
(texture (load-texture top))
|
(texture (load-texture top))
|
||||||
(translate (vector 0 0.5 0))
|
(translate (vector 0 0.5 0))
|
||||||
(rotate (vector 90 0 0))
|
(rotate (vector 90 0 0))
|
||||||
(build-plane))
|
(build-plane))))
|
||||||
|
(when lower (with-primitive t
|
||||||
|
(pdata-map!
|
||||||
|
(lambda (t)
|
||||||
|
(vmul t 10))
|
||||||
|
"t"))))
|
||||||
|
|
||||||
(with-state
|
(with-state
|
||||||
(texture (load-texture left))
|
(texture (load-texture left))
|
||||||
|
|
@ -972,11 +987,13 @@
|
||||||
(rotate (vector 0 90 0))
|
(rotate (vector 0 90 0))
|
||||||
(build-plane))
|
(build-plane))
|
||||||
|
|
||||||
(with-state
|
(when lower
|
||||||
|
(with-state
|
||||||
(texture (load-texture bottom))
|
(texture (load-texture bottom))
|
||||||
(translate (vector 0 -0.5 0))
|
(translate (vector 0 -0.5 0))
|
||||||
(rotate (vector 90 0 0))
|
(rotate (vector 90 0 0))
|
||||||
(build-plane))
|
(build-plane)))
|
||||||
|
|
||||||
p)))
|
p)))
|
||||||
|
|
||||||
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||||||
|
|
@ -988,7 +1005,7 @@
|
||||||
(plants '()) ; map of ids -> plants
|
(plants '()) ; map of ids -> plants
|
||||||
(pickups '()) ; map of ids -> pickups
|
(pickups '()) ; map of ids -> pickups
|
||||||
(camera-dist 1)
|
(camera-dist 1)
|
||||||
(env-root (with-state (scale 20) (build-locator)))
|
(env-root (with-state (scale 1000) (build-locator)))
|
||||||
(root-camera-t 0)
|
(root-camera-t 0)
|
||||||
#;(upper-env (with-state
|
#;(upper-env (with-state
|
||||||
(parent env-root)
|
(parent env-root)
|
||||||
|
|
@ -1005,6 +1022,23 @@
|
||||||
(build-env-box "textures/bottom-trans.png" "textures/bottom.png"
|
(build-env-box "textures/bottom-trans.png" "textures/bottom.png"
|
||||||
"textures/sleft.png" "textures/sright.png"
|
"textures/sleft.png" "textures/sright.png"
|
||||||
"textures/sfront.png" "textures/sback.png")))
|
"textures/sfront.png" "textures/sback.png")))
|
||||||
|
(upper-env (with-state
|
||||||
|
(parent env-root)
|
||||||
|
;(hint-depth-sort)
|
||||||
|
(hint-unlit)
|
||||||
|
(translate (vector 0 0.28 0))
|
||||||
|
(build-env-box "textures/sky-top.png" "textures/floor.png"
|
||||||
|
"textures/sky-side.png" "textures/sky-side.png"
|
||||||
|
"textures/sky-side.png" "textures/sky-side.png" #f)))
|
||||||
|
(lower-env (with-state
|
||||||
|
(parent env-root)
|
||||||
|
;(hint-depth-sort)
|
||||||
|
(hint-unlit)
|
||||||
|
(colour (earth-colour))
|
||||||
|
(translate (vector 0 -0.22001 0))
|
||||||
|
(build-env-box "textures/floor.png" "textures/earth-bottom.png"
|
||||||
|
"textures/earth-side.png" "textures/earth-side.png"
|
||||||
|
"textures/earth-side.png" "textures/earth-side.png" #t)))
|
||||||
(nutrients (let ((p (with-state
|
(nutrients (let ((p (with-state
|
||||||
(hint-depth-sort)
|
(hint-depth-sort)
|
||||||
(texture (load-texture "textures/particle.png"))
|
(texture (load-texture "textures/particle.png"))
|
||||||
|
|
@ -1012,7 +1046,7 @@
|
||||||
(with-primitive p
|
(with-primitive p
|
||||||
(pdata-map!
|
(pdata-map!
|
||||||
(lambda (p)
|
(lambda (p)
|
||||||
(vmul (vadd (crndvec) (vector 0 -1 0)) 90))
|
(vmul (vadd (crndvec) (vector 0 -1 0)) 900))
|
||||||
"p")
|
"p")
|
||||||
(pdata-map!
|
(pdata-map!
|
||||||
(lambda (s)
|
(lambda (s)
|
||||||
|
|
@ -1026,10 +1060,9 @@
|
||||||
(light-diffuse l (vector 1 1 1))
|
(light-diffuse l (vector 1 1 1))
|
||||||
(light-position l (vector 10 50 -4)))
|
(light-position l (vector 10 50 -4)))
|
||||||
|
|
||||||
(clear-colour (vector 0.5 0.3 0.2))
|
(clear-colour fog-col)
|
||||||
|
(clip 0.5 10000)
|
||||||
(fog (vector 0.5 0.3 0.2) 0.02 1 100)
|
(fog fog-col fog-strength 1 100))
|
||||||
#;(fog (vector 0.2 0.5 0.3) 0.02 1 100))
|
|
||||||
|
|
||||||
(define/public (add-plant plant)
|
(define/public (add-plant plant)
|
||||||
(set! plants (cons (list (send plant get-id) plant) plants)))
|
(set! plants (cons (list (send plant get-id) plant) plants)))
|
||||||
|
|
@ -1146,7 +1179,8 @@
|
||||||
((eq? (send msg get-name) 'twig-grow)
|
((eq? (send msg get-name) 'twig-grow)
|
||||||
(send (get-plant (send msg get-data 'plant-id)) grow-twig
|
(send (get-plant (send msg get-data 'plant-id)) grow-twig
|
||||||
(send msg get-data 'twig-id)
|
(send msg get-data 'twig-id)
|
||||||
(send msg get-data 'point)))
|
(send msg get-data 'point)
|
||||||
|
(send msg get-data 'width)))
|
||||||
|
|
||||||
((eq? (send msg get-name) 'new-pickup)
|
((eq? (send msg get-name) 'new-pickup)
|
||||||
(add-pickup
|
(add-pickup
|
||||||
|
|
@ -1210,22 +1244,29 @@
|
||||||
|
|
||||||
(define/public (setup)
|
(define/public (setup)
|
||||||
(lock-camera cam)
|
(lock-camera cam)
|
||||||
(camera-lag 0.1)
|
(camera-lag 0.2)
|
||||||
(clip 1 1000)
|
(clip 1 1000)
|
||||||
(set-camera-transform (mtranslate (vector 0 0 -1))))
|
(set-camera-transform (mtranslate (vector 0 0 -4))))
|
||||||
|
|
||||||
(define/public (update)
|
(define/public (update)
|
||||||
(when (key-pressed-this-frame " ")
|
(when (key-pressed-this-frame " ")
|
||||||
(set! current-twig (make-object twig-logic% 0 player-plant 'root
|
(cond ((and current-twig (not current-twig-growing))
|
||||||
(vmul fwd -1)
|
(let ((new-twig (send current-twig add-twig current-point
|
||||||
start-twig-width max-twig-points 'extruded))
|
(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! current-twig new-twig)))
|
||||||
|
(else
|
||||||
|
(set! current-twig (make-object twig-logic% (vector 0 0 0) 0 player-plant 'root
|
||||||
|
(vmul fwd -1)
|
||||||
|
start-twig-width max-twig-points 'extruded))
|
||||||
(send player-plant add-twig current-twig)
|
(send player-plant add-twig current-twig)
|
||||||
(set! current-twig-growing #t))
|
(set! current-twig-growing #t))))
|
||||||
|
|
||||||
(when (or (key-pressed "a") (key-special-pressed 100)) (set! yaw (+ yaw 1)))
|
(when (or (key-pressed "a") (key-special-pressed 100)) (set! yaw (+ yaw 2)))
|
||||||
(when (or (key-pressed "d") (key-special-pressed 102)) (set! yaw (- yaw 1)))
|
(when (or (key-pressed "d") (key-special-pressed 102)) (set! yaw (- yaw 2)))
|
||||||
(when (or (key-pressed "w") (key-special-pressed 101)) (set! tilt (+ tilt 1)))
|
(when (or (key-pressed "w") (key-special-pressed 101)) (set! tilt (+ tilt 2)))
|
||||||
(when (or (key-pressed "s") (key-special-pressed 103)) (set! tilt (- tilt 1)))
|
(when (or (key-pressed "s") (key-special-pressed 103)) (set! tilt (- tilt 2)))
|
||||||
|
|
||||||
; clamp tilt to prevent gimbal lock
|
; clamp tilt to prevent gimbal lock
|
||||||
(when (> tilt 88) (set! tilt 88))
|
(when (> tilt 88) (set! tilt 88))
|
||||||
|
|
@ -1233,7 +1274,7 @@
|
||||||
|
|
||||||
(when (key-pressed-this-frame "q")
|
(when (key-pressed-this-frame "q")
|
||||||
(cond ((not current-twig)
|
(cond ((not current-twig)
|
||||||
(set! current-twig (send player-plant get-twig-from-dir (vmul fwd 1)))
|
(set! current-twig (send player-plant get-twig-from-dir (vmul fwd -1)))
|
||||||
(set! current-point 2))
|
(set! current-point 2))
|
||||||
(else
|
(else
|
||||||
(when (< current-point (- (send current-twig get-num-points) 1))
|
(when (< current-point (- (send current-twig get-num-points) 1))
|
||||||
|
|
@ -1245,33 +1286,35 @@
|
||||||
(when (< current-point 2)
|
(when (< current-point 2)
|
||||||
(set! current-twig #f)
|
(set! current-twig #f)
|
||||||
(set! pos (vector 0 0 0))
|
(set! pos (vector 0 0 0))
|
||||||
(set-camera-transform (mtranslate (vector 0 0 -1)))))))
|
#;(set-camera-transform (mtranslate (vector 0 0 -1)))))))
|
||||||
|
|
||||||
|
; 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)))))
|
||||||
|
|
||||||
|
|
||||||
; if we are on a twig not growing
|
; if we are on a twig not growing
|
||||||
(cond ((and current-twig (not current-twig-growing))
|
(cond ((and current-twig (not current-twig-growing))
|
||||||
(set! pos (send current-twig get-point current-point))
|
(set! pos (send current-twig get-point current-point))
|
||||||
(when (> current-point 0)
|
#;(when (> current-point 0)
|
||||||
(set! fwd (vnormalise (vsub (send current-twig get-point (- current-point 1))
|
(set! fwd (vmix fwd (vnormalise (vsub (send current-twig get-point
|
||||||
pos)))))
|
(- current-point 1))
|
||||||
|
pos)) 0.5))))
|
||||||
|
|
||||||
(else
|
(else
|
||||||
(when current-twig-growing
|
(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))
|
(let ((twig-view (send (send game-view get-plant (send player-plant get-id))
|
||||||
get-twig (send current-twig get-id))))
|
get-twig (send current-twig get-id))))
|
||||||
(when twig-view
|
(when twig-view
|
||||||
(set! pos (vsub (send twig-view get-end-pos)
|
(set! pos (vsub (send twig-view get-end-pos)
|
||||||
(vmul (send current-twig get-dir) 5)))))
|
(vmul (send current-twig get-dir) 1)))))
|
||||||
(when (eq? (send current-twig get-num-points)
|
(when (eq? (send current-twig get-num-points)
|
||||||
(send current-twig get-length))
|
(send current-twig get-length))
|
||||||
(set! current-twig-growing #f)
|
(set! current-twig-growing #f)
|
||||||
(set! current-twig #f)))
|
(set! current-point (- (send current-twig get-num-points) 1))))))
|
||||||
|
|
||||||
; 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)))))))
|
|
||||||
|
|
||||||
(let* ((side (vnormalise (vcross up fwd)))
|
(let* ((side (vnormalise (vcross up fwd)))
|
||||||
(up (vnormalise (vcross fwd side))))
|
(up (vnormalise (vcross fwd side))))
|
||||||
|
|
@ -1297,14 +1340,14 @@
|
||||||
(send gl setup)
|
(send gl setup)
|
||||||
|
|
||||||
(define plant1 (make-object plant-logic% "dave@fo.am" (vector 0 0 0)))
|
(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)))
|
(define plant2 (make-object plant-logic% "plant00001@fo.am" (vector 0 0 90)))
|
||||||
|
|
||||||
(send c set-player-plant plant1)
|
(send c set-player-plant plant1)
|
||||||
|
|
||||||
(send gl add-plant plant1)
|
(send gl add-plant plant1)
|
||||||
(send gl add-plant plant2)
|
(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))
|
(send plant2 add-twig (make-object twig-logic% (vector 0 0 0) 0 plant2 'root (vector 0 -1 0) start-twig-width 10 'ribbon))
|
||||||
|
|
||||||
(define tick-time 0)
|
(define tick-time 0)
|
||||||
|
|
||||||
|
|
|
||||||
BIN
plant-eyes/textures/earth-bottom.png
Normal file
BIN
plant-eyes/textures/earth-bottom.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 22 KiB |
BIN
plant-eyes/textures/earth-side.png
Normal file
BIN
plant-eyes/textures/earth-side.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 22 KiB |
BIN
plant-eyes/textures/earth-top.png
Normal file
BIN
plant-eyes/textures/earth-top.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 1.9 KiB |
BIN
plant-eyes/textures/floor.png
Normal file
BIN
plant-eyes/textures/floor.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 16 KiB |
BIN
plant-eyes/textures/grid.png
Normal file
BIN
plant-eyes/textures/grid.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 1.6 KiB |
BIN
plant-eyes/textures/root2.png
Normal file
BIN
plant-eyes/textures/root2.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 44 KiB |
BIN
plant-eyes/textures/sky-side.png
Normal file
BIN
plant-eyes/textures/sky-side.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 42 KiB |
BIN
plant-eyes/textures/sky-top.png
Normal file
BIN
plant-eyes/textures/sky-top.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 29 KiB |
BIN
plant-eyes/textures/v5roots.png
Normal file
BIN
plant-eyes/textures/v5roots.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 544 KiB |
BIN
plant-eyes/textures/v5roots2.png
Normal file
BIN
plant-eyes/textures/v5roots2.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 601 KiB |
|
|
@ -8,16 +8,16 @@
|
||||||
(vector x y 0)))
|
(vector x y 0)))
|
||||||
|
|
||||||
(define (build-ellipse rmin rmaj num-verts)
|
(define (build-ellipse rmin rmaj num-verts)
|
||||||
(define p (build-polygons (* 3 num-verts) 'triangle-list))
|
(define p (build-polygons num-verts 'polygon))
|
||||||
(with-primitive p
|
(with-primitive p
|
||||||
(for ([i (in-range 0 (* 3 num-verts) 3) ])
|
(for ([i (in-range 0 num-verts)])
|
||||||
(pdata-set! "p" i (vector 0 0 0))
|
;(pdata-set! "p" i (vector 0 0 0))
|
||||||
(pdata-set! "n" i (vector 0 0 1))
|
;(pdata-set! "n" i (vector 0 0 1))
|
||||||
(pdata-set! "p" (+ i 1) (calc-xyz (/ i 3) num-verts rmin))
|
(pdata-set! "p" i (calc-xyz i num-verts rmin))
|
||||||
(pdata-set! "n" (+ i 1) (vnormalise (calc-xyz (/ i 3) num-verts rmin)))
|
#;(pdata-set! "n" i (vnormalise (calc-xyz i num-verts rmin)))
|
||||||
(pdata-set! "p" (+ i 2) (calc-xyz (+ (/ i 3) 1) num-verts rmin))
|
;(pdata-set! "p" (+ i 2) (calc-xyz (+ (/ i 3) 1) num-verts rmin))
|
||||||
(pdata-set! "n" (+ i 2) (vnormalise (calc-xyz (+ (/ i 3) 1) num-verts rmin))))
|
#;(pdata-set! "n" (+ i 2) (vnormalise (calc-xyz (+ (/ i 3) 1) num-verts rmin))))
|
||||||
(poly-convert-to-indexed))
|
#;(poly-convert-to-indexed))
|
||||||
p)
|
p)
|
||||||
|
|
||||||
(define-struct stones ((pos-list #:mutable) size-list (root #:mutable) (obj-list #:mutable)))
|
(define-struct stones ((pos-list #:mutable) size-list (root #:mutable) (obj-list #:mutable)))
|
||||||
|
|
@ -42,7 +42,7 @@
|
||||||
(parent root)
|
(parent root)
|
||||||
(map
|
(map
|
||||||
(lambda (pos size)
|
(lambda (pos size)
|
||||||
(if (and (< size 0.4) (zero? (random 3)))
|
(if (and #f (< size 0.4) (zero? (random 3)))
|
||||||
(let ((o (with-state
|
(let ((o (with-state
|
||||||
(hint-unlit)
|
(hint-unlit)
|
||||||
(scale 0.2)
|
(scale 0.2)
|
||||||
|
|
@ -51,9 +51,13 @@
|
||||||
(with-primitive o (apply-transform))
|
(with-primitive o (apply-transform))
|
||||||
o)
|
o)
|
||||||
(with-state
|
(with-state
|
||||||
;(hint-unlit)
|
;(hint-none)
|
||||||
|
(hint-wire)
|
||||||
|
(hint-unlit)
|
||||||
|
(line-width 2)
|
||||||
|
(wire-colour 0)
|
||||||
(hint-ignore-depth)
|
(hint-ignore-depth)
|
||||||
(colour (hsv->rgb (vector (+ 0 (* 0.2 (rndf))) 0.5 (+ 0.1 (rndf)))))
|
(colour (hsv->rgb (vector (+ -0.1 (* 0.2 (rndf))) 0.5 (+ 0.1 (rndf)))))
|
||||||
(translate pos)
|
(translate pos)
|
||||||
(build-ellipse size size 32))))
|
(build-ellipse size size 32))))
|
||||||
(stones-pos-list stones)
|
(stones-pos-list stones)
|
||||||
|
|
@ -146,12 +150,12 @@
|
||||||
(light-diffuse 0 (vector 0.2 0.2 0.2))
|
(light-diffuse 0 (vector 0.2 0.2 0.2))
|
||||||
(light-diffuse l (vector 1 1 1))
|
(light-diffuse l (vector 1 1 1))
|
||||||
|
|
||||||
(define s (stones-build (stones-init 100 5 1)))
|
(define s (stones-build (stones-init 1000 5 1)))
|
||||||
|
|
||||||
(define roots (build-list 10 (lambda (_) (build-root (* 5 (crndf))))))
|
#;(define roots (build-list 10 (lambda (_) (build-root (* 5 (crndf))))))
|
||||||
|
|
||||||
(define (animate)
|
(define (animate)
|
||||||
(for-each
|
#;(for-each
|
||||||
(lambda (root)
|
(lambda (root)
|
||||||
(with-primitive root
|
(with-primitive root
|
||||||
(nudge s 0.01)
|
(nudge s 0.01)
|
||||||
|
|
|
||||||
Loading…
Reference in a new issue