hXmixer-0.1.1.0: src/MixerForm.hs

module MixerForm where

import Graphics.UI.Gtk
import qualified Data.Text as T

import MixerQuery

-- | Creates the mixer form.
createForm mixers = do
   window <- windowNew   
   mainBox <- vBoxNew False 10
   
   deviceBox <- hBoxNew True 10
   deviceDropDown <- comboBoxNewText
   
   windowCloseBtn <- buttonNewWithLabel "Close"
   on windowCloseBtn buttonActivated $ do
      mainQuit
   
   on deviceDropDown changed $ do
      maybeMixer <- comboBoxGetActiveText deviceDropDown       
      case maybeMixer of
         Nothing -> return ()
         Just mixer -> do
            containerGetChildren mainBox >>= dropKnobs mainBox
            channelBox <- hBoxNew False 10
            knobs <- (mixerChannels $ T.unpack mixer) >>= mapM (createKnob mixer)
            mapM (\x -> boxPackStart channelBox x PackRepel 0) knobs
            boxPackStart mainBox channelBox PackGrow 0
            widgetShowAll window

   mapM (comboBoxAppendText deviceDropDown . T.pack) mixers   
   comboBoxSetActive deviceDropDown 0

   boxPackStart deviceBox deviceDropDown PackGrow 0
   boxPackStart deviceBox windowCloseBtn PackRepel 0
      
   boxPackEnd mainBox deviceBox PackNatural 0

   set window
      [containerBorderWidth := 10,
       containerChild := mainBox,
       windowTitle := "hXmixer"]

   on window objectDestroy mainQuit
   widgetShowAll window

dropKnobs _ [] = return ()
dropKnobs b (x:_) = containerRemove b x

-- | Creates an individual mixer section.
createKnob mixer (name, (left, right)) = do
   vbox <- vBoxNew False 5
   label <- labelNew $ Just name
   
   hbox <- hBoxNew True 5
   leftAdj <- adjustmentNew (fromIntegral left) 0.00 100.00 1.0 5.0 0.0
   rightAdj <- adjustmentNew (fromIntegral right) 0.00 100.00 1.0 5.0 0.0

   leftKnob <- vScaleNew leftAdj
   rightKnob <- vScaleNew rightAdj

   rangeSetInverted leftKnob True
   rangeSetInverted rightKnob True
   
   scaleSetDigits leftKnob 0
   scaleSetDigits rightKnob 0
   
   lLabel <- labelNew $ Just "L"
   rLabel <- labelNew $ Just "R"
   
   lbox <- vBoxNew False 5
   rbox <- vBoxNew False 5
   
   boxPackStart lbox lLabel PackNatural 0
   boxPackStart rbox rLabel PackNatural 0
   boxPackStart lbox leftKnob PackGrow 0
   boxPackStart rbox rightKnob PackGrow 0
   
   lockCB <- checkButtonNewWithLabel "Lock"
   toggleButtonSetActive lockCB $ left == right
   on lockCB toggled $ do
      locked <- toggleButtonGetActive lockCB
      case locked of
         True -> do
            leftVal <- rangeGetValue leftKnob
            rangeSetValue rightKnob leftVal
         False -> return ()
   
   boxPackStart hbox lbox PackGrow 0
   boxPackStart hbox rbox PackGrow 0
   
   boxPackStart vbox label PackNatural 0
   boxPackStart vbox hbox PackGrow 0
   boxPackStart vbox lockCB PackNatural 0
   
   on leftKnob valueChanged $ do
      locked <- toggleButtonGetActive lockCB
      case locked of
         True -> do
            leftVal <- rangeGetValue leftKnob
            rangeSetValue rightKnob leftVal
            setVol (T.unpack mixer) name (floor leftVal) (floor leftVal)
         False -> do
            leftVal <- rangeGetValue leftKnob
            rightVal <- rangeGetValue rightKnob
            setVol (T.unpack mixer) name (floor leftVal) (floor rightVal)
   
   on rightKnob valueChanged $ do
      locked <- toggleButtonGetActive lockCB
      case locked of
         True -> do
            rightVal <- rangeGetValue rightKnob
            rangeSetValue leftKnob rightVal
            setVol (T.unpack mixer) name (floor rightVal) (floor rightVal)
         False -> do
            leftVal <- rangeGetValue leftKnob
            rightVal <- rangeGetValue rightKnob
            setVol (T.unpack mixer) name (floor leftVal) (floor rightVal)
   
   return vbox