src/RMCA/Layer/LayerConf.hs

   1 {-# LANGUAGE Arrows, TupleSections #-}
   2
   3 module RMCA.Layer.LayerConf where
   4
   5 import Data.Ratio
   6 import Data.ReactiveValue
   7 import FRP.Yampa
   8 import RMCA.Auxiliary
   9 import RMCA.Global.Clock
  10 import RMCA.Semantics
  11
  12 -- | Datatype representing dynamically modifiable characteristics for a layer.
  13 data DynLayerConf = DynLayerConf { layerBeat :: Rational
  14                                  , relPitch  :: RelPitch
  15                                  , strength  :: Strength
  16                                  } deriving (Show, Read, Eq)
  17
  18 -- | Datatype representing statically modifiable characteristics for a layer.
  19 data StaticLayerConf = StaticLayerConf { beatsPerBar :: BeatsPerBar
  20                                        } deriving (Show, Read, Eq)
  21
  22 -- | Datatype containing informations useful for the synthetizer.
  23 data SynthConf = SynthConf { volume     :: Int
  24                            , instrument :: InstrumentNo
  25                            } deriving (Show, Read, Eq)
  26
  27 type LayerConf = (StaticLayerConf, DynLayerConf, SynthConf)
  28
  29 dynConf :: LayerConf -> DynLayerConf
  30 dynConf (_,d,_) = d
  31
  32 staticConf :: LayerConf -> StaticLayerConf
  33 staticConf (s,_,_) = s
  34
  35 synthConf :: LayerConf -> SynthConf
  36 synthConf (_,_,s) = s
  37
  38 layerMetronome :: StaticLayerConf
  39                -> SF (Event AbsBeat, DynLayerConf) (Event BeatNo)
  40 layerMetronome (StaticLayerConf { beatsPerBar = bpb
  41                                 }) =
  42   proc (eb, DynLayerConf { layerBeat = r
  43                          }) -> do
  44     ewbno <- accumFilter (\_ (ab,r) -> ((),selectBeat (ab,r))) () -< (,r) <$> eb
  45     accumBy (flip nextBeatNo) 1 -< ewbno `tag` bpb
  46       where selectBeat (absBeat, layBeat) =
  47               maybeIf ((absBeat - 1) `mod`
  48                         floor (fromIntegral maxAbsBeat * layBeat) == 0)
  49
  50 getDefaultLayerConfRV :: IO (ReactiveFieldReadWrite IO LayerConf)
  51 getDefaultLayerConfRV = newCBMVarRW defaultLayerConf
  52
  53 defaultLayerConf :: LayerConf
  54 defaultLayerConf = (defaultStaticLayerConf,defaultDynLayerConf,defaultSynthConf)
  55
  56 defaultStaticLayerConf :: StaticLayerConf
  57 defaultStaticLayerConf = StaticLayerConf { beatsPerBar = 4
  58                                          }
  59 defaultDynLayerConf :: DynLayerConf
  60 defaultDynLayerConf = DynLayerConf { layerBeat = 1 % 4
  61                                    , relPitch = 0
  62                                    , strength = 1
  63                                    }
  64 defaultSynthConf :: SynthConf
  65 defaultSynthConf = SynthConf { volume = 127
  66                              , instrument = 0
  67                              }