diff options
author | Thomas White <taw@physics.org> | 2020-08-17 22:40:12 +0200 |
---|---|---|
committer | Thomas White <taw@physics.org> | 2020-08-17 22:40:12 +0200 |
commit | 6df3b4e050b1e8b00506f20c0c0cf4400a7840e6 (patch) | |
tree | b960fab16e01bf9939eecbad33ec045d498d6d32 | |
parent | ef9bc2d3655d1fb5635c018a001d387ecbd0734c (diff) |
Implement 'go'
-rw-r--r-- | examples/demo.scm | 4 | ||||
-rw-r--r-- | guile/starlet/playback.scm | 56 |
2 files changed, 42 insertions, 18 deletions
diff --git a/examples/demo.scm b/examples/demo.scm index 11ec524..de25680 100644 --- a/examples/demo.scm +++ b/examples/demo.scm @@ -100,7 +100,3 @@ (register-state! pb) ;; Jump to zero (blackout) cue -(cut-to-cue! pb 0) - -;; Run the first cue -(run-cue! pb 1) diff --git a/guile/starlet/playback.scm b/guile/starlet/playback.scm index 94c83ef..36d76a1 100644 --- a/guile/starlet/playback.scm +++ b/guile/starlet/playback.scm @@ -3,7 +3,8 @@ #:use-module (srfi srfi-1) #:use-module (srfi srfi-9) #:use-module (starlet base) - #:export (make-playback cue cut-to-cue! run-cue!)) + #:export (make-playback cue load-cue! + cut-to-cue-number! run-cue-number! go!)) ;; A "playback" is a state which knows how to run cues @@ -18,6 +19,11 @@ #:init-keyword #:cue-list #:getter get-playback-cue-list) + (rest-of-cue-list + #:init-value '() + #:getter get-rest-of-cue-list + #:setter set-rest-of-cue-list!) + (hash-table #:allocation #:virtual #:getter get-state-hash-table @@ -124,19 +130,28 @@ new-playback)) +(define (find-cue-tail cue-list cue-number) + (find-tail (lambda (a) + (eqv? (get-cue-number a) + cue-number)) + cue-list)) + + (define (find-cue cue-list cue-number) - (find (lambda (a) - (eqv? (get-cue-number a) - cue-number)) - cue-list)) + (car + (find-cue-tail cue-list + cue-number))) + +(define (cut-to-cue-number! pb cue-number) + (let ((cue-tail (find-cue-tail (get-playback-cue-list pb) + cue-number))) + (cut-to-cue! pb (car cue-tail)) + (set-rest-of-cue-list! pb (cdr cue-tail)))) -(define (cut-to-cue! pb cue-number) - (let* ((state (expand-state - (get-cue-state - (find-cue (get-playback-cue-list pb) - cue-number))))) +(define (cut-to-cue! pb cue) + (let* ((state (expand-state (get-cue-state cue)))) ;; Flush everything out and just set the state (set-active-fade-list! pb (list (make-fade @@ -144,6 +159,14 @@ 0.0 1.0 0.0 0.0 (hirestime)))))) +(define (go! pb) + (let ((cue-tail (get-rest-of-cue-list pb))) + (unless (eq? '() cue-tail) + (run-cue! pb (car cue-tail)) + (set-rest-of-cue-list! pb (cdr cue-tail))))) + ;; else at the end of the cue list + + (define (add-fade! pb fade) (set-active-fade-list! pb (cons fade @@ -188,10 +211,15 @@ (get-active-fade-list pb)))) -(define (run-cue! pb cue-number) - (let ((tnow (hirestime)) - (cue (find-cue (get-playback-cue-list pb) - cue-number))) +(define (run-cue-number! pb cue-number) + (let ((cue-tail (find-cue-tail (get-playback-cue-list pb) + cue-number))) + (run-cue! pb (car cue-tail)) + (set-rest-of-cue-list! pb (cdr cue-tail)))) + + +(define (run-cue! pb cue) + (let ((tnow (hirestime))) (retire-old-fades! pb tnow) (fade-down-all-active-states! pb tnow |