hs-pgms-0.1: src/GUI/Config.hs
-- |
-- Module : GUI.Config
-- Copyright : (c) 2008 Bertram Felgenhauer
-- License : BSD3
--
-- Maintainer : Bertram Felgenhauer <int-e@gmx.de>
-- Stability : experimental
-- Portability : portable
--
-- This module is part of Haskell PGMS.
--
-- Configuration dialogs and menu handlers.
--
module GUI.Config (
configs,
selectStrategy,
selectConfig,
customConfig,
) where
import Mine
import GUI.Common
import qualified Graphics.UI.Gtk as G
import Control.Monad
import Data.IORef
-- list of standard configurations with associated names
configs :: [(String, Config)]
configs = [("Beginner", beginner),
("Intermediate", intermediate),
("Expert", expert)]
-- select a config associated with a menu entry
--
-- Note: This is also called when changing away from the menu entry. We save
-- the previous config in the `sPreviousConfigItem' state in that case, to
-- be able to reactivate it in `customConfig' if an invalid config is chosen.
selectConfig :: G.RadioMenuItem -> Config -> Globals -> IO ()
selectConfig item cfg g = do
active <- G.checkMenuItemGetActive item
if not active then do
modifyIORef (gState g) $ \s -> s { sPreviousConfigItem = Just item }
else do
s <- readIORef (gState g)
when (sConfig s /= cfg) $ do
writeIORef (gState g) s { sConfig = cfg }
resetGame g
G.widgetQueueDraw (gBoard g)
modifyIORef (gState g) $ \s -> s { sPreviousConfigItem = Nothing }
-- select a custom config
customConfig :: G.RadioMenuItem -> Globals -> IO ()
customConfig item g = do
active <- G.checkMenuItemGetActive item
when active $ customConfig' item g
-- worker for customConfig
customConfig' :: G.RadioMenuItem -> Globals -> IO ()
customConfig' item g = do
s <- readIORef (gState g)
let Config { cSize = Pos sX sY, cMines = m } = sConfig s
-- create dialog
dia <- G.dialogNew
G.windowSetTitle dia "Custom config"
G.dialogAddButton dia G.stockCancel G.ResponseCancel
G.dialogAddButton dia G.stockOk G.ResponseOk
G.dialogSetDefaultResponse dia G.ResponseCancel
upper <- G.dialogGetUpper dia
table <- G.tableNew 2 3 False
upper `G.containerAdd` table
-- add input fields
let fs = [("width", 2, sX, pX maxSize),
("height", 2, sY, pY maxSize),
("mines", 1, m, 999)]
fields <- forM (zip [0..] fs) $ \(c, (n, l, v, h)) -> do
label <- G.labelNew (Just n)
G.tableAttach table label 0 1 c (c+1) [G.Fill] [] 5 2
G.miscSetAlignment label 0 0.5
adj <- G.adjustmentNew (fromIntegral v) l (fromIntegral h) 1 10 10
button <- G.spinButtonNew adj 0.5 0
G.tableAttach table button 1 2 c (c+1) [G.Expand, G.Fill] [] 5 2
return button
G.widgetShowAll dia
res <- G.dialogRun dia
[width, height, mines] <- forM fields $ \f -> do
round `liftM` G.spinButtonGetValue f
G.widgetDestroy dia
let cfg' = Config { cSize = Pos width height,
cMines = min (width * height - 1) mines }
case res of
G.ResponseOk -> selectConfig item cfg' g
_ -> do
-- dialog cancelled ... select previous menu entry
case sPreviousConfigItem s of
Just item -> G.checkMenuItemSetActive item True
_ -> return ()
-- select another strategy
selectStrategy :: Strategy -> Globals -> IO ()
selectStrategy strat g = do
modifyIORef (gState g) $ \s -> s { sStrategy = strat }
resetGame g
G.widgetQueueDraw (gBoard g)
-- stop currently playing game - if any
resetGame :: Globals -> IO ()
resetGame g = do
s <- readIORef (gState g)
writeIORef (gState g) s { sBoard = Nothing, sStop = Nothing }
maybe (return ()) id (sStop s)