]> Git — Sourcephile - tmp/julm/arpeggigon.git/blob - src/RMCA/Translator/Translator.hs
Deleted 'Unknown' directory.
[tmp/julm/arpeggigon.git] / src / RMCA / Translator / Translator.hs
1 {-# LANGUAGE Arrows #-}
2
3 module RMCA.Translator.Translator ( readMessages
4 , gatherMessages
5 ) where
6
7 import qualified Data.Bifunctor as BF
8 import FRP.Yampa
9 import RMCA.Auxiliary.Curry
10 import RMCA.Semantics
11 import RMCA.Translator.Controller
12 import RMCA.Translator.Message
13 import RMCA.Translator.Note
14 import RMCA.Translator.SortMessage
15
16 -- Uses function defined in SortMessage. This is a pure function and
17 -- it might not need to be a signal function.
18 readMessages' :: [(Frames,RawMessage)]
19 -> ([(Frames,Note)], [(Frames,Controller)], [(Frames,RawMessage)])
20 readMessages' = proc r -> do
21 (mes, raw) <- sortRawMessages -< r
22 (notes, ctrl) <- convertMessages <<< sortNotes -< mes
23 returnA -< (notes, ctrl, raw)
24
25 readMessages :: SF [(Frames, RawMessage)]
26 ([(Frames,Note)], [(Frames,Controller)], [(Frames,RawMessage)])
27 readMessages = arr readMessages'
28
29 gatherMessages' :: LTempo
30 -> SampleRate
31 -> Int
32 -> ([(Frames,Note)],[(Frames,Controller)],[(Frames,RawMessage)])
33 -> [(Frames, RawMessage)]
34 gatherMessages' layTempo sr chan = proc (notes, ctrl, raw) -> do
35 notes' <- concat <<< map (noteToMessages layTempo sr chan) -< notes
36 ctrl' <- map (BF.second controllerToMessages) -< ctrl
37 rawNotes <- map (BF.second toRawMessage) -< notes'
38 rawCtrl <- map (BF.second toRawMessage) -< ctrl'
39 returnA -< rawNotes ++ rawCtrl ++ raw
40
41 gatherMessages :: SF
42 ( LTempo, SampleRate, Int
43 , ([(Frames,Note)],[(Frames,Controller)],[(Frames,RawMessage)]))
44 [(Frames, RawMessage)]
45 gatherMessages = arr $ uncurry4 gatherMessages'