Add an RV to describe the to be processed event queue.
authorGuerric Chupin <guerric.chupin@gmail.com>
Thu, 2 Jun 2016 15:44:17 +0000 (16:44 +0100)
committerGuerric Chupin <guerric.chupin@gmail.com>
Thu, 2 Jun 2016 15:44:17 +0000 (16:44 +0100)
RCMA/Translator/RV.hs

index 78204fdbb1e545395af00fafa0182b7e06f63438..b58a5f312770648cf111e4bf13250db63cc03929 100644 (file)
@@ -2,6 +2,8 @@
 
 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
@@ -13,11 +15,11 @@ import qualified Sound.JACK                          as Jack
 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)
 
@@ -26,16 +28,16 @@ readMIDIEvent input nframes = ReactiveFieldRead getter notifier
                     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…
@@ -45,3 +47,13 @@ writeMIDIEvent input nframes@(Jack.NFrames nframesInt') =
                     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