From d099dcbb755f1330224568e3b9aeae1a9e4214b7 Mon Sep 17 00:00:00 2001 From: Thomas White Date: Wed, 19 Aug 2020 17:10:02 +0200 Subject: Add lots more side-effects --- guile/guile-midi/control.scm | 28 ++++++------- guile/starlet/base.scm | 16 ++++---- guile/venues/demo-venue.scm | 96 ++++++++++++++++++++++---------------------- 3 files changed, 70 insertions(+), 70 deletions(-) (limited to 'guile') diff --git a/guile/guile-midi/control.scm b/guile/guile-midi/control.scm index 0314d1d..e3ff848 100644 --- a/guile/guile-midi/control.scm +++ b/guile/guile-midi/control.scm @@ -5,7 +5,7 @@ #:use-module (ice-9 binary-ports) #:use-module (srfi srfi-1) #:export (start-midi-control - make-midi-controller + make-midi-controller! get-controller-value make-midi-led set-midi-led! @@ -62,7 +62,7 @@ (atomic-box-ref (get-value-box a))) -(define* (make-midi-controller +(define* (make-midi-controller! #:key (channel 1) (cc-number 1)) (let ((new-controller (make #:channel channel @@ -93,28 +93,28 @@ new-callback)) -(define enqueue-midi-bytes +(define enqueue-midi-bytes! (lambda bytes (unless (eq? (atomic-box-compare-and-swap! send-queue '() bytes) '()) - (apply enqueue-midi-bytes bytes)))) + (apply enqueue-midi-bytes! bytes)))) (define (set-midi-led! led val) (if val ;; Note on - (enqueue-midi-bytes (+ #b10010000 (get-channel led)) - (get-note-number led) - 127) + (enqueue-midi-bytes! (+ #b10010000 (get-channel led)) + (get-note-number led) + 127) ;; Note off - (enqueue-midi-bytes (+ #b10000000 (get-channel led)) - (get-note-number led) - 0))) + (enqueue-midi-bytes! (+ #b10000000 (get-channel led)) + (get-note-number led) + 0))) -(define (handle-cc-change channel cc-number value) +(define (handle-cc-change! channel cc-number value) (for-each (lambda (a) (atomic-box-set! (get-value-box a) value)) (filter (lambda (a) @@ -156,9 +156,9 @@ ;; Control value ((11) (let* ((cc-number (get-u8 midi-port)) (value (get-u8 midi-port))) - (handle-cc-change channel - cc-number - (scale-127-100 value))))) + (handle-cc-change! channel + cc-number + (scale-127-100 value))))) (yield) (again)))) diff --git a/guile/starlet/base.scm b/guile/starlet/base.scm index 83fb04d..39dc214 100644 --- a/guile/starlet/base.scm +++ b/guile/starlet/base.scm @@ -8,7 +8,7 @@ #:use-module (srfi srfi-1) #:use-module (srfi srfi-9) #:export ( - start-ola-output patch-fixture + start-ola-output patch-fixture! set-attr! home-attr! home-all! blackout scanout-freq make-empty-state register-state! percent->dmxval msb lsb chan @@ -143,9 +143,9 @@ ;; Patch a new fixture -(define* (patch-fixture class - start-addr - #:key (universe 1) (friendly-name "Fixture")) +(define* (patch-fixture! class + start-addr + #:key (universe 1) (friendly-name "Fixture")) (let ((new-fixture (make class #:sa start-addr #:uni universe @@ -189,7 +189,7 @@ ;; Add the contents of state "new" to "combined-state" -(define (add-state-to-state merge-rule new combined-state) +(define (add-state-to-state! merge-rule new combined-state) (state-for-each (lambda (fix attr value) (let ((current-value (state-find fix attr @@ -244,9 +244,9 @@ (define (merge-states merge-rule list-of-states) (let ((combined-state (make ))) (for-each (lambda (state) - (add-state-to-state merge-rule - (expand-state state) - combined-state)) + (add-state-to-state! merge-rule + (expand-state state) + combined-state)) list-of-states) combined-state)) diff --git a/guile/venues/demo-venue.scm b/guile/venues/demo-venue.scm index 2ec1eec..f334720 100644 --- a/guile/venues/demo-venue.scm +++ b/guile/venues/demo-venue.scm @@ -3,55 +3,55 @@ #:use-module (starlet fixture-library generic)) ;; Conventional dimmers (1-48) -(define-public dim1 (patch-fixture 1)) -(define-public dim2 (patch-fixture 2)) -(define-public dim3 (patch-fixture 3)) -(define-public dim4 (patch-fixture 4)) -(define-public dim5 (patch-fixture 5)) -(define-public dim6 (patch-fixture 6)) -(define-public dim7 (patch-fixture 7)) -(define-public dim8 (patch-fixture 8)) -(define-public dim9 (patch-fixture 9)) +(define-public dim1 (patch-fixture! 1)) +(define-public dim2 (patch-fixture! 2)) +(define-public dim3 (patch-fixture! 3)) +(define-public dim4 (patch-fixture! 4)) +(define-public dim5 (patch-fixture! 5)) +(define-public dim6 (patch-fixture! 6)) +(define-public dim7 (patch-fixture! 7)) +(define-public dim8 (patch-fixture! 8)) +(define-public dim9 (patch-fixture! 9)) -(define-public dim10 (patch-fixture 10)) -(define-public dim11 (patch-fixture 11)) -(define-public dim12 (patch-fixture 12)) -(define-public dim13 (patch-fixture 13)) -(define-public dim14 (patch-fixture 14)) -(define-public dim15 (patch-fixture 15)) -(define-public dim16 (patch-fixture 16)) -(define-public dim17 (patch-fixture 17)) -(define-public dim18 (patch-fixture 18)) -(define-public dim19 (patch-fixture 19)) +(define-public dim10 (patch-fixture! 10)) +(define-public dim11 (patch-fixture! 11)) +(define-public dim12 (patch-fixture! 12)) +(define-public dim13 (patch-fixture! 13)) +(define-public dim14 (patch-fixture! 14)) +(define-public dim15 (patch-fixture! 15)) +(define-public dim16 (patch-fixture! 16)) +(define-public dim17 (patch-fixture! 17)) +(define-public dim18 (patch-fixture! 18)) +(define-public dim19 (patch-fixture! 19)) -(define-public dim20 (patch-fixture 20)) -(define-public dim21 (patch-fixture 21)) -(define-public dim22 (patch-fixture 22)) -(define-public dim23 (patch-fixture 23)) -(define-public dim24 (patch-fixture 24)) -(define-public dim25 (patch-fixture 25)) -(define-public dim26 (patch-fixture 26)) -(define-public dim27 (patch-fixture 27)) -(define-public dim28 (patch-fixture 28)) -(define-public dim29 (patch-fixture 29)) +(define-public dim20 (patch-fixture! 20)) +(define-public dim21 (patch-fixture! 21)) +(define-public dim22 (patch-fixture! 22)) +(define-public dim23 (patch-fixture! 23)) +(define-public dim24 (patch-fixture! 24)) +(define-public dim25 (patch-fixture! 25)) +(define-public dim26 (patch-fixture! 26)) +(define-public dim27 (patch-fixture! 27)) +(define-public dim28 (patch-fixture! 28)) +(define-public dim29 (patch-fixture! 29)) -(define-public dim30 (patch-fixture 30)) -(define-public dim31 (patch-fixture 31)) -(define-public dim32 (patch-fixture 32)) -(define-public dim33 (patch-fixture 33)) -(define-public dim34 (patch-fixture 34)) -(define-public dim35 (patch-fixture 35)) -(define-public dim36 (patch-fixture 36)) -(define-public dim37 (patch-fixture 37)) -(define-public dim38 (patch-fixture 38)) -(define-public dim39 (patch-fixture 39)) +(define-public dim30 (patch-fixture! 30)) +(define-public dim31 (patch-fixture! 31)) +(define-public dim32 (patch-fixture! 32)) +(define-public dim33 (patch-fixture! 33)) +(define-public dim34 (patch-fixture! 34)) +(define-public dim35 (patch-fixture! 35)) +(define-public dim36 (patch-fixture! 36)) +(define-public dim37 (patch-fixture! 37)) +(define-public dim38 (patch-fixture! 38)) +(define-public dim39 (patch-fixture! 39)) -(define-public dim40 (patch-fixture 40)) -(define-public dim41 (patch-fixture 41)) -(define-public dim42 (patch-fixture 42)) -(define-public dim43 (patch-fixture 43)) -(define-public dim44 (patch-fixture 44)) -(define-public dim45 (patch-fixture 45)) -(define-public dim46 (patch-fixture 46)) -(define-public dim47 (patch-fixture 47)) -(define-public dim48 (patch-fixture 48)) +(define-public dim40 (patch-fixture! 40)) +(define-public dim41 (patch-fixture! 41)) +(define-public dim42 (patch-fixture! 42)) +(define-public dim43 (patch-fixture! 43)) +(define-public dim44 (patch-fixture! 44)) +(define-public dim45 (patch-fixture! 45)) +(define-public dim46 (patch-fixture! 46)) +(define-public dim47 (patch-fixture! 47)) +(define-public dim48 (patch-fixture! 48)) -- cgit v1.2.3