From 6beaa3ae1f4951fb2a40513009bc020477f80c79 Mon Sep 17 00:00:00 2001 From: Thomas White Date: Tue, 25 Apr 2023 21:12:23 +0200 Subject: Add OSC utilities --- examples/demo-show.scm | 25 +++++---- guile/starlet/open-sound-control/utils.scm | 87 ++++++++++++++++++++++++++++++ guile/starlet/utils.scm | 8 ++- 3 files changed, 110 insertions(+), 10 deletions(-) create mode 100644 guile/starlet/open-sound-control/utils.scm diff --git a/examples/demo-show.scm b/examples/demo-show.scm index 6282d9b..55ddab2 100644 --- a/examples/demo-show.scm +++ b/examples/demo-show.scm @@ -14,7 +14,8 @@ (starlet fixture-library stairville z120m) (starlet fixture-library robe dl7s) (open-sound-control server-thread) - (open-sound-control client)) + (open-sound-control client) + (starlet open-sound-control utils)) ;; Patch fixtures @@ -92,11 +93,17 @@ ;; OSC controls -(define osc-server (make-osc-server-thread "7770")) -(define osc-send-addr (make-osc-address "7771")) -(add-osc-method osc-server "/starlet/selection/clear" (lambda () (sel #f))) -(add-osc-method osc-server "/starlet/selection/mhLL" (lambda () (sel mhLL))) -(add-osc-method osc-server "/starlet/selection/mhL" (lambda () (sel mhL))) -(add-osc-method osc-server "/starlet/selection/mhR" (lambda () (sel mhR))) -(add-osc-method osc-server "/starlet/selection/mhRR" (lambda () (sel mhRR))) -(osc-send osc-send-addr "/x1k2/leds/*" 1) +(define osc-server (make-osc-server-thread "osc.udp://:7770")) +(define x1k2 (make-osc-address "osc.udp://localhost:7771")) +(osc-send x1k2 "/x1k2/leds/*" 'off) +(osc-playback-indicators pb x1k2 "/x1k2/leds/101" "/x1k2/leds/29" "/x1k2/leds/25") +(osc-playback-controls pb osc-server "/x1k2/buttons/101" "/x1k2/buttons/29" "/x1k2/buttons/25") +(osc-playback-indicators pb x1k2 "/x1k2/leds/102" "/x1k2/leds/32" "/x1k2/leds/28") +(osc-playback-controls pb osc-server "/x1k2/buttons/102" "/x1k2/buttons/32" "/x1k2/buttons/28") +(add-osc-method osc-server "/x1k2/buttons/30" "" (lambda () + (reload-cue-list! pb) + (reassert-current-cue! pb))) +(add-osc-method osc-server "/x1k2/buttons/31" "" sel) +(osc-send x1k2 "/x1k2/leds/30" 'green) +(osc-send x1k2 "/x1k2/leds/31" 'green) +(osc-select-button osc-server "/x1k2/buttons/17" x1k2 "/x1k2/leds/17" front-leds) diff --git a/guile/starlet/open-sound-control/utils.scm b/guile/starlet/open-sound-control/utils.scm new file mode 100644 index 0000000..bb9c310 --- /dev/null +++ b/guile/starlet/open-sound-control/utils.scm @@ -0,0 +1,87 @@ +;; +;; starlet/open-sound-control/utils.scm +;; +;; Copyright © 2020-2023 Thomas White +;; +;; This file is part of Starlet. +;; +;; Starlet is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . +;; +(define-module (starlet open-sound-control utils) + #:use-module (starlet playback) + #:use-module (starlet state) + #:use-module (starlet utils) + #:use-module (open-sound-control client) + #:use-module (open-sound-control server-thread) + #:export (osc-playback-indicators + osc-playback-controls + osc-select-button)) + + +(define* (osc-playback-controls pb server go-method stop-method back-method + #:key (min-time-between-presses 0.2)) + + (let ((time-last-press 0)) + (add-osc-method server go-method "" + (lambda () + (let ((time-this-press (hirestime))) + (if (> time-this-press (+ time-last-press min-time-between-presses)) + (go! pb) + (display "Too soon after last press!\n")) + (set! time-last-press time-this-press))))) + + (add-osc-method server stop-method "" (lambda () (stop! pb))) + (add-osc-method server back-method "" (lambda () (back! pb)))) + + +(define (osc-playback-indicators pb addr go-led stop-led back-led) + + (add-and-run-hook! + (state-change-hook pb) + (lambda (new-state) + + (if (eq? new-state 'running) + (osc-send addr stop-led 'green) + (osc-send addr stop-led 'off)) + + (cond + ((eq? new-state 'pause) + (osc-send addr go-led 'orange)) + ((eq? new-state 'ready) + (osc-send addr go-led 'green)) + ((eq? new-state 'running) + (osc-send addr go-led 'green)) + (else + (osc-send addr go-led 'off)))) + + (playback-state pb)) + + (osc-send addr back-led 'green)) + + +(define (osc-select-button server button-method addr led fix) + + (add-osc-method server button-method "" + (lambda () + (if (selected? fix) + (desel fix) + (sel fix)))) + + (add-and-run-hook! + selection-hook + (lambda (sel) + (if (selected? fix) + (osc-send addr led 'orange) + (osc-send addr led 'red))) + (get-selection))) diff --git a/guile/starlet/utils.scm b/guile/starlet/utils.scm index e38e6b7..e1b92a8 100644 --- a/guile/starlet/utils.scm +++ b/guile/starlet/utils.scm @@ -40,7 +40,8 @@ percent->dmxval16 comment hash-table-empty? - lookup)) + lookup + add-and-run-hook!)) (define (print-hash-table ht) @@ -173,3 +174,8 @@ (cadr (car dictionary))) (else (lookup key (cdr dictionary))))) + + +(define (add-and-run-hook! hook proc . initial-args) + (add-hook! hook proc) + (apply proc initial-args)) -- cgit v1.2.3