Reactogon/Translator/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) $
  24   proc _ -> do
  25     returnA -< M.empty
  26
  27   {-mainSF-}
  28
  29 initialize :: MVar EventQueue -> IO EventQueue
  30 initialize inRef = takeMVar inRef
  31
  32 sensing :: MVar ClientState
  33         -> MVar EventQueue
  34         -> Bool
  35         -> IO (DTime, Maybe EventQueue)
  36 sensing clientRef inRef _ = do
  37   print "Reading."
  38   client <- readMVar clientRef
  39   input <- takeMVar inRef
  40   let (NFrames buff) = buffSize client
  41       dt = (fromIntegral $ rate client)/(fromIntegral buff)
  42   print "Done reading."
  43   return (dt, Just input)
  44
  45 actuation :: MVar EventQueue
  46           -> Bool
  47           -> EventQueue
  48           -> IO Bool
  49 actuation outRef _ output = do
  50   print "Actuating."
  51   out <- takeMVar outRef
  52   putMVar outRef $ M.union output out
  53   print "Done actuating."
  54   return True
  55
  56 mainSF :: SF EventQueue EventQueue
  57 mainSF = identity