Split playbacks into separate module

2 files changed, 206 insertions, 199 deletions

diff --git a/guile/starlet/base.scm b/guile/starlet/base.scm
index a7ba8b0..83fb04d 100644
--- a/guile/starlet/base.scm
+++ b/guile/starlet/base.scm
@@ -5,16 +5,16 @@
   #:use-module (web client)
   #:use-module (web http)
   #:use-module (web uri)
+  #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-9)
-  #:export (<fixture> <fixture-attribute>
+  #:export (<fixture> <fixture-attribute> <starlet-state>
              start-ola-output patch-fixture
              set-attr! home-attr! home-all! blackout
              scanout-freq make-empty-state register-state!
-             make-playback cue cut-to-cue! run-cue!
-             percent->dmxval msb lsb chan))
-
-(use-modules (srfi srfi-1))
-
+             percent->dmxval msb lsb chan
+             hirestime expand-state set-in-state! state-for-each
+             merge-states-htp value->number get-attr-name
+             get-state-hash-table))
 
 (define-class <fixture-attribute> (<object>)
   (name
@@ -73,28 +73,6 @@
    #:setter set-state-hash-table!))
 
 
-;; A "playback" is a state which knows how to run cues
-;; from a cue list
-(define-class <starlet-playback> (<starlet-state>)
-  (active-fade-list
-   #:init-value '()
-   #:getter get-active-fade-list
-   #:setter set-active-fade-list!)
-
-  (cue-list
-   #:init-keyword #:cue-list
-   #:getter get-playback-cue-list)
-
-  (hash-table
-   #:allocation #:virtual
-   #:getter get-state-hash-table
-   #:slot-ref (lambda (instance)
-                (merge-active-fades (hirestime)
-                                    (get-active-fade-list instance)))
-   #:slot-set! (lambda (instance new-val)
-                 (error "Can't set hash table on playback"))))
-
-
 (define-method (set-in-state! (state <starlet-state>)
                               (fix <fixture>)
                               (attr <fixture-attribute>)
@@ -104,177 +82,6 @@
              value))
 
 
-(define-record-type <fade>
-  (make-fade state start-frac target-frac fade-time fade-delay start-time)
-  fade?
-  (start-frac   get-fade-start-frac)
-  (target-frac  get-fade-target-frac)
-  (fade-time    get-fade-time)
-  (state        get-fade-state)
-  (start-time   get-fade-start-time)
-  (fade-delay   get-fade-delay-time))
-
-
-(define-record-type <cue>
-  (make-cue number state up-time down-time up-delay down-delay)
-  cue?
-  (number      get-cue-number)
-  (state       get-cue-state)
-  (up-time     up-time)
-  (up-delay    up-delay)
-  (down-time   down-time)
-  (down-delay  down-delay))
-
-
-(define (wrap-scale scale-factor a)
-  (lambda (time)
-    (* (value->number a time)
-       scale-factor)))
-
-
-(define (get-current-fraction fade current-time)
-  (let ((elapsed-fade-time (- current-time
-                              (get-fade-start-time fade)
-                              (get-fade-delay-time fade))))
-    (cond
-
-     ;; Before start of fade
-     ((< elapsed-fade-time 0)
-      (get-fade-start-frac fade))
-
-     ;; After end of fade
-     ((> elapsed-fade-time
-         (get-fade-time fade))
-      (get-fade-target-frac fade))
-
-     ;; During the fade
-     (else
-      (+ (get-fade-start-frac fade)
-         (* (- (get-fade-target-frac fade)
-               (get-fade-start-frac fade))
-
-          ;; Fraction of fade time elapsed
-            (/ elapsed-fade-time
-               (get-fade-time fade))))))))
-
-
-(define (scale-fade fade current-time)
-  (let ((state (make-empty-state))
-        (scale-factor (get-current-fraction fade current-time)))
-    (state-for-each (lambda (fix attr value)
-                      (if (eq? 'intensity (get-attr-name attr))
-                          (set-in-state! state
-                                         fix
-                                         attr
-                                         (wrap-scale scale-factor value))
-                          (set-in-state! state fix attr value)))
-                    (get-fade-state fade))
-    state))
-
-
-(define (merge-active-fades current-time list-of-fades)
-  (get-state-hash-table
-   (merge-states-htp
-    (map (lambda (fade) (scale-fade fade current-time))
-         list-of-fades))))
-
-
-(define (qnum a)
-  (/ (inexact->exact (* a 1000)) 1000))
-
-
-(define* (cue number
-              state
-              #:key (fade-up 5) (fade-down 5) (up-delay 0) (down-delay 0))
-  (make-cue (qnum number)
-            state
-            fade-up
-            fade-down
-            up-delay
-            down-delay))
-
-
-(define (make-playback cue-list)
-  (let ((new-playback (make <starlet-playback>
-                        #:cue-list cue-list)))
-    new-playback))
-
-
-(define (find-cue cue-list cue-number)
-  (find (lambda (a)
-          (eqv? (get-cue-number a)
-                cue-number))
-        cue-list))
-
-
-(define (cut-to-cue! pb cue-number)
-  (let* ((state (expand-state
-                 (get-cue-state
-                  (find-cue (get-playback-cue-list pb)
-                            cue-number)))))
-
-    ;; Flush everything out and just set the state
-    (set-active-fade-list! pb
-                           (list (make-fade
-                                  state
-                                  0.0 1.0 0.0 0.0 (hirestime))))))
-
-
-(define (add-fade! pb fade)
-  (set-active-fade-list! pb
-                         (cons fade
-                               (get-active-fade-list pb))))
-
-
-(define (make-fade-from-cue cue time)
-  (make-fade
-   (expand-state (get-cue-state cue))
-   0.0
-   1.0
-   (up-time cue)
-   (up-delay cue)
-   time))
-
-
-(define (retire-old-fades! pb tnow)
-  (set-active-fade-list!
-   pb
-   (filter (lambda (a)
-             (or
-              (< tnow
-                 (+ (get-fade-start-time a)
-                    (get-fade-delay-time a)
-                    (get-fade-time a)))
-              (> (get-fade-target-frac a)
-                 0.0)))
-           (get-active-fade-list pb))))
-
-
-(define (fade-down-all-active-states! pb tnow down-time down-delay)
-  (set-active-fade-list!
-   pb
-   (map (lambda (a)
-          (make-fade
-           (get-fade-state a)
-           (get-current-fraction a tnow)
-           0.0
-           down-time
-           down-delay
-           tnow))
-        (get-active-fade-list pb))))
-
-
-(define (run-cue! pb cue-number)
-  (let ((tnow (hirestime))
-        (cue (find-cue (get-playback-cue-list pb)
-                       cue-number)))
-    (retire-old-fades! pb tnow)
-    (fade-down-all-active-states! pb
-                                  tnow
-                                  (down-time cue)
-                                  (down-delay cue))
-    (add-fade! pb (make-fade-from-cue cue tnow))))
-
 
 ;; List of fixtures
 (define patched-fixture-list (make-atomic-box '()))
diff --git a/guile/starlet/playback.scm b/guile/starlet/playback.scm
new file mode 100644
index 0000000..94c83ef
--- /dev/null
+++ b/guile/starlet/playback.scm
@@ -0,0 +1,200 @@
+(define-module (starlet playback)
+  #:use-module (oop goops)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9)
+  #:use-module (starlet base)
+  #:export (make-playback cue cut-to-cue! run-cue!))
+
+
+;; A "playback" is a state which knows how to run cues
+;; from a cue list
+(define-class <starlet-playback> (<starlet-state>)
+  (active-fade-list
+   #:init-value '()
+   #:getter get-active-fade-list
+   #:setter set-active-fade-list!)
+
+  (cue-list
+   #:init-keyword #:cue-list
+   #:getter get-playback-cue-list)
+
+  (hash-table
+   #:allocation #:virtual
+   #:getter get-state-hash-table
+   #:slot-ref (lambda (instance)
+                (merge-active-fades (hirestime)
+                                    (get-active-fade-list instance)))
+   #:slot-set! (lambda (instance new-val)
+                 (error "Can't set hash table on playback"))))
+
+
+(define-record-type <fade>
+  (make-fade state start-frac target-frac fade-time fade-delay start-time)
+  fade?
+  (start-frac   get-fade-start-frac)
+  (target-frac  get-fade-target-frac)
+  (fade-time    get-fade-time)
+  (state        get-fade-state)
+  (start-time   get-fade-start-time)
+  (fade-delay   get-fade-delay-time))
+
+
+(define-record-type <cue>
+  (make-cue number state up-time down-time up-delay down-delay)
+  cue?
+  (number      get-cue-number)
+  (state       get-cue-state)
+  (up-time     up-time)
+  (up-delay    up-delay)
+  (down-time   down-time)
+  (down-delay  down-delay))
+
+
+(define (wrap-scale scale-factor a)
+  (lambda (time)
+    (* (value->number a time)
+       scale-factor)))
+
+
+(define (get-current-fraction fade current-time)
+  (let ((elapsed-fade-time (- current-time
+                              (get-fade-start-time fade)
+                              (get-fade-delay-time fade))))
+    (cond
+
+     ;; Before start of fade
+     ((< elapsed-fade-time 0)
+      (get-fade-start-frac fade))
+
+     ;; After end of fade
+     ((> elapsed-fade-time
+         (get-fade-time fade))
+      (get-fade-target-frac fade))
+
+     ;; During the fade
+     (else
+      (+ (get-fade-start-frac fade)
+         (* (- (get-fade-target-frac fade)
+               (get-fade-start-frac fade))
+
+          ;; Fraction of fade time elapsed
+            (/ elapsed-fade-time
+               (get-fade-time fade))))))))
+
+
+(define (scale-fade fade current-time)
+  (let ((state (make-empty-state))
+        (scale-factor (get-current-fraction fade current-time)))
+    (state-for-each (lambda (fix attr value)
+                      (if (eq? 'intensity (get-attr-name attr))
+                          (set-in-state! state
+                                         fix
+                                         attr
+                                         (wrap-scale scale-factor value))
+                          (set-in-state! state fix attr value)))
+                    (get-fade-state fade))
+    state))
+
+
+(define (merge-active-fades current-time list-of-fades)
+  (get-state-hash-table
+   (merge-states-htp
+    (map (lambda (fade) (scale-fade fade current-time))
+         list-of-fades))))
+
+
+(define (qnum a)
+  (/ (inexact->exact (* a 1000)) 1000))
+
+
+(define* (cue number
+              state
+              #:key (fade-up 5) (fade-down 5) (up-delay 0) (down-delay 0))
+  (make-cue (qnum number)
+            state
+            fade-up
+            fade-down
+            up-delay
+            down-delay))
+
+
+(define (make-playback cue-list)
+  (let ((new-playback (make <starlet-playback>
+                        #:cue-list cue-list)))
+    new-playback))
+
+
+(define (find-cue cue-list cue-number)
+  (find (lambda (a)
+          (eqv? (get-cue-number a)
+                cue-number))
+        cue-list))
+
+
+(define (cut-to-cue! pb cue-number)
+  (let* ((state (expand-state
+                 (get-cue-state
+                  (find-cue (get-playback-cue-list pb)
+                            cue-number)))))
+
+    ;; Flush everything out and just set the state
+    (set-active-fade-list! pb
+                           (list (make-fade
+                                  state
+                                  0.0 1.0 0.0 0.0 (hirestime))))))
+
+
+(define (add-fade! pb fade)
+  (set-active-fade-list! pb
+                         (cons fade
+                               (get-active-fade-list pb))))
+
+
+(define (make-fade-from-cue cue time)
+  (make-fade
+   (expand-state (get-cue-state cue))
+   0.0
+   1.0
+   (up-time cue)
+   (up-delay cue)
+   time))
+
+
+(define (retire-old-fades! pb tnow)
+  (set-active-fade-list!
+   pb
+   (filter (lambda (a)
+             (or
+              (< tnow
+                 (+ (get-fade-start-time a)
+                    (get-fade-delay-time a)
+                    (get-fade-time a)))
+              (> (get-fade-target-frac a)
+                 0.0)))
+           (get-active-fade-list pb))))
+
+
+(define (fade-down-all-active-states! pb tnow down-time down-delay)
+  (set-active-fade-list!
+   pb
+   (map (lambda (a)
+          (make-fade
+           (get-fade-state a)
+           (get-current-fraction a tnow)
+           0.0
+           down-time
+           down-delay
+           tnow))
+        (get-active-fade-list pb))))
+
+
+(define (run-cue! pb cue-number)
+  (let ((tnow (hirestime))
+        (cue (find-cue (get-playback-cue-list pb)
+                       cue-number)))
+    (retire-old-fades! pb tnow)
+    (fade-down-all-active-states! pb
+                                  tnow
+                                  (down-time cue)
+                                  (down-delay cue))
+    (add-fade! pb (make-fade-from-cue cue tnow))))