RCMA/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 Reactogon.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           Reactogon.Semantics
  16 import           Reactogon.Translator.Message
  17
  18 -- TEMPORARY
  19 data Controller = Lol
  20 --
  21
  22 sortRawMessages :: [RawMessage] -> ([Message], [RawMessage])
  23 sortRawMessages = sortRawMessages' ([],[])
  24   where sortRawMessages' r [] = r
  25         sortRawMessages' (m, rm) (x:xs)
  26           | isNothing nm = sortRawMessages' (m, x:rm) xs
  27           | otherwise = sortRawMessages' ((fromJust nm) :m, rm) xs
  28           where nm = fromRawMessage x
  29
  30 -- Direct each message to a specific channel.
  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 :: [Message] -> ([Message], [Message])
  40 sortNotes = sortNotes' ([],[])
  41   where sortNotes' r [] = r
  42         sortNotes' (n, c) (x:xs)
  43           | isNoteOn x = sortNotes' (x:n, c) xs
  44           | isNoteOff x = sortNotes' (n,c) xs
  45           | isControl x = sortNotes' (n,x:c) xs
  46           | otherwise = sortNotes' (n,c) xs
  47 {-
  48 sortMessages :: [RawMessage] -> ([Note], [Control], [RawMessage])
  49 sortMessages = (\((a,b),c) -> (a,b,c)) . BF.first sortNotes . sortRawMessages
  50 -}
  51
  52 -- Note messages are converted to PlayHeads
  53 sortMessages :: SF ([Message], [Message]) ([Note], [Controller])
  54 sortMessages = proc (notes, ctrl) -> do
  55   notes' <- arr $ map convertNotes   -< notes
  56   ctrl'  <- arr $ map convertControl -< ctrl
  57   returnA -< (notes', ctrl')
  58
  59 -- /!\ Unsafe function that shouldn't be exported.
  60 convertNotes :: Message -> Note
  61 convertNotes = undefined
  62
  63 -- /!\ Unsafe function that shouldn't be exported.
  64 convertControl :: Message -> Controller
  65 convertControl _ = Lol
  66
  67 gatherMessages :: ([Note], [Controller], [RawMessage]) -> [Message]
  68 gatherMessages ([], [], []) = []
  69 gatherMessages _ = undefined
  70
  71 readMessages :: SF ([RawMessage]) ([Note], [Controller], [RawMessage])
  72 readMessages = undefined