etc

minipat-live/src/Minipat/Live/OscRpc.hs

@@ -12,11 +12,11 @@
 --  - * Attribute names starting with `!` are system level attributes and
 --  -  should be removed before further processing.
 --  -    * `!requestId` is one such attribute that should be carried
---  -      over into a responses.
---    - * Errors can be signaled by the attribute `!error` mapping to a string.
+--  -     over into a responses.
+--  -   * Errors can be signaled by the attribute `!error` mapping to a string
+--  -    datum containing a reason.
 --  - * Type checking of requests and responses should be lenient -
 --  -  it's OK to have unrecognized attributes.
---  -  datum containing a reason.
 --  - * Responses should carry the corresponding `!requestId`, but if they
 --  -  do not, they should be associated with the last request to the original
 --  -  address.

minipat-midi/src/Minipat/Midi/Convert.hs

@@ -3,13 +3,15 @@
 -- | Converts attrs to MIDI events
 module Minipat.Midi.Convert where
 
+import Data.Default (def)
 import Dahdit.Midi.Midi (ChanData (..), ChanVoiceData (..))
 import Dahdit.Midi.Osc (Datum (..))
 import Data.Functor ((<&>))
 import Data.Int (Int32)
 import Minipat.Live.Attrs (Attrs, IsAttrs (..), attrsSingleton)
-import Minipat.Live.Convert (Branch (..), ConvErr, ConvM, branchM, defaultM, runConvM)
+import Minipat.Live.Convert (Branch (..), ConvErr, ConvM, branchM, defaultM, runConvM, lookupM)
 import Minipat.Live.Datum (DatumProxy (..))
+import Minipat.Midi.Midi (PortData (..), psFromText)
 
 newtype Vel = Vel {unVel :: Int32}
   deriving stock (Show)
@@ -23,20 +25,21 @@ instance IsAttrs Vel where
 -- program change
 -- control change
 -- the rest of ChanDataVoice
-convertMidiAttrs :: Attrs -> Either ConvErr ChanData
+convertMidiAttrs :: Attrs -> Either ConvErr PortData
 convertMidiAttrs = runConvM rootM
 
 -- Default velocity in something like Ableton is 100
 defVel :: Int32
 defVel = 100
 
-rootM :: ConvM ChanData
-rootM =
+rootM :: ConvM PortData
+rootM = do
+  port <- fmap (maybe def psFromText) (lookupM "port" DatumProxyString)
   branchM @[]
     [
       ( "note"
       , Branch DatumProxyInt32 $ \(fromIntegral -> note) -> do
           vel <- defaultM "vel" DatumProxyInt32 defVel <&> fromIntegral
-          pure (ChanDataVoice (ChanVoiceDataNoteOn (note + 60) vel))
+          pure (PortData port (ChanDataVoice (ChanVoiceDataNoteOn (note + 60) vel)))
       )
     ]

minipat-midi/src/Minipat/Midi/Impl.hs

@@ -32,65 +32,61 @@ import Minipat.Live.Core (St, logAsyncState, stBackend, useCallback)
 import Minipat.Live.Logger (logInfo)
 import Minipat.Live.Resources (acquireAwait, qhHeap)
 import Minipat.Midi.Convert (convertMidiAttrs)
-import Minipat.Midi.Midi (MidiState, SortedMsg (..), TimedMsg (..))
+import Minipat.Midi.Midi (MidiState (..), SortedMsg (..), TimedMsg (..), PortName, PortMsg, MidiEnv (..), PortData)
 import Minipat.Time (Arc (..))
 import Nanotime (PosixTime, TimeDelta, threadDelayDelta)
-
--- import Sound.RtMidi (OutputDevice)
--- import Sound.RtMidi qualified as R
+import Libremidi.Api (Api (..))
 
 defaultMaxMsgLen :: Int
 defaultMaxMsgLen = 1024
 
--- TODO add max msg length
 data MidiBackend = MidiBackend
