minesweeper-0.9: GTK/Preferences.hs

module GTK.Preferences
    ( setPreferences
    ) where

import Core.Square
import Configuration
import Preferences
--import State.Functions

import Control.Monad
import Graphics.UI.Gtk 
import Graphics.UI.Gtk.Glade 
import Data.List

-----------------------

getSize c 
    = (size . configuration $ c, mines . configuration $ c)

sizeTable = 
    [ (boardSize 5 5,   5)
    , (boardSize 10 10, 20)
    , (boardSize 15 15, 45)
    ]

getStyle c 
    = (strategy . configuration $ c, deathProbRange . configuration $ c, recursiveReveal c, undoAllowed c, hintAllowed c)

styleTable =
    [ (Random, (0,1), True, False, Nothing)
    , (Random, (1,1), True, False, Nothing)
    , (HighestProb, (1,1), False, True, Just FullHint)
    ]

-----------------------

setPreferences :: GladeXML -> IO (Preferences -> IO (Maybe Preferences))
setPreferences xml = do

    dialog      <- xmlGetWidget xml castToDialog        "prefdialog"
    predefsize  <- xmlGetWidget xml castToComboBox      "predefsize"
    gamestyle   <- xmlGetWidget xml castToComboBox      "gamestyle"
    sizex       <- xmlGetWidget xml castToSpinButton    "sizex"
    sizey       <- xmlGetWidget xml castToSpinButton    "sizey"
    mines'      <- xmlGetWidget xml castToSpinButton    "mines"
    strategy'   <- xmlGetWidget xml castToComboBox      "strategy"
    deathlow    <- xmlGetWidget xml castToSpinButton    "deathlow"
    deathhigh   <- xmlGetWidget xml castToSpinButton    "deathhigh"
    lifes       <- xmlGetWidget xml castToSpinButton    "lifes"
    recreveal   <- xmlGetWidget xml castToCheckButton   "recreveal"
    undoallowed <- xmlGetWidget xml castToCheckButton   "undoallowed"
    hintallowed <- xmlGetWidget xml castToComboBox      "hintallowed"

    let setPS :: (BoardSize, Int) -> IO ()
        setPS (s, m) = do
            set sizex       [spinButtonValue    := fromIntegral (xSize s)]
            set sizey       [spinButtonValue    := fromIntegral (ySize s)]
            set mines'      [spinButtonValue    := fromIntegral m]

        setGS :: (Strategy, (Probability, Probability), Bool, Bool, Maybe HintType) -> IO ()
        setGS (str, (dl, dh), rec, un, hi)  = do
            set strategy'   [comboBoxActive     := fromEnum str]
            set deathlow    [spinButtonValue    := realToFrac dl]
            set deathhigh   [spinButtonValue    := realToFrac dh]
            set recreveal   [toggleButtonActive := rec]
            set undoallowed [toggleButtonActive := un]
            set hintallowed [comboBoxActive     := case hi of Nothing -> 0; Just i -> 1 + fromEnum i]

        setSensS = do
            psize <- get predefsize comboBoxActive
            let b = psize == 3
            widgetSetSensitivity sizex  b
            widgetSetSensitivity sizey  b
            widgetSetSensitivity mines' b
            unless b $ setPS $ sizeTable !! toEnum psize

        setSensG = do
            gstyle <- get gamestyle comboBoxActive
            let b = gstyle == 3
            widgetSetSensitivity strategy'   b
            widgetSetSensitivity deathlow    b
            widgetSetSensitivity deathhigh   b
            widgetSetSensitivity lifes       b
            widgetSetSensitivity recreveal   b
            widgetSetSensitivity undoallowed b
            widgetSetSensitivity hintallowed b
            unless b $ setGS $ styleTable !! toEnum gstyle 

        setRange = do
            x <- get sizex spinButtonValue
            y <- get sizey spinButtonValue
            spinButtonSetRange mines' 0 (x*y)

    _ <- predefsize `on` changed $ setSensS
    _ <- gamestyle  `on` changed $ setSensG
    _ <- onValueSpinned sizex setRange
    _ <- onValueSpinned sizey setRange

    return $ \c -> do

        set predefsize  [comboBoxActive := maybe 3 id (elemIndex (getSize c) sizeTable)]
        setPS $ getSize c
        setSensS

        set gamestyle   [comboBoxActive := maybe 3 id (elemIndex (getStyle c) styleTable)]
        setGS $ getStyle c
        setSensG

        setRange

        r <- dialogRun dialog
        widgetHide dialog

        case r of
            ResponseOk  -> do
                x   <- get sizex        spinButtonValue
                y   <- get sizey        spinButtonValue
                m   <- get mines'       spinButtonValue
                s   <- get strategy'    comboBoxActive
                dl  <- get deathlow     spinButtonValue
                dh  <- get deathhigh    spinButtonValue
                rr  <- get recreveal    toggleButtonActive
                ua  <- get undoallowed  toggleButtonActive
                ha  <- get hintallowed  comboBoxActive

                return $ Just $ c 
                    { configuration = (configuration c)
                        { tableConfig     = tConfig (boardSize (round x) (round y)) (round m)
                        , strategy        = toEnum s
                        , deathProbRange  = (realToFrac dl, realToFrac dh)
                        }
                    , recursiveReveal = rr
                    , undoAllowed     = ua
                    , hintAllowed     = if ha == 0 then Nothing else Just (toEnum $ ha-1)
                    }

            _ -> 
                return Nothing