]> Git — Sourcephile - tmp/julm/arpeggigon.git/blob - src/RMCA/Layer/Layer.hs
Solved memory leak issue when Jack is connected. There still is a leak when Jack...
[tmp/julm/arpeggigon.git] / src / RMCA / Layer / Layer.hs
1 {-# LANGUAGE Arrows, TupleSections #-}
2
3 module RMCA.Layer.Layer where
4
5 import Data.CBMVar
6 import Data.ReactiveValue
7 import FRP.Yampa
8 import RMCA.Global.Clock
9 import RMCA.Semantics
10
11 -- Data representing the state of a layer. It is updated continuously.
12 data Layer = Layer { relTempo :: Double
13 , relPitch :: RelPitch
14 , strength :: Strength
15 , beatsPerBar :: BeatsPerBar
16 , volume :: Int
17 } deriving (Show,Read)
18
19 layerTempo :: SF (Tempo, Layer) LTempo
20 layerTempo = proc (t, Layer { relTempo = r }) ->
21 returnA -< floor $ r * fromIntegral t
22
23 -- /!\ To be changed in the initialization of the bpb /!\
24 layerMetronome :: SF (Tempo, Layer) (Event BeatNo)
25 layerMetronome = proc (t,l@Layer { beatsPerBar = bpb }) -> do
26 eb <- metronome <<< layerTempo -< (t,l)
27 accumBy (\bn bpb -> nextBeatNo bpb bn) 1 -< eb `tag` bpb
28
29 layerRV :: CBMVar Layer -> ReactiveFieldReadWrite IO Layer
30 layerRV mvar = ReactiveFieldReadWrite setter getter notifier
31 where setter :: Layer -> IO ()
32 setter = writeCBMVar mvar
33
34 getter :: IO Layer
35 getter = readCBMVar mvar
36
37 notifier :: IO () -> IO ()
38 notifier = installCallbackCBMVar mvar
39
40 getDefaultLayerRV :: IO (ReactiveFieldReadWrite IO Layer)
41 getDefaultLayerRV = layerRV <$> newCBMVar defaultLayer
42
43 defaultLayer :: Layer
44 defaultLayer = Layer { relTempo = 1
45 , relPitch = 0
46 , strength = 1
47 , beatsPerBar = 4
48 , volume = 127
49 }