]> Git — Sourcephile - tmp/julm/arpeggigon.git/blob - src/RMCA/Translator/RV.hs
Merge branch 'master' of gitlab.com:chupin/arpeggigon
[tmp/julm/arpeggigon.git] / 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 Data.CBMVar
8 import qualified Data.EventList.Absolute.TimeBody as EventListAbs
9 import qualified Data.List as L
10 import Data.Ord (comparing)
11 import Data.ReactiveValue
12 import RMCA.Translator.Message
13 import qualified Sound.JACK as Jack
14 import Sound.JACK.Exception (All, toStringWithHead)
15 import qualified Sound.JACK.MIDI as JMIDI
16 import qualified System.IO as IO
17
18 handleError :: (Monoid a) => ExceptionalT All IO a -> IO a
19 handleError = resolveT $ \e -> do
20 IO.hPutStrLn IO.stderr $ toStringWithHead e
21 return mempty
22
23 inMIDIEvent :: JMIDI.Port Jack.Input
24 -> Jack.NFrames
25 -> ReactiveFieldRead IO [(Frames,RawMessage)]
26 inMIDIEvent input nframes = ReactiveFieldRead getter notifier
27 where getter :: IO [(Frames, RawMessage)]
28 getter = handleError $ transform <$>
29 JMIDI.readEventsFromPort input nframes
30
31 transform :: EventListAbs.T Jack.NFrames t -> [(Frames, t)]
32 transform = map (BF.first (\(Jack.NFrames n) -> fromIntegral n)) .
33 EventListAbs.toPairList
34
35 notifier :: IO () -> IO ()
36 notifier = id
37
38 outMIDIEvent :: JMIDI.Port Jack.Output
39 -> Jack.NFrames
40 -> ReactiveFieldWrite IO [(Frames, RawMessage)]
41 outMIDIEvent output nframes@(Jack.NFrames nframesInt') =
42 ReactiveFieldWrite setter
43 where setter :: [(Frames, RawMessage)] -> IO ()
44 setter = handleError .
45 JMIDI.writeEventsToPort output nframes . transform
46 -- Doesn't assume the list is sorted or small enough. For
47 -- large size buffer, this might cause performance issue. All
48 -- the unprocessed events are lost, which is unfortunate…
49 transform :: [(Frames, RawMessage)]
50 -> EventListAbs.T Jack.NFrames RawMessage
51 transform = EventListAbs.fromPairList .
52 map (BF.first (Jack.NFrames . fromIntegral)) .
53 takeWhile ((< nframesInt) . fst) . L.sortBy (comparing fst)
54 nframesInt = fromIntegral nframesInt'