misc-deps
/
lux
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Fix FPS change on evt

This commit is contained in:
Jay McCarthy 2014-11-21 12:46:17 -08:00
parent 5f25210e86
commit 4a58b7fe53
1 changed files with 21 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
word.rkt
View File

@ -50,7 +50,7 @@
(factum-fiat-lux c w)) (factum-fiat-lux c w))
(define (factum-fiat-lux c w) (define (factum-fiat-lux c w)
(define (update-word w make-next-tick-evt f) (define (update-word w f make-next-time)
(define start-time (current-inexact-milliseconds)) (define start-time (current-inexact-milliseconds))
(define new-w (f w)) (define new-w (f w))
(match new-w (match new-w
@ -63,9 +63,13 @@
(define new-label (define new-label
(word-label new-w frame-time)) (word-label new-w frame-time))
(chaos-label! c new-label) (chaos-label! c new-label)
(define next-tick-evt (make-next-tick-evt new-w start-time)) (define next-time (make-next-time new-w start-time))
(body next-tick-evt new-w)])) (body next-time new-w)]))
(define (body tick-evt w) (define (compute-next-time start-time fps)
(define time-incr (fl* (fl/ 1.0 fps) 1000.0))
(define next-time (fl+ start-time time-incr))
next-time)
(define (body next-time w)
(chaos-yield (chaos-yield
c c
(choice-evt (choice-evt
@ -73,22 +77,23 @@
(chaos-event c) (chaos-event c)
(λ (e) (λ (e)
(update-word w (update-word w
(λ (w start-time)
tick-evt)
(λ (w) (λ (w)
(word-event w e))))) (word-event w e))
(λ (new-w start-time)
(define old-fps (word-fps w))
(define fps (word-fps new-w))
(if (= old-fps fps)
next-time
(compute-next-time start-time fps))))))
(handle-evt (handle-evt
tick-evt (alarm-evt next-time)
(λ (_) (λ (_)
(update-word w (update-word w
(λ (w start-time) word-tick
(define fps (word-fps w)) (λ (new-w start-time)
(define time-incr (fl* (fl/ 1.0 fps) 1000.0)) (define fps (word-fps new-w))
(define next-time (fl+ start-time time-incr)) (compute-next-time start-time fps))))))))
(define next-tick-evt (alarm-evt next-time)) (chaos-swap! c (λ () (body 0 w))))
next-tick-evt)
word-tick))))))
(chaos-swap! c (λ () (body always-evt w))))
(provide (provide
gen:word gen:word