src/RMCA/Layer/Layer.hs

   1 {-# LANGUAGE Arrows, TupleSections #-}
   2
   3 module RMCA.Layer.Layer where
   4
   5 import Data.CBMVar
   6 import Data.Ratio
   7 import Data.ReactiveValue
   8 import FRP.Yampa
   9 import RMCA.Auxiliary
  10 import RMCA.Global.Clock
  11 import RMCA.Semantics
  12
  13 -- Data representing the state of a layer. It is updated continuously.
  14 data Layer = Layer { layerBeat   :: Rational
  15                    , relPitch    :: RelPitch
  16                    , strength    :: Strength
  17                    , beatsPerBar :: BeatsPerBar
  18                    , volume      :: Int
  19                    } deriving (Show,Read,Eq)
  20
  21 layerMetronome :: SF (Event AbsBeat, Layer) (Event BeatNo)
  22 layerMetronome = proc (eb, Layer { layerBeat = r
  23                                  , beatsPerBar = bpb }) -> do
  24   ewbno <- accumFilter (\_ (ab,r) -> ((),selectBeat (ab,r))) () -< (,r) <$> eb
  25   accumBy (flip nextBeatNo) 1 -< ewbno `tag` bpb
  26   where selectBeat (absBeat, layBeat) =
  27           maybeIf ((absBeat - 1) `mod` floor (fromIntegral maxAbsBeat * layBeat) == 0)
  28 {-
  29 -- /!\ To be changed in the initialization of the bpb /!\
  30 layerMetronome :: SF (Tempo, Layer) (Event BeatNo)
  31 layerMetronome = proc (t,l@Layer { beatsPerBar = bpb }) -> do
  32   eb <- metronome <<< layerTempo -< (t,l)
  33   accumBy (flip nextBeatNo) 1 -< eb `tag` bpb
  34 -}
  35 layerRV :: CBMVar Layer -> ReactiveFieldReadWrite IO Layer
  36 layerRV mvar = ReactiveFieldReadWrite setter getter notifier
  37   where setter :: Layer ->  IO ()
  38         setter = writeCBMVar mvar
  39
  40         getter :: IO Layer
  41         getter = readCBMVar mvar
  42
  43         notifier :: IO () -> IO ()
  44         notifier = installCallbackCBMVar mvar
  45
  46 getDefaultLayerRV :: IO (ReactiveFieldReadWrite IO Layer)
  47 getDefaultLayerRV = layerRV <$> newCBMVar defaultLayer
  48
  49 defaultLayer :: Layer
  50 defaultLayer = Layer { layerBeat   = 1 % 4
  51                      , relPitch    = 0
  52                      , strength    = 1
  53                      , beatsPerBar = 4
  54                      , volume      = 127
  55                      }