aboutsummaryrefslogtreecommitdiff
path: root/guile
diff options
context:
space:
mode:
Diffstat (limited to 'guile')
-rw-r--r--guile/starlet/base.scm205
-rw-r--r--guile/starlet/playback.scm200
2 files changed, 206 insertions, 199 deletions
diff --git a/guile/starlet/base.scm b/guile/starlet/base.scm
index a7ba8b0..83fb04d 100644
--- a/guile/starlet/base.scm
+++ b/guile/starlet/base.scm
@@ -5,16 +5,16 @@
#:use-module (web client)
#:use-module (web http)
#:use-module (web uri)
+ #:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
- #:export (<fixture> <fixture-attribute>
+ #:export (<fixture> <fixture-attribute> <starlet-state>
start-ola-output patch-fixture
set-attr! home-attr! home-all! blackout
scanout-freq make-empty-state register-state!
- make-playback cue cut-to-cue! run-cue!
- percent->dmxval msb lsb chan))
-
-(use-modules (srfi srfi-1))
-
+ percent->dmxval msb lsb chan
+ hirestime expand-state set-in-state! state-for-each
+ merge-states-htp value->number get-attr-name
+ get-state-hash-table))
(define-class <fixture-attribute> (<object>)
(name
@@ -73,28 +73,6 @@
#:setter set-state-hash-table!))
-;; A "playback" is a state which knows how to run cues
-;; from a cue list
-(define-class <starlet-playback> (<starlet-state>)
- (active-fade-list
- #:init-value '()
- #:getter get-active-fade-list
- #:setter set-active-fade-list!)
-
- (cue-list
- #:init-keyword #:cue-list
- #:getter get-playback-cue-list)
-
- (hash-table
- #:allocation #:virtual
- #:getter get-state-hash-table
- #:slot-ref (lambda (instance)
- (merge-active-fades (hirestime)
- (get-active-fade-list instance)))
- #:slot-set! (lambda (instance new-val)
- (error "Can't set hash table on playback"))))
-
-
(define-method (set-in-state! (state <starlet-state>)
(fix <fixture>)
(attr <fixture-attribute>)
@@ -104,177 +82,6 @@
value))
-(define-record-type <fade>
- (make-fade state start-frac target-frac fade-time fade-delay start-time)
- fade?
- (start-frac get-fade-start-frac)
- (target-frac get-fade-target-frac)
- (fade-time get-fade-time)
- (state get-fade-state)
- (start-time get-fade-start-time)
- (fade-delay get-fade-delay-time))
-
-
-(define-record-type <cue>
- (make-cue number state up-time down-time up-delay down-delay)
- cue?
- (number get-cue-number)
- (state get-cue-state)
- (up-time up-time)
- (up-delay up-delay)
- (down-time down-time)
- (down-delay down-delay))
-
-
-(define (wrap-scale scale-factor a)
- (lambda (time)
- (* (value->number a time)
- scale-factor)))
-
-
-(define (get-current-fraction fade current-time)
- (let ((elapsed-fade-time (- current-time
- (get-fade-start-time fade)
- (get-fade-delay-time fade))))
- (cond
-
- ;; Before start of fade
- ((< elapsed-fade-time 0)
- (get-fade-start-frac fade))
-
- ;; After end of fade
- ((> elapsed-fade-time
- (get-fade-time fade))
- (get-fade-target-frac fade))
-
- ;; During the fade
- (else
- (+ (get-fade-start-frac fade)
- (* (- (get-fade-target-frac fade)
- (get-fade-start-frac fade))
-
- ;; Fraction of fade time elapsed
- (/ elapsed-fade-time
- (get-fade-time fade))))))))
-
-
-(define (scale-fade fade current-time)
- (let ((state (make-empty-state))
- (scale-factor (get-current-fraction fade current-time)))
- (state-for-each (lambda (fix attr value)
- (if (eq? 'intensity (get-attr-name attr))
- (set-in-state! state
- fix
- attr
- (wrap-scale scale-factor value))
- (set-in-state! state fix attr value)))
- (get-fade-state fade))
- state))
-
-
-(define (merge-active-fades current-time list-of-fades)
- (get-state-hash-table
- (merge-states-htp
- (map (lambda (fade) (scale-fade fade current-time))
- list-of-fades))))
-
-
-(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 (make-playback cue-list)
- (let ((new-playback (make <starlet-playback>
- #:cue-list cue-list)))
- 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* ((state (expand-state
- (get-cue-state
- (find-cue (get-playback-cue-list pb)
- cue-number)))))
-
- ;; Flush everything out and just set the state
- (set-active-fade-list! pb
- (list (make-fade
- state
- 0.0 1.0 0.0 0.0 (hirestime))))))
-
-
-(define (add-fade! pb fade)
- (set-active-fade-list! pb
- (cons fade
- (get-active-fade-list pb))))
-
-
-(define (make-fade-from-cue cue time)
- (make-fade
- (expand-state (get-cue-state cue))
- 0.0
- 1.0
- (up-time cue)
- (up-delay cue)
- time))
-
-
-(define (retire-old-fades! pb tnow)
- (set-active-fade-list!
- pb
- (filter (lambda (a)
- (or
- (< tnow
- (+ (get-fade-start-time a)
- (get-fade-delay-time a)
- (get-fade-time a)))
- (> (get-fade-target-frac a)
- 0.0)))
- (get-active-fade-list pb))))
-
-
-(define (fade-down-all-active-states! pb tnow down-time down-delay)
- (set-active-fade-list!
- pb
- (map (lambda (a)
- (make-fade
- (get-fade-state a)
- (get-current-fraction a tnow)
- 0.0
- down-time
- down-delay
- tnow))
- (get-active-fade-list pb))))
-
-
-(define (run-cue! pb cue-number)
- (let ((tnow (hirestime))
- (cue (find-cue (get-playback-cue-list pb)
- cue-number)))
- (retire-old-fades! pb tnow)
- (fade-down-all-active-states! pb
- tnow
- (down-time cue)
- (down-delay cue))
- (add-fade! pb (make-fade-from-cue cue tnow))))
-
;; List of fixtures
(define patched-fixture-list (make-atomic-box '()))
diff --git a/guile/starlet/playback.scm b/guile/starlet/playback.scm
new file mode 100644
index 0000000..94c83ef
--- /dev/null
+++ b/guile/starlet/playback.scm
@@ -0,0 +1,200 @@
+(define-module (starlet playback)
+ #:use-module (oop goops)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-9)
+ #:use-module (starlet base)
+ #:export (make-playback cue cut-to-cue! run-cue!))
+
+
+;; A "playback" is a state which knows how to run cues
+;; from a cue list
+(define-class <starlet-playback> (<starlet-state>)
+ (active-fade-list
+ #:init-value '()
+ #:getter get-active-fade-list
+ #:setter set-active-fade-list!)
+
+ (cue-list
+ #:init-keyword #:cue-list
+ #:getter get-playback-cue-list)
+
+ (hash-table
+ #:allocation #:virtual
+ #:getter get-state-hash-table
+ #:slot-ref (lambda (instance)
+ (merge-active-fades (hirestime)
+ (get-active-fade-list instance)))
+ #:slot-set! (lambda (instance new-val)
+ (error "Can't set hash table on playback"))))
+
+
+(define-record-type <fade>
+ (make-fade state start-frac target-frac fade-time fade-delay start-time)
+ fade?
+ (start-frac get-fade-start-frac)
+ (target-frac get-fade-target-frac)
+ (fade-time get-fade-time)
+ (state get-fade-state)
+ (start-time get-fade-start-time)
+ (fade-delay get-fade-delay-time))
+
+
+(define-record-type <cue>
+ (make-cue number state up-time down-time up-delay down-delay)
+ cue?
+ (number get-cue-number)
+ (state get-cue-state)
+ (up-time up-time)
+ (up-delay up-delay)
+ (down-time down-time)
+ (down-delay down-delay))
+
+
+(define (wrap-scale scale-factor a)
+ (lambda (time)
+ (* (value->number a time)
+ scale-factor)))
+
+
+(define (get-current-fraction fade current-time)
+ (let ((elapsed-fade-time (- current-time
+ (get-fade-start-time fade)
+ (get-fade-delay-time fade))))
+ (cond
+
+ ;; Before start of fade
+ ((< elapsed-fade-time 0)
+ (get-fade-start-frac fade))
+
+ ;; After end of fade
+ ((> elapsed-fade-time
+ (get-fade-time fade))
+ (get-fade-target-frac fade))
+
+ ;; During the fade
+ (else
+ (+ (get-fade-start-frac fade)
+ (* (- (get-fade-target-frac fade)
+ (get-fade-start-frac fade))
+
+ ;; Fraction of fade time elapsed
+ (/ elapsed-fade-time
+ (get-fade-time fade))))))))
+
+
+(define (scale-fade fade current-time)
+ (let ((state (make-empty-state))
+ (scale-factor (get-current-fraction fade current-time)))
+ (state-for-each (lambda (fix attr value)
+ (if (eq? 'intensity (get-attr-name attr))
+ (set-in-state! state
+ fix
+ attr
+ (wrap-scale scale-factor value))
+ (set-in-state! state fix attr value)))
+ (get-fade-state fade))
+ state))
+
+
+(define (merge-active-fades current-time list-of-fades)
+ (get-state-hash-table
+ (merge-states-htp
+ (map (lambda (fade) (scale-fade fade current-time))
+ list-of-fades))))
+
+
+(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 (make-playback cue-list)
+ (let ((new-playback (make <starlet-playback>
+ #:cue-list cue-list)))
+ 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* ((state (expand-state
+ (get-cue-state
+ (find-cue (get-playback-cue-list pb)
+ cue-number)))))
+
+ ;; Flush everything out and just set the state
+ (set-active-fade-list! pb
+ (list (make-fade
+ state
+ 0.0 1.0 0.0 0.0 (hirestime))))))
+
+
+(define (add-fade! pb fade)
+ (set-active-fade-list! pb
+ (cons fade
+ (get-active-fade-list pb))))
+
+
+(define (make-fade-from-cue cue time)
+ (make-fade
+ (expand-state (get-cue-state cue))
+ 0.0
+ 1.0
+ (up-time cue)
+ (up-delay cue)
+ time))
+
+
+(define (retire-old-fades! pb tnow)
+ (set-active-fade-list!
+ pb
+ (filter (lambda (a)
+ (or
+ (< tnow
+ (+ (get-fade-start-time a)
+ (get-fade-delay-time a)
+ (get-fade-time a)))
+ (> (get-fade-target-frac a)
+ 0.0)))
+ (get-active-fade-list pb))))
+
+
+(define (fade-down-all-active-states! pb tnow down-time down-delay)
+ (set-active-fade-list!
+ pb
+ (map (lambda (a)
+ (make-fade
+ (get-fade-state a)
+ (get-current-fraction a tnow)
+ 0.0
+ down-time
+ down-delay
+ tnow))
+ (get-active-fade-list pb))))
+
+
+(define (run-cue! pb cue-number)
+ (let ((tnow (hirestime))
+ (cue (find-cue (get-playback-cue-list pb)
+ cue-number)))
+ (retire-old-fades! pb tnow)
+ (fade-down-all-active-states! pb
+ tnow
+ (down-time cue)
+ (down-delay cue))
+ (add-fade! pb (make-fade-from-cue cue tnow))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-19 14:26:41 +0000