]> Git — Sourcephile - tmp/julm/arpeggigon.git/blob - src/RMCA/Layer/LayerConf.hs
Greying out for static conf works.
[tmp/julm/arpeggigon.git] / 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 }