packages feed

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)