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