]> Git — Sourcephile - tmp/julm/arpeggigon.git/blob - src/RMCA/Layer/LayerConf.hs
Corrected pragma in Board.hs
[tmp/julm/arpeggigon.git] / 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 getDefaultLayerConfRV :: IO (ReactiveFieldReadWrite IO LayerConf)
48 getDefaultLayerConfRV = newCBMVarRW defaultLayerConf
49
50 defaultLayerConf :: LayerConf
51 defaultLayerConf = (defaultStaticLayerConf,defaultDynLayerConf,defaultSynthConf)
52
53 defaultStaticLayerConf :: StaticLayerConf
54 defaultStaticLayerConf = StaticLayerConf { beatsPerBar = 4
55 , repeatCount = Nothing
56 }
57 defaultDynLayerConf :: DynLayerConf
58 defaultDynLayerConf = DynLayerConf { layerBeat = 1 % 4
59 , relPitch = 0
60 , strength = 1
61 }
62 defaultSynthConf :: SynthConf
63 defaultSynthConf = SynthConf { volume = 127
64 , instrument = 0
65 }