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.Layer.Layer
  11 import           RMCA.Semantics
  12 import           RMCA.Translator.Controller
  13 import           RMCA.Translator.Message
  14 import           RMCA.Translator.Note
  15 import           RMCA.Translator.SortMessage
  16
  17 -- Uses function defined in SortMessage. This is a pure function and
  18 -- it might not need to be a signal function.
  19 readMessages' :: [(Frames,RawMessage)]
  20               -> ([(Frames,Note)], [(Frames,Controller)], [(Frames,RawMessage)])
  21 readMessages' = proc r -> do
  22   (mes, raw) <- sortRawMessages -< r
  23   (notes, ctrl) <- convertMessages <<< sortNotes -< mes
  24   returnA -< (notes, ctrl, raw)
  25
  26 readMessages :: SF [(Frames, RawMessage)]
  27                 ([(Frames,Note)], [(Frames,Controller)], [(Frames,RawMessage)])
  28 readMessages = arr readMessages'
  29
  30 gatherMessages' :: LTempo
  31                 -> SampleRate
  32                 -> Int
  33                 -> ([(Frames,Note)],[(Frames,Controller)],[(Frames,RawMessage)])
  34                 -> [(Frames, RawMessage)]
  35 gatherMessages' layTempo sr chan = proc (notes, ctrl, raw) -> do
  36   notes'   <- concat <<< map (noteToMessages layTempo sr chan) -< notes
  37   ctrl'    <- map (BF.second controllerToMessages)             -< ctrl
  38   rawNotes <- map (BF.second toRawMessage)                     -< notes'
  39   rawCtrl  <- map (BF.second toRawMessage)                     -< ctrl'
  40   returnA  -< rawNotes ++ rawCtrl ++ raw
  41
  42 gatherMessages :: SF
  43   ( LTempo, SampleRate, Int
  44   , ([(Frames,Note)],[(Frames,Controller)],[(Frames,RawMessage)]))
  45   [(Frames, RawMessage)]
  46 gatherMessages = arr $ uncurry4 gatherMessages'