aboutsummaryrefslogtreecommitdiff
path: root/guile/starlet
diff options
context:
space:
mode:
Diffstat (limited to 'guile/starlet')
-rw-r--r--guile/starlet/midi-control/faders.scm15
-rw-r--r--guile/starlet/state.scm59
2 files changed, 58 insertions, 16 deletions
diff --git a/guile/starlet/midi-control/faders.scm b/guile/starlet/midi-control/faders.scm
index 8745688..dbd2a0f 100644
--- a/guile/starlet/midi-control/faders.scm
+++ b/guile/starlet/midi-control/faders.scm
@@ -128,7 +128,8 @@
attr
(clamp-to-attr-range
attr-obj
- (+ old-val offset))))))
+ (+ old-val offset))
+ controller))))
fixtures old-vals)))))))
@@ -177,13 +178,15 @@
attr-name
gradients
initial-vals
- fixtures)
+ fixtures
+ controller)
(for-each (lambda (fix initial-val gradient)
(set-in-state! programmer-state
fix
attr-name
(+ initial-val
- (* gradient cc-offset))))
+ (* gradient cc-offset))
+ controller))
fixtures
initial-vals
gradients))
@@ -225,13 +228,15 @@
attr-name
up-gradients
initial-vals
- fixtures))
+ fixtures
+ controller))
((<= new-cc-value congruent-val)
(apply-fader (- new-cc-value congruent-val)
attr-name
dn-gradients
initial-vals
- fixtures)))
+ fixtures
+ controller)))
(when (or (and (not prev-cc-val)
(= new-cc-value congruent-val))
diff --git a/guile/starlet/state.scm b/guile/starlet/state.scm
index 82db18b..010e486 100644
--- a/guile/starlet/state.scm
+++ b/guile/starlet/state.scm
@@ -52,7 +52,8 @@
get-selection
value->number
atomically-overlay-state!
- update-state!))
+ update-state!
+ add-update-hook!))
;; A "state" is an atomically-updating container for an immutable
@@ -63,13 +64,21 @@
(define-class <starlet-state> (<object>)
(hash-table-box
#:init-form (make-atomic-box (make-hash-table))
- #:getter get-ht-box))
+ #:getter get-ht-box)
+ (update-hook
+ #:init-form (make-hook 4)
+ #:getter get-update-hook))
;; The state used to build a new scene for recording
(define programmer-state (make <starlet-state>))
+(define (add-update-hook! state proc)
+ (add-hook! (get-update-hook state)
+ proc))
+
+
(define (find-colour state fix)
(let ((col (state-find fix 'colour state)))
(if (eq? 'no-value col)
@@ -93,7 +102,8 @@
(define-method (set-in-state! (state <starlet-state>)
(fix <fixture>)
(attr <colour-component-id>)
- new-val)
+ new-val
+ source)
(let ((current-colour (find-colour state fix))
(colour-component (get-colour-component attr)))
@@ -104,48 +114,55 @@
(set-in-state! state fix 'colour
(make-colour-cmy new-val
(magenta orig-colour)
- (yellow orig-colour)))))
+ (yellow orig-colour))
+ source)))
((eq? colour-component 'magenta)
(let ((orig-colour (colour-as-cmy current-colour)))
(set-in-state! state fix 'colour
(make-colour-cmy (cyan orig-colour)
new-val
- (yellow orig-colour)))))
+ (yellow orig-colour))
+ source)))
((eq? colour-component 'yellow)
(let ((orig-colour (colour-as-cmy current-colour)))
(set-in-state! state fix 'colour
(make-colour-cmy (cyan orig-colour)
(magenta orig-colour)
- new-val))))
+ new-val)
+ source)))
((eq? colour-component 'red)
(let ((orig-colour (colour-as-rgb current-colour)))
(set-in-state! state fix 'colour
(make-colour-rgb new-val
(green orig-colour)
- (blue orig-colour)))))
+ (blue orig-colour))
+ source)))
((eq? colour-component 'green)
(let ((orig-colour (colour-as-rgb current-colour)))
(set-in-state! state fix 'colour
(make-colour-rgb (red orig-colour)
new-val
- (blue orig-colour)))))
+ (blue orig-colour))
+ source)))
((eq? colour-component 'blue)
(let ((orig-colour (colour-as-rgb current-colour)))
(set-in-state! state fix 'colour
(make-colour-rgb (red orig-colour)
(green orig-colour)
- new-val)))))))
+ new-val)
+ source))))))
(define-method (set-in-state! (state <starlet-state>)
(fix <fixture>)
(attr <symbol>)
- value)
+ value
+ source)
(let* ((old-ht (atomic-box-ref (get-ht-box state)))
(new-ht (copy-hash-table old-ht)))
(hash-set! new-ht
@@ -156,7 +173,27 @@
old-ht
new-ht)
old-ht)
- (set-in-state! state fix attr)))) ;; Try again
+ (set-in-state! state fix attr)) ;; Try again
+
+ (run-hook (get-update-hook state)
+ fix
+ attr
+ value
+ source)))
+
+
+(define-method (set-in-state! (state <starlet-state>)
+ (fix <fixture>)
+ (attr <symbol>)
+ value)
+ (set-in-state! state fix attr value #f))
+
+
+(define-method (set-in-state! (state <starlet-state>)
+ (fix <fixture>)
+ (attr <colour-component-id>)
+ new-val)
+ (set-in-state! state fix attr new-val #f))
;; Set any intensity attributes in the current state to zero