aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorThomas White <taw@physics.org>2021-09-11 11:05:08 +0200
committerThomas White <taw@physics.org>2021-09-11 11:05:08 +0200
commitbaa097304625ccbcb0396ba4163eb9f21398db33 (patch)
treea5b8a80fdeec8be7a2b984129cbc6efc47922720
parentd79c75b3db76e242e0299d5d324191e3133de235 (diff)
new WIPwip
-rw-r--r--examples/show.scm2
-rw-r--r--guile/starlet/effects.scm34
-rw-r--r--guile/starlet/midi-control/base.scm11
-rw-r--r--guile/starlet/midi-control/faders.scm58
4 files changed, 75 insertions, 30 deletions
diff --git a/examples/show.scm b/examples/show.scm
index 1e51a99..d672572 100644
--- a/examples/show.scm
+++ b/examples/show.scm
@@ -72,7 +72,7 @@
(state-on-fader controller 19 my-state)
-(use-midi-control-map
+(set-midi-control-map!
controller
(list
(list 'intensity 'fader 16 '(108 72))
diff --git a/guile/starlet/effects.scm b/guile/starlet/effects.scm
index c14f5a0..068bc10 100644
--- a/guile/starlet/effects.scm
+++ b/guile/starlet/effects.scm
@@ -21,27 +21,41 @@
(define-module (starlet effects)
#:use-module (starlet clock)
#:export (flash
- sinewave))
+ sinewave
+ lighting-effect
+ effect-clock
+ chase))
(define pi (* 2 (acos 0)))
+(define effect-clock (make-parameter #f))
+
+
+(define-syntax lighting-effect
+ (syntax-rules ()
+ ((_ body ...)
+ (if (effect-clock)
+ (lambda () body ...)
+ (parameterize ((effect-clock (make-clock)))
+ (lambda () body ...))))))
+
+
(define (square-wave time hz)
(if (> (sin (* 2 pi hz time))
0)
100
0))
+
(define (flash hz)
- (let ((clock (make-clock)))
- (lambda ()
- (square-wave (elapsed-time clock)
- hz))))
+ (lighting-effect
+ (square-wave (elapsed-time (effect-clock))
+ hz)))
(define (sinewave hz range-min range-max)
- (let ((clock (make-clock)))
- (lambda ()
- (+ range-min
- (* (/ (- range-max range-min) 2)
- (+ 1 (sin (* 2 pi hz (elapsed-time clock)))))))))
+ (lighting-effect
+ (+ range-min
+ (* (/ (- range-max range-min) 2)
+ (+ 1 (sin (* 2 pi hz (elapsed-time (effect-clock)))))))))
diff --git a/guile/starlet/midi-control/base.scm b/guile/starlet/midi-control/base.scm
index 08310ae..c2e92af 100644
--- a/guile/starlet/midi-control/base.scm
+++ b/guile/starlet/midi-control/base.scm
@@ -33,7 +33,9 @@
send-note-off
register-midi-note-callback!
register-midi-cc-callback!
- remove-midi-callback!))
+ remove-midi-callback!
+ get-control-map
+ set-control-map!))
(define-class <midi-control-surface> (<object>)
@@ -52,7 +54,12 @@
(send-queue
#:init-form (make-atomic-box '())
- #:getter get-send-queue))
+ #:getter get-send-queue)
+
+ (control-map
+ #:init-value #f
+ #:getter get-control-map
+ #:setter set-control-map!))
(define-class <midi-callback> (<object>)
diff --git a/guile/starlet/midi-control/faders.scm b/guile/starlet/midi-control/faders.scm
index dbd2a0f..8ba2b3e 100644
--- a/guile/starlet/midi-control/faders.scm
+++ b/guile/starlet/midi-control/faders.scm
@@ -26,7 +26,7 @@
#:use-module (starlet scanout)
#:use-module (starlet utils)
#:use-module (srfi srfi-1)
- #:export (use-midi-control-map
+ #:export (set-midi-control-map!
state-on-fader))
@@ -277,23 +277,47 @@
(send-note-off controller leds))))
-(define (use-midi-control-map controller control-map)
- (let ((midi-callbacks '()))
- (add-hook! selection-hook
- (lambda (fixture-list)
+(define (install-control-map-callbacks)
+ )
- (for-each (lambda (callback)
- (remove-midi-callback! controller callback))
- midi-callbacks)
- (for-each (lambda (control-spec)
- (led-off controller (cadddr control-spec)))
- control-map)
+(define (install-control-map-item map-item)
+ (let ((attr-name (car map-item))
+ (control-type (cadr map-item))
+ (cc-number (caddr map-item))
+ (leds (cadddr map-item)))
- (set! midi-callbacks '())
+ (add-update-hook! programmer-state
+ (lambda (fix attr value source)
+ (unless (eq? source controller)
+ (when (and (memq? selection fix)
+ (in-control-map new-control-map attr))
+ (format #t "State change from ~a (~a / ~a to ~a)\n"
+ source fix attr value)))))))
- (unless (nil? fixture-list)
- (set! midi-callbacks
- (map (lambda (control-spec)
- (midi-control-attr controller control-spec fixture-list))
- control-map)))))))
+(define (update-midi-controls controller fixture-list)
+ (for-each (lambda (callback)
+ (remove-midi-callback! controller callback))
+ midi-callbacks)
+
+ (for-each (lambda (control-spec)
+ (led-off controller (cadddr control-spec)))
+ (get-control-map controller))
+
+ (set! midi-callbacks '())
+
+ (unless (nil? fixture-list)
+ (set! midi-callbacks
+ (map (lambda (control-spec)
+ (midi-control-attr controller control-spec fixture-list))
+ control-map))))
+
+
+(define (set-midi-control-map! controller new-control-map)
+ (let ((old-control-map (get-control-map controller)))
+ (set-control-map! controller new-control-map)
+ (unless old-control-map
+ (add-hook!
+ selection-hook
+ (lambda (fixture-list)
+ (update-midi-controls controller fixture-list))))))