1 {-# LANGUAGE FlexibleContexts, MultiParamTypeClasses, TupleSections #-}
3 module RMCA.GUI.LayerSettings where
5 import qualified Data.IntMap as M
7 import Data.ReactiveValue
10 import Graphics.UI.Gtk
11 import Graphics.UI.Gtk.Reactive
12 import Graphics.UI.Gtk.Reactive.ToggleButton
14 import RMCA.GUI.NoteSettings
15 import RMCA.Layer.LayerConf
18 import RMCA.Translator.Instruments
19 import RMCA.Translator.Message
21 floatConv :: (ReactiveValueReadWrite a b m,
22 Real c, Real b, Fractional c, Fractional b) =>
23 a -> ReactiveFieldReadWrite m c
24 floatConv = liftRW $ bijection (realToFrac, realToFrac)
26 mkVScale :: String -> Adjustment -> IO (HBox,VScale)
28 hBox <- hBoxNew False 10
29 boxLabel <- labelNew (Just s)
30 labelSetAngle boxLabel 90
31 boxPackStart hBox boxLabel PackNatural 0
32 boxScale <- vScaleNew adj
33 boxPackStart hBox boxScale PackNatural 0
34 return (hBox,boxScale)
36 layerSettings :: IO ( VBox
37 , MCBMVar StaticLayerConf
38 , MCBMVar DynLayerConf
42 ------------------------------------------------------------------------------
44 ------------------------------------------------------------------------------
45 layerSettingsVBox <- vBoxNew True 10
46 layerSettingsBox <- hBoxNew True 10
47 boxPackStart layerSettingsVBox layerSettingsBox PackNatural 0
50 layBeatBox <- hBoxNew False 10
51 layBeatCombo <- comboBoxNewText
52 layBeatIndex <- mapM (\(str,dur) -> do i <- comboBoxAppendText layBeatCombo
54 return (dur,i)) noteList'
55 comboBoxSetActive layBeatCombo 0
57 fromMaybe (error "In indexToDur: failed \
58 \to find the correct \
60 \selected index.") $ lookup i $ map swap layBeatIndex
62 fromMaybe (error "In durToIndex: \
65 \for the duration.") $ lookup d layBeatIndex
66 layBeatRV = bijection (indexToDur, durToIndex) `liftRW`
67 comboBoxIndexRV layBeatCombo
68 layBeatLabel <- labelNew (Just "Layer beat"){-=<<
69 (`lookup` symbolString) <$> reactiveValueRead layBeatRV-}
70 --labelSetAngle layBeatLabel 90
71 labelSetLineWrap layBeatLabel True
72 let layBeatLabelRV = labelTextReactive layBeatLabel
73 boxPackStart layerSettingsBox layBeatBox PackNatural 0
74 auxLayBeatBox <- vBoxNew False 0
75 boxPackEnd layBeatBox auxLayBeatBox PackRepel 0
76 boxPackStart auxLayBeatBox layBeatLabel PackRepel 0
77 boxPackStart auxLayBeatBox layBeatCombo PackNatural 0
79 layVolumeAdj <- adjustmentNew 100 0 100 1 1 1
80 (layVolumeBox,layVolumeScale) <- mkVScale "Volume" layVolumeAdj
81 boxPackStart layerSettingsBox layVolumeBox PackNatural 0
82 (Requisition layVolW layVolH) <- widgetSizeRequest layVolumeScale
83 widgetSetSizeRequest layerSettingsBox layVolW (max layVolH 100)
84 scaleSetDigits layVolumeScale 0
86 layTempoAdj <- adjustmentNew 1 0 2 0.1 0.1 1
87 (layTempoBox, layTempoScale) <- mkVScale "Layer tempo" layTempoAdj
88 boxPackStart layerSettingsBox layTempoBox PackNatural 0
90 strAdj <- adjustmentNew 0.8 0 2 0.1 0.1 0
91 (strBox, layStrengthScale) <- mkVScale "Strength" strAdj
92 boxPackStart layerSettingsBox strBox PackNatural 0
94 bpbBox <- vBoxNew False 0
95 boxPackStart layerSettingsBox bpbBox PackNatural 0
96 bpbLabel <- labelNew (Just "Beat per bar")
97 labelSetLineWrap bpbLabel True
98 bpbAdj <- adjustmentNew 4 1 16 1 1 0
99 bpbButton <- spinButtonNew bpbAdj 1 0
100 auxBpbBox <- vBoxNew False 0
101 centerAl <- alignmentNew 0.5 0.5 0 0
102 containerAdd auxBpbBox centerAl
103 boxPackStart bpbBox auxBpbBox PackRepel 0
104 boxPackStart auxBpbBox bpbLabel PackGrow 0
105 boxPackStart auxBpbBox bpbButton PackGrow 0
107 repeatBox <- vBoxNew False 0
108 boxPackStart layerSettingsBox repeatBox PackNatural 0
109 repeatLabel <- labelNew (Just "Repeat count")
110 labelSetLineWrap repeatLabel True
111 repeatAdj <- adjustmentNew 0 0 100 1 1 0
112 repeatButton <- spinButtonNew repeatAdj 1 0
113 auxRepeatBox <- vBoxNew False 0
114 centerAl' <- alignmentNew 0.5 0.5 0 0
115 containerAdd auxRepeatBox centerAl'
116 boxPackStart repeatBox auxRepeatBox PackRepel 0
117 boxPackStart auxRepeatBox repeatLabel PackGrow 0
118 boxPackStart auxRepeatBox repeatButton PackGrow 0
119 repeatCheckButton <- checkButtonNewWithLabel "Unable repeat count"
120 boxPackStart auxRepeatBox repeatCheckButton PackGrow 0
122 instrumentCombo <- comboBoxNewText
123 instrumentIndex <- mapM (\(ind,ins) ->
124 do i <- comboBoxAppendText instrumentCombo $
126 return (i, ind)) instrumentList
127 comboBoxSetActive instrumentCombo 0
128 boxPackStart layerSettingsVBox instrumentCombo PackNatural 10
129 ------------------------------------------------------------------------------
131 ------------------------------------------------------------------------------
132 let indexToInstr i = fromMaybe (error "Can't get the selected instrument.") $
133 lookup i instrumentIndex
135 fromMaybe (error "Can't retrieve the index for the instrument.") $
136 lookup ins $ map swap instrumentIndex
137 instrumentComboRV = bijection (indexToInstr, instrToIndex) `liftRW`
138 comboBoxIndexRV instrumentCombo
139 layVolumeRV = liftRW (bijection (floor, fromIntegral)) $
140 scaleValueReactive layVolumeScale
142 synthMCBMVar <- newMCBMVar
143 =<< reactiveValueRead (liftR2 SynthConf layVolumeRV instrumentComboRV)
145 layPitchRV <- newCBMVarRW 1
146 let strengthRV = floatConv $ scaleValueReactive layStrengthScale
148 dynMCBMVar <- newMCBMVar
149 =<< reactiveValueRead (liftR3 DynLayerConf layBeatRV layPitchRV strengthRV)
151 let bpbRV = spinButtonValueIntReactive bpbButton
152 repeatCheckRV = toggleButtonActiveReactive repeatCheckButton
153 repeatRV' = spinButtonValueIntReactive repeatButton
154 repeatRV = liftR2 (\act r -> if act then Just r else Nothing)
155 repeatCheckRV repeatRV'
156 reactiveValueWrite repeatCheckRV False
157 --reactiveValueOnCanRead repeatCheckRV $ do
159 statMCBMVar <- newMCBMVar
160 =<< reactiveValueRead (liftR2 StaticLayerConf bpbRV repeatRV)
162 reactiveValueOnCanRead dynMCBMVar $ postGUIAsync $ do
163 nDyn <- reactiveValueRead dynMCBMVar
164 reactiveValueWriteOnNotEq layBeatRV $ layerBeat nDyn
165 reactiveValueWriteOnNotEq layPitchRV $ relPitch nDyn
166 reactiveValueWriteOnNotEq strengthRV $ strength nDyn
168 reactiveValueOnCanRead statMCBMVar $ postGUIAsync $ do
169 nStat <- reactiveValueRead statMCBMVar
170 reactiveValueWriteOnNotEq bpbRV $ beatsPerBar nStat
172 reactiveValueOnCanRead synthMCBMVar $ do
173 nSynth <- reactiveValueRead synthMCBMVar
174 reactiveValueWriteOnNotEq layVolumeRV $ volume nSynth
175 reactiveValueWriteOnNotEq instrumentComboRV $ instrument nSynth
177 syncRightOnLeftWithBoth (\nt ol -> ol { layerBeat = nt })
179 syncRightOnLeftWithBoth (\np ol -> ol { relPitch = np })
180 layPitchRV dynMCBMVar
181 syncRightOnLeftWithBoth (\ns ol -> ol { strength = ns })
182 strengthRV dynMCBMVar
183 syncRightOnLeftWithBoth (\nb ol -> ol { beatsPerBar = nb})
185 syncRightOnLeftWithBoth (\nv ol -> ol { volume = nv })
186 layVolumeRV synthMCBMVar
187 syncRightOnLeftWithBoth (\ni ol -> ol { instrument = ni })
188 instrumentComboRV synthMCBMVar
191 reactiveValueOnCanRead layVolumeRV $ do
192 vol <- reactiveValueRead layVolumeRV
193 chan <- reactiveValueRead chanRV
194 let vol' = floor ((fromIntegral vol / 100) * 127)
195 reactiveValueAppend boardQueue ([],[Volume (mkChannel chan) vol'])
197 return (layerSettingsVBox, statMCBMVar, dynMCBMVar, synthMCBMVar)