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                      }