From 6b7f396ce476aa1ce2e4774c7f9f791495ca6198 Mon Sep 17 00:00:00 2001 From: Thomas White Date: Sun, 2 Jul 2023 14:11:52 +0200 Subject: Split smart potentiometer control logic out of osc-smart-potentiometer --- guile/starlet/open-sound-control/utils.scm | 211 +++++++++++++++++------------ 1 file changed, 124 insertions(+), 87 deletions(-) diff --git a/guile/starlet/open-sound-control/utils.scm b/guile/starlet/open-sound-control/utils.scm index d89665c..ae97c2c 100644 --- a/guile/starlet/open-sound-control/utils.scm +++ b/guile/starlet/open-sound-control/utils.scm @@ -29,7 +29,9 @@ #:use-module (open-sound-control client) #:use-module (open-sound-control server-thread) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-9) #:use-module (srfi srfi-26) + #:use-module (ice-9 receive) #:export (osc-playback-controls osc-select-button osc-parameter-encoder @@ -180,48 +182,41 @@ (get-selection-as-string))))) -(define (fader-congruent vals attrs) - (mean (map (lambda (val attr) - (scale-to-range val (get-attr-range attr) '(0 127))) - vals attrs))) - - (define (fader-up-gradients initial-vals - attrs + max-vals congruent-val) - (map (lambda (initial-val attr) - (let ((attr-max (cadr (get-attr-range attr)))) - (if (< congruent-val 127) + (map (lambda (initial-val attr-max) + (if (< congruent-val 127) (/ (- attr-max initial-val) (- 127 congruent-val)) - 0))) + 0)) initial-vals - attrs)) + max-vals)) (define (fader-down-gradients initial-vals - attrs + min-vals congruent-val) - (map (lambda (initial-val attr) - (let ((attr-min (car (get-attr-range attr)))) - (if (> congruent-val 0) + (map (lambda (initial-val attr-min) + (if (> congruent-val 0) (/ (- initial-val attr-min) congruent-val) - 0))) - + 0)) initial-vals - attrs)) + min-vals)) (define (fixtures-with-attr fixture-list attr-name) - (let ((attrs (map (cut find-attr <> attr-name) fixture-list))) - (fold (lambda (fix attr old) - (if attr - (cons (cons fix (car old)) - (cons attr (cdr old))) - old)) - (cons '() '()) - fixture-list attrs))) + (let ((fix-attrs + (map (lambda (fix) + (let ((attr (find-attr fix attr-name))) + (if attr + (cons fix attr) + (cons #f #f)))) + fixture-list))) + (values + (filter (lambda (x) x) (map car fix-attrs)) + (filter (lambda (x) x) (map cdr fix-attrs))))) (define (current-values fixture-list attr-name) @@ -230,23 +225,73 @@ fixture-list)) -(define (apply-fader cc-offset - attr-name - gradients - initial-vals - fixtures - label) - (for-each - (lambda (fix initial-val gradient) - (set-in-state! programmer-state - fix - attr-name - (+ initial-val - (* gradient cc-offset)) - label)) - fixtures - initial-vals - gradients)) +(define-record-type + (smart-pot-record addr + pot-method + initial-vals + min-vals + max-vals + congruent-val + up-gradients + dn-gradients) + smart-pot? + (addr get-target-addr) + (pot-method get-method) + (initial-vals get-initial-vals set-initial-vals) + (min-vals get-min-vals set-min-vals) + (max-vals get-max-vals set-max-vals) + (congruent-val get-congruent-val set-congruent-val) + (up-gradients get-up-gradients set-up-gradients) + (dn-gradients get-dn-gradients set-dn-gradients)) + + +(define (make-smart-potentiometer server addr pot-method callback) + + (let ((sp (smart-pot-record addr pot-method '() '() '() 0 '() '()))) + + (add-osc-method + server + (string-append pot-method "/value-change") + "i" + (lambda (new-cc-value) + (callback + (map + (lambda (initial-val gradient) + (+ initial-val + (* gradient + (- new-cc-value (get-congruent-val sp))))) + (get-initial-vals sp) + (if (> new-cc-value (get-congruent-val sp)) + (get-up-gradients sp) + (get-dn-gradients sp)))))) + + sp)) + + +(define (reset-gradients sp) + (unless (nil? (get-initial-vals sp)) + (set-congruent-val sp + (mean + (map + (lambda (val min-val max-val) + (scale-to-range val (list min-val max-val) '(0 127))) + (get-initial-vals sp) + (get-min-vals sp) + (get-max-vals sp)))) + (set-up-gradients sp + (fader-up-gradients + (get-initial-vals sp) + (get-max-vals sp) + (get-congruent-val sp))) + (set-dn-gradients sp + (fader-up-gradients + (get-initial-vals sp) + (get-min-vals sp) + (get-congruent-val sp))) + (osc-send + (get-target-addr sp) + (string-append (get-method sp) "/set-pickup") + (get-congruent-val sp)))) (define (osc-smart-potentiometer attr-name @@ -254,58 +299,50 @@ addr potentiometer) - (let ((fixtures '()) - (attrs '()) - (initial-vals '()) - (congruent-val 0) - (up-gradients '()) - (dn-gradients '())) - - (let ((set-gradients - (lambda () - (unless (nil? fixtures) - (set! initial-vals (current-values fixtures attr-name)) - (set! congruent-val (fader-congruent initial-vals attrs)) - (set! up-gradients (fader-up-gradients initial-vals attrs congruent-val)) - (set! dn-gradients (fader-down-gradients initial-vals attrs congruent-val)) - (osc-send addr (string-append potentiometer "/set-pickup") congruent-val))))) - + (let ((fixtures '())) + + ;; First, create a smart potentiometer object and tell it to + ;; set the attribute values in the programmer state + (let ((smart-pot + (make-smart-potentiometer + server + addr + potentiometer + (lambda (new-vals) + (for-each + (lambda (fix new-val) + (set-in-state! programmer-state + fix + attr-name + new-val + potentiometer)) + fixtures new-vals))))) + + ;; Next, set up a selection hook callback to update the list of + ;; fixtures we are controlling (add-and-run-hook! selection-hook (lambda (selection) - (let ((fixtures-attrs (fixtures-with-attr selection attr-name))) - (if (null? (car fixtures-attrs)) + (receive + (new-fixtures attrs) + (fixtures-with-attr selection attr-name) + (if (nil? new-fixtures) (osc-send addr (string-append potentiometer "/disable")) (begin - (set! fixtures (car fixtures-attrs)) - (set! attrs (cdr fixtures-attrs)) - (set-gradients) + (set! fixtures new-fixtures) + (let ((ranges (map get-attr-range attrs))) + (set-min-vals smart-pot (map first ranges)) + (set-max-vals smart-pot (map second ranges))) + (set-initial-vals smart-pot (current-values fixtures attr-name)) + (reset-gradients smart-pot) (osc-send addr (string-append potentiometer "/enable")))))) (get-selection)) - (add-osc-method - server - (string-append potentiometer "/value-change") - "i" - (lambda (new-cc-value) - (cond - ((> new-cc-value congruent-val) - (apply-fader (- new-cc-value congruent-val) - attr-name - up-gradients - initial-vals - fixtures - potentiometer)) - ((<= new-cc-value congruent-val) - (apply-fader (- new-cc-value congruent-val) - attr-name - dn-gradients - initial-vals - fixtures - potentiometer))))) - + ;; Finally, arrange for the smart potentiometer object to be notified + ;; if the values change externally (add-update-hook! programmer-state (lambda (source) (unless (eq? source potentiometer) - (set-gradients))))))) + (set-initial-vals smart-pot (current-values fixtures attr-name)) + (reset-gradients smart-pot))))))) -- cgit v1.2.3