Reactogon/Reactogon.hs

   1 module Main where
   2
   3 import qualified MIDI as React
   4
   5 import qualified Sound.JACK as Jack
   6 import qualified Sound.MIDI.Message as MIDI
   7 import qualified Sound.JACK.MIDI as JMIDI
   8 import Data.IORef ( IORef
   9                   , newIORef
  10                   , readIORef
  11                   , writeIORef
  12                   )
  13 import qualified Foreign.C.Error as E
  14 import qualified Data.EventList.Relative.TimeBody as EventList
  15 import qualified Data.EventList.Absolute.TimeBody as EventListAbs
  16 import qualified Data.EventList.Relative.TimeMixed as EventListTM
  17 import qualified Control.Monad.Exception.Synchronous as Sync
  18 import qualified Control.Monad.Trans.Class as Trans
  19
  20 eventLoop :: [(Jack.NFrames,MIDI.T)]
  21 eventLoop = []
  22
  23 reactogonName :: String
  24 reactogonName = "Reactogon"
  25
  26 inPortName :: String
  27 inPortName = "input"
  28
  29 outPortName :: String
  30 outPortName = "output"
  31
  32 fsPortName :: String
  33 fsPortName = "fluidsynth:midi"
  34
  35 main = do
  36   stateRef <- newIORef eventLoop
  37   Jack.handleExceptions $
  38     Jack.withClientDefault reactogonName $ \client ->
  39     Jack.withPort client outPortName $ \output -> do
  40     Jack.withProcess client (process client stateRef output) $
  41       Jack.withActivation client $ do
  42         Jack.connect client (reactogonName ++ ":" ++ outPortName) fsPortName
  43         Trans.lift $ putStrLn $ "Started " ++ reactogonName
  44         Trans.lift $ Jack.waitForBreak
  45
  46 process ::
  47     Jack.Client ->
  48     IORef [(Jack.NFrames,MIDI.T)] ->
  49     JMIDI.Port Jack.Output ->
  50     Jack.NFrames ->
  51     Sync.ExceptionalT E.Errno IO ()
  52 process client stateRef output nframes@(Jack.NFrames nframesInt) = do
  53   rate <- Trans.lift $ Jack.getSampleRate client
  54   events <- Trans.lift $ readIORef stateRef
  55   let (processableEvents, futureEvents) =
  56         break (\(Jack.NFrames n,_) ->
  57                  n < floor (fromIntegral nframesInt / fromIntegral rate)) events
  58   Trans.lift $ writeIORef stateRef futureEvents
  59   if null processableEvents
  60     then Trans.lift $ putStrLn "No events in queue."
  61     else JMIDI.writeEventsToPort output nframes $
  62          EventListAbs.mapTime Jack.NFrames $
  63          EventList.toAbsoluteEventList 0 $
  64          EventList.mapTime (\(Jack.NFrames n) -> n) $
  65          EventList.fromPairList processableEvents