src/RMCA/Translator/Translator.hs

   1 {-# LANGUAGE Arrows #-}
   2
   3 module RMCA.Translator.Translator ( readMessages
   4                                   , gatherMessages
   5                                   ) where
   6
   7 import qualified Data.Bifunctor              as BF
   8 import           FRP.Yampa
   9 import           RMCA.Auxiliary.Curry
  10 import           RMCA.Semantics
  11 import           RMCA.Translator.Controller
  12 import           RMCA.Translator.Message
  13 import           RMCA.Translator.Note
  14 import           RMCA.Translator.SortMessage
  15
  16 -- Uses function defined in SortMessage. This is a pure function and
  17 -- it might not need to be a signal function.
  18 readMessages' :: [(Frames,RawMessage)]
  19               -> ([(Frames,Note)], [(Frames,Controller)], [(Frames,RawMessage)])
  20 readMessages' = proc r -> do
  21   (mes, raw) <- sortRawMessages -< r
  22   (notes, ctrl) <- convertMessages <<< sortNotes -< mes
  23   returnA -< (notes, ctrl, raw)
  24
  25 readMessages :: SF [(Frames, RawMessage)]
  26                 ([(Frames,Note)], [(Frames,Controller)], [(Frames,RawMessage)])
  27 readMessages = arr readMessages'
  28
  29 gatherMessages' :: LTempo
  30                 -> SampleRate
  31                 -> Int
  32                 -> ([(Frames,Note)],[(Frames,Controller)],[(Frames,RawMessage)])
  33                 -> [(Frames, RawMessage)]
  34 gatherMessages' layTempo sr chan = proc (notes, ctrl, raw) -> do
  35   notes'   <- concat <<< map (noteToMessages layTempo sr chan) -< notes
  36   ctrl'    <- map (BF.second controllerToMessages)             -< ctrl
  37   rawNotes <- map (BF.second toRawMessage)                     -< notes'
  38   rawCtrl  <- map (BF.second toRawMessage)                     -< ctrl'
  39   returnA  -< rawNotes ++ rawCtrl ++ raw
  40
  41 gatherMessages :: SF
  42   ( LTempo, SampleRate, Int
  43   , ([(Frames,Note)],[(Frames,Controller)],[(Frames,RawMessage)]))
  44   [(Frames, RawMessage)]
  45 gatherMessages = arr $ uncurry4 gatherMessages'