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