Merge branch 'master' of ssh://nik@fo.am/var/git/groworld
This commit is contained in:
commit
f111c2c04d
1 changed files with 72 additions and 18 deletions
|
@ -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)
|
||||||
|
@ -968,7 +968,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)))))))
|
||||||
|
@ -1144,10 +1144,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)
|
||||||
|
@ -1184,10 +1186,6 @@
|
||||||
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))
|
||||||
|
@ -1253,13 +1251,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)))
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
@ -1368,14 +1363,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 (or (key-pressed "a") (key-special-pressed 100)) (set! yaw (+ yaw 1)))
|
||||||
|
(when (or (key-pressed "d") (key-special-pressed 102)) (set! yaw (- yaw 1)))
|
||||||
|
(when (or (key-pressed "w") (key-special-pressed 101)) (set! tilt (+ tilt 1)))
|
||||||
|
(when (or (key-pressed "s") (key-special-pressed 103)) (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)
|
||||||
|
|
||||||
|
@ -1400,7 +1453,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)
|
||||||
|
@ -1416,6 +1469,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)))
|
||||||
|
|
Loading…
Reference in a new issue