From 69337c0e3eed3cb1f93ff18d07058ef82a5bd159 Mon Sep 17 00:00:00 2001
From: Thomas White <taw@physics.org>
Date: Sat, 1 Apr 2023 22:59:24 +0200
Subject: Scanout: Retrieve the combined state only once

---
 guile/starlet/engine.scm  |  7 +++++-
 guile/starlet/scanout.scm | 55 ++++++++++++++++++++++++++++-------------------
 2 files changed, 39 insertions(+), 23 deletions(-)

(limited to 'guile')

diff --git a/guile/starlet/engine.scm b/guile/starlet/engine.scm
index 37656cb..6c43cf1 100644
--- a/guile/starlet/engine.scm
+++ b/guile/starlet/engine.scm
@@ -35,6 +35,7 @@
             total-num-attrs
             register-state!
             current-value
+            current-value-state
             patched-fixture-names
             patched-fixtures))
 
@@ -56,6 +57,10 @@
   (map get-fixture-name (atomic-box-ref fixtures)))
 
 
+(define (current-value-state)
+  (atomic-box-ref current-values))
+
+
 (define (patched-fixtures)
   (atomic-box-ref fixtures))
 
@@ -122,7 +127,7 @@
 
 
 (define-method (current-value (fix <fixture>) (attr-name <starlet-attribute>))
-  (let ((v (state-find fix attr-name (atomic-box-ref current-values))))
+  (let ((v (state-find fix attr-name (current-value-state))))
     (if (eq? v 'no-value)
       (get-attr-home-val fix attr-name)
       v)))
diff --git a/guile/starlet/scanout.scm b/guile/starlet/scanout.scm
index e0d1133..e54843c 100644
--- a/guile/starlet/scanout.scm
+++ b/guile/starlet/scanout.scm
@@ -26,6 +26,7 @@
   #:use-module (starlet colours)
   #:use-module (starlet attributes)
   #:use-module (starlet guile-ola)
+  #:use-module (oop goops)
   #:use-module (ice-9 threads)
   #:use-module (ice-9 atomic)
   #:use-module (ice-9 exceptions)
@@ -41,12 +42,20 @@
 (define current-scanout-fixture (make-parameter #f))
 (define current-scanout-universe (make-parameter #f))
 (define current-scanout-addr (make-parameter #f))
+(define current-scanout-state (make-parameter (make-empty-state)))
 
 
-(define (get-attr attr-name)
-  (current-value
-    (current-scanout-fixture)
-    attr-name))
+(define-method (get-attr (attr-name <starlet-attribute>))
+  (let ((v (state-find (current-scanout-fixture)
+                       attr-name
+                       (current-scanout-state))))
+    (if (eq? v 'no-value)
+      (get-attr-home-val (current-scanout-fixture) attr-name)
+      v)))
+
+
+(define-method (get-attr (attr-name <colour-component-id>))
+  (extract-colour-component (get-attr colour) attr-name))
 
 
 (define (set-dmx universe addr value)
@@ -86,24 +95,26 @@
 
   (let ((universes '()))
 
-    (for-each
-      (lambda (fix)
-
-        ;; Ensure the DMX array exists for this fixture's universe
-        (unless (assq (get-fixture-universe fix) universes)
-          (set! universes (acons (get-fixture-universe fix)
-                                 (make-ola-dmx-buffer)
-                                 universes)))
-
-        (parameterize
-          ((current-scanout-fixture fix)
-           (current-scanout-universe (assq-ref
-                                       universes
-                                       (get-fixture-universe fix)))
-           (current-scanout-addr (get-fixture-addr fix)))
-          (scanout-fixture fix)))
-
-      (patched-fixtures))
+    (parameterize
+      ((current-scanout-state (current-value-state)))
+      (for-each
+        (lambda (fix)
+
+          ;; Ensure the DMX array exists for this fixture's universe
+          (unless (assq (get-fixture-universe fix) universes)
+            (set! universes (acons (get-fixture-universe fix)
+                                   (make-ola-dmx-buffer)
+                                   universes)))
+
+          (parameterize
+            ((current-scanout-fixture fix)
+             (current-scanout-universe (assq-ref
+                                         universes
+                                         (get-fixture-universe fix)))
+             (current-scanout-addr (get-fixture-addr fix)))
+            (scanout-fixture fix)))
+
+        (patched-fixtures)))
 
     (for-each
       (lambda (uni-buf-pair)
-- 
cgit v1.2.3