cue-state and apply-state

2 files changed, 32 insertions, 4 deletions

diff --git a/examples/demo.scm b/examples/demo.scm
index 359b99b..dd959d3 100644
--- a/examples/demo.scm
+++ b/examples/demo.scm
@@ -77,20 +77,29 @@
 
 
 (define cue-list
-  (list (cue 0 make-empty-state
+  (list (cue 0
+             (cue-state)
              #:fade-up 1
              #:fade-down 1)
 
-        (cue 1 (lambda () example-state-1)
+        (cue 1
+             (cue-state (apply-state example-state-1))
              #:fade-up 3
              #:fade-down 5)
 
-        (cue 2 (lambda () example-state-2)
+        (cue 2
+             (cue-state (apply-state example-state-2))
              #:fade-up 3
              #:fade-down 1
              #:down-delay 3)
 
-        (cue 3 make-empty-state
+        (cue 2.5
+             (cue-state (apply-state example-state-2)
+                        (at dim1 'intensity 100))
+             #:fade-up 1
+             #:fade-down 1)
+
+        (cue 3 (cue-state)
              #:fade-up 0
              #:fade-down 2)))
 
diff --git a/guile/starlet/base.scm b/guile/starlet/base.scm
index f0dead1..1e6e44a 100644
--- a/guile/starlet/base.scm
+++ b/guile/starlet/base.scm
@@ -29,6 +29,8 @@
             attr-list
             current-state
             lighting-state
+            cue-state
+            apply-state
             at))
 
 (define-class <fixture-attribute> (<object>)
@@ -223,6 +225,10 @@
                  new))
 
 
+(define (apply-state state)
+  (add-state-to-state! merge-rule-ltp state (current-state)))
+
+
 (define (value->number val time)
   (if (procedure? val)
       (val time)
@@ -413,6 +419,19 @@
        (current-state)))))
 
 
+(define-syntax cue-state
+  (syntax-rules ()
+
+    ((_)
+     make-empty-state)
+
+    ((_ body ...)
+     (lambda ()
+       (parameterize ((current-state (make-empty-state)))
+         body ...
+         (current-state))))))
+
+
 (define-syntax at
   (syntax-rules ()