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