RCMA/Translator/RV.hs

   1 {-# LANGUAGE ScopedTypeVariables #-}
   2
   3 module Reactogon.Translator.RV where
   4
   5 import           Control.Monad.Exception.Synchronous (ExceptionalT)
   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           RCMA.Translator.Message
  12 import qualified Sound.JACK                          as Jack
  13 import           Sound.JACK.Exception                (ThrowsErrno)
  14 import qualified Sound.JACK.MIDI                     as JMIDI
  15
  16 readMIDIEvent :: forall e. (ThrowsErrno e) =>
  17                  JMIDI.Port Jack.Input
  18               -> Jack.NFrames
  19               -> ReactiveFieldRead (ExceptionalT e IO) [(Frames,RawMessage)]
  20 readMIDIEvent input nframes = ReactiveFieldRead getter notifier
  21   where getter :: ExceptionalT e IO [(Frames, RawMessage)]
  22         getter = transform <$> (JMIDI.readEventsFromPort input nframes)
  23
  24         transform :: EventListAbs.T Jack.NFrames t -> [(Frames, t)]
  25         transform = map (BF.first (\(Jack.NFrames n) -> fromIntegral n)) .
  26                     EventListAbs.toPairList
  27
  28         notifier :: ExceptionalT e IO () -> ExceptionalT e IO ()
  29         notifier _ = return ()
  30
  31 writeMIDIEvent :: forall e. (ThrowsErrno e) =>
  32                   JMIDI.Port Jack.Output
  33                -> Jack.NFrames
  34                -> ReactiveFieldWrite (ExceptionalT e IO) [(Frames, RawMessage)]
  35 writeMIDIEvent input nframes@(Jack.NFrames nframesInt') =
  36   ReactiveFieldWrite setter
  37   where setter :: [(Frames, RawMessage)] -> ExceptionalT e IO ()
  38         setter = JMIDI.writeEventsToPort input nframes . transform
  39         -- Doesn't assume the list is sorted or small enough. For
  40         -- large size buffer, this might cause performance issue. All
  41         -- the unprocessed events are lost, which is unfortunate…
  42         transform :: [(Frames, RawMessage)]
  43                   -> EventListAbs.T Jack.NFrames RawMessage
  44         transform = EventListAbs.fromPairList .
  45                     map (BF.first (Jack.NFrames . fromIntegral)) .
  46                     takeWhile ((< nframesInt) . fst) . L.sortBy (comparing fst)
  47         nframesInt = fromIntegral nframesInt'