]> Git — Sourcephile - tmp/julm/arpeggigon.git/blob - src/RMCA/Translator/RV.hs
Add a warning about Jack in the README.
[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 Data.Monoid hiding (All)
7 import qualified Data.Bifunctor as BF
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 $
29 fmap transform (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'