diff options
author | Thomas White <taw@physics.org> | 2020-08-21 22:13:26 +0200 |
---|---|---|
committer | Thomas White <taw@physics.org> | 2020-08-21 22:17:49 +0200 |
commit | 1a9ebe6735b7dab8784ce1aa9dc8eb0f4e3c24a4 (patch) | |
tree | a9a7ba111563d8b0a450ae8a4531a94b0ca9765b | |
parent | 7057172ad190ae0fc718a93a7adb07b826dee323 (diff) |
Add 'at' macro
-rw-r--r-- | examples/demo.scm | 30 | ||||
-rw-r--r-- | guile/starlet/base.scm | 16 |
2 files changed, 29 insertions, 17 deletions
diff --git a/examples/demo.scm b/examples/demo.scm index 315ada4..1dbc783 100644 --- a/examples/demo.scm +++ b/examples/demo.scm @@ -21,9 +21,9 @@ (define-state worklight (let ((fader-pos (lambda () (get-controller-value working-light-fader)))) - (set-attr! (current-state) dim11 'intensity (fader-pos)) - (set-attr! (current-state) dim12 'intensity (fader-pos)) - (set-attr! (current-state) dim13 'intensity (fader-pos)))) + (at dim11 'intensity (fader-pos)) + (at dim12 'intensity (fader-pos)) + (at dim13 'intensity (fader-pos)))) (register-state! worklight) @@ -37,8 +37,8 @@ (define-state movers (let ((fader-pos (lambda () (get-controller-value movers-fader)))) - (set-attr! (current-state) mh1 'intensity (fader-pos)) - (set-attr! (current-state) mh2 'intensity (fader-pos)))) + (at mh1 'intensity (fader-pos)) + (at mh2 'intensity (fader-pos)))) (register-state! movers) @@ -50,15 +50,15 @@ (define-state example-state-1 ;; Front wash - (set-attr! (current-state) dim11 'intensity 50) - (set-attr! (current-state) dim12 'intensity 50) - (set-attr! (current-state) dim13 'intensity 50) + (at dim11 'intensity 50) + (at dim12 'intensity 50) + (at dim13 'intensity 50) ;; Sidelight - (set-attr! (current-state) dim7 'intensity (flash 2)) - (set-attr! (current-state) dim8 'intensity 50) + (at dim7 'intensity (flash 2)) + (at dim8 'intensity 50) - (set-attr! (current-state) dim48 'intensity + (at dim48 'intensity (lambda (a) (get-controller-value pot1)))) @@ -66,12 +66,12 @@ (define-state example-state-2 ;; Front wash - (set-attr! (current-state) dim1 'intensity 10) - (set-attr! (current-state) dim2 'intensity 10) - (set-attr! (current-state) dim3 'intensity 10) + (at dim1 'intensity 10) + (at dim2 'intensity 10) + (at dim3 'intensity 10) ;; Sidelight - (set-attr! (current-state) dim7 'intensity (flash 5))) + (at dim7 'intensity (flash 5))) (define cue-list diff --git a/guile/starlet/base.scm b/guile/starlet/base.scm index 4e16642..8be8576 100644 --- a/guile/starlet/base.scm +++ b/guile/starlet/base.scm @@ -9,7 +9,7 @@ #:use-module (srfi srfi-9) #:export (<fixture> <fixture-attribute> <starlet-state> start-ola-output patch-fixture! - set-attr! home-attr! home-all! blackout + home-attr! home-all! blackout scanout-freq make-empty-state register-state! percent->dmxval msb lsb hirestime expand-state set-in-state! state-for-each @@ -17,7 +17,7 @@ get-state-hash-table scanout-fixture get-fixture-universe get-fixture-addr attr-continuous attr-boolean attr-list - current-state define-state)) + current-state define-state at)) (define-class <fixture-attribute> (<object>) (name @@ -396,3 +396,15 @@ (parameterize ((current-state (make-empty-state))) body ... (current-state))))))) + + +(define-syntax at + (syntax-rules () + + ;; No attribute named -> set intensity + ((_ fixture value) + (set-attr! (current-state) fixture 'intensity value)) + + ;; Set specified attribute + ((_ fixture attr-name value) + (set-attr! (current-state) fixture attr-name value)))) |