From b71668d0362df473d9081f4deaf7d2aa758ba177 Mon Sep 17 00:00:00 2001
From: Thomas White <taw@physics.org>
Date: Tue, 18 Aug 2020 18:13:17 +0200
Subject: Add MIDI note callbacks

---
 examples/demo.scm            |  7 +++++++
 guile/guile-midi/control.scm | 45 ++++++++++++++++++++++++++++++++++++++------
 2 files changed, 46 insertions(+), 6 deletions(-)

diff --git a/examples/demo.scm b/examples/demo.scm
index de25680..57c8257 100644
--- a/examples/demo.scm
+++ b/examples/demo.scm
@@ -100,3 +100,10 @@
 (register-state! pb)
 
 ;; Jump to zero (blackout) cue
+(cut-to-cue-number! pb 0)
+
+;; Set up a "go" button
+(register-midi-note-callback!
+ #:channel 14
+ #:note-number #xc
+ #:func (lambda () (go! pb)))
diff --git a/guile/guile-midi/control.scm b/guile/guile-midi/control.scm
index f45d4fc..0314d1d 100644
--- a/guile/guile-midi/control.scm
+++ b/guile/guile-midi/control.scm
@@ -8,10 +8,12 @@
             make-midi-controller
             get-controller-value
             make-midi-led
-            set-midi-led!))
+            set-midi-led!
+            register-midi-note-callback!))
 
 
 (define cc-list (make-atomic-box '()))
+(define callback-list (make-atomic-box '()))
 (define send-queue (make-atomic-box '()))
 
 
@@ -26,6 +28,21 @@
    #:getter get-note-number))
 
 
+(define-class <midi-note-callback> (<object>)
+
+  (channel
+   #:init-keyword #:channel
+   #:getter get-channel)
+
+  (note-number
+   #:init-keyword #:note-number
+   #:getter get-note-number)
+
+  (callback
+   #:init-keyword #:func
+   #:getter get-callback-func))
+
+
 (define-class <midi-control> (<object>)
 
   (channel
@@ -64,6 +81,18 @@
     new-led))
 
 
+(define* (register-midi-note-callback!
+          #:key (channel 1) (note-number 1) (func #f))
+  (let ((new-callback (make <midi-note-callback>
+                        #:channel channel
+                        #:note-number note-number
+                        #:func func)))
+    (atomic-box-set! callback-list
+                     (cons new-callback
+                           (atomic-box-ref callback-list)))
+    new-callback))
+
+
 (define enqueue-midi-bytes
   (lambda bytes
     (unless (eq? (atomic-box-compare-and-swap! send-queue '() bytes)
@@ -94,6 +123,14 @@
                     (atomic-box-ref cc-list))))
 
 
+(define (check-note-callbacks channel note-number)
+  (for-each (lambda (a) ((get-callback-func a)))
+            (filter (lambda (a)
+                      (and (eq? note-number (get-note-number a))
+                           (eq? channel (get-channel a))))
+                    (atomic-box-ref callback-list))))
+
+
 (define (scale-127-100 n)
   (/ (* n 100) 127))
 
@@ -114,11 +151,7 @@
            ;; 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)))
+                  (check-note-callbacks channel note)))
 
            ;; Control value
            ((11) (let* ((cc-number (get-u8 midi-port))
-- 
cgit v1.2.3