]> Git — Sourcephile - tmp/julm/arpeggigon.git/blob - RMCA/Unknown/Reactimation.hs
Hexagonal shape.
[tmp/julm/arpeggigon.git] / RMCA / Unknown / 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