Final version, much better performance, tested on examples

log-check.rkt

@@ -21,8 +21,6 @@
 ;; This is really bad. The goal should be for the counts for
 ;; word-(evt,output,label,fps) to all be the same as tick
 ;;
-;; The second release was this:
-;;
 ;; [log.2]
 ;; 844 Events
 ;; word-event: #179, average gap 27.584044724367978
@@ -33,11 +31,27 @@
 ;; word-return: #1, average gap 0
 ;; word-tick: #132, average gap 37.29275442807729
 ;;
+;; [log.3]
+;; 1997 Events
+;; word-event: #492, average gap 22.231684480810845
+;; word-evt: #301, average gap 36.38639729817708
+;; word-fps: #301, average gap 36.386416829427084
+;; word-label: #301, average gap 36.440130208333336
+;; word-output: #301, average gap 37.64551025390625
+;; word-return: #1, average gap 0
+;; word-tick: #300, average gap 36.4600801499791
+;;
+;; [log.4]
+;; 1231 Events
+;; word-event: #306, average gap 22.516072457735657
+;; word-evt: #185, average gap 37.325081203294836
+;; word-fps: #185, average gap 37.32514091159987
+;; word-label: #185, average gap 37.34000562584919
+;; word-output: #185, average gap 39.36237501061481
+;; word-return: #1, average gap 0
+;; word-tick: #184, average gap 37.38046981728142
 
-(module+ main
-  (require racket/runtime-path)
-  (define-runtime-path log-p "log")
-  
+(define (check log-p)
   (define events (file->list log-p))
 
   (printf "~a Events\n" (length events))
@@ -64,11 +78,18 @@
          (define t (first ts))
          (cons (- t last)
                (loop t (rest ts)))])))
-  
+
   (define (average-gap ts)
     (average (gaps ts)))
-  (for ([(i ts) (in-hash label->times)])
+  (for ([i (in-list (sort (hash-keys label->times) string<=? #:key symbol->string))])
+    (define ts (hash-ref label->times i))
     (printf "~a: #~a, average gap ~a\n"
             i
             (length ts)
             (average-gap ts))))
+
+(module+ main
+  (require racket/cmdline)
+  (command-line #:program "log-check"
+                #:args (log-p)
+                (check log-p)))

word.rkt

@@ -67,62 +67,68 @@
   (define next-time (fl+ start-time time-incr))
   next-time)
 
+(define (continue-or-word-return next-w old-w k)
+  (cond
+    [(not next-w)
+     (word-return old-w)]
+    [else
+     (k next-w)]))
+
 (define (factum-fiat-lux c w)
-  (define (continue-or-word-return next-w old-w k)
-    (cond
-      [(not next-w)
-       ((LOG! word-return) old-w)]
-      [else
-       (k next-w)]))
   (define (output&process-input&wait frame-start-time w)
-    (chaos-output! c ((LOG! word-output) w))
+    (chaos-output! c (word-output w))
     (define frame-end-time (current-inexact-milliseconds))
     (define frame-time (- frame-end-time frame-start-time))
-    (define new-label ((LOG! word-label) w frame-time))
+    (define new-label (word-label w frame-time))
     (chaos-label! c new-label)
 
-    (define fps ((LOG! word-fps) w))
+    (define fps (word-fps w))
     (define next-time (compute-next-time frame-end-time fps))
     (define deadline-evt (alarm-evt next-time))
-    (define input-enabled? (zero? fps))
+    (define input-enabled? (fl= 0.0 fps))
 
-    (define w-evt ((LOG! word-evt) w))
+    (define w-evt (word-evt w))
     (define c-evt (chaos-event c))
     (define w-or-c-evt (choice-evt w-evt c-evt))
 
-    (let process-input&wait ([w w])
-      (define wait-evt
-        (handle-evt deadline-evt
-                    (λ (_)
-                      (define next-w ((LOG! word-tick) w))
-                      (continue-or-word-return
-                       next-w w
-                       (λ (next-w)
-                         (output&process-input&wait frame-end-time next-w))))))
-      (define input-evt
-        (handle-evt w-or-c-evt
-                    (λ (e)
-                      (define next-w ((LOG! word-event) w e))
-                      (continue-or-word-return
-                       next-w w
-                       (λ (next-w)
-                         (if input-enabled?
-                             (output&process-input&wait frame-end-time next-w)
-                             (process-input&wait next-w)))))))
-      (define both-evt
-        (choice-evt input-evt wait-evt))
-      (sync/timeout
-       (λ () (chaos-yield c both-evt))
-       input-evt)))
+    (define continue
+      (λ (next-w)
+        (output&process-input&wait frame-end-time next-w)))
+
+    (define THE-W w)
+    (define wait-evt
+      (handle-evt deadline-evt
+                  (λ (_)
+                    (define next-w (word-tick THE-W))
+                    (continue-or-word-return
+                     next-w THE-W
+                     continue))))
+    (define input-continue
+      (λ (next-w)
+        (cond
+          [input-enabled?
+           (output&process-input&wait frame-end-time next-w)]
+          [else
+           (set! THE-W next-w)
+           (process-input&wait)])))
+    (define input-evt
+      (handle-evt w-or-c-evt
+                  (λ (e)
+                    (define next-w (word-event THE-W e))
+                    (continue-or-word-return
+                     next-w THE-W
+                     input-continue))))
+    (define both-evt
+      (choice-evt input-evt wait-evt))
+    (define timeout-f
+      (λ () (chaos-yield c both-evt)))
+    (define (process-input&wait)
+      (sync/timeout timeout-f input-evt))
+
+    (process-input&wait))
 
   (chaos-swap! c (λ () (output&process-input&wait (current-inexact-milliseconds) w))))
 
-(define-syntax-rule (LOG! id)
-  (begin (LOG!* 'id) id))
-(define (LOG!* i)
-  (writeln (cons (current-inexact-milliseconds) i))
-  (flush-output))
-
 (provide
  gen:word
  (contract-out