From d2138c27ffc90080fe7e0b16a9e7f3109200ee23 Mon Sep 17 00:00:00 2001
From: Thomas White <taw@physics.org>
Date: Thu, 11 May 2023 21:02:48 +0200
Subject: Programmer state should be LTP

---
 guile/starlet/engine.scm | 40 +++++++++++++++++++++-------------------
 guile/starlet/state.scm  |  7 +++++++
 2 files changed, 28 insertions(+), 19 deletions(-)

diff --git a/guile/starlet/engine.scm b/guile/starlet/engine.scm
index 6c43cf1..ca6f1cf 100644
--- a/guile/starlet/engine.scm
+++ b/guile/starlet/engine.scm
@@ -181,25 +181,27 @@
 
   ;; Combine all the active attributes and send it out
   (atomic-box-swap! current-values
-    (let ((states (atomic-box-ref state-list)))
-      (for-each update-state! states)
-      (fold
-        (lambda (incoming-state combined-state)
-          (state-for-each
-            (lambda (fix attr val)
-              (let ((incoming-val (value->number val))
-                    (current-val (state-find fix attr combined-state)))
-                (unless (eq? incoming-val 'no-value)
-                  (if (eq? current-val 'no-value)
-                    (set-in-state! combined-state fix attr incoming-val)
-                    (set-in-state! combined-state fix attr
-                                   (if (htp-attr? attr)
-                                     (max incoming-val current-val)
-                                     incoming-val))))))
-            incoming-state)
-          combined-state)
-        (make-empty-state)
-        (append states (list programmer-state)))))
+    (combine-states
+      (let ((states (atomic-box-ref state-list)))
+        (for-each update-state! states)
+        (fold
+          (lambda (incoming-state combined-state)
+            (state-for-each
+              (lambda (fix attr val)
+                (let ((incoming-val (value->number val))
+                      (current-val (state-find fix attr combined-state)))
+                  (unless (eq? incoming-val 'no-value)
+                    (if (eq? current-val 'no-value)
+                      (set-in-state! combined-state fix attr incoming-val)
+                      (set-in-state! combined-state fix attr
+                                     (if (htp-attr? attr)
+                                       (max incoming-val current-val)
+                                       incoming-val))))))
+              incoming-state)
+            combined-state)
+          (make-empty-state)
+          states))
+      programmer-state))
 
   (usleep 10000)
 
diff --git a/guile/starlet/state.scm b/guile/starlet/state.scm
index dbc7e38..5844b3f 100644
--- a/guile/starlet/state.scm
+++ b/guile/starlet/state.scm
@@ -47,6 +47,7 @@
             current-state
             at
             apply-state
+            combine-states
             show-state
             lighting-state
             programmer-state
@@ -329,6 +330,12 @@ pre-existing contents."
        (current-state)))))
 
 
+(define (combine-states a b)
+  (lighting-state
+    (apply-state a)
+    (apply-state b)))
+
+
 (define (print-state a)
   (pretty-print (state-source a)))
 
-- 
cgit v1.2.3