-- | -- Module : GUI.Config -- Copyright : (c) 2008 Bertram Felgenhauer -- License : BSD3 -- -- Maintainer : Bertram Felgenhauer -- 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)