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