initial pass at fixing timing with logs to tell if it worked

log-check.rkt

@@ -0,0 +1,60 @@
+#lang racket/base
+(require racket/file
+         racket/list
+         racket/function
+         racket/match
+         math/base)
+
+;; The idea here is that the average gap should be about 16.6. In the
+;; first version, the numbers were:
+;;
+;; 1734 Events
+;; word-evt: #294, average gap 34.903754432860495
+;; word-tick: #27, average gap 43.47511643629808
+;; word-output: #293, average gap 34.90750665534033
+;; word-label: #293, average gap 33.786167092519264
+;; word-fps: #559, average gap 17.674883442540324
+;; word-event: #267, average gap 37.07471437382519
+;; word-return: #1, average gap 0
+;;
+;; This is really bad. The goal should be for the counts for
+;; word-(evt,output,label,fps) to all be the same as tick
+
+(module+ main
+  (require racket/runtime-path)
+  (define-runtime-path log-p "log")
+  
+  (define events (file->list log-p))
+
+  (printf "~a Events\n" (length events))
+
+  (define label->times (make-hasheq))
+  (for ([e (in-list events)])
+    (match-define (cons t i) e)
+    (hash-update! label->times i (curry cons t) empty))
+
+  (define (average l)
+    (if (empty? l)
+        0
+        (/ (sum l) (length l))))
+
+  (define (gaps ts)
+    (let loop ([last #f]
+               [ts (sort ts <=)])
+      (cond
+        [(empty? ts)
+         empty]
+        [(not last)
+         (loop (first ts) (rest ts))]
+        [else
+         (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)])
+    (printf "~a: #~a, average gap ~a\n"
+            i
+            (length ts)
+            (average-gap ts))))

word.rkt

@@ -68,13 +68,13 @@
     (define new-w (f w))
     (match new-w
       [#f
-       (word-return w)]
+       ((LOG! word-return) w)]
       [_
-       (chaos-output! c (word-output new-w))
+       (chaos-output! c ((LOG! 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))
+         ((LOG! word-label) new-w frame-time))
        (chaos-label! c new-label)
        (define next-time (make-next-time new-w start-time))
        (body next-time new-w)]))
@@ -85,15 +85,15 @@
   (define (body next-time w)
     (define input-evt
       (handle-evt
-       (choice-evt (word-evt w)
+       (choice-evt ((LOG! word-evt) w)
                    (chaos-event c))
        (λ (e)
          (update-word w
                       (λ (w)
-                        (word-event w e))
+                        ((LOG! word-event) w e))
                       (λ (new-w start-time)
-                        (define old-fps (word-fps w))
-                        (define fps (word-fps new-w))
+                        (define old-fps ((LOG! word-fps) w))
+                        (define fps ((LOG! word-fps) new-w))
                         (if (= old-fps fps)
                             next-time
                             (compute-next-time start-time fps)))))))
@@ -102,9 +102,9 @@
        (alarm-evt next-time)
        (λ (_)
          (update-word w
-                      word-tick
+                      (LOG! word-tick)
                       (λ (new-w start-time)
-                        (define fps (word-fps new-w))
+                        (define fps ((LOG! word-fps) new-w))
                         (compute-next-time start-time fps))))))
     (sync/timeout
      (λ ()
@@ -114,6 +114,12 @@
      input-evt))
   (chaos-swap! c (λ () (body 0 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