src/RMCA/Layer/LayerConf.hs

   1 {-# LANGUAGE Arrows, TupleSections #-}
   2
   3 module RMCA.Layer.LayerConf where
   4
   5 import Data.IntMap             (IntMap)
   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 import RMCA.Translator.Message
  13
  14 -- | Datatype representing dynamically modifiable characteristics for a layer.
  15 data DynLayerConf = DynLayerConf { layerBeat :: Rational
  16                                  , relPitch  :: RelPitch
  17                                  , strength  :: Strength
  18                                  } deriving (Show, Read, Eq)
  19
  20 -- | Datatype representing statically modifiable characteristics for a layer.
  21 data StaticLayerConf = StaticLayerConf { beatsPerBar :: BeatsPerBar
  22                                        , repeatCount :: Maybe Int
  23                                        } deriving (Show, Read, Eq)
  24
  25 -- | Datatype containing informations useful for the synthetizer.
  26 data SynthConf = SynthConf { volume     :: Int
  27                            , instrument :: InstrumentNo
  28                            } deriving (Show, Read, Eq)
  29
  30 synthMessage :: Int -> SynthConf -> [Message]
  31 synthMessage chan (SynthConf { volume = v
  32                              , instrument = i
  33                              }) = [ Volume (mkChannel chan) v
  34                                   , Instrument (mkChannel chan) (mkProgram i)
  35                                   ]
  36
  37 type LayerConf = (StaticLayerConf, DynLayerConf, SynthConf)
  38
  39 dynConf :: LayerConf -> DynLayerConf
  40 dynConf (_,d,_) = d
  41
  42 staticConf :: LayerConf -> StaticLayerConf
  43 staticConf (s,_,_) = s
  44
  45 synthConf :: LayerConf -> SynthConf
  46 synthConf (_,_,s) = s
  47
  48 layerMetronome :: StaticLayerConf
  49                -> SF (Event AbsBeat, DynLayerConf) (Event BeatNo)
  50 layerMetronome (StaticLayerConf { beatsPerBar = bpb
  51                                 }) =
  52   proc (eb, DynLayerConf { layerBeat = r
  53                          }) -> do
  54     ewbno <- accumFilter (\_ (ab,r) -> ((),selectBeat (ab,r))) () -< (,r) <$> eb
  55     accumBy (flip nextBeatNo) 1 -< ewbno `tag` bpb
  56       where selectBeat (absBeat, layBeat) =
  57               maybeIf ((absBeat - 1) `mod`
  58                         floor (fromIntegral maxAbsBeat * layBeat) == 0)
  59
  60 getDefaultLayerConfRV :: IO (ReactiveFieldReadWrite IO LayerConf)
  61 getDefaultLayerConfRV = newCBMVarRW defaultLayerConf
  62
  63 defaultLayerConf :: LayerConf
  64 defaultLayerConf = (defaultStaticLayerConf,defaultDynLayerConf,defaultSynthConf)
  65
  66 defaultStaticLayerConf :: StaticLayerConf
  67 defaultStaticLayerConf = StaticLayerConf { beatsPerBar = 4
  68                                          , repeatCount = Nothing
  69                                          }
  70 defaultDynLayerConf :: DynLayerConf
  71 defaultDynLayerConf = DynLayerConf { layerBeat = 1 % 4
  72                                    , relPitch = 0
  73                                    , strength = 1
  74                                    }
  75 defaultSynthConf :: SynthConf
  76 defaultSynthConf = SynthConf { volume = 127
  77                              , instrument = 0
  78                              }