camera stuff

This commit is contained in:
Dave Griffiths 2009-07-02 14:38:43 +01:00
parent ec0e0c876e
commit 1dc73c2a9f

View file

@ -1,5 +1,5 @@
;#lang scheme/base #lang scheme/base
;(require fluxus-016/drflux) (require fluxus-016/drflux)
(require scheme/class) (require scheme/class)
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@ -40,7 +40,7 @@
(define twig-jitter 0.1) (define twig-jitter 0.1)
(define branch-jitter 0.5) (define branch-jitter 0.5)
(define max-twig-points 10) (define max-twig-points 10)
(define start-twig-width 0.1) (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)
@ -963,7 +963,7 @@
(widths '())) (widths '()))
(define/override (build) (define/override (build)
(set! profile (build-circle-profile 5 1)) (set! profile (build-circle-profile 7 1))
(set! path (build-list num-points (lambda (n) (vector 0 0 0)))) (set! path (build-list num-points (lambda (n) (vector 0 0 0))))
(set! widths (build-list num-points (lambda (n) (if (eq? n (- num-points 1)) 0 (set! widths (build-list num-points (lambda (n) (if (eq? n (- num-points 1)) 0
(* radius (- 1 (/ n num-points))))))) (* radius (- 1 (/ n num-points)))))))
@ -1139,10 +1139,12 @@
(define game-view% (define game-view%
(class object% (class object%
(init-field
(controller #f))
(field (field
(plants '()) ; map of ids -> plants (plants '()) ; map of ids -> plants
(pickups '()) ; map of ids -> pickups (pickups '()) ; map of ids -> pickups
(camera (build-locator))
(player-plant-id #f) (player-plant-id #f)
(current-twig-id #f) (current-twig-id #f)
(camera-dist 1) (camera-dist 1)
@ -1178,11 +1180,7 @@
"s")) "s"))
p))) p)))
(define/public (setup) (define/public (setup)
(lock-camera camera)
(camera-lag 0.05)
(set-camera-position (vector 0 0 -1))
(let ((l (make-light 'point 'free))) (let ((l (make-light 'point 'free)))
(light-diffuse 0 (vector 0.5 0.5 0.5)) (light-diffuse 0 (vector 0.5 0.5 0.5))
(light-diffuse l (vector 1 1 1)) (light-diffuse l (vector 1 1 1))
@ -1248,13 +1246,10 @@
(if current-twig-id (if current-twig-id
(let ((twig (send (get-player) get-twig current-twig-id))) (let ((twig (send (get-player) get-twig current-twig-id)))
(with-primitive camera (send controller set-pos (vadd (send twig get-end-pos)
(identity)
(translate (vadd (send twig get-end-pos)
(vmul (send twig get-dir) (* camera-dist -2)) (vmul (send twig get-dir) (* camera-dist -2))
(vcross (send twig get-dir) (vector 0 1 0)))) (vcross (send twig get-dir) (vector 0 1 0)))))
)) (send controller set-pos (vector 0 0 0)))
(with-primitive camera (identity)))
@ -1363,14 +1358,72 @@
(super-new))) (super-new)))
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
(define controller%
(class object%
(field
(fwd (vector 0 0 1))
(up (vector 0 1 0))
(pos (vector 0 0 0))
(mtx (mident))
(cam (build-locator))
(tilt 0)
(yaw 0))
(define/public (get-cam-obj)
cam)
(define/public (set-pos s)
(set! pos s))
(define/public (set-fwd s)
(set! fwd s))
(define/public (get-fwd)
fwd)
(define/public (setup)
(lock-camera cam)
(camera-lag 0.1)
(clip 1 1000)
(set-camera-transform (mtranslate (vector 0 0 -1))))
(define/public (update)
(when (key-pressed "a") (set! yaw (+ yaw 1)))
(when (key-pressed "d") (set! yaw (- yaw 1)))
(when (key-pressed "w") (set! tilt (+ tilt 1)))
(when (key-pressed "s") (set! tilt (- tilt 1)))
; clamp tilt to prevent gimbal lock
(when (> tilt 88) (set! tilt 88))
(when (< tilt -88) (set! tilt -88))
(set! fwd (vtransform (vector 0 0 1)
(mmul
(mrotate (vector 0 yaw 0))
(mrotate (vector tilt 0 0)))))
(let* ((side (vnormalise (vcross up fwd)))
(up (vnormalise (vcross fwd side))))
(with-primitive cam
(identity)
(concat (vector (vx side) (vy side) (vz side) 0
(vx up) (vy up) (vz up) 0
(vx fwd) (vy fwd) (vz fwd) 0
(vx pos) (vy pos) (vz pos) 1)))))
(super-new)))
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
(clear) (clear)
(define c (make-object controller%))
(define gl (make-object game-logic%)) (define gl (make-object game-logic%))
(define gv (make-object game-view%)) (define gv (make-object game-view% c))
(send c setup)
(send gv setup) (send gv setup)
(send gl setup) (send gl setup)
@ -1395,7 +1448,7 @@
(define (animate) (define (animate)
(when (and debounce (key-pressed " ")) (when (and debounce (key-pressed " "))
(send plant1 add-twig (make-object twig-logic% 0 plant1 'root (send plant1 add-twig (make-object twig-logic% 0 plant1 'root
(vtransform-rot (vector 0 0 -1) (minverse (get-camera-transform))) (vmul (send c get-fwd) -1)
start-twig-width max-twig-points 'extruded)) start-twig-width max-twig-points 'extruded))
(set! tick-time 0) (set! tick-time 0)
(set! debounce #f) (set! debounce #f)
@ -1411,6 +1464,7 @@
(send gv update (pe-time) (pe-delta) (send gl update))) (send gv update (pe-time) (pe-delta) (send gl update)))
(send gv update (pe-time) (pe-delta) '()) (send gv update (pe-time) (pe-delta) '())
(send c update)
(pt-update)) (pt-update))
#;(for ((i (in-range 0 10000))) #;(for ((i (in-range 0 10000)))