hs-pgms-0.1: src/Strat1.hs

-- |
-- Module      : Strat1
-- 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.
--
-- A simple minesweeper strategy.
--

module Strat1 (strat1) where

import Mine

import Data.Array.IArray
import System.Random

strat1 :: Strategy
strat1 = defaultStrategy {
    sName        = "Strategy1",
    sAuthor      = "Bertram Felgenhauer <int-e@gmx.de>",
    sDescription =
        "A first attempt at implementing the Single Point Strategy. It's \
        \missing some forced inferences though.",
    sRun         = \s -> getConfig >>= \c -> worker c s
}

worker :: Config -> StdGen -> StrategyM String
worker cfg@Config { cSize = Pos sX sY } gen = worker' gen []
  where
    worker' :: StdGen -> [Pos] -> StrategyM String
    worker' gen [] = do
        vw <- getView
        let (x, gen') = randomR (1, sX) gen
            (y, gen'') = randomR (1, sY) gen'
            p = Pos x y
        if vw ! p == Hidden then
            move p >> worker' gen'' [p]
          else
            worker' gen'' []
    worker' gen (p : ps) = do
        vw <- getView
        let Exposed i = vw ! p
            a = neighbours cfg p
            m = [q | q <- a, Marked <- [vw ! q]]
            u = [q | q <- a, Hidden <- [vw ! q]]
        if length m == i then do
            mapM_ move u
            worker' gen ([r | q <- u, r <- neighbours cfg q,
                              Exposed _ <- [vw ! r]] ++ u ++ ps)
         else if length u + length m == i then do
            mapM_ mark u
            worker' gen ([r | q <- u, r <- neighbours cfg q,
                              Exposed _ <- [vw ! r]] ++ ps)
         else
            worker' gen ps