1 {-# LANGUAGE Arrows #-}
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.
8 module RCMA.Translator.SortMessage where
10 import qualified Data.Bifunctor as BF
11 import Data.Function (on)
12 import Data.List (groupBy)
17 import RCMA.Translator.Controller
18 import RCMA.Translator.Message
19 import RCMA.Translator.Note
21 sortRawMessages :: [(Frames, RawMessage)]
22 -> ([(Frames,Message)], [(Frames,RawMessage)])
23 sortRawMessages = sortRawMessages' ([],[])
24 where sortRawMessages' r [] = r
25 sortRawMessages' (m, rm) (x@(n,xm):xs)
26 | isNothing nm = sortRawMessages' (m, x:rm) xs
27 | otherwise = sortRawMessages' ((n,fromJust nm) :m, rm) xs
28 where nm = fromRawMessage xm
30 -- Direct each message to a specific channel.
31 -- /!\ To be modified.
32 sortChannel :: [Message] -> [(Int,[Message])]
33 sortChannel = map ((,) <$> (fst . head) <*> (map snd))
34 . groupBy ((==) `on` fst) . map sortChannel'
35 where sortChannel' :: Message -> (Int, Message)
36 sortChannel' m = let c = getChannel m in (c,m)
38 -- NoteOn messages are on the right, other Control messages are on the
39 -- left. For now we throw away NoteOff messages.
40 sortNotes :: [(Frames, Message)]
41 -> ([(Frames,Message)], [(Frames,Message)])
42 sortNotes = sortNotes' ([],[])
43 where sortNotes' r [] = r
44 sortNotes' (n, c) (x@(_,m):xs)
45 | isNoteOn m = sortNotes' (x:n, c) xs
46 | isNoteOff m = sortNotes' (n,c) xs
47 | isControl m = sortNotes' (n,x:c) xs
48 | otherwise = sortNotes' (n,c) xs
50 -- Note messages are converted to PlayHeads
51 convertMessages :: ([(Frames,Message)], [(Frames,Message)])
52 -> ([(Frames,Note)], [(Frames,Controller)])
53 convertMessages = proc (notes, ctrl) -> do
54 notes' <- arr $ map (BF.second messageToNote) -< notes
55 ctrl' <- arr $ map (BF.second messageToController) -< ctrl
56 returnA -< (notes', ctrl')