src/RMCA/Translator/RV.hs

   1 {-# LANGUAGE ScopedTypeVariables #-}
   2
   3 module RMCA.Translator.RV where
   4
   5 import           Control.Monad.Exception.Synchronous (ExceptionalT, resolveT)
   6 import qualified Data.Bifunctor                      as BF
   7 import qualified Data.EventList.Absolute.TimeBody    as EventListAbs
   8 import qualified Data.List                           as L
   9 import           Data.Ord                            (comparing)
  10 import           Data.ReactiveValue
  11 import           RMCA.Translator.Message
  12 import qualified Sound.JACK                          as Jack
  13 import           Sound.JACK.Exception                (All, toStringWithHead)
  14 import qualified Sound.JACK.MIDI                     as JMIDI
  15 import qualified System.IO                           as IO
  16
  17 handleError :: (Monoid a) => ExceptionalT All IO a -> IO a
  18 handleError = resolveT $ \e -> do
  19   IO.hPutStrLn IO.stderr $ toStringWithHead e
  20   return mempty
  21
  22 inMIDIEvent :: JMIDI.Port Jack.Input
  23             -> Jack.NFrames
  24             -> ReactiveFieldRead IO [(Frames,RawMessage)]
  25 inMIDIEvent input nframes = ReactiveFieldRead getter notifier
  26   where getter :: IO [(Frames, RawMessage)]
  27         getter = handleError $ transform <$>
  28                  JMIDI.readEventsFromPort input nframes
  29
  30         transform :: EventListAbs.T Jack.NFrames t -> [(Frames, t)]
  31         transform = map (BF.first (\(Jack.NFrames n) -> fromIntegral n)) .
  32                     EventListAbs.toPairList
  33
  34         notifier :: IO () -> IO ()
  35         notifier = id
  36
  37 outMIDIEvent :: JMIDI.Port Jack.Output
  38              -> Jack.NFrames
  39              -> ReactiveFieldWrite IO [(Frames, RawMessage)]
  40 outMIDIEvent output nframes@(Jack.NFrames nframesInt') =
  41   ReactiveFieldWrite setter
  42   where setter :: [(Frames, RawMessage)] -> IO ()
  43         setter = handleError .
  44                  JMIDI.writeEventsToPort output nframes . transform
  45         -- Doesn't assume the list is sorted or small enough. For
  46         -- large size buffer, this might cause performance issue. All
  47         -- the unprocessed events are lost, which is unfortunate…
  48         transform :: [(Frames, RawMessage)]
  49                   -> EventListAbs.T Jack.NFrames RawMessage
  50         transform = EventListAbs.fromPairList .
  51                     map (BF.first (Jack.NFrames . fromIntegral)) .
  52                     takeWhile ((< nframesInt) . fst) . L.sortBy (comparing fst)
  53         nframesInt = fromIntegral nframesInt'