module Reactogon.Translator.RV where
+import Control.Concurrent.MVar
+import Control.Monad
import Control.Monad.Exception.Synchronous (ExceptionalT)
import qualified Data.Bifunctor as BF
import qualified Data.EventList.Absolute.TimeBody as EventListAbs
import Sound.JACK.Exception (ThrowsErrno)
import qualified Sound.JACK.MIDI as JMIDI
-readMIDIEvent :: forall e. (ThrowsErrno e) =>
+inMIDIEvent :: forall e. (ThrowsErrno e) =>
JMIDI.Port Jack.Input
-> Jack.NFrames
-> ReactiveFieldRead (ExceptionalT e IO) [(Frames,RawMessage)]
-readMIDIEvent input nframes = ReactiveFieldRead getter notifier
+inMIDIEvent input nframes = ReactiveFieldRead getter notifier
where getter :: ExceptionalT e IO [(Frames, RawMessage)]
getter = transform <$> (JMIDI.readEventsFromPort input nframes)
EventListAbs.toPairList
notifier :: ExceptionalT e IO () -> ExceptionalT e IO ()
- notifier _ = return ()
+ notifier = id
-writeMIDIEvent :: forall e. (ThrowsErrno e) =>
+outMIDIEvent :: forall e. (ThrowsErrno e) =>
JMIDI.Port Jack.Output
-> Jack.NFrames
-> ReactiveFieldWrite (ExceptionalT e IO) [(Frames, RawMessage)]
-writeMIDIEvent input nframes@(Jack.NFrames nframesInt') =
+outMIDIEvent output nframes@(Jack.NFrames nframesInt') =
ReactiveFieldWrite setter
where setter :: [(Frames, RawMessage)] -> ExceptionalT e IO ()
- setter = JMIDI.writeEventsToPort input nframes . transform
+ setter = JMIDI.writeEventsToPort output nframes . transform
-- Doesn't assume the list is sorted or small enough. For
-- large size buffer, this might cause performance issue. All
-- the unprocessed events are lost, which is unfortunate…
map (BF.first (Jack.NFrames . fromIntegral)) .
takeWhile ((< nframesInt) . fst) . L.sortBy (comparing fst)
nframesInt = fromIntegral nframesInt'
+
+toProcess :: MVar [(Frames, RawMessage)]
+ -> ReactiveFieldReadWrite IO [(Frames, RawMessage)]
+toProcess mvar = ReactiveFieldReadWrite setter getter notifier
+ where setter :: [(Frames, RawMessage)] -> IO ()
+ setter new = readMVar mvar >>= return . (++ new) >>= void . swapMVar mvar
+ getter :: IO [(Frames, RawMessage)]
+ getter = swapMVar mvar []
+ notifier :: IO () -> IO ()
+ notifier = id