From f78e14611ad9b32a224bdc4058651447ad3a8f32 Mon Sep 17 00:00:00 2001 From: Thomas White Date: Tue, 26 Jan 2021 22:30:11 +0100 Subject: Move "sel" to base, and add a callback --- guile/starlet/base.scm | 21 +++++++++++++++++++++ guile/starlet/midi-control/button-utils.scm | 2 +- guile/starlet/midi-control/faders.scm | 17 ++++++----------- 3 files changed, 28 insertions(+), 12 deletions(-) diff --git a/guile/starlet/base.scm b/guile/starlet/base.scm index ddefcdf..10bd484 100644 --- a/guile/starlet/base.scm +++ b/guile/starlet/base.scm @@ -46,6 +46,8 @@ find-attr fixture? fixture-attribute? + selection-hook + sel programmer-state current-value)) @@ -510,3 +512,22 @@ ;; Set specified attribute ((_ fixture attr-name value) (set-attr! (current-state) fixture attr-name value)))) + + +(define selection-hook (make-hook 1)) + +(define selection '()) + + +(define (flatten-sublists l) + (fold (lambda (a prev) + (if (list? a) + (append a prev) + (cons a prev))) + '() l)) + + +(define (sel . fixture-list) + (set! selection + (flatten-sublists fixture-list)) + (run-hook selection-hook selection)) diff --git a/guile/starlet/midi-control/button-utils.scm b/guile/starlet/midi-control/button-utils.scm index 008d2c5..f0add16 100644 --- a/guile/starlet/midi-control/button-utils.scm +++ b/guile/starlet/midi-control/button-utils.scm @@ -1,6 +1,6 @@ (define-module (starlet midi-control button-utils) #:use-module (starlet midi-control base) - #:use-module (starlet midi-control faders) + #:use-module (starlet base) #:use-module (starlet playback) #:export (make-go-button make-stop-button diff --git a/guile/starlet/midi-control/faders.scm b/guile/starlet/midi-control/faders.scm index cf672f2..113917c 100644 --- a/guile/starlet/midi-control/faders.scm +++ b/guile/starlet/midi-control/faders.scm @@ -4,8 +4,7 @@ #:use-module (ice-9 receive) #:use-module (srfi srfi-9) #:use-module (srfi srfi-1) - #:export (state-on-fader - sel)) + #:export (state-on-fader)) (define (put-state-on-fader cc-number @@ -241,15 +240,8 @@ ;; Stuff to clear up when we're done with selected fixtures (define midi-callbacks '()) -(define (flatten-sublists l) - (fold (lambda (a prev) - (if (list? a) - (append a prev) - (cons a prev))) - '() l)) - -(define (sel . fixture-list) +(define (select-midi fixture-list) (define (led-off leds) (cond @@ -268,5 +260,8 @@ (when (car fixture-list) (set! midi-callbacks - (map (partial midi-control-attr (flatten-sublists fixture-list)) + (map (partial midi-control-attr fixture-list) control-map)))) + + +(add-hook! selection-hook select-midi) -- cgit v1.2.3