RCMA/Translator/RV.hs

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