Reactogon/Reactimation.hs

   1 {-# LANGUAGE Arrows #-}
   2
   3 module Reactimation where
   4
   5 import Data.Map ( Map
   6                 , empty
   7                 )
   8 import qualified Data.Map as M
   9 import FRP.Yampa
  10 import Control.Concurrent.MVar
  11 import Sound.JACK ( NFrames(NFrames)
  12                   )
  13
  14 import MIDI
  15 import ClientState
  16 --import Arpeggiated
  17
  18 mainReact :: MVar EventQueue
  19           -> MVar EventQueue
  20           -> MVar ClientState
  21           -> IO ()
  22 mainReact inRef outRef clientRef =
  23   reactimate (initialize inRef) (sensing clientRef inRef) (actuation outRef) mainSF
  24
  25 initialize :: MVar EventQueue -> IO EventQueue
  26 initialize inRef = readMVar inRef
  27
  28 sensing :: MVar ClientState
  29         -> MVar EventQueue
  30         -> Bool
  31         -> IO (DTime, Maybe EventQueue)
  32 sensing clientRef inRef _ = do
  33   client <- readMVar clientRef
  34   input <- takeMVar inRef
  35   let (NFrames buff) = buffSize client
  36       dt = (fromIntegral $ rate client)/(fromIntegral buff)
  37   return (dt, Just input)
  38
  39 actuation :: MVar EventQueue
  40           -> Bool
  41           -> EventQueue
  42           -> IO Bool
  43 actuation outRef _ output = do
  44   out <- takeMVar outRef
  45   putMVar outRef $ M.union output out
  46   return True
  47
  48 mainSF :: SF EventQueue EventQueue
  49 mainSF = identity