]> Git — Sourcephile - tmp/julm/arpeggigon.git/blob - RMCA/Translator/Translator.hs
Tiles are removable by dragging them outside.
[tmp/julm/arpeggigon.git] / 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.Layer.Layer
11 import RMCA.Semantics
12 import RMCA.Translator.Controller
13 import RMCA.Translator.Message
14 import RMCA.Translator.Note
15 import RMCA.Translator.SortMessage
16
17 -- Uses function defined in SortMessage. This is a pure function and
18 -- it might not need to be a signal function.
19 readMessages' :: [(Frames,RawMessage)]
20 -> ([(Frames,Note)], [(Frames,Controller)], [(Frames,RawMessage)])
21 readMessages' = proc r -> do
22 (mes, raw) <- sortRawMessages -< r
23 (notes, ctrl) <- convertMessages <<< sortNotes -< mes
24 returnA -< (notes, ctrl, raw)
25
26 readMessages :: SF [(Frames, RawMessage)]
27 ([(Frames,Note)], [(Frames,Controller)], [(Frames,RawMessage)])
28 readMessages = arr readMessages'
29
30 gatherMessages' :: LTempo
31 -> SampleRate
32 -> Int
33 -> ([(Frames,Note)],[(Frames,Controller)],[(Frames,RawMessage)])
34 -> [(Frames, RawMessage)]
35 gatherMessages' layTempo sr chan = proc (notes, ctrl, raw) -> do
36 notes' <- concat <<< map (noteToMessages layTempo sr chan) -< notes
37 ctrl' <- map (BF.second controllerToMessages) -< ctrl
38 rawNotes <- map (BF.second toRawMessage) -< notes'
39 rawCtrl <- map (BF.second toRawMessage) -< ctrl'
40 returnA -< rawNotes ++ rawCtrl ++ raw
41
42 gatherMessages :: SF
43 ( LTempo, SampleRate, Int
44 , ([(Frames,Note)],[(Frames,Controller)],[(Frames,RawMessage)]))
45 [(Frames, RawMessage)]
46 gatherMessages = arr $ uncurry4 gatherMessages'