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           Data.Ratio
  15 import           FRP.Yampa
  16 import           RMCA.Semantics
  17 import           RMCA.Translator.Controller
  18 import           RMCA.Translator.Message
  19 import           RMCA.Translator.Note
  20
  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
  29
  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)
  37
  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
  49
  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')