camera fixes, ready for v3

This commit is contained in:
Dave Griffiths 2009-06-26 10:28:18 +01:00
parent 4310213545
commit 9c8d97369d
3 changed files with 115 additions and 55 deletions

View file

@ -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))

Binary file not shown.

After

Width:  |  Height:  |  Size: 163 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 330 KiB