-  { mbOpenPred :: !(PortName -> Bool)
-  , mbDefaultPred :: !(PortName -> Bool)
+  { mbApi :: !Api
   , mbMaxMsgLen :: !Int
   , mbDelay :: !(Maybe TimeDelta)
   }
 
 instance Default MidiBackend where
-  def = MidiBackend (const False) (const False) defaultMaxMsgLen Nothing
+  def = MidiBackend ApiUnspecified defaultMaxMsgLen Nothing
 
 type MidiSt = St MidiBackend
 
-mkTimedMsgs :: WithPlayMeta ChanData -> Seq TimedMsg
-mkTimedMsgs (WithPlayMeta pm cd) =
+mkTimedMsgs :: WithPlayMeta PortData -> Seq TimedMsg
+mkTimedMsgs (WithPlayMeta pm pd) =
   let Arc t1 t2 = pmRealArc pm
       c = fromInteger (pmOrbit pm - 1)
       m1 = LiveMsgChan c cd
       s1 = Seq.singleton (TimedMsg t1 (SortedMsg m1))
-  in  case mkNoteOff c cd of
+  in  case mkNoteOff c pd of
         Just m2 -> s1 :|> TimedMsg t2 (SortedMsg m2)
         Nothing -> s1
 
 data MidiData = MidiData
-  { mdMidiState :: !MidiState
+  { mdMidiEnv :: !MidiEnv
   , mdObsTask :: !(Async ())
   , mdSendTask :: !(Async ())
   }
 
-sendMsgs :: (Foldable f) => St MidiBackend -> f LiveMsg -> IO ()
-sendMsgs st msgs = useCallback st $ \md ->
-  let MidiBackend _ maxLen mayDelay = stBackend st
-  in  sendLiveMsgs maxLen mayDelay (mdDevice md) msgs
-
-connectAndSendMsgs :: (Foldable f) => MidiBackend -> f LiveMsg -> IO ()
-connectAndSendMsgs (MidiBackend openPred defPred maxLen mayDelay) msgs = do
-  device <- liftIO R.defaultOutput
-  mp <- R.findPort device portSel
-  case mp of
-    Nothing -> fail "Could not find acceptable port"
-    Just p -> do
-      flip finally (R.closePort device) $ do
-        R.openPort device p "minipat"
-        sendLiveMsgs maxLen mayDelay device msgs
+-- sendMsgs :: (Foldable f) => St MidiBackend -> f PortMsg -> IO ()
+-- sendMsgs st msgs = useCallback st $ \md ->
+--   let MidiBackend _ _ maxLen mayDelay = stBackend st
+--   in  sendLiveMsgs maxLen mayDelay msgs
+--
+-- connectAndSendMsgs :: (Foldable f) => MidiBackend -> f PortMsg -> IO ()
+-- connectAndSendMsgs (MidiBackend openPred defPred maxLen mayDelay) msgs = do
+--   device <- liftIO R.defaultOutput
+--   mp <- R.findPort device portSel
+--   case mp of
+--     Nothing -> fail "Could not find acceptable port"
+--     Just p -> do
+--       flip finally (R.closePort device) $ do
+--         R.openPort device p "minipat"
+--         sendLiveMsgs maxLen mayDelay device msgs
 
 instance Backend MidiBackend where
   type BackendData MidiBackend = MidiData
 
-  backendInit (MidiBackend portSel maxLen mayDelay) logger getPlayingSTM = do
+  backendInit (MidiBackend api maxLen mayDelay) logger getPlayingSTM = do
     -- device <- liftIO R.defaultOutput
     -- let getPort = do
     --       mp <- R.findPort device portSel
@@ -102,8 +98,9 @@ instance Backend MidiBackend where
     --           R.openPort device p "minipat"
     --           logInfo logger "Connected"
     -- _ <- mkAcquire getPort (const (R.closePort device))
-    heap <- liftIO (newTVarIO H.empty)
     buf <- liftIO (VSM.new maxLen)
+    ms <- newMidiState
+    let me = MidiEnv api ms
     let send (TimedMsg _ (SortedMsg m)) = do
           len <- fmap fromIntegral (mutEncode m buf)
           VSM.unsafeWith buf (\ptr -> R.sendUnsafeMessage device ptr len)

minipat-midi/src/Minipat/Midi/Midi.hs

@@ -55,54 +55,6 @@ import Minipat.Midi.Count (CountM, throwErrM)
 import Nanotime (PosixTime, TimeDelta, threadDelayDelta)
 import Prettyprinter (Pretty (..))
 
-isNoteOff :: LiveMsg -> Bool
-isNoteOff = \case
-  LiveMsgChan _ (ChanDataVoice cvd) ->
-    case cvd of
-      ChanVoiceDataNoteOn _ 0 -> True
-      ChanVoiceDataNoteOff _ _ -> True
-      _ -> False
-  _ -> False
-
-mkNoteOff :: Channel -> ChanData -> Maybe LiveMsg
-mkNoteOff c = \case
-  ChanDataVoice (ChanVoiceDataNoteOn n v)
-    | v > 0 ->
-        Just (LiveMsgChan c (ChanDataVoice (ChanVoiceDataNoteOn n 0)))
-  _ -> Nothing
-
--- | We order so that note offs come before other messages
-newtype SortedMsg = SortedMsg {unSortedMsg :: LiveMsg}
-  deriving stock (Show)
-  deriving newtype (Eq)
-
-instance Ord SortedMsg where
-  compare (SortedMsg m1) (SortedMsg m2) =
-    let o1 = isNoteOff m1
-        o2 = isNoteOff m2
-        r = compare m1 m2
-    in  if o1
-          then
-            if o2
-              then r
-              else LT
-          else
-            if o2
-              then GT
-              else r
-
-data TimedMsg = TimedMsg
-  { tmTime :: !PosixTime
-  , tmMsg :: !SortedMsg
-  }
-  deriving stock (Eq, Ord, Show)
-
-data SetDefault = SetDefaultNo | SetDefaultYes
-  deriving stock (Eq, Ord, Show, Enum, Bounded)
-
-instance Default SetDefault where
-  def = SetDefaultNo
-
 newtype PortName = PortName {unPortName :: Text}
   deriving stock (Eq, Ord, Show)
   deriving newtype (IsString, Pretty)
@@ -150,6 +102,59 @@ data PortMsg = PortMsg
   }
   deriving stock (Eq, Ord, Show)
 
+isNoteOff :: PortMsg -> Bool
+isNoteOff (PortMsg _ lm) = case lm of
+  LiveMsgChan _ (ChanDataVoice cvd) ->
+    case cvd of
+      ChanVoiceDataNoteOn _ 0 -> True
+      ChanVoiceDataNoteOff _ _ -> True
+      _ -> False
+  _ -> False
+
+data PortData = PortData
+  { pdPort :: !PortSel
+  , pdChan :: !ChanData
+  } deriving stock (Eq, Ord, Show)
+
+mkNoteOff :: Channel -> PortData -> Maybe PortMsg
+mkNoteOff c (PortData ps cd) = case cd of
+  ChanDataVoice (ChanVoiceDataNoteOn n v)
+    | v > 0 ->
+        Just (PortMsg ps (LiveMsgChan c (ChanDataVoice (ChanVoiceDataNoteOn n 0))))
+  _ -> Nothing
+
+-- | We order so that note offs come before other messages
+newtype SortedMsg = SortedMsg {unSortedMsg :: PortMsg}
+  deriving stock (Show)
+  deriving newtype (Eq)
+
+instance Ord SortedMsg where
+  compare (SortedMsg m1) (SortedMsg m2) =
+    let o1 = isNoteOff m1
+        o2 = isNoteOff m2
+        r = compare m1 m2
+    in  if o1
+          then
+            if o2
+              then r
+              else LT
+          else
+            if o2
+              then GT
+              else r
+
+data TimedMsg = TimedMsg
+  { tmTime :: !PosixTime
+  , tmMsg :: !SortedMsg
+  }
+  deriving stock (Eq, Ord, Show)
+
+data SetDefault = SetDefaultNo | SetDefaultYes
+  deriving stock (Eq, Ord, Show, Enum, Bounded)
+
+instance Default SetDefault where
+  def = SetDefaultNo
+
 data OutState = OutState
   { osPort :: !OutPort
   , osHandle :: !(UniquePtr LMF.OutHandle)
@@ -187,6 +192,9 @@ data MidiState = MidiState
   }
   deriving stock (Eq)
 
+newMidiState :: IO MidiState
+newMidiState = MidiState <$> newTVarIO Map.empty <*> newTVarIO Nothing
+
 selectOutState :: PortSel -> MidiState -> STM (Maybe (PortName, OutState))
 selectOutState ps (MidiState omv odv) = do
   om <- readTVar omv