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')