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