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

always give input priority

This commit is contained in:
Jay McCarthy 2015-04-14 13:49:09 -04:00
parent 8561328213
commit 818fc3d419
1 changed files with 10 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
word.rkt
View File

@ -72,9 +72,7 @@
(define next-time (fl+ start-time time-incr)) (define next-time (fl+ start-time time-incr))
next-time) next-time)
(define (body next-time w) (define (body next-time w)
(chaos-yield (define input-evt
c
(choice-evt
(handle-evt (handle-evt
(chaos-event c) (chaos-event c)
(λ (e) (λ (e)
@ -86,7 +84,8 @@
(define fps (word-fps new-w)) (define fps (word-fps new-w))
(if (= old-fps fps) (if (= old-fps fps)
next-time next-time
(compute-next-time start-time fps)))))) (compute-next-time start-time fps)))))))
(define refresh-evt
(handle-evt (handle-evt
(alarm-evt next-time) (alarm-evt next-time)
(λ (_) (λ (_)
@ -94,7 +93,13 @@
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
(λ ()
(chaos-yield
c
(choice-evt input-evt refresh-evt)))
input-evt))
(chaos-swap! c (λ () (body 0 w)))) (chaos-swap! c (λ () (body 0 w))))
(provide (provide