From 33c05f33e4ca9928773a78ad150f252fc7fff8cc Mon Sep 17 00:00:00 2001
From: Thomas White <taw@physics.org>
Date: Thu, 25 Feb 2021 22:35:16 +0100
Subject: Gracefully handle unavailable MIDI control device

---
 guile/starlet/midi-control/base.scm | 103 ++++++++++++++++++++++--------------
 1 file changed, 63 insertions(+), 40 deletions(-)

(limited to 'guile/starlet/midi-control')

diff --git a/guile/starlet/midi-control/base.scm b/guile/starlet/midi-control/base.scm
index 8b882d8..64fcae7 100644
--- a/guile/starlet/midi-control/base.scm
+++ b/guile/starlet/midi-control/base.scm
@@ -2,6 +2,7 @@
   #:use-module (oop goops)
   #:use-module (ice-9 atomic)
   #:use-module (ice-9 threads)
+  #:use-module (ice-9 exceptions)
   #:use-module (ice-9 binary-ports)
   #:use-module (srfi srfi-1)
   #:export (start-midi-control
@@ -175,52 +176,74 @@
 
 (define default-channel 0)
 
-(define* (start-midi-control device-name
-                             #:key (channel #f))
-
-  (when channel
-    (set! default-channel channel))
-
+(define (start-midi-control-real device-name channel)
   (let ((midi-port (open-file device-name "r+0b")))
 
     ;; Read thread
     (begin-thread
-     (with-exception-handler
-         (lambda (exn)
-           (backtrace)
-           (raise-exception exn))
-       (lambda ()
-         (let again ()
-
-           (let* ((status-byte (get-u8 midi-port))
-                  (channel (bit-extract status-byte 0 4))
-                  (command (bit-extract status-byte 4 8)))
-
-             (case command
-
-               ;; Note on
-               ((9) (let* ((note (get-u8 midi-port))
-                           (vel (get-u8 midi-port)))
-                      (check-note-callbacks channel note)))
-
-               ;; Control value
-               ((11) (let* ((cc-number (get-u8 midi-port))
-                            (value (get-u8 midi-port)))
-                       (handle-cc-change! channel
-                                          cc-number
-                                          value))))
-
-             (yield)
-             (again))))))
+      (with-exception-handler
+        (lambda (exn)
+          (backtrace)
+          (raise-exception exn))
+        (lambda ()
+          (let again ()
+
+            (let* ((status-byte (get-u8 midi-port))
+                   (channel (bit-extract status-byte 0 4))
+                   (command (bit-extract status-byte 4 8)))
+
+              (case command
+
+                ;; Note on
+                ((9) (let* ((note (get-u8 midi-port))
+                            (vel (get-u8 midi-port)))
+                       (check-note-callbacks channel note)))
+
+                ;; Control value
+                ((11) (let* ((cc-number (get-u8 midi-port))
+                             (value (get-u8 midi-port)))
+                        (handle-cc-change! channel
+                                           cc-number
+                                           value))))
+
+              (yield)
+              (again))))))
 
     ;; Write thread
     (begin-thread
-     (let again ()
-       (let ((bytes-to-send (atomic-box-swap! send-queue '())))
-         (for-each (lambda (a)
-                     (put-u8 midi-port a))
-                   bytes-to-send)
-         (usleep 1000)
-         (again))))
+      (let again ()
+        (let ((bytes-to-send (atomic-box-swap! send-queue '())))
+          (for-each (lambda (a)
+                      (put-u8 midi-port a))
+                    bytes-to-send)
+          (usleep 1000)
+          (again))))
 
     (all-notes-off! default-channel)))
+
+
+(define (start-dummy-midi)
+  (display "Using dummy MIDI control\n")
+  (begin-thread
+    (let again ()
+      (let ((bytes-to-send (atomic-box-swap! send-queue '())))
+        (usleep 1000)
+        (again)))))
+
+(define* (start-midi-control device-name
+                             #:key (channel #f))
+
+  (when channel
+    (set! default-channel channel))
+
+  (with-exception-handler
+
+    (lambda (exn)
+      (format #t "Couldn't start MIDI ~a\n"
+              (exception-irritants exn))
+      (start-dummy-midi))
+
+    (lambda ()
+      (start-midi-control-real device-name channel))
+
+    #:unwind? #t))
-- 
cgit v1.2.3