Simplify MIDI control

1 files changed, 61 insertions, 75 deletions

diff --git a/guile/guile-midi/control.scm b/guile/guile-midi/control.scm
index fc7d4c2..f6f315d 100644
--- a/guile/guile-midi/control.scm
+++ b/guile/guile-midi/control.scm
@@ -1,101 +1,87 @@
 (define-module (guile-midi control)
+  #:use-module (oop goops)
+  #:use-module (ice-9 atomic)
   #:use-module (ice-9 threads)
   #:use-module (ice-9 binary-ports)
-  #:export (make-midi-port
-            midi-cc-value
-            send-midi-note))
+  #:use-module (srfi srfi-1)
+  #:export (start-midi-control
+            make-midi-controller
+            get-controller-value))
 
 
-(define (make-midi-port device-name listen-channel)
+(define cc-list (make-atomic-box '()))
 
-  (let ((cc-vals (make-array 0 128))
-        (midi-port (open-file device-name "r+0b")))
 
+(define-class <midi-control> (<object>)
 
-    ;; Send a note off command
-    (define (send-noteoff note)
-      (put-u8 midi-port
-              (+ #b10000000 listen-channel))
-      (put-u8 midi-port note)
-      (put-u8 midi-port 0))
+  (channel
+   #:init-keyword #:channel
+   #:getter get-channel)
 
+  (cc-number
+   #:init-keyword #:cc-number
+   #:getter get-cc-number)
 
-    ;; Send a note on command
-    (define (send-note note velocity)
-      (put-u8 midi-port
-              (+ #b10010000 listen-channel))
-      (put-u8 midi-port note)
-      (put-u8 midi-port velocity))
+  (value-box
+   #:init-form (make-atomic-box 0)
+   #:getter get-value-box))
 
 
-    ;; Get a CC value
-    (define (get-cc-value controller-number)
-      (array-ref cc-vals
-                 controller-number))
+(define (get-controller-value a)
+  (atomic-box-ref (get-value-box a)))
 
 
-    (define (run-midi)
+(define* (make-midi-controller
+          #:key (channel 1) (cc-number 1))
+  (let ((new-controller (make <midi-control>
+                          #:channel channel
+                          #:cc-number cc-number)))
+    (atomic-box-set! cc-list
+                     (cons new-controller
+                           (atomic-box-ref cc-list)))
+    new-controller))
 
-        (let again ()
-          (letrec* ((status-byte (get-u8 midi-port))
-                    (channel (bit-extract status-byte 0 4))
-                    (command (bit-extract status-byte 4 8)))
 
-            (when (eq? channel listen-channel)
-              (case command
+(define (handle-cc-change channel cc-number value)
+  (for-each (lambda (a)
+              (atomic-box-set! (get-value-box a) value))
+            (filter (lambda (a)
+                      (and (eq? cc-number (get-cc-number a))
+                           (eq? channel (get-channel a))))
+                    (atomic-box-ref cc-list))))
 
-                ;; Note on
-                ((9) (let ((note (get-u8 midi-port))
-                           (vel (get-u8 midi-port)))
-                       (display "Note = ")
-                       (display (number->string note 16))
-                       (display " velocity = ")
-                       (display vel)
-                       (newline)))
 
-                ;; Control value
-                ((11) (let* ((controller-number (get-u8 midi-port))
-                             (value (get-u8 midi-port)))
-                        (array-set! cc-vals
-                                    value
-                                    controller-number)))))
+(define (scale-127-100 n)
+  (/ (* n 100) 127))
 
 
-            (again))))
+(define (start-midi-control device-name)
+  (let ((midi-port (open-file device-name "r+0b")))
 
-    ;; Clear out any LEDs by first sending note-on with velocity zero
-    (for-each (lambda (n)
-                (send-note n 0))
-              (iota 128 0))
+    (begin-thread
+     (let again ()
 
-    ;; ... and subsequently sending note-off
-    (for-each (lambda (n)
-                (send-noteoff n))
-              (iota 128 0))
+       (letrec* ((status-byte (get-u8 midi-port))
+                 (channel (bit-extract status-byte 0 4))
+                 (command (bit-extract status-byte 4 8)))
 
-    (make-thread run-midi)
+         (case command
 
-    (lambda args
-      (apply
-       (case (car args)
-         ((get-cc-value) get-cc-value)
-         ((send-note) send-note))
-       (cdr args)))))
+           ;; Note on
+           ((9) (let ((note (get-u8 midi-port))
+                      (vel (get-u8 midi-port)))
+                  (display "Note = ")
+                  (display (number->string note 16))
+                  (display " velocity = ")
+                  (display vel)
+                  (newline)))
 
+           ;; 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)))))
 
-(define-syntax midi-cc-value
-  (lambda (x)
-    (syntax-case x ()
-      ((_ port controller-number)
-       #'(port 'get-cc-value controller-number)))))
-
-
-(define-syntax send-midi-note
-  (lambda (x)
-    (syntax-case x ()
-
-      ((_ port note velocity)
-       #'(port 'send-note note velocity))
-
-      ((_ port note)
-       #'(port 'send-note note 127)))))
+         (yield)
+         (again))))))