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           RMCA.Semantics
  15 import           RMCA.Translator.Message
  16 import           RMCA.Translator.Note
  17
  18 sortRawMessages :: [(Frames, RawMessage)]
  19                 -> ([(Frames,Message)], [(Frames,RawMessage)])
  20 sortRawMessages = sortRawMessages' ([],[])
  21   where sortRawMessages' r [] = r
  22         sortRawMessages' (m, rm) (x@(n,xm):xs)
  23           | isNothing nm = sortRawMessages' (m, x:rm) xs
  24           | otherwise = sortRawMessages' ((n,fromJust nm) :m, rm) xs
  25           where nm = fromRawMessage xm
  26
  27 -- Direct each message to a specific channel.
  28 -- /!\ To be modified.
  29 sortChannel :: [Message] -> [(Int,[Message])]
  30 sortChannel = map ((,) <$> (fst . head) <*> map snd)
  31               . groupBy ((==) `on` fst) . map sortChannel'
  32   where sortChannel' :: Message -> (Int, Message)
  33         sortChannel' m = let c = getChannel m in (c,m)
  34
  35 -- NoteOn messages are on the right, other Control messages are on the
  36 -- left. For now we throw away NoteOff messages.
  37 sortNotes :: [(Frames, Message)]
  38           -> ([(Frames,Message)], [(Frames,Message)])
  39 sortNotes = sortNotes' ([],[])
  40   where sortNotes' r [] = r
  41         sortNotes' (n, c) (x@(_,m):xs)
  42           | isNoteOn m = sortNotes' (x:n, c) xs
  43           | isNoteOff m = sortNotes' (n,c) xs
  44           | isControl m = sortNotes' (n,x:c) xs
  45           | otherwise = sortNotes' (n,c) xs
  46
  47 -- Note messages are converted to PlayHeads
  48 convertMessages :: [(Frames,Message)] -> [(Frames,Note)]
  49 convertMessages = map (BF.second messageToNote)