diff options
author | Thomas White <taw@physics.org> | 2020-08-30 21:24:29 +0200 |
---|---|---|
committer | Thomas White <taw@physics.org> | 2020-08-30 21:24:29 +0200 |
commit | 9c87690dd43e6b74c631aea553dfb755ad2202b6 (patch) | |
tree | 1657d2662c6af13f52255b424febb06934b0b928 | |
parent | c454bd5e208ebc8c9184e51d728b3c91ad117d4c (diff) |
cue-state and apply-state
-rw-r--r-- | examples/demo.scm | 17 | ||||
-rw-r--r-- | guile/starlet/base.scm | 19 |
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 () |