Added device management support.

README.md

@@ -63,15 +63,25 @@ Note that, depending upon the configured log level, you may see a fair amount of
 (um:list-devices)
 (set device "model_15")
 (set channel 1)
-(um.note:play device channel (um.note:play device channel (um.note:make 'C3)))
+(um.note:play device channel (um.note:make 'C3))
 
-(set term (midimsg:note-on channel (mref (um.note:make 'C3) 'pitch) 64))
-(um.ml:send device term)
-
-(set term (midimsg:note-off channel (mref (um.note:make 'C3) 'pitch) 64))
-(timer:apply_after 250 'um.ml 'send (list device term))
+(undermidi:start)
+(um:list-devices)
+(set device "model_15")
+(set channel 1)
+(um.note:play-notes device channel (um.note:make '(C3 C3 C4 C3)) 500)
+(set notes (um.note:make '(C3 C3 Eb3 C3 C3 Bb3 C4 C3)))
+(um.note:play-notes device channel notes 250 8)
+(set notes (um.note:make '(C3 C3 Eb3 C3 Eb4 Bb3 C4 C3)))
+(um.note:play-notes device channel notes 250 8)
 
-(um.ml:send device term)
+(undermidi:start)
+(um:list-devices)
+(set device "model_15")
+(set `#(ok ,d) (undermidi.devices:new device))
+(undermidi.device.conn:echo d "testing ...")
+(undermidi:play-note d 'C3)
+(undermidi:play-notes d '(C3 C3 Eb3 C3 C3 Bb3 C4 C3) 250 8)
 ```
 
 ## API

include/errors.lfe

@@ -0,0 +1,2 @@
+(defun ERR_NO_DEVICE () #(error "no such device; see (um:list-devices) for known system MIDI devices."))
+

src/undermidi.lfe

@@ -4,7 +4,10 @@
    (stop 0)
    (restart 0))
   (export
-   (example 0) (example 1)
+   (play-note 2)
+   (play-notes 2) (play-notes 3) (play-notes 4)
+   )
+  (export
    (list-devices 0)
    (version 0)
    (versions 0)))
@@ -15,7 +18,7 @@
   (let ((cfg-file "config/sys.config"))
     (io:format "~s" (list (undermidi.util:banner)))
     (logjam:set-config `#(path ,cfg-file))
-    (log-notice "Starting undermidi, version ~s ..." (list (undermidi.util:version)))
+    (log-notice "Starting undermidi, version ~s ..." (list (undermidi:version)))
     (application:ensure_all_started 'undermidi)
     (log-debug "\nVersions:\n~p\n" (list (versions)))))
 
@@ -26,13 +29,21 @@
   (stop)
   (start))
 
-;;; Aliases
+;;; Notes API
+
+(defun play-note (pid note)
+  (undermidi.device.conn:apply pid 'um.note 'play-note (list (um.note:make note))))
 
-(defun example ()
-  (example #m(device 0 channel 0 pitch 48 velocity 100 duration 4)))
+(defun play-notes (pid notes)
+  (undermidi.device.conn:apply pid 'um.note 'play-notes (list (um.note:make notes))))
 
-(defun example (opts)
-  (undermidi.supervisor:example opts))
+(defun play-notes (pid notes delay)
+  (undermidi.device.conn:apply pid 'um.note 'play-notes (list (um.note:make notes) delay)))
+
+(defun play-notes (pid notes delay repeats)
+  (undermidi.device.conn:apply pid 'um.note 'play-notes (list (um.note:make notes) delay repeats)))
+
+;;; Aliases
 
 (defun list-devices ()
   (um.nif:list-devices))

src/undermidi/device/conn.lfe

@@ -0,0 +1,169 @@
+;;;; This gen_server is for keeping track of an individual device a that is writing
+;;;; MIDI to, and the current MIDI channel in use for communications to that device.
+(defmodule undermidi.device.conn
+  (behaviour gen_server)
+  ;; gen_server implementation
+  (export
+    (start_link 1)
+    (stop 1))
+  ;; callback implementation
+  (export
+    (code_change 3)
+    (handle_call 3)
+    (handle_cast 2)
+    (handle_info 2)
+    (init 1)
+    (terminate 2))
+  ;; device API
+  (export
+   (apply 4)
+   (channel 1) (channel 2)
+   (device 1)
+   (state 1)
+   (send 2) (send 3)
+   (batch 2) (batch 3))
+  ;; debug API
+  (export
+    (echo 2)))
+
+(include-lib "logjam/include/logjam.hrl")
+(include-lib "undermidi/include/errors.lfe")
+
+;;;;;::=--------------------=::;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;::=-   config functions   -=::;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;::=--------------------=::;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun DELIMITER () #"\n")
+(defun NAME () "MIDI device connection")
+
+(defun genserver-opts () '())
+
+(defun unknown-command (data)
+  `#(error ,(lists:flatten (++ "Unknown command: " data))))
+
+;;;;;::=-----------------------------=::;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;::=-   gen_server implementation   -=::;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;::=-----------------------------=::;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun start_link (device-name)
+  (log-info "Starting ~s ..." (list (NAME)))
+  (gen_server:start_link (MODULE)
+                         device-name
+                         (genserver-opts)))
+
+(defun stop (pid)
+  (gen_server:call pid 'stop))
+
+;;;;;::=---------------------------=::;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;::=-   callback implementation   -=::;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;::=---------------------------=::;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun init (device-name)
+   (log-debug "Initialising ...")
+   `#(ok #m(device ,device-name
+            channel ,(undermidi.devices:read device-name 'channel))))
+
+(defun handle_call
+  ;; Management
+  ((`#(state) _from state)
+   `#(reply ,state ,state))
+  ;; Stop
+  (('stop _from state)
+   (log-notice "Stopping ~s ..." (list (NAME)))
+   `#(stop normal ok ,state))
+  ;; Testing / debugging
+  ((`#(echo ,msg) _from state)
+   `#(reply ,msg ,state))
+  ;; Fall-through
+  ((message _from state)
+   `#(reply ,(unknown-command (io_lib:format "~p" `(,message))) ,state)))
+
+(defun handle_cast
+  ;; Command support
+  (((= `(#(command ,_)) cmd) state)
+   (log-warn "Unsupported server command: ~p" `(,cmd))
+   `#(noreply ,state))
+  ((msg state)
+   (log-warn "Got undexected cast msg: ~p" (list msg))
+   `#(noreply ,state)))
+
+(defun handle_info
+  ;; Standard-output messages
+  ((`#(stdout ,_pid ,msg) state)
+   (io:format "~s" (list (binary_to_list msg)))
+   `#(noreply ,state))
+  ;; Standard-error messages
+  ((`#(stderr ,_pid ,msg) state)
+   (io:format "~s" (list (binary_to_list msg)))
+   `#(noreply ,state))
+  ;; Exit-handling
+  ((`#(,port #(exit_status ,exit-status)) state) (when (is_port port))
+   (log-warn "~p: exited with status ~p" `(,port ,exit-status))
+   `#(noreply ,state))
+  ((`#(EXIT ,_from normal) state)
+   (logger:info "~s is exiting (normal)." (list (NAME)))
+   `#(noreply ,state))
+  ((`#(EXIT ,_from shutdown) state)
+   (logger:info "~s is exiting (shutdown)." (list (NAME)))
+   `#(noreply ,state))
+  ((`#(EXIT ,pid ,reason) state)
+   (log-notice "Process ~p exited! (Reason: ~p)" `(,pid ,reason))
+   `#(noreply ,state))
+  ;; Fall-through
+  ((msg state)
+   (log-debug "Unknwon info: ~p" `(,msg))
+   `#(noreply ,state)))
+
+(defun terminate
+  ((_reason _state)
+   (log-notice "Terminating ~s ..." (list (NAME)))
+   'ok))
+
+(defun code_change (_old-version state _extra)
+  `#(ok ,state))
+
+;;;;;::=-----------------=::;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;::=-   Device API   -=::;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;::=-----------------=::;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun channel (pid)
+  (mref (state pid) 'channel))
+
+(defun channel (pid num)
+  (gen_server:call pid `#(set-channel ,num)))
+
+(defun device (pid)
+  (mref (state pid) 'devicel))
+
+(defun apply (pid m f a)
+  (let ((`#m(device ,device
+             channel ,channel) (state pid)))
+    (apply m f (++ (list device channel) a))))
+
+(defun state (pid)
+  (gen_server:call pid `#(state)))
+
+(defun send (pid msg)
+  (let ((`#m(device ,device
+             channel ,channel) (state pid)))
+    (um.ml:send device channel msg)))
+
+(defun send (pid channel msg)
+  (channel pid channel)
+  (um.ml:send (device pid) channel msg))
+
+(defun batch (pid msgs)
+  (let ((`#m(device ,device
+             channel ,channel) (state pid)))
+    (um.ml:batch device channel msgs)))
+
+(defun batch (pid channel msgs)
+  (channel pid channel)
+  (um.ml:batch (device pid) channel msgs))
+
+;;;;;::=-----------------=::;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;::=-   debugging API   -=::;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;::=-----------------=::;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun echo (pid msg)
+  (gen_server:call pid `#(echo ,msg)))

src/undermidi/device/supervisor.lfe

@@ -0,0 +1,34 @@
+(defmodule undermidi.device.supervisor
+  (behaviour supervisor)
+  (export
+   (start_link 0))
+  (export
+   (init 1)))
+
+(include-lib "logjam/include/logjam.hrl")
+
+(defun SERVER () (MODULE))
+(defun NAME () "device connection supervisor")
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;   OTP Supervisor   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun start_link ()
+  (log-info "Starting ~s ..." (list (NAME)))
+  (supervisor:start_link `#(local ,(SERVER)) (MODULE) '()))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;   Supervisor Callbacks   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun init (_)
+  `#(ok #(#m(strategy simple_one_for_one
+             intensity 3
+	     period 60)
+            (#m(id ,(MODULE)
+                start #(undermidi.device.conn start_link ())
+                restart transient
+                type worker
+                shutdown brutal_kill
+                modules (undermidi.device.conn))))))