]> Git — Sourcephile - tmp/julm/arpeggigon.git/blob - src/RMCA/Translator/SortMessage.hs
Better note selection.
[tmp/julm/arpeggigon.git] / src / RMCA / Translator / SortMessage.hs
1 {-# LANGUAGE Arrows #-}
2
3 -- The idea is that the stream of data coming from the MIDI input port
4 -- will be sorted in three categories: note on events, controller
5 -- events and other events. The latter will be transmitted as is
6 -- through the whole systems.
7
8 module RMCA.Translator.SortMessage where
9
10 import qualified Data.Bifunctor as BF
11 import Data.Function (on)
12 import Data.List (groupBy)
13 import Data.Maybe
14 import FRP.Yampa
15 import RMCA.Semantics
16 import RMCA.Translator.Controller
17 import RMCA.Translator.Message
18 import RMCA.Translator.Note
19
20 sortRawMessages :: [(Frames, RawMessage)]
21 -> ([(Frames,Message)], [(Frames,RawMessage)])
22 sortRawMessages = sortRawMessages' ([],[])
23 where sortRawMessages' r [] = r
24 sortRawMessages' (m, rm) (x@(n,xm):xs)
25 | isNothing nm = sortRawMessages' (m, x:rm) xs
26 | otherwise = sortRawMessages' ((n,fromJust nm) :m, rm) xs
27 where nm = fromRawMessage xm
28
29 -- Direct each message to a specific channel.
30 -- /!\ To be modified.
31 sortChannel :: [Message] -> [(Int,[Message])]
32 sortChannel = map ((,) <$> (fst . head) <*> map snd)
33 . groupBy ((==) `on` fst) . map sortChannel'
34 where sortChannel' :: Message -> (Int, Message)
35 sortChannel' m = let c = getChannel m in (c,m)
36
37 -- NoteOn messages are on the right, other Control messages are on the
38 -- left. For now we throw away NoteOff messages.
39 sortNotes :: [(Frames, Message)]
40 -> ([(Frames,Message)], [(Frames,Message)])
41 sortNotes = sortNotes' ([],[])
42 where sortNotes' r [] = r
43 sortNotes' (n, c) (x@(_,m):xs)
44 | isNoteOn m = sortNotes' (x:n, c) xs
45 | isNoteOff m = sortNotes' (n,c) xs
46 | isControl m = sortNotes' (n,x:c) xs
47 | otherwise = sortNotes' (n,c) xs
48
49 -- Note messages are converted to PlayHeads
50 convertMessages :: ([(Frames,Message)], [(Frames,Message)])
51 -> ([(Frames,Note)], [(Frames,Controller)])
52 convertMessages = proc (notes, ctrl) -> do
53 notes' <- arr $ map (BF.second messageToNote) -< notes
54 ctrl' <- arr $ map (BF.second messageToController) -< ctrl
55 returnA -< (notes', ctrl')