src/RMCA/GUI/LayerSettings.hs

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