src/GUI/Config.hs

   1 module GUI.Config (
   2     configs,
   3     selectStrategy,
   4     selectConfig,
   5     customConfig,
   6 ) where
   7
   8 import Mine
   9 import GUI.Common
  10
  11 import qualified Graphics.UI.Gtk as G
  12 import Control.Monad
  13 import Data.IORef
  14
  15 configs :: [(String, Config)]
  16 configs = [("Beginner",     beginner),
  17            ("Intermediate", intermediate),
  18            ("Expert",       expert)]
  19
  20 selectConfig :: G.RadioMenuItem -> Config -> Globals -> IO ()
  21 selectConfig item cfg g = do
  22     active <- G.checkMenuItemGetActive item
  23     if not active then do
  24         modifyIORef (gState g) $ \s -> s { sPreviousConfigItem = Just item }
  25      else do
  26         s <- readIORef (gState g)
  27         when (sConfig s /= cfg) $ do
  28             writeIORef (gState g) s { sConfig = cfg }
  29             reset g
  30             G.widgetQueueDraw (gBoard g)
  31         modifyIORef (gState g) $ \s -> s { sPreviousConfigItem = Nothing }
  32
  33 customConfig :: G.RadioMenuItem -> Globals -> IO ()
  34 customConfig item g = do
  35     active <- G.checkMenuItemGetActive item
  36     when active $ customConfig' item g
  37
  38 customConfig' :: G.RadioMenuItem -> Globals -> IO ()
  39 customConfig' item g = do
  40     s <- readIORef (gState g)
  41     let Config { cSize = Pos sx sy, cMines = m } = sConfig s
  42
  43     dia <- G.dialogNew
  44     G.dialogAddButton dia G.stockCancel G.ResponseCancel
  45     okButton <- G.dialogAddButton dia G.stockOk G.ResponseOk
  46     G.dialogSetDefaultResponse dia G.ResponseCancel
  47     G.windowSetTitle dia "Custom config"
  48
  49     upper <- G.dialogGetUpper dia
  50     table <- G.tableNew 2 3 False
  51     upper `G.containerAdd` table
  52     let fs = [("width",  2, sx, pX maxSize),
  53               ("height", 2, sy, pY maxSize),
  54               ("mines", 1, m, 999)]
  55     fields <- forM (zip [0..] fs) $ \(c, (n, l, v, h)) -> do
  56          label <- G.labelNew (Just n)
  57          G.tableAttach table label 0 1 c (c+1) [G.Fill] [] 5 2
  58          G.miscSetAlignment label 0 0.5
  59          adj <- G.adjustmentNew (fromIntegral v) l (fromIntegral h) 1 10 10
  60          button <- G.spinButtonNew adj 0.5 0
  61          G.tableAttach table button 1 2 c (c+1) [G.Expand, G.Fill] [] 5 2
  62          return button
  63
  64     G.widgetShowAll dia
  65     res <- G.dialogRun dia
  66     [width, height, mines] <- forM fields $ \f -> do
  67          round `liftM` G.spinButtonGetValue f
  68     let cfg' = Config { cSize = Pos width height,
  69                         cMines = min (width * height - 1) mines }
  70     G.widgetDestroy dia
  71     case res of
  72         G.ResponseOk -> selectConfig item cfg' g
  73         _ -> maybe (return ()) (`G.checkMenuItemSetActive` True)
  74                    (sPreviousConfigItem s)
  75
  76 selectStrategy :: Strategy -> Globals -> IO ()
  77 selectStrategy strat g = do
  78     modifyIORef (gState g) $ \s -> s { sStrategy = strat }
  79     reset g
  80     G.widgetQueueDraw (gBoard g)
  81
  82 reset :: Globals -> IO ()
  83 reset g = do
  84     s <- readIORef (gState g)
  85     writeIORef (gState g) s { sBoard = Nothing, sStop = Nothing }
  86     maybe (return ()) id (sStop s)