1 {-# LANGUAGE FlexibleContexts, LambdaCase, MultiParamTypeClasses, TupleSections
4 module RMCA.GUI.LayerSettings where
7 import Data.ReactiveValue
10 import Graphics.UI.Gtk
11 import Graphics.UI.Gtk.Reactive
13 import RMCA.GUI.NoteSettings
14 import RMCA.Layer.Board
15 import RMCA.Layer.LayerConf
17 import RMCA.Translator.Instruments
19 mkVScale :: String -> Adjustment -> IO (HBox,VScale)
21 hBox <- hBoxNew False 10
22 boxLabel <- labelNew (Just s)
23 labelSetAngle boxLabel 90
24 boxPackStart hBox boxLabel PackNatural 0
25 boxScale <- vScaleNew adj
26 boxPackStart hBox boxScale PackNatural 0
27 return (hBox,boxScale)
29 layerSettings :: (ReactiveValueRead isStarted RunStatus IO) =>
30 isStarted -> IO ( VBox
31 , MCBMVar StaticLayerConf
32 , MCBMVar DynLayerConf
35 layerSettings isStartedRV = do
36 ------------------------------------------------------------------------------
38 ------------------------------------------------------------------------------
39 layerSettingsVBox <- vBoxNew True 10
40 layerSettingsBox <- hBoxNew False 0
41 centerSettings <- alignmentNew 0.5 0.5 0 0
42 containerAdd layerSettingsBox centerSettings
43 boxPackStart layerSettingsVBox layerSettingsBox PackNatural 0
46 layBeatBox <- hBoxNew False 10
47 layBeatCombo <- comboBoxNewText
48 layBeatIndex <- mapM (\(str,dur) -> do i <- comboBoxAppendText layBeatCombo
50 return (dur,i)) noteList'
51 comboBoxSetActive layBeatCombo 0
53 fromMaybe (error "In indexToDur: failed \
54 \to find the correct \
56 \selected index.") $ lookup i $ map swap layBeatIndex
58 fromMaybe (error "In durToIndex: \
61 \for the duration.") $ lookup d layBeatIndex
62 layBeatRV = bijection (indexToDur, durToIndex) `liftRW`
63 comboBoxIndexRV layBeatCombo
64 layBeatLabel <- labelNew (Just "Layer beat"){-=<<
65 (`lookup` symbolString) <$> reactiveValueRead layBeatRV-}
66 --labelSetAngle layBeatLabel 90
67 labelSetLineWrap layBeatLabel True
68 --let layBeatLabelRV = labelTextReactive layBeatLabel
69 boxPackStart layerSettingsBox layBeatBox PackRepel 0
70 auxLayBeatBox <- vBoxNew False 0
71 boxPackEnd layBeatBox auxLayBeatBox PackRepel 0
72 boxPackStart auxLayBeatBox layBeatLabel PackRepel 0
73 boxPackStart auxLayBeatBox layBeatCombo PackNatural 0
75 layVolumeAdj <- adjustmentNew 100 0 100 1 1 1
76 (layVolumeBox,layVolumeScale) <- mkVScale "Volume" layVolumeAdj
77 boxPackStart layerSettingsBox layVolumeBox PackRepel 0
78 (Requisition layVolW layVolH) <- widgetSizeRequest layVolumeScale
79 widgetSetSizeRequest layerSettingsBox layVolW (max layVolH 75)
80 scaleSetDigits layVolumeScale 0
82 layTempoAdj <- adjustmentNew 1 0 2 0.1 0.1 1
83 (layTempoBox, layTempoScale) <- mkVScale "Layer tempo" layTempoAdj
84 boxPackStart layerSettingsBox layTempoBox PackNatural 0
86 strAdj <- adjustmentNew 0.8 0 2 0.1 0.1 0
87 (strBox, layStrengthScale) <- mkVScale "Strength" strAdj
88 boxPackStart layerSettingsBox strBox PackRepel 0
90 layerSettingsBox' <- hBoxNew False 10
91 boxPackStart layerSettingsVBox layerSettingsBox' PackNatural 0
92 centerSettings' <- alignmentNew 0 0.5 0 0
93 containerAdd layerSettingsBox' centerSettings'
95 bpbBox <- vBoxNew False 0
96 boxPackStart layerSettingsBox' bpbBox PackRepel 0
97 bpbLabel <- labelNew (Just "Beats per bar")
98 labelSetLineWrap bpbLabel True
99 bpbAdj <- adjustmentNew 4 1 16 1 1 0
100 bpbButton <- spinButtonNew bpbAdj 1 0
101 auxBpbBox <- vBoxNew False 0
102 centerAl <- alignmentNew 0.5 0.5 0 0
103 containerAdd auxBpbBox centerAl
104 boxPackStart bpbBox auxBpbBox PackRepel 0
105 boxPackStart auxBpbBox bpbLabel PackGrow 0
106 boxPackStart auxBpbBox bpbButton PackGrow 0
108 repeatBox <- vBoxNew False 0
109 boxPackStart layerSettingsBox' repeatBox PackRepel 0
110 repeatLabel <- labelNew (Just "Repeat count")
111 labelSetLineWrap repeatLabel True
112 repeatAdj <- adjustmentNew 0 0 (fromIntegral (maxBound :: Int)) 1 1 0
113 repeatButton <- spinButtonNew repeatAdj 1 0
114 auxRepeatBox <- vBoxNew False 0
115 centerAl' <- alignmentNew 0.5 0.5 0 0
116 containerAdd auxRepeatBox centerAl'
117 boxPackStart repeatBox auxRepeatBox PackRepel 0
118 boxPackStart auxRepeatBox repeatLabel PackGrow 0
119 boxPackStart auxRepeatBox repeatButton PackGrow 0
120 repeatCheckButton <- checkButtonNewWithLabel "Unable repeat count"
121 boxPackStart auxRepeatBox repeatCheckButton PackGrow 0
123 instrumentCombo <- comboBoxNewText
124 instrumentIndex <- mapM (\(ind,ins) ->
125 do i <- comboBoxAppendText instrumentCombo $
127 return (i, ind)) instrumentList
128 comboBoxSetActive instrumentCombo 0
129 boxPackStart layerSettingsVBox instrumentCombo PackNatural 10
130 ------------------------------------------------------------------------------
132 ------------------------------------------------------------------------------
133 let indexToInstr i = fromMaybe (error "Can't get the selected instrument.") $
134 lookup i instrumentIndex
136 fromMaybe (error "Can't retrieve the index for the instrument.") $
137 lookup ins $ map swap instrumentIndex
138 instrumentComboRV = bijection (indexToInstr, instrToIndex) `liftRW`
139 comboBoxIndexRV instrumentCombo
140 layVolumeRV = liftRW (bijection (floor, fromIntegral)) $
141 scaleValueReactive layVolumeScale
143 synthMCBMVar <- newMCBMVar
144 =<< reactiveValueRead (liftR2 SynthConf layVolumeRV instrumentComboRV)
146 layPitchRV <- newCBMVarRW 1
147 let strengthRV = floatConv $ scaleValueReactive layStrengthScale
149 dynMCBMVar <- newMCBMVar
150 =<< reactiveValueRead (liftR3 DynLayerConf layBeatRV layPitchRV strengthRV)
152 let bpbRV = spinButtonValueIntReactive bpbButton
153 repeatCheckRV = toggleButtonActiveReactive repeatCheckButton
154 repeatRV' = spinButtonValueIntReactive repeatButton
155 repeatRV = liftR2 (\act r -> if act then Just r else Nothing)
156 repeatCheckRV repeatRV'
157 repeatSensitive = widgetSensitiveReactive repeatButton
158 repeatCheckSensitive = widgetSensitiveReactive repeatCheckButton
160 bpbSensitiveRV <- swapHandlerStorage $
161 widgetSensitiveReactive bpbButton
163 reactiveValueOnCanRead isStartedRV $ do
164 reactiveValueRead isStartedRV >>=
166 Running -> do reactiveValueRead repeatCheckRV
167 reactiveValueWrite repeatSensitive False
168 reactiveValueWrite bpbSensitiveRV False
169 reactiveValueWrite repeatCheckSensitive False
170 Stopped -> do reactiveValueRead repeatCheckRV >>=
171 reactiveValueWrite repeatSensitive
172 reactiveValueWrite bpbSensitiveRV True
173 reactiveValueWrite repeatCheckSensitive True
175 repeatCheckRV =:> repeatSensitive
176 reactiveValueWrite repeatCheckRV False
177 reactiveValueWrite repeatSensitive False
179 statMCBMVar <- newMCBMVar
180 =<< reactiveValueRead (liftR2 StaticLayerConf bpbRV repeatRV)
182 reactiveValueOnCanRead dynMCBMVar $ postGUIAsync $ do
183 nDyn <- reactiveValueRead dynMCBMVar
184 reactiveValueWriteOnNotEq layBeatRV $ layerBeat nDyn
185 reactiveValueWriteOnNotEq layPitchRV $ relPitch nDyn
186 reactiveValueWriteOnNotEq strengthRV $ strength nDyn
188 reactiveValueOnCanRead statMCBMVar $ postGUIAsync $ do
189 nStat <- reactiveValueRead statMCBMVar
190 reactiveValueWriteOnNotEq bpbRV $ beatsPerBar nStat
192 reactiveValueOnCanRead synthMCBMVar $ do
193 nSynth <- reactiveValueRead synthMCBMVar
194 reactiveValueWriteOnNotEq layVolumeRV $ volume nSynth
195 reactiveValueWriteOnNotEq instrumentComboRV $ instrument nSynth
197 syncRightOnLeftWithBoth (\nt ol -> ol { layerBeat = nt })
199 syncRightOnLeftWithBoth (\np ol -> ol { relPitch = np })
200 layPitchRV dynMCBMVar
201 syncRightOnLeftWithBoth (\ns ol -> ol { strength = ns })
202 strengthRV dynMCBMVar
203 syncRightOnLeftWithBoth (\nb ol -> ol { beatsPerBar = nb})
205 syncRightOnLeftWithBoth (\nv ol -> ol { volume = nv })
206 layVolumeRV synthMCBMVar
207 syncRightOnLeftWithBoth (\ni ol -> ol { instrument = ni })
208 instrumentComboRV synthMCBMVar
210 return (layerSettingsVBox, statMCBMVar, dynMCBMVar, synthMCBMVar)