Remove home state and abolish fixture-attribute use in states

The "home state" has no reason to exist.  The home values are already
stored perfectly well in the attribute lists of the fixtures.  Any time
we need to look up a home value, we already have the fixture itself
available.

This also gets rid of any use of <fixture-attribute> in states.  This
was confusing me.  Better to just pass symbols around and only get the
real attribute objects when needed (which isn't very often).

3 files changed, 114 insertions, 158 deletions

diff --git a/guile/starlet/base.scm b/guile/starlet/base.scm
index b857a7f..278e44c 100644
--- a/guile/starlet/base.scm
+++ b/guile/starlet/base.scm
@@ -25,9 +25,8 @@
             get-attr-type
             get-attr-range
             get-attr-name
-            fixture-attribute?
+            get-attr-home-val
             intensity?
-            home-val
 
             <starlet-state>
             make-empty-state
@@ -39,8 +38,9 @@
             clear-state!
             print-state
             state-source
-            set-attr!
+            set-in-state!
             state-find
+            have-value
             merge-states-htp
             current-state
             at
@@ -83,8 +83,7 @@
   (home-value
     #:init-value 0
     #:init-keyword #:home-value
-    #:getter get-attr-home-value
-    #:setter set-attr-home-value!))
+    #:getter attr-home-value))
 
 
 (define-class <fixture> (<object>)
@@ -125,10 +124,6 @@
   (is-a? f <fixture>))
 
 
-(define (fixture-attribute? f)
-  (is-a? f <fixture-attribute>))
-
-
 ;; A "state" is just a thin wrapper around a hash table
 ;; of (fixture . attribute)  -->  value
 (define-class <starlet-state> (<object>)
@@ -140,44 +135,46 @@
 
 (define-method (set-in-state! (state <starlet-state>)
                               (fix <fixture>)
-                              (attr <fixture-attribute>)
+                              (attr <symbol>)
                               value)
   (hash-set! (get-state-hash-table state)
              (cons fix attr)
              value))
 
-
-(define make-fixture-home-pair cons)
-(define get-fixture-list car)
-(define get-home-state cdr)
-
 ;; List of fixtures and home state (must remain consistent)
-(define fixtures
-  (make-atomic-box
-    (make-fixture-home-pair
-
-      ;; Actual list of fixtures
-      '()
-
-      ;; Basic state which holds everything at "home" unless commanded otherwise
-      (make <starlet-state>))))
+(define fixtures (make-atomic-box '()))
 
+;; List of states being scanned out
+(define state-list (make-atomic-box '()))
 
 ;; The state used to build a new scene for recording
 (define programmer-state (make <starlet-state>))
 
-(define (blackout state)
-  (state-for-each
-   (lambda (fix attr val)
-     (when (intensity? attr)
-       (set-in-state! state fix attr 0.0)))
-   state))
 
 (define (make-empty-state)
   (make <starlet-state>))
 
-;; List of states being scanned out
-(define state-list (make-atomic-box '()))
+
+(define (find-attr fix attr-name)
+  (find (lambda (a)
+          (eq? (get-attr-name a)
+               attr-name))
+        (slot-ref fix 'attributes)))
+
+
+(define (get-attr-home-val fix attr)
+  (let ((attr-obj (find-attr fix attr)))
+    (if attr-obj
+        (attr-home-value attr-obj)
+        'fixture-does-not-have-attribute)))
+
+
+(define (blackout state)
+  (state-for-each
+    (lambda (fix attr val)
+      (when (intensity? attr)
+        (set-in-state! state fix attr 0.0)))
+    state))
 
 
 ;; Set a single attribute to home position
@@ -185,7 +182,7 @@
   (set-in-state! state
                  fix
                  attr
-                 (get-attr-home-value attr)))
+                 (get-attr-home-val fix attr)))
 
 
 (define (copy-state state)
@@ -199,46 +196,15 @@
     new-state))
 
 
-;; Return a new state with all attributes of 'fix' set to home values
-(define (home-all state fix)
-  (let ((new-home-state (copy-state state)))
-    (for-each (lambda (attr)
-                (home-attr! new-home-state fix attr))
-              (slot-ref fix 'attributes))
-    new-home-state))
-
-
-(define (home-val fix attr)
-  (state-find fix
-              attr
-              (get-home-state
-                (atomic-box-ref fixtures))))
-
 (define (intensity? a)
-  (eq? 'intensity (get-attr-name a)))
+  (eq? 'intensity a))
 
 
-(define (find-attr fix attr-name)
-  (find (lambda (a)
-          (eq? (get-attr-name a)
-               attr-name))
-        (slot-ref fix 'attributes)))
-
 (define (register-state! new-state)
   (atomic-box-set! state-list
                    (cons new-state
                          (atomic-box-ref state-list))))
 
-;; Set an attribute by name
-(define (set-attr! state fix attr-name value)
-  (cond
-   ((symbol? attr-name)
-    (let ((attr (find-attr fix attr-name)))
-      (when attr (set-in-state! state fix attr value))))
-   ((fixture-attribute? attr-name)
-    (set-in-state! state fix attr-name value))))
-
-
 ;; Patch a new fixture
 (define* (patch-real name
                      class
@@ -248,14 +214,9 @@
                            #:name name
                            #:sa start-addr
                            #:uni universe
-                           #:friendly-name friendly-name))
-        (fixture-home-pair (atomic-box-ref fixtures)))
-    (atomic-box-set! fixtures
-                     (make-fixture-home-pair
-                       (cons new-fixture
-                             (get-fixture-list fixture-home-pair))
-                       (home-all (get-home-state fixture-home-pair)
-                                 new-fixture)))
+                           #:friendly-name friendly-name)))
+    (atomic-box-set! fixtures (cons new-fixture
+                                    (atomic-box-ref fixtures)))
     new-fixture))
 
 
@@ -301,9 +262,14 @@
                          value))
                  (get-state-hash-table state)))
 
+
+(define (have-value val)
+  (not (eq? val 'attribute-not-in-state)))
+
 (define (state-find fix attr state)
   (hash-ref (get-state-hash-table state)
-            (cons fix attr)))
+            (cons fix attr)
+            'attribute-not-in-state))
 
 (define (state-map func state)
   (hash-map->list (lambda (key value)
@@ -319,7 +285,7 @@
                     (let ((current-value (state-find fix
                                                      attr
                                                      combined-state)))
-                      (if current-value
+                      (if (have-value current-value)
                           (set-in-state! combined-state
                                          fix
                                          attr
@@ -444,7 +410,6 @@ pre-existing contents."
     (let* ((fixture-home-pair (atomic-box-ref fixtures))
            (combined-state (merge-states-ltp
                              (list
-                               (get-home-state fixture-home-pair)
                                (merge-states-htp
                                  (atomic-box-ref state-list))
                                programmer-state))))
@@ -458,10 +423,10 @@ pre-existing contents."
                     ;; Helper function to get a value for this
                     ;; fixture in the current state
                     (define (get-attr attr-name)
-                      (value->number (state-find fix
-                                                 (find-attr fix attr-name)
-                                                 combined-state)
-                                     (hirestime)))
+                      (let ((val (state-find fix attr-name combined-state)))
+                        (if (have-value val)
+                            (value->number val (hirestime))
+                            (get-attr-home-val fix attr-name))))
 
                     ;; Helper function to set 8-bit DMX value
                     (define (set-chan relative-channel-number value)
@@ -478,7 +443,7 @@ pre-existing contents."
 
                     (scanout-fixture fix get-attr set-chan set-chan-16bit)))
 
-                (get-fixture-list fixture-home-pair))
+                (atomic-box-ref fixtures))
 
 
       ;; Send everything to OLA
@@ -527,12 +492,13 @@ pre-existing contents."
   (let* ((fixture-home-pair (atomic-box-ref fixtures))
          (combined-state (merge-states-ltp
                            (list
-                             (get-home-state fixture-home-pair)
                              (merge-states-htp
                                (atomic-box-ref state-list))
-                             programmer-state)))
-         (attr (find-attr fix attr-name)))
-    (value->number (state-find fix attr combined-state) 0)))
+                             programmer-state))))
+    (let ((val (state-find fix attr-name combined-state)))
+      (if (have-value val)
+          (value->number val 0)
+          (get-attr-home-val fix attr-name)))))
 
 
 (define-syntax attr-continuous
@@ -584,17 +550,12 @@ pre-existing contents."
                     (values output1 output2 others))))
 
 
-(define (attr-or-symbol? a)
-  (or (fixture-attribute? a)
-      (symbol? a)))
-
-
 (define (set-fixtures fixtures attr-name value)
   (for-each (lambda (fix)
-              (set-attr! (current-state)
-                         fix
-                         (car attr-name)
-                         (car value)))
+              (set-in-state! (current-state)
+                             fix
+                             (car attr-name)
+                             (car value)))
             fixtures))
 
 
@@ -609,7 +570,7 @@ pre-existing contents."
 
 (define (at . args)
   (receive (fixtures attr-name value)
-           (partition3 fixture? attr-or-symbol? (flatten-sublists args))
+           (partition3 fixture? symbol? (flatten-sublists args))
            (cond
              ((nil? value)
               (error "at: Value not specified"))
@@ -647,6 +608,6 @@ pre-existing contents."
         (state-map (lambda (fix attr val)
                      (list 'at
                            (get-fixture-name fix)
-                           (list 'quote (get-attr-name attr))
+                           (list 'quote attr)
                            val))
                    a)))
diff --git a/guile/starlet/midi-control/faders.scm b/guile/starlet/midi-control/faders.scm
index 97ed1ff..ae8162a 100644
--- a/guile/starlet/midi-control/faders.scm
+++ b/guile/starlet/midi-control/faders.scm
@@ -80,10 +80,10 @@
          #:func (lambda (prev-cc-val new-cc-value)
                   (set! offset (+ offset (ccval->offset new-cc-value)))
                   (for-each (lambda (fix old-val)
-                              (set-attr! programmer-state
-                                         fix
-                                         attr
-                                         (+ old-val offset)))
+                              (set-in-state! programmer-state
+                                             fix
+                                             attr
+                                             (+ old-val offset)))
                             fixtures old-vals)))))))
 
 
@@ -129,11 +129,11 @@
                      initial-vals
                      fixtures)
   (for-each (lambda (fix initial-val gradient)
-              (set-attr! programmer-state
-                         fix
-                         attr-name
-                         (+ initial-val
-                            (* gradient cc-offset))))
+              (set-in-state! programmer-state
+                             fix
+                             attr-name
+                             (+ initial-val
+                                (* gradient cc-offset))))
             fixtures
             initial-vals
             gradients))
diff --git a/guile/starlet/playback.scm b/guile/starlet/playback.scm
index 9746659..1d28d46 100644
--- a/guile/starlet/playback.scm
+++ b/guile/starlet/playback.scm
@@ -306,7 +306,7 @@
 
    ;; Attr not seen before in this playback: start fading from home
    ((eq? old-fade-record #f)
-    (home-val fix attr))
+    (get-attr-home-val fix attr))
 
    ;; Attr seen in a finished fade
    ((fade-finished? tnow old-fade-record)
@@ -330,54 +330,54 @@
 
       ;; Non-intensity attribute
       ((not (intensity? attr))
-       (set-attr! pb fix attr (wrap-fade (fade-previous fade-record)
-                                         (fade-target fade-record)
-                                         (fade-preset fade-record)
-                                         attr-time
-                                         attr-delay
-                                         preset-time
-                                         preset-delay
-                                         (fade-start-time fade-record))))
+       (set-in-state! pb fix attr (wrap-fade (fade-previous fade-record)
+                                             (fade-target fade-record)
+                                             (fade-preset fade-record)
+                                             attr-time
+                                             attr-delay
+                                             preset-time
+                                             preset-delay
+                                             (fade-start-time fade-record))))
 
       ;; Number to number, fading up
       ((and (number? target) (number? prev-val) (> target prev-val))
-       (set-attr! pb fix attr (wrap-fade prev-val
-                                         target
-                                         #f
-                                         up-time
-                                         up-delay
-                                         0.0
-                                         0.0
-                                         (fade-start-time fade-record))))
+       (set-in-state! pb fix attr (wrap-fade prev-val
+                                             target
+                                             #f
+                                             up-time
+                                             up-delay
+                                             0.0
+                                             0.0
+                                             (fade-start-time fade-record))))
 
       ;; Number to number, fading down
       ((and (number? target) (number? prev-val) (< target prev-val))
-       (set-attr! pb fix attr (wrap-fade prev-val
-                                         target
-                                         #f
-                                         down-time
-                                         down-delay
-                                         0.0
-                                         0.0
-                                         (fade-start-time fade-record))))
+       (set-in-state! pb fix attr (wrap-fade prev-val
+                                             target
+                                             #f
+                                             down-time
+                                             down-delay
+                                             0.0
+                                             0.0
+                                             (fade-start-time fade-record))))
 
       ;; Number to number, staying the same
       ((and (number? target) (number? prev-val))
-       (set-attr! pb fix attr (wrap-fade prev-val
-                                         target
-                                         #f
-                                         0.0
-                                         0.0
-                                         0.0
-                                         0.0
-                                         (fade-start-time fade-record))))
+       (set-in-state! pb fix attr (wrap-fade prev-val
+                                             target
+                                             #f
+                                             0.0
+                                             0.0
+                                             0.0
+                                             0.0
+                                             (fade-start-time fade-record))))
 
       ;; Everything else, e.g. number to effect
       (else
-       (set-attr! pb fix attr (wrap-xf (fade-previous fade-record)
-                                       (fade-target fade-record)
-                                       (get-fade-record-fade-times fade-record)
-                                       (fade-start-time fade-record))))))))
+       (set-in-state! pb fix attr (wrap-xf (fade-previous fade-record)
+                                           (fade-target fade-record)
+                                           (get-fade-record-fade-times fade-record)
+                                           (fade-start-time fade-record))))))))
 
 
 (define (fade-finished? tnow fade-record)
@@ -409,20 +409,13 @@
 
    ((and (pair? attr-el)
          (fixture? (car attr-el))
-         (fixture-attribute? (cdr attr-el)))
-    (and (eq? (car attr-el) fix)
-         (eq? (cdr attr-el) attr)))
-
-   ((and (pair? attr-el)
-         (fixture? (car attr-el))
          (symbol? (cdr attr-el)))
     (and (eq? (car attr-el) fix)
-         (eq? (cdr attr-el) (get-attr-name attr))))
+         (eq? (cdr attr-el) attr)))
 
    ((list? attr-el)
     (and (memq fix attr-el)
-         (or (memq attr attr-el)
-             (memq (get-attr-name attr) attr-el))))
+         (memq attr attr-el)))
 
    (else #f)))
 
@@ -445,9 +438,9 @@
 
 (define (fixture-dark? fix the-cue)
   (let ((val (state-find fix
-                         (find-attr fix 'intensity)
+                         'intensity
                          (get-realized-state the-cue))))
-    (or (not val)
+    (or (not (have-value val))
         (eqv? 0 val))))
 
 
@@ -577,11 +570,13 @@
         ((get-cue-state-function the-cue))
         (state-for-each (lambda (fix attr val)
                           (unless (intensity? attr)
-                            (unless (state-find fix attr old-current-state)
-                              (set-attr! old-current-state
-                                         fix
-                                         attr
-                                         (home-val fix attr)))))
+                            (unless (have-value (state-find fix
+                                                            attr
+                                                            old-current-state))
+                              (set-in-state! old-current-state
+                                             fix
+                                             attr
+                                             (get-attr-home-val fix attr)))))
                         (current-state))))))