From 5f25210e86edb1d1cd4b9b29f78e87d73d5378b3 Mon Sep 17 00:00:00 2001 From: Jay McCarthy Date: Fri, 21 Nov 2014 10:26:01 -0800 Subject: [PATCH] Move fps to word and fix display error --- chaos.rkt | 6 +----- chaos/gui.rkt | 13 +++++-------- chaos/pair.rkt | 7 +------ examples/spin.rkt | 6 ++++-- examples/val-demo.rkt | 6 ++++-- word.rkt | 17 ++++++++++------- 6 files changed, 25 insertions(+), 30 deletions(-) diff --git a/chaos.rkt b/chaos.rkt index 648d9b4..b1132ae 100644 --- a/chaos.rkt +++ b/chaos.rkt @@ -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)] diff --git a/chaos/gui.rkt b/chaos/gui.rkt index e2f6841..eb9a86b 100644 --- a/chaos/gui.rkt +++ b/chaos/gui.rkt @@ -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%)) diff --git a/chaos/pair.rkt b/chaos/pair.rkt index 3948f82..37518cc 100644 --- a/chaos/pair.rkt +++ b/chaos/pair.rkt @@ -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 diff --git a/examples/spin.rkt b/examples/spin.rkt index 12dd90c..def563a 100644 --- a/examples/spin.rkt +++ b/examples/spin.rkt @@ -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)))) diff --git a/examples/val-demo.rkt b/examples/val-demo.rkt index 0b5a3db..a05d24f 100644 --- a/examples/val-demo.rkt +++ b/examples/val-demo.rkt @@ -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))))) diff --git a/word.rkt b/word.rkt index 8d17b93..95d3621 100644 --- a/word.rkt +++ b/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)