RCMA/Translator/Jack.hs

   1 {-# LANGUAGE Arrows, PartialTypeSignatures #-}
   2
   3 -- Contains all the information and functions necessary to run a Jack
   4 -- port and exchange information through reactive values and Yampa.
   5 module RCMA.Translator.Jack where
   6
   7 import qualified Control.Monad.Exception.Synchronous as Sync
   8 import qualified Control.Monad.Trans.Class           as Trans
   9 import qualified Data.EventList.Absolute.TimeBody    as EventListAbs
  10 import           Data.ReactiveValue
  11 import qualified Foreign.C.Error                     as E
  12 import           RCMA.Translator.Message
  13 import           RCMA.Translator.RV
  14 import qualified Sound.JACK                          as Jack
  15 import qualified Sound.JACK.MIDI                     as JMIDI
  16 import Hails.Yampa
  17
  18 rcmaName :: String
  19 rcmaName = "RCMA"
  20
  21 inPortName :: String
  22 inPortName = "input"
  23
  24 outPortName :: String
  25 outPortName = "output"
  26
  27 -- Starts a default client with an input and an output port. Doesn't
  28 -- do anything as such.
  29 jackSetup :: IO ()
  30 jackSetup = Jack.handleExceptions $ do
  31   toProcessQueue <- toProcess <$> newMVar []
  32   let toProcess = toProcess toProcessMVar
  33   Jack.withClientDefault rcmaName $ \client ->
  34   Jack.withPort client outPortName $ \output ->
  35   Jack.withPort client inPortName  $ \input ->
  36   jackRun client input output (jackCallBack client input output)
  37
  38 -- Loop that does nothing except setting up a callback function
  39 -- (called when Jack is ready to take new inputs).
  40 jackRun :: Jack.Client
  41         -> JMIDI.Port Jack.Input
  42         -> JMIDI.Port Jack.Output
  43         -> _
  44         -> _
  45 jackRun client input output callback =
  46   Jack.withProcess client callback $ do
  47   Trans.lift $ putStrLn $ "Started " ++ rcmaName
  48   Trans.lift $ Jack.waitForBreak
  49
  50 -- The callback function. It pumps value out of the input port, mix
  51 -- them with value coming from the machine itself and stuff them into
  52 -- the output port. When this function is not running, events are
  53 -- processed.
  54 jackCallBack :: _
  55 jackCallBack client input output toProcessQueue
  56   boardInRV
  57   nframes@(Jack.NFrames nframesInt) = do
  58   let inMIDIRV = inMIDIEvent input nframes
  59       outMIDIRV = outMIDIEvent output nframes
  60   -- This gets the sample rate of the client and the last frame number
  61   -- it processed. We then use it to calculate the current absolute time
  62   sr <- Trans.lift $ Jack.getSampleRate client
  63   (Jack.NFrames lframeInt) <- Trans.lift $ Jack.lastFrameTime client
  64   -- We write the content of the input buffer to the input of a
  65   -- translation signal function.
  66   (inRaw, outPure) <- yampaReactiveDual [] transFromRaw -- TODO Move in a
  67                              -- separate function
  68   inMIDIRV =:> inRaw
  69   board <- reactiveValueRead boardIn
  70   outMIDI <- reactiveValueRead outPure
  71
  72   -- We translate all signals to be sent into low level signals and
  73   -- write them to the output buffer.
  74   (inPure, outRaw) <- yampaReactiveDual [] transToRaw
  75   reactiveValueWrite inPure (board ++ outMIDI)
  76   outRaw =:> outMIDIRV
  77   return ()