From ca6343f7bc0d4fb5771e5a75df2fd537fd851ce0 Mon Sep 17 00:00:00 2001 From: Tristan de Cacqueray Date: Fri, 14 Jan 2022 11:54:54 +0000 Subject: [PATCH] Add midiDevices to query available devices (#37) * Add midiInputDevices and midiOutputDevice to query available devices This change adds a new binding to the FRP.Event.MIDI module and updates the WTK example to display the available devices list. * Update src/FRP/Event/MIDI.purs Co-authored-by: Mike Solomon * Update src/FRP/Event/MIDI.purs --- examples/wtk/WTK.purs | 25 ++++++++++++++++++++----- src/FRP/Event/MIDI.js | 26 ++++++++++++++++++++++++-- src/FRP/Event/MIDI.purs | 35 ++++++++++++++++++++++++++++++++++- 3 files changed, 78 insertions(+), 8 deletions(-) diff --git a/examples/wtk/WTK.purs b/examples/wtk/WTK.purs index dd53a5af..0e7d7027 100644 --- a/examples/wtk/WTK.purs +++ b/examples/wtk/WTK.purs @@ -5,6 +5,7 @@ import Prelude import Control.Alt ((<|>)) import Control.Comonad.Cofree (Cofree, mkCofree) import Control.Promise (toAffE) +import Data.Array (fromFoldable, singleton) import Data.Foldable (for_) import Data.List (List(..)) import Data.Maybe (Maybe(..)) @@ -12,7 +13,7 @@ import Effect (Effect) import Effect.Aff.Class (class MonadAff) import Effect.Class (class MonadEffect) import FRP.Event (subscribe) -import FRP.Event.MIDI (midi, midiAccess) +import FRP.Event.MIDI (midi, midiAccess, midiInputDevices, MIDIDevice) import Halogen as H import Halogen.Aff (awaitBody, runHalogenAff) import Halogen.HTML as HH @@ -37,6 +38,7 @@ type State = { unsubscribe :: Effect Unit , audioCtx :: Maybe AudioContext + , devices :: List MIDIDevice } data Action @@ -55,11 +57,13 @@ initialState :: forall input. input -> State initialState _ = { unsubscribe: pure unit , audioCtx: Nothing + , devices: Nil } render :: forall m. State -> H.ComponentHTML Action () m -render _ = do - HH.div_ +render s = HH.div_ (ui <> dev) + where + ui = [ HH.h1_ [ HH.text "The Well-Typed Klavier" ] , HH.button @@ -69,11 +73,22 @@ render _ = do [ HE.onClick \_ -> StopAudio ] [ HH.text "Stop audio" ] ] + dev = case s.devices of + Nil -> [] + devices -> + [ HH.h4_ + [ HH.text "Available input devices"] + , HH.ul_ (fromFoldable $ map (HH.li_ <<< singleton <<< HH.text <<< showDevices) devices) + ] + showDevices d = + let manufacturer = if d.manufacturer == "" then "" else d.manufacturer <> ": " + in manufacturer <> d.name handleAction :: forall output m. MonadEffect m => MonadAff m => Action -> H.HalogenM State Action () output m Unit handleAction = case _ of StartAudio -> do midAcc <- H.liftAff $ toAffE midiAccess + midDev <- H.liftEffect $ midiInputDevices midAcc -- alt Nil for thunk let trigger = (bufferToList 5 (midi midAcc)) <|> pure Nil @@ -90,9 +105,9 @@ handleAction = case _ of (piece { makeRenderingEnv }) ) (\(_ :: Run Unit ()) -> pure unit) - H.modify_ _ { unsubscribe = unsubscribe, audioCtx = Just audioCtx } + H.modify_ _ { unsubscribe = unsubscribe, audioCtx = Just audioCtx, devices = midDev } StopAudio -> do { unsubscribe, audioCtx } <- H.get H.liftEffect unsubscribe for_ audioCtx (H.liftEffect <<< close) - H.modify_ _ { unsubscribe = pure unit, audioCtx = Nothing } + H.modify_ _ { unsubscribe = pure unit, audioCtx = Nothing, devices = Nil } diff --git a/src/FRP/Event/MIDI.js b/src/FRP/Event/MIDI.js index 34d38399..9c497297 100644 --- a/src/FRP/Event/MIDI.js +++ b/src/FRP/Event/MIDI.js @@ -1,6 +1,28 @@ exports.midiAccess = function () { - return navigator.requestMIDIAccess(); -}; + return navigator.requestMIDIAccess() +} + +const mkMidiDevices = function (devices) { + return function (mk) { + return function () { + const res = []; + for (let device of devices.entries()) { + const portID = device[0]; + const dev = device[1]; + res.push(mk(portID)(dev.manufacturer)(dev.name)) + } + return res; + } + } +} + +exports.midiInputDevices_ = function (midiAccess) { + return mkMidiDevices(midiAccess.inputs) +} + +exports.midiOutputDevices_ = function (midiAccess) { + return mkMidiDevices(midiAccess.outputs) +} exports.getData_ = function (nothing) { return function (just) { diff --git a/src/FRP/Event/MIDI.purs b/src/FRP/Event/MIDI.purs index aef364b4..bf3a50c3 100644 --- a/src/FRP/Event/MIDI.purs +++ b/src/FRP/Event/MIDI.purs @@ -2,15 +2,19 @@ module FRP.Event.MIDI ( MIDIAccess(..) , MIDIEvent(..) , MIDIEventInTime(..) + , MIDIDevice , midi , midiAccess + , midiInputDevices + , midiOutputDevices ) where import Prelude + import Control.Promise (Promise) import Data.ArrayBuffer.Types (ArrayBuffer) import Data.Foldable (traverse_) -import Data.List (List) +import Data.List (List, fromFoldable) import Data.Map as M import Data.Maybe (Maybe(..), maybe) import Data.Newtype (wrap) @@ -40,6 +44,17 @@ type MIDIEventInTime , event :: MIDIEvent } +-- | Represents a MIDI device. +type MIDIDevice + = + { portID :: String + , manufacturer :: String + , name :: String + } + +mkMIDIDevice :: String -> String -> String -> MIDIDevice +mkMIDIDevice portID manufacturer name = { portID, manufacturer, name } + -- | The Web API's [MIDIAccess](https://developer.mozilla.org/en-US/docs/Web/API/MIDIAccess). foreign import data MIDIAccess :: Type @@ -49,6 +64,16 @@ foreign import data MIDIMessageEvent :: Type -- | Get the [MIDIAccess](https://developer.mozilla.org/en-US/docs/Web/API/MIDIAccess) from the browser. foreign import midiAccess :: Effect (Promise MIDIAccess) +foreign import midiInputDevices_ + :: MIDIAccess + -> (String -> String -> String -> MIDIDevice) + -> Effect (Array MIDIDevice) + +foreign import midiOutputDevices_ + :: MIDIAccess + -> (String -> String -> String -> MIDIDevice) + -> Effect (Array MIDIDevice) + foreign import toTargetMap :: MIDIAccess -> Effect (O.Object EventTarget) foreign import toMIDIEvent_ @@ -90,6 +115,14 @@ toMIDIEvent = fromEvent :: WE.Event -> Maybe MIDIMessageEvent fromEvent = unsafeReadProtoTagged "MIDIMessageEvent" +midiInputDevices :: MIDIAccess -> Effect (List MIDIDevice) +midiInputDevices midiAccess_ = + fromFoldable <$> midiInputDevices_ midiAccess_ mkMIDIDevice + +midiOutputDevices :: MIDIAccess -> Effect (List MIDIDevice) +midiOutputDevices midiAccess_ = + fromFoldable <$> midiOutputDevices_ midiAccess_ mkMIDIDevice + -- | After having acquired the [MIDIAccess](https://developer.mozilla.org/en-US/docs/Web/API/MIDIAccess) from the browser, use it to create a streamed event of type `Event MIDIEventInTime`. midi :: MIDIAccess -> Event MIDIEventInTime midi midiAccess_ =