minesweeper-0.8.8: GTK/Preferences.hs

module GTK.Preferences
    ( setPreferences
    ) where

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

import Control.Monad
import Graphics.UI.Gtk hiding (Clear)
import Graphics.UI.Gtk.Glade 
import Data.List

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

getSize c 
    = (size c, mines c)

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

getStyle c 
    = (strategy c, deathProbRange c, allowedDeaths c, recursiveReveal c, undoAllowed c, hintAllowed c)

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

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

setPreferences :: GladeXML -> IO (Configuration -> IO (Maybe Configuration))
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 :: (Board, 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), Int, Bool, Bool, Maybe HintType) -> IO ()
        setGS (str, (dl, dh), ad, rec, un, hi)  = do
            set strategy'   [comboBoxActive     := fromEnum str]
            set deathlow    [spinButtonValue    := realToFrac dl]
            set deathhigh   [spinButtonValue    := realToFrac dh]
            set lifes       [spinButtonValue    := 1 + fromIntegral ad]
            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
                l   <- get lifes        spinButtonValue
                rr  <- get recreveal    toggleButtonActive
                ua  <- get undoallowed  toggleButtonActive
                ha  <- get hintallowed  comboBoxActive

                return $ Just $ configuration' $ Configuration
                    { size            = board (round x) (round y)
                    , mines           = round m
                    , strategy        = toEnum s
                    , deathProbRange  = (realToFrac dl, realToFrac dh)
                    , allowedDeaths   = round l - 1
                    , recursiveReveal = rr
                    , undoAllowed     = ua
                    , hintAllowed     = if ha == 0 then Nothing else Just (toEnum $ ha-1)
--                    , numOfSolutions  = undefined
                    }

            _ -> 
                return Nothing