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

Revert "tmp" 

This reverts commit 518b1cc249.
This commit is contained in:
Jay McCarthy 2015-07-30 13:54:41 -06:00
parent 518b1cc249
commit 68ed89e4f2
1 changed files with 11 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
word.rkt
View File

@ -54,40 +54,33 @@
(error 'fiat-lux "Not called within call-with-chaos")) (error 'fiat-lux "Not called within call-with-chaos"))
(factum-fiat-lux c w)) (factum-fiat-lux c w))
;; xxx try to use (collect-garbage #t)
(define (factum-fiat-lux c w) (define (factum-fiat-lux c w)
(define (update-word w last-start-time output? f make-next-time) (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
[#f [#f
(word-return w)] (word-return w)]
[_ [_
(when output?
(chaos-output! c (word-output new-w)) (chaos-output! c (word-output new-w))
(define end-time (current-inexact-milliseconds)) (define end-time (current-inexact-milliseconds))
(define frame-time (fl- end-time start-time)) (define frame-time (fl- end-time start-time))
(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-start-time (define next-time (make-next-time new-w start-time))
(if output? start-time last-start-time)) (body next-time new-w)]))
(define next-time (make-next-time new-w next-start-time))
(body next-start-time
next-time new-w)]))
(define (compute-next-time start-time fps) (define (compute-next-time start-time fps)
(define time-incr (fl* (fl/ 1.0 fps) 1000.0)) (define time-incr (fl* (fl/ 1.0 fps) 1000.0))
(define next-time (fl+ start-time time-incr)) (define next-time (fl+ start-time time-incr))
next-time) next-time)
(define (body last-start-time next-time w) (define (body next-time w)
(define input-evt (define input-evt
(handle-evt (handle-evt
(choice-evt (word-evt w) (choice-evt (word-evt w)
(chaos-event c)) (chaos-event c))
(λ (e) (λ (e)
(update-word w (update-word w
last-start-time
(not (fl= 0.0 (word-fps w)))
(λ (w) (λ (w)
(word-event w e)) (word-event w e))
(λ (new-w start-time) (λ (new-w start-time)
@ -101,23 +94,17 @@
(alarm-evt next-time) (alarm-evt next-time)
(λ (_) (λ (_)
(update-word w (update-word w
last-start-time
#t
word-tick word-tick
(λ (new-w start-time) (λ (new-w start-time)
(define fps (word-fps new-w)) (define fps (word-fps new-w))
(compute-next-time start-time fps)))))) (compute-next-time start-time fps))))))
(sync/timeout (sync/timeout
(λ () (λ ()
(define spare-time (fl- next-time (current-inexact-milliseconds)))
(when (fl> spare-time 7.0)
(eprintf "spare-time: ~v\n" spare-time)
(collect-garbage #t))
(chaos-yield (chaos-yield
c c
(choice-evt input-evt refresh-evt))) (choice-evt input-evt refresh-evt)))
input-evt)) input-evt))
(chaos-swap! c (λ () (body (current-inexact-milliseconds) 0.0 w)))) (chaos-swap! c (λ () (body 0 w))))
(provide (provide
gen:word gen:word