Move fps to word and fix display error
This commit is contained in:
parent
f1a4039c55
commit
5f25210e86
|
@ -3,16 +3,13 @@
|
||||||
racket/generic)
|
racket/generic)
|
||||||
|
|
||||||
(define-generics chaos
|
(define-generics chaos
|
||||||
(chaos-fps chaos)
|
|
||||||
(chaos-yield chaos evt)
|
(chaos-yield chaos evt)
|
||||||
(chaos-event chaos)
|
(chaos-event chaos)
|
||||||
(chaos-output! chaos outputs)
|
(chaos-output! chaos outputs)
|
||||||
(chaos-label! chaos label)
|
(chaos-label! chaos label)
|
||||||
(chaos-swap! chaos thunk)
|
(chaos-swap! chaos thunk)
|
||||||
#:fallbacks
|
#:fallbacks
|
||||||
[(define (chaos-fps c)
|
[(define (chaos-yield c e)
|
||||||
60.0)
|
|
||||||
(define (chaos-yield c e)
|
|
||||||
(sync e))
|
(sync e))
|
||||||
(define (chaos-event c)
|
(define (chaos-event c)
|
||||||
never-evt)
|
never-evt)
|
||||||
|
@ -27,7 +24,6 @@
|
||||||
gen:chaos
|
gen:chaos
|
||||||
(contract-out
|
(contract-out
|
||||||
[chaos? (-> any/c boolean?)]
|
[chaos? (-> any/c boolean?)]
|
||||||
[chaos-fps (-> chaos? flonum?)]
|
|
||||||
[chaos-yield (-> chaos? evt? any)]
|
[chaos-yield (-> chaos? evt? any)]
|
||||||
[chaos-event (-> chaos? evt?)]
|
[chaos-event (-> chaos? evt?)]
|
||||||
[chaos-output! (-> chaos? any/c any)]
|
[chaos-output! (-> chaos? any/c any)]
|
||||||
|
|
|
@ -6,11 +6,9 @@
|
||||||
racket/async-channel
|
racket/async-channel
|
||||||
lux/chaos)
|
lux/chaos)
|
||||||
|
|
||||||
(struct gui (depth-box event-ch fps drawer frame refresh!)
|
(struct gui (depth-box event-ch drawer frame refresh!)
|
||||||
#:methods gen:chaos
|
#:methods gen:chaos
|
||||||
[(define (chaos-fps c)
|
[(define (chaos-yield c e)
|
||||||
(gui-fps c))
|
|
||||||
(define (chaos-yield c e)
|
|
||||||
(yield e))
|
(yield e))
|
||||||
(define (chaos-event c)
|
(define (chaos-event c)
|
||||||
(gui-event-ch c))
|
(gui-event-ch c))
|
||||||
|
@ -28,8 +26,7 @@
|
||||||
(send (gui-frame c) show #f)
|
(send (gui-frame c) show #f)
|
||||||
(set-box! db og))))])
|
(set-box! db og))))])
|
||||||
|
|
||||||
(define (make-gui fps
|
(define (make-gui #:mode [mode 'draw]
|
||||||
#:mode [mode 'draw]
|
|
||||||
#:width [init-w 800]
|
#:width [init-w 800]
|
||||||
#:height [init-h 600])
|
#:height [init-h 600])
|
||||||
(define events-ch (make-async-channel))
|
(define events-ch (make-async-channel))
|
||||||
|
@ -84,12 +81,12 @@
|
||||||
|
|
||||||
(define depth-box (box 0))
|
(define depth-box (box 0))
|
||||||
|
|
||||||
(gui depth-box events-ch fps drawer f refresh!))
|
(gui depth-box events-ch drawer f refresh!))
|
||||||
|
|
||||||
(provide
|
(provide
|
||||||
(contract-out
|
(contract-out
|
||||||
[make-gui
|
[make-gui
|
||||||
(->* (flonum?)
|
(->* ()
|
||||||
(#:mode
|
(#:mode
|
||||||
(or/c (one-of/c 'draw 'compat-gl 'core-gl)
|
(or/c (one-of/c 'draw 'compat-gl 'core-gl)
|
||||||
(is-a?/c gl-config%))
|
(is-a?/c gl-config%))
|
||||||
|
|
|
@ -7,16 +7,11 @@
|
||||||
|
|
||||||
(struct pair (l r)
|
(struct pair (l r)
|
||||||
#:methods gen:chaos
|
#:methods gen:chaos
|
||||||
[(define/generic super-fps chaos-fps)
|
[(define/generic super-yield chaos-yield)
|
||||||
(define/generic super-yield chaos-yield)
|
|
||||||
(define/generic super-inputs chaos-inputs)
|
(define/generic super-inputs chaos-inputs)
|
||||||
(define/generic super-output! chaos-output!)
|
(define/generic super-output! chaos-output!)
|
||||||
(define/generic super-label! chaos-label!)
|
(define/generic super-label! chaos-label!)
|
||||||
(define/generic super-swap! chaos-swap!)
|
(define/generic super-swap! chaos-swap!)
|
||||||
(define (chaos-fps c)
|
|
||||||
(match-define (pair l r) c)
|
|
||||||
(max (super-fps l)
|
|
||||||
(super-fps r)))
|
|
||||||
(define (chaos-yield c e)
|
(define (chaos-yield c e)
|
||||||
(match-define (pair l r) c)
|
(match-define (pair l r) c)
|
||||||
(super-yield l
|
(super-yield l
|
||||||
|
|
|
@ -13,7 +13,9 @@
|
||||||
|
|
||||||
(struct spin (layer color frame x y)
|
(struct spin (layer color frame x y)
|
||||||
#:methods gen:word
|
#:methods gen:word
|
||||||
[(define (word-label s ft)
|
[(define (word-fps w)
|
||||||
|
60.0)
|
||||||
|
(define (word-label s ft)
|
||||||
(lux-standard-label "Spin!" ft))
|
(lux-standard-label "Spin!" ft))
|
||||||
(define (word-event w e)
|
(define (word-event w e)
|
||||||
(match-define (spin layer color f x y) w)
|
(match-define (spin layer color f x y) w)
|
||||||
|
@ -54,6 +56,6 @@
|
||||||
|
|
||||||
(module+ main
|
(module+ main
|
||||||
(call-with-chaos
|
(call-with-chaos
|
||||||
(make-gui 60.0)
|
(make-gui)
|
||||||
(λ ()
|
(λ ()
|
||||||
(spin-it 0))))
|
(spin-it 0))))
|
||||||
|
|
|
@ -20,7 +20,9 @@
|
||||||
(struct demo
|
(struct demo
|
||||||
(g/v mode)
|
(g/v mode)
|
||||||
#:methods gen:word
|
#:methods gen:word
|
||||||
[(define (word-label s ft)
|
[(define (word-fps w)
|
||||||
|
60.0)
|
||||||
|
(define (word-label s ft)
|
||||||
(lux-standard-label "Values" ft))
|
(lux-standard-label "Values" ft))
|
||||||
(define (word-output w)
|
(define (word-output w)
|
||||||
(match-define (demo g/v mode-n) w)
|
(match-define (demo g/v mode-n) w)
|
||||||
|
@ -41,5 +43,5 @@
|
||||||
|
|
||||||
(module+ main
|
(module+ main
|
||||||
(call-with-chaos
|
(call-with-chaos
|
||||||
(make-gui 60.0)
|
(make-gui)
|
||||||
(λ () (fiat-lux (demo (make-gui/val) 0)))))
|
(λ () (fiat-lux (demo (make-gui/val) 0)))))
|
||||||
|
|
17
word.rkt
17
word.rkt
|
@ -8,13 +8,16 @@
|
||||||
lux/chaos)
|
lux/chaos)
|
||||||
|
|
||||||
(define-generics word
|
(define-generics word
|
||||||
|
(word-fps word)
|
||||||
(word-label word frame-time)
|
(word-label word frame-time)
|
||||||
(word-event word evt)
|
(word-event word evt)
|
||||||
(word-tick word)
|
(word-tick word)
|
||||||
(word-output word)
|
(word-output word)
|
||||||
(word-return word)
|
(word-return word)
|
||||||
#:fallbacks
|
#:fallbacks
|
||||||
[(define (word-label w frame-time)
|
[(define (word-fps w)
|
||||||
|
60.0)
|
||||||
|
(define (word-label w frame-time)
|
||||||
(lux-standard-label "Lux" frame-time))
|
(lux-standard-label "Lux" frame-time))
|
||||||
(define (word-event w e) w)
|
(define (word-event w e) w)
|
||||||
(define (word-tick w) w)
|
(define (word-tick w) w)
|
||||||
|
@ -47,8 +50,6 @@
|
||||||
(factum-fiat-lux c w))
|
(factum-fiat-lux c w))
|
||||||
|
|
||||||
(define (factum-fiat-lux c w)
|
(define (factum-fiat-lux c w)
|
||||||
(define fps (chaos-fps c))
|
|
||||||
(define time-incr (fl* (fl/ 1.0 fps) 1000.0))
|
|
||||||
(define (update-word w make-next-tick-evt f)
|
(define (update-word w make-next-tick-evt f)
|
||||||
(define start-time (current-inexact-milliseconds))
|
(define start-time (current-inexact-milliseconds))
|
||||||
(define new-w (f w))
|
(define new-w (f w))
|
||||||
|
@ -56,13 +57,13 @@
|
||||||
[#f
|
[#f
|
||||||
(word-return w)]
|
(word-return w)]
|
||||||
[_
|
[_
|
||||||
(chaos-output! c (word-output 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-tick-evt (make-next-tick-evt start-time))
|
(define next-tick-evt (make-next-tick-evt new-w start-time))
|
||||||
(body next-tick-evt new-w)]))
|
(body next-tick-evt new-w)]))
|
||||||
(define (body tick-evt w)
|
(define (body tick-evt w)
|
||||||
(chaos-yield
|
(chaos-yield
|
||||||
|
@ -72,7 +73,7 @@
|
||||||
(chaos-event c)
|
(chaos-event c)
|
||||||
(λ (e)
|
(λ (e)
|
||||||
(update-word w
|
(update-word w
|
||||||
(λ (start-time)
|
(λ (w start-time)
|
||||||
tick-evt)
|
tick-evt)
|
||||||
(λ (w)
|
(λ (w)
|
||||||
(word-event w e)))))
|
(word-event w e)))))
|
||||||
|
@ -80,7 +81,9 @@
|
||||||
tick-evt
|
tick-evt
|
||||||
(λ (_)
|
(λ (_)
|
||||||
(update-word w
|
(update-word w
|
||||||
(λ (start-time)
|
(λ (w start-time)
|
||||||
|
(define fps (word-fps w))
|
||||||
|
(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))
|
||||||
(define next-tick-evt (alarm-evt next-time))
|
(define next-tick-evt (alarm-evt next-time))
|
||||||
next-tick-evt)
|
next-tick-evt)
|
||||||
|
|
Loading…
Reference in New Issue