diff options
author | Thomas White <taw@physics.org> | 2020-08-11 17:58:58 +0200 |
---|---|---|
committer | Thomas White <taw@physics.org> | 2020-08-11 17:58:58 +0200 |
commit | 9d38b9ce666138567c27008bdf4531c15bd5ca92 (patch) | |
tree | ee509b42c56c65e6ce1f5cd0c1746adcd848b5d2 | |
parent | 6f97fd3ffd1579e04efee17500877dcc64ef5f1c (diff) |
WIP on cues and playbacks
-rw-r--r-- | examples/demo.scm | 15 | ||||
-rw-r--r-- | guile/starlet/base.scm | 85 |
2 files changed, 94 insertions, 6 deletions
diff --git a/examples/demo.scm b/examples/demo.scm index 17a031f..19f3879 100644 --- a/examples/demo.scm +++ b/examples/demo.scm @@ -78,5 +78,16 @@ (set-attr! wksp dim8 'intensity 50)) -(fade-up cue-wksp example-state-1 - #:fade-time 1) +(define cue-list + (list (cue 1 example-state-1 + #:fade-up 3 + #:fade-down 5) + + (cue 2 example-state-2 + #:fade-up 3 + #:fade-down 5))) + +(define pb + (make-playback cue-list)) + +(cut-to-cue pb 1) diff --git a/guile/starlet/base.scm b/guile/starlet/base.scm index cd68a01..aa939d7 100644 --- a/guile/starlet/base.scm +++ b/guile/starlet/base.scm @@ -5,10 +5,12 @@ #:use-module (web client) #:use-module (web http) #:use-module (web uri) + #:use-module (srfi srfi-9) #:export (<fixture> <fixture-attribute> start-ola-output patch-fixture set-attr! home-attr! home-all! blackout - make-workspace fade-up scanout-freq + make-workspace scanout-freq + make-playback cue cut-to-cue percent->dmxval msb lsb chan)) (use-modules (srfi srfi-1)) @@ -95,6 +97,79 @@ #:setter set-workspace-priority!)) +(define-record-type <fade> + (make-fade state target-frac fade-time fade-delay start-time) + fade? + (state get-fade-state) + (target-frac get-fade-target-frac) + (fade-time get-fade-time) + (fade-delay get-fade-delay) + (start-time get-fade-start-time)) + + +(define-record-type <cue> + (make-cue number state-func up-time down-time up-delay down-delay) + cue? + (number get-cue-number) + (state-func get-cue-state-func) + (up-time up-time) + (up-delay up-delay) + (down-time down-time) + (down-delay down-delay)) + + +(define (qnum a) + (/ (inexact->exact (* a 1000)) 1000)) + + +(define* (cue number + state + #:key (fade-up 5) (fade-down 5) (up-delay 0) (down-delay 0)) + (make-cue (qnum number) + state + fade-up + fade-down + up-delay + down-delay)) + + +(define-class <starlet-playback> (<starlet-workspace>) + (active-state + #:init-value '() + #:getter get-active-state-list + #:setter set-active-state-list!) + (cue-list + #:init-keyword #:cue-list + #:getter get-playback-cue-list)) + + +(define (make-playback cue-list) + (let ((new-playback (make <starlet-playback> + #:cue-list cue-list))) + (add-to-workspace-list new-playback) + new-playback)) + + +(define (find-cue cue-list cue-number) + (find (lambda (a) + (eqv? (get-cue-number a) + cue-number)) + cue-list)) + + +(define (cut-to-cue pb cue-number) + (let* ((cue-state-func + (get-cue-state-func + (find-cue (get-playback-cue-list pb) + cue-number)))) + + ;; Flush everything out and just set the state + (set-active-state-list! pb + (list (make-fade + (cue-state-func pb) + 1.0 0.0 0.0 (hirestime)))))) + + ;; List of fixtures (define patched-fixture-list (make-atomic-box '())) @@ -135,12 +210,14 @@ attr-name)) (slot-ref fix 'attributes))) +(define (add-to-workspace-list new-workspace) + (atomic-box-set! workspace-list + (cons new-workspace + (atomic-box-ref workspace-list)))) (define (make-workspace) (let ((new-workspace (make <starlet-workspace>))) - (atomic-box-set! workspace-list - (cons new-workspace - (atomic-box-ref workspace-list))) + (add-to-workspace-list new-workspace) new-workspace)) |