camera fixes, ready for v3
This commit is contained in:
parent
4310213545
commit
9c8d97369d
3 changed files with 115 additions and 55 deletions
|
@ -1,5 +1,5 @@
|
|||
#lang scheme/base
|
||||
(require fluxus-016/drflux)
|
||||
;#lang scheme/base
|
||||
;(require fluxus-016/drflux)
|
||||
(require scheme/class)
|
||||
|
||||
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||||
|
@ -33,14 +33,18 @@
|
|||
; side - eg. lsystem, or different methods per plant (or per twig even)
|
||||
|
||||
(define debug-messages #f) ; prints out all the messages sent to the renderer
|
||||
(define logic-tick 1) ; time between logic updates
|
||||
|
||||
(define branch-probability 5) ; as in one in branch-probability chance
|
||||
(define branch-probability 2) ; 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 40)
|
||||
(define max-twig-points 10)
|
||||
(define start-twig-width 0.1)
|
||||
(define default-max-twigs 5)
|
||||
(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))
|
||||
|
||||
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||||
; a message for sending betwixt logic and render side
|
||||
|
@ -105,14 +109,15 @@
|
|||
(dir (vector 0 1 0)) ; the general direction we are pointing in
|
||||
(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
|
||||
(render-type 'extruded) ; the way to tell the view to render this twig
|
||||
(dist 1)) ; distance between points
|
||||
|
||||
(field
|
||||
(points '()) ; the 3d points for this twig
|
||||
(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
|
||||
(last-point (vector 0 0 0))
|
||||
(dist 1)) ; distance between points
|
||||
(last-point (vector 0 0 0)) ; distance between points
|
||||
(branch #f)) ; are we a main branch twig?
|
||||
|
||||
(inherit send-message)
|
||||
|
||||
|
@ -137,19 +142,22 @@
|
|||
(define/public (get-render-type)
|
||||
render-type)
|
||||
|
||||
(define/public (set-branch! s)
|
||||
(set! branch s))
|
||||
|
||||
(define/public (get-point point-index)
|
||||
(list-ref points point-index))
|
||||
|
||||
(define/public (scale a)
|
||||
(set! width (* width a))
|
||||
(set! dist (* dist a))
|
||||
(printf "~a~n" dist))
|
||||
(set! dist (* dist a)))
|
||||
|
||||
(define/public (grow)
|
||||
(when (< (length points) num-points)
|
||||
(let ((new-point (if (zero? (length points))
|
||||
(vector 0 0 0) ; first point should be at the origin
|
||||
(vadd last-point (vmul dir dist) (vmul (srndvec) twig-jitter)))))
|
||||
; first point should be at edge of the seed if we are a branch
|
||||
(if branch (vmul dir dist) (vector 0 0 0))
|
||||
(vadd last-point (vmul dir dist) (vmul (srndvec) (* dist twig-jitter))))))
|
||||
(set! last-point new-point)
|
||||
(set! points (append points (list new-point)))
|
||||
(send-message 'twig-grow (list
|
||||
|
@ -164,7 +172,8 @@
|
|||
(vadd dir (vmul (srndvec) branch-jitter))
|
||||
(* width branch-width-reduction)
|
||||
(quotient num-points 2)
|
||||
render-type))))
|
||||
render-type
|
||||
dist))))
|
||||
(for-each
|
||||
(lambda (twig)
|
||||
(send (cadr twig) grow))
|
||||
|
@ -286,7 +295,7 @@
|
|||
(size 1) ; the age of this plant
|
||||
(max-twigs default-max-twigs) ; the maximum twigs allowed at any time - oldest removed first
|
||||
(next-twig-id 0)
|
||||
(grow-amount 1.1))
|
||||
(grow-amount default-scale-factor))
|
||||
|
||||
(inherit send-message)
|
||||
|
||||
|
@ -336,10 +345,11 @@
|
|||
(define/public (add-twig twig)
|
||||
(send twig set-id! (get-next-twig-id))
|
||||
(set! size (* size grow-amount))
|
||||
(send twig scale size)
|
||||
(send twig scale size)
|
||||
(send twig set-branch! #t)
|
||||
|
||||
(send-message 'grow-seed (list
|
||||
(list 'pland-id id)
|
||||
(list 'plant-id id)
|
||||
(list 'amount grow-amount)))
|
||||
(send-message 'new-branch-twig (list
|
||||
(list 'plant-id id)
|
||||
|
@ -490,20 +500,29 @@
|
|||
(- path-size 1)
|
||||
in)))))
|
||||
|
||||
(define (build-extrusion profile path)
|
||||
(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 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)
|
||||
(extrude 0 profile path (vector 0 0 0))
|
||||
(recalc-normals 0))
|
||||
p))
|
||||
|
||||
; partial extrusions are for animating
|
||||
|
||||
(define (build-partial-extrusion profile path)
|
||||
(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) '())))
|
||||
(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)
|
||||
|
@ -582,6 +601,9 @@
|
|||
(define/public (get-id)
|
||||
id)
|
||||
|
||||
(define/public (get-dir)
|
||||
dir)
|
||||
|
||||
(define/public (build)
|
||||
0)
|
||||
|
||||
|
@ -627,9 +649,8 @@
|
|||
(define/override (build)
|
||||
(set! root (let ((p (with-state
|
||||
(translate pos)
|
||||
;(hint-unlit)
|
||||
(colour (vector 0.8 1 0.6))
|
||||
;(concat (maim dir (vector 0 0 1)))
|
||||
(texture (load-texture "textures/root.png"))
|
||||
(build-ribbon num-points))))
|
||||
(with-primitive p
|
||||
(pdata-map!
|
||||
|
@ -673,41 +694,40 @@
|
|||
(define extruded-twig-view%
|
||||
(class twig-view%
|
||||
|
||||
(inherit-field index radius num-points pos)
|
||||
(inherit-field index radius num-points pos dir)
|
||||
|
||||
(field
|
||||
(profile '())
|
||||
(path '())
|
||||
(root 0)
|
||||
(v (vector 0 0 0))
|
||||
(grow-speed 2)
|
||||
(grow-speed default-grow-speed)
|
||||
(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! path (build-list num-points (lambda (n) (vector 0 0 0))))
|
||||
(set! root (let ((p (with-state
|
||||
(backfacecull 0)
|
||||
(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))))
|
||||
(texture (load-texture "textures/root.png"))
|
||||
(build-partial-extrusion profile path 6))))
|
||||
p)))
|
||||
|
||||
(define/override (get-root)
|
||||
root)
|
||||
|
||||
(define/override (get-point point-index)
|
||||
(when (> point-index index) (error "asked for point before we've set it"))
|
||||
(list-ref path point-index))
|
||||
|
||||
|
||||
(define (list-set l c s)
|
||||
(cond ((null? l) '())
|
||||
((zero? c) (cons s (list-set (cdr l) (- c 1) s)))
|
||||
(else (cons (car l) (list-set (cdr l) (- c 1) s)))))
|
||||
|
||||
(define/override (grow 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 root index v profile path))
|
||||
|
@ -721,7 +741,7 @@
|
|||
(define/public (get-end-pos)
|
||||
(with-primitive root
|
||||
(pdata-ref "p" (* index (length profile)))))
|
||||
|
||||
|
||||
(super-new)))
|
||||
|
||||
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||||
|
@ -746,6 +766,7 @@
|
|||
(opacity 0.6)
|
||||
(colour (vector 0.8 1 0.6))
|
||||
(hint-depth-sort)
|
||||
(scale 0.5)
|
||||
(hint-unlit)
|
||||
(load-primitive "meshes/seed.obj"))))
|
||||
|
||||
|
@ -794,7 +815,10 @@
|
|||
(set! twigs (cons (list (send twig get-id) twig) twigs))))
|
||||
|
||||
(define/public (grow-twig twig-id point)
|
||||
(send (get-twig twig-id) grow point))
|
||||
(send (get-twig twig-id) grow point))
|
||||
|
||||
(define/public (grow-seed amount)
|
||||
(with-primitive seed (scale amount)))
|
||||
|
||||
(define/public (update t d)
|
||||
|
||||
|
@ -811,8 +835,10 @@
|
|||
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||||
|
||||
(define (build-env-box top bottom left right front back)
|
||||
(let ((p (build-locator)))
|
||||
(with-state
|
||||
(parent p)
|
||||
(hint-unlit)
|
||||
(scale 40)
|
||||
(with-state
|
||||
(texture (load-texture top))
|
||||
(translate (vector 0 0.5 0))
|
||||
|
@ -847,7 +873,8 @@
|
|||
(texture (load-texture bottom))
|
||||
(translate (vector 0 -0.5 0))
|
||||
(rotate (vector 90 0 0))
|
||||
(build-plane)))
|
||||
(build-plane))
|
||||
p)))
|
||||
|
||||
(define game-view%
|
||||
(class object%
|
||||
|
@ -856,18 +883,21 @@
|
|||
(camera (build-locator))
|
||||
(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
|
||||
(parent env-root)
|
||||
(hint-depth-sort)
|
||||
(colour 2)
|
||||
(scale 5)
|
||||
(translate (vector 0 20.01 0))
|
||||
(translate (vector 0 0.28 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))
|
||||
(parent env-root)
|
||||
(hint-depth-sort)
|
||||
(translate (vector 0 -0.22001 0))
|
||||
(build-env-box "textures/bottom-trans.png" "textures/bottom.png"
|
||||
"textures/sleft.png" "textures/sright.png"
|
||||
"textures/sfront.png" "textures/sback.png")))
|
||||
|
@ -888,16 +918,17 @@
|
|||
|
||||
(define/public (setup)
|
||||
(lock-camera camera)
|
||||
(camera-lag 0.05)
|
||||
(camera-lag 0.05)
|
||||
(set-camera-position (vector 0 0 -1))
|
||||
|
||||
(let ((l (make-light 'point 'free)))
|
||||
(light-diffuse 0 (vector 0 0 0))
|
||||
(light-diffuse 0 (vector 0.5 0.5 0.5))
|
||||
(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))
|
||||
(fog (vector 0.2 0.5 0.3) 0.02 1 100))
|
||||
|
||||
(define/public (get-player)
|
||||
(get-plant player-plant-id))
|
||||
|
@ -911,7 +942,8 @@
|
|||
|
||||
(define/public (add-branch-twig plant-id twig)
|
||||
(when (eq? plant-id player-plant-id)
|
||||
(set! current-twig-id (send twig get-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)
|
||||
|
@ -920,6 +952,13 @@
|
|||
(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))
|
||||
#;(fog (vector 0.2 0.5 0.3) (* 0.01 (* amount amount amount)) 1 100))
|
||||
(send (get-plant plant-id) grow-seed amount))
|
||||
|
||||
(define/public (update t d messages)
|
||||
|
||||
(for-each
|
||||
|
@ -927,13 +966,24 @@
|
|||
(send (cadr plant) update t d))
|
||||
plants)
|
||||
|
||||
(when current-twig-id
|
||||
(if current-twig-id
|
||||
(let ((twig (send (get-player) get-twig current-twig-id)))
|
||||
(with-primitive camera
|
||||
(identity)
|
||||
(translate (send twig get-end-pos)))))
|
||||
(translate (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)))
|
||||
|
||||
|
||||
|
||||
(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)
|
||||
|
@ -952,6 +1002,10 @@
|
|||
(send msg get-data 'plant-id)
|
||||
(send msg get-data 'pos)) #f))
|
||||
|
||||
((eq? (send msg get-name) 'grow-seed)
|
||||
(grow-seed (send msg get-data 'plant-id)
|
||||
(send msg get-data 'amount)))
|
||||
|
||||
((eq? (send msg get-name) 'destroy-branch-twig)
|
||||
(destroy-branch-twig (send msg get-data 'plant-id) (send msg get-data 'twig-id)))
|
||||
|
||||
|
@ -1023,36 +1077,42 @@
|
|||
(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 60 0 0)))
|
||||
(define plant2 (make-object plant-logic% "plant00001@fo.am" (vector 0 0 9)))
|
||||
|
||||
(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 plant2 add-twig (make-object twig-logic% 0 plant2 'root (vector 0 -1 0) start-twig-width 10 'ribbon))
|
||||
|
||||
(define tick-time 0)
|
||||
(define tick 0.5)
|
||||
(define debounce #t)
|
||||
(define debounce-time 0)
|
||||
|
||||
(define pt 0)
|
||||
(define pd 0.02)
|
||||
(define (pe-time) pt)
|
||||
(define (pe-delta) pd)
|
||||
(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
|
||||
(vtransform-rot (vector 0 0 -1) (minverse (get-camera-transform)))
|
||||
start-twig-width 20 'extruded))
|
||||
start-twig-width max-twig-points 'extruded))
|
||||
(set! tick-time 0)
|
||||
(set! debounce #f)
|
||||
(set! debounce-time (+ (flxtime) 0.2)))
|
||||
(set! debounce-time (+ (pe-time) 0.2)))
|
||||
|
||||
(when (> (flxtime) debounce-time)
|
||||
(when (> (pe-time) debounce-time)
|
||||
(set! debounce #t))
|
||||
|
||||
(when (< tick-time (flxtime))
|
||||
(set! tick-time (+ (flxtime) tick))
|
||||
(when (< tick-time (pe-time))
|
||||
(set! tick-time (+ (pe-time) logic-tick))
|
||||
(send plant1 grow)
|
||||
(send plant2 grow)
|
||||
(send gv update (flxtime) (delta) (send gl update)))
|
||||
(send gv update (pe-time) (pe-delta) (send gl update)))
|
||||
|
||||
(send gv update (flxtime) (delta) '()))
|
||||
(send gv update (pe-time) (pe-delta) '())
|
||||
(pt-update))
|
||||
|
||||
(every-frame (animate))
|
||||
|
|
BIN
plant-eyes/textures/bottom-trans.png
Normal file
BIN
plant-eyes/textures/bottom-trans.png
Normal file
Binary file not shown.
After Width: | Height: | Size: 163 KiB |
BIN
plant-eyes/textures/root.png
Normal file
BIN
plant-eyes/textures/root.png
Normal file
Binary file not shown.
After Width: | Height: | Size: 330 KiB |
Loading…
Reference in a new issue