src/RMCA/GUI/Buttons.hs

   1 {-# LANGUAGE OverloadedStrings #-}
   2
   3 module RMCA.GUI.Buttons where
   4
   5 import Data.ReactiveValue
   6 import Graphics.UI.Gtk
   7 import Graphics.UI.Gtk.Reactive
   8 import System.Glib
   9
  10 gtkMediaPlay :: DefaultGlibString
  11 gtkMediaPlay = stringToGlib "gtk-media-play"
  12
  13 gtkMediaStop :: DefaultGlibString
  14 gtkMediaStop = stringToGlib "gtk-media-stop"
  15
  16 gtkMediaPause :: DefaultGlibString
  17 gtkMediaPause = stringToGlib "gtk-media-pause"
  18
  19 gtkMediaRecord :: DefaultGlibString
  20 gtkMediaRecord = stringToGlib "gtk-media-record"
  21
  22 gtkMediaSave :: DefaultGlibString
  23 gtkMediaSave = stringToGlib "gtk-save"
  24
  25 gtkMediaOpen :: DefaultGlibString
  26 gtkMediaOpen = stringToGlib "gtk-open"
  27
  28 buttonNewFromStockWithLabel :: StockId -> String -> IO Button
  29 buttonNewFromStockWithLabel s l = do
  30   button <- buttonNew
  31   buttonBox <- hBoxNew False 0
  32   buttonImg <- imageNewFromStock s IconSizeButton
  33   buttonLabel <- labelNew (Just l)
  34   labelSetUseUnderline buttonLabel True
  35   containerAdd button buttonBox
  36   boxPackStart buttonBox buttonImg PackRepel 0
  37   boxPackStart buttonBox buttonLabel PackRepel 0
  38   return button
  39
  40 toggleButtonNewFromStock :: StockId -> IO ToggleButton
  41 toggleButtonNewFromStock s = do
  42   button <- toggleButtonNew
  43   buttonBox <- hBoxNew False 0
  44   buttonImg <- imageNewFromStock s IconSizeButton
  45   stockTxt <- stockLookupItem s
  46   buttonLabel <- labelNew (siLabel <$> stockTxt)
  47   labelSetUseUnderline buttonLabel True
  48   containerAdd button buttonBox
  49   boxPackStart buttonBox buttonImg PackRepel 0
  50   boxPackStart buttonBox buttonLabel PackRepel 0
  51   return button
  52
  53 getButtons :: IO ( VBox
  54                  , ReactiveFieldRead IO ()
  55                  , ReactiveFieldRead IO ()
  56                  , ReactiveFieldRead IO Bool
  57                  , ReactiveFieldRead IO Bool
  58                  , ReactiveFieldRead IO ()
  59                  , ReactiveFieldRead IO ()
  60                  )
  61 getButtons = do
  62   buttonBox <- vBoxNew False 10
  63
  64   buttonBoxTop <- hBoxNew True 10
  65   boxPackStart buttonBox buttonBoxTop PackNatural 0
  66
  67   buttonSave <- buttonNewFromStockWithLabel gtkMediaSave "_Save configuration"
  68   let confSaveRV = buttonActivateField buttonSave
  69   boxPackStart buttonBoxTop buttonSave PackGrow 0
  70
  71   buttonLoad <- buttonNewFromStockWithLabel gtkMediaOpen "_Load configuration"
  72   let confLoadRV = buttonActivateField buttonLoad
  73   boxPackStart buttonBoxTop buttonLoad PackGrow 0
  74
  75
  76   buttonBoxBot <- hBoxNew True 10
  77   boxPackStart buttonBox buttonBoxBot PackNatural 0
  78   buttonPlay <- buttonNewFromStock gtkMediaPlay
  79   let playRV = buttonActivateField buttonPlay
  80   boxPackStart buttonBoxBot buttonPlay PackRepel 0
  81
  82   buttonPause <- toggleButtonNewFromStock gtkMediaPause
  83   let pauseRV = readOnly $ toggleButtonActiveReactive buttonPause
  84   boxPackStart buttonBoxBot buttonPause PackRepel 0
  85
  86   buttonStop <- buttonNewFromStock gtkMediaStop
  87   let stopRV = buttonActivateField buttonStop
  88   boxPackStart buttonBoxBot buttonStop PackRepel 0
  89
  90   buttonRecord <- toggleButtonNewFromStock gtkMediaRecord
  91   let recordRV = readOnly $ toggleButtonActiveReactive buttonRecord
  92   boxPackStart buttonBoxBot buttonRecord PackRepel 0
  93
  94   return ( buttonBox
  95          , playRV
  96          , stopRV
  97          , pauseRV
  98          , recordRV
  99          , confSaveRV
 100          , confLoadRV
 101          )