{-# OPTIONS -cpp #-}
{-# LANGUAGE CPP #-}
{-
    Copyright © 2005  Antti-Juhani Kaijanaho

    This program is free software; you can redistribute it and/or
    modify it under the terms of Version 2 of the GNU General Public
    License as published by the Free Software Foundation.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
-}

#include <gtk2hs-config.h>
#include "version.h"

-- #define NO_CAIRO
#if GTK_CHECK_VERSION(2,8,0) && defined(ENABLE_CAIRO) && !defined(NO_CAIRO)
#define USE_CAIRO
#endif

module Main where

import Model
import AI
import System.Glib.Attributes (AttrOp (..))
import qualified Graphics.UI.Gtk as Gtk
#ifdef USE_CAIRO
import qualified Graphics.UI.Gtk.Cairo as Gtk.Cairo
import qualified Graphics.Rendering.Cairo as Cairo
#endif
import Data.IORef
import Random (randomRIO)
import License
import Icon

infixl 7 //

version :: String
version = UNBOUNDED_VERSION

int2dc :: Integral a => a -> DrawCoord
flt2dc :: Double -> DrawCoord
dc2int :: Integral a => DrawCoord -> a
dc2flt :: DrawCoord -> Double
(//) :: DrawCoord -> DrawCoord -> DrawCoord
#ifdef USE_CAIRO
type DrawCoord = Double
int2dc = fromIntegral
flt2dc = id
dc2int = round
dc2flt = id
(//) = (/)
#else
type DrawCoord = Int
int2dc = fromIntegral
flt2dc = round
dc2int = fromIntegral
dc2flt = fromIntegral
(//) = div
#endif

data State = State { boardRef :: IORef Board,
                     centerPos :: IORef Pos,
                     hilight :: IORef [Pos],
                     posSize :: IORef (DrawCoord,DrawCoord),
                     winner :: IORef [(Mark, Pos, Dir)],
                     pressedPos :: IORef (Maybe Pos),
                     goal :: IORef Int,
                     demo :: IORef (Maybe Gtk.HandlerId),
                     drawingArea :: Gtk.DrawingArea }

newState :: Gtk.DrawingArea -> IO State
newState da = do br <- newIORef (emptyBoard 5)
                 cp <- newIORef (0,0)
                 pp <- newIORef Nothing
                 ps <- newIORef (20,20)
                 hl <- newIORef []
                 wi <- newIORef []
                 goal <- newIORef 5
                 demo <- newIORef Nothing
                 return $ State { boardRef = br,
                                  centerPos = cp,
                                  drawingArea = da,
                                  posSize = ps,
                                  hilight = hl,
                                  winner = wi,
                                  goal = goal,
                                  demo = demo,
                                  pressedPos = pp }

ui = unlines
     ["<ui>",
      "   <menubar>",
      "     <menu name=\"GameMenu\" action=\"GameMenuAction\">",
      "       <menuitem name=\"New\" action=\"NewAction\" />",
      "       <menuitem name=\"Quit\" action=\"QuitAction\" />",
      "     </menu>",
      "     <menu name=\"HelpMenu\" action=\"HelpMenuAction\">",
      "       <menuitem name=\"Rules\" action=\"RulesAction\" />",
      "       <menuitem name=\"About\" action=\"AboutAction\" />",
      "     </menu>",
      "   </menubar>",
      "</ui>"]

data NewResponse = Cancel | User | Comp | Demo

main :: IO ()
main = do Gtk.initGUI
          uim <- Gtk.uiManagerNew
          ag <- Gtk.actionGroupNew ""
          da <- Gtk.drawingAreaNew
          state <- newState da
          Gtk.actionGroupAddAction ag =<< (Gtk.actionNew "GameMenuAction"
                                              "Game"
                                              Nothing Nothing)
          Gtk.actionGroupAddAction ag =<< (Gtk.actionNew "HelpMenuAction"
                                              "Help"
                                              Nothing Nothing)
          do a <- Gtk.actionNew "QuitAction" "Quit" Nothing Nothing
             Gtk.onActionActivate a Gtk.mainQuit
             Gtk.actionGroupAddAction ag a
          let restart = do g <- readIORef (goal state)
                           writeIORef (boardRef state) (emptyBoard g)
                           writeIORef (centerPos state) (0,0)
                           writeIORef (pressedPos state) Nothing
                           writeIORef (hilight state) []
                           writeIORef (winner state) []
                           d <- readIORef (demo state)
                           case d of
                             Just id -> do Gtk.timeoutRemove id
                                           writeIORef (demo state) Nothing
                             Nothing -> return ()
                           Gtk.widgetQueueDraw da
                           Gtk.widgetSetSensitivity da True
          do a <- Gtk.actionNew "NewAction" "New\x2026" Nothing Nothing
             Gtk.onActionActivate a $ do
               r <- newDialog state
               case r of Cancel -> return ()
                         User   -> restart
                         Comp   -> do restart
                                      makeMove state O (0,0) fail (return ())
                                      writeIORef (hilight state) []
                         Demo   -> do
                           restart
                           Gtk.widgetSetSensitivity da False
                           mr <- newIORef X
			   sis <- newIORef False
                           makeMove state O (0,0) fail (return ())
                           d <- flip Gtk.timeoutAdd 200 $
			     do s <- readIORef sis
			        if s then return True
				 else do
				   writeIORef sis True
                                   b <- readIORef (boardRef state)
                                   m <- readIORef mr
                                   writeIORef mr (otherMark m)
                                   modifyIORef (hilight state) $ \ls ->
                                       case ls of [] -> []
                                                  [x] -> [x]
                                                  _ -> init ls
                                   p <- randsel (bestPositions m b)
                                   makeMove state m p fail (return ())
                                   w <- readIORef (winner state)
                                   Gtk.widgetQueueDraw da
				   writeIORef sis False
                                   case w of [] -> return True
                                             _  -> return False
                           writeIORef (demo state) (Just d)
             Gtk.actionGroupAddAction ag a
          do a <- Gtk.actionNew "DemoAction" "Demo" Nothing Nothing
             Gtk.onActionActivate a $ do
               restart
               Gtk.widgetSetSensitivity da False
               mr <- newIORef X
               makeMove state O (0,0) fail (return ())
               d <- flip Gtk.timeoutAdd 1000 $
                    do b <- readIORef (boardRef state)
                       m <- readIORef mr
                       writeIORef mr (otherMark m)
                       modifyIORef (hilight state) $ \ls ->
                           case ls of [] -> []
                                      [x] -> [x]
                                      _ -> init ls
                       p <- randsel (bestPositions m b)
                       makeMove state m p fail (return ())
                       w <- readIORef (winner state)
                       Gtk.widgetQueueDraw da
                       case w of [] -> return True
                                 _  -> return False
               writeIORef (demo state) (Just d)
             Gtk.actionGroupAddAction ag a
          do a <- Gtk.actionNew "AboutAction" "About\x2026" Nothing Nothing
             Gtk.onActionActivate a aboutDialog
             Gtk.actionGroupAddAction ag a
          do a <- Gtk.actionNew "RulesAction" "Rules\x2026" Nothing Nothing
             Gtk.onActionActivate a rulesDialog
             Gtk.actionGroupAddAction ag a
          Gtk.uiManagerInsertActionGroup uim ag 0
          Gtk.uiManagerAddUiFromString uim ui
          Just mb <- Gtk.uiManagerGetWidget uim "/ui/menubar"
          mw <- Gtk.windowNew
          Gtk.windowSetIcon mw xwins
          Gtk.windowSetTitle mw "Unbounded Tic-Tac-Toe"
          Gtk.windowSetDefaultSize mw 600 450
          Gtk.onDestroy mw Gtk.mainQuit
          tbl <- Gtk.tableNew 3 5 False
          Gtk.containerAdd mw tbl
          Gtk.tableAttach tbl mb 0 3 0 1 [Gtk.Expand,Gtk.Fill] [] 0 0 
          Gtk.tableAttachDefaults tbl da 1 2 2 3
          Gtk.onExposeRect da (drawBoard state)
          Gtk.onButtonPress da (handleClick state)
          Gtk.onButtonRelease da (handleClick state)
          bs <- sequence $ flip map [("\x2191", N,  1, 1),
                                     ("\x2197", NE, 2, 1),
                                     ("\x2192", E,  2, 2),
                                     ("\x2198", SE, 2, 3),
                                     ("\x2193", S,  1, 3),
                                     ("\x2199", SW, 0, 3),
                                     ("\x2190", W,  0, 2),
                                     ("\x2196", NW, 0, 1)] $
                \(lbl,dir,x,y) -> do
            b <- Gtk.buttonNewWithLabel lbl
            let optx 1 = [Gtk.Expand,Gtk.Fill]
                optx _ = []
                opty 2 = [Gtk.Expand,Gtk.Fill]
                opty _ = []
            Gtk.tableAttach tbl b x (x+1) y (y+1) (optx x) (opty y) 0 0
            Gtk.onClicked b $ do modifyIORef (centerPos state) $ move dir 1
                                 Gtk.widgetQueueDraw da
            return b
          Gtk.widgetShowAll mw
          Gtk.mainGUI

handleClick :: State -> Gtk.Event -> IO Bool
handleClick st@(State { pressedPos = pp })
                (Gtk.Button { Gtk.eventClick = Gtk.SingleClick,
                              Gtk.eventButton = Gtk.LeftButton,
                              Gtk.eventX = x, Gtk.eventY = y })
    = do p <- findPos st (flt2dc x) (flt2dc y)
         writeIORef pp (Just p)
         return True
handleClick (State { pressedPos = pp })
                (Gtk.Button { Gtk.eventClick = Gtk.DoubleClick,
                              Gtk.eventButton = Gtk.LeftButton })
    = do writeIORef pp Nothing
         return True
handleClick (State { pressedPos = pp })
                (Gtk.Button { Gtk.eventClick = Gtk.TripleClick,
                              Gtk.eventButton = Gtk.LeftButton })
    = do writeIORef pp Nothing
         return True
handleClick st@(State { boardRef = br, pressedPos = pp, drawingArea = da,
                        hilight = hlr, winner = winner })
                (Gtk.Button { Gtk.eventClick = Gtk.ReleaseClick,
                              Gtk.eventButton = Gtk.LeftButton,
                              Gtk.eventX = x, Gtk.eventY = y })
    = do p <- findPos st (flt2dc x) (flt2dc y)
         pm <- readIORef pp
         writeIORef pp Nothing
         case pm of
           Just p' | p == p'
                 -> do writeIORef hlr []
                       makeMove st X p (\_ -> Gtk.beep) $ do
                         Gtk.widgetSetSensitivity da False
                         flip Gtk.timeoutAdd 1000 $
                              do b <- readIORef br
                                 p' <- randsel (bestPositions O b)
                                 Gtk.widgetSetSensitivity da True
                                 makeMove st O p' fail (return ())
                                 Gtk.widgetQueueDraw da
                                 return False
                         return ()
           _ -> return ()
         Gtk.widgetQueueDraw da
         return True
handleClick _ _ = return False

makeMove :: State -> Mark -> Pos -> (String -> IO ()) -> IO () -> IO ()
makeMove st@(State { boardRef = br, drawingArea = da, hilight = hlr,
                     winner = winner }) m p err cont
    = do b <- readIORef br
         case placeMark m p b of
           Return b' -> do writeIORef br b'
                           modifyIORef hlr ((:)p)
                           case findWinner b' of
                             [] -> cont
                             w  -> do writeIORef winner w
                                      Gtk.widgetSetSensitivity da False
           Fail s    -> err s

randsel :: [a] -> IO a
randsel l = do i <- randomRIO (0, length l - 1)
               return (l !! i)

findPos :: State -> DrawCoord -> DrawCoord -> IO Pos
findPos (State { drawingArea = da, centerPos = cpr, posSize = psr }) xd yd
    = do (w,h) <- readIORef psr
         (x0,y0) <- readIORef cpr
         (daw,dah) <- Gtk.drawingAreaGetSize da
         let rv = (x0 + (x - fromIntegral daw `div` 2) `div` dc2int w,
                   y0 + (y - fromIntegral dah `div` 2) `div` dc2int h)
         -- putStrLn $ "findPos " ++ show rv
         return rv
    where x = dc2int xd
          y = dc2int yd
         
pos2coord :: State -> Pos -> IO (DrawCoord, DrawCoord)
pos2coord (State { drawingArea = da, centerPos = cpr, posSize = psr }) (x,y)
    = do (w,h) <- readIORef psr
         (daw,dah) <- Gtk.drawingAreaGetSize da
         (x0,y0) <- readIORef cpr
         let rv = ((fromIntegral (x - x0) * w) + fromIntegral daw // 2 + w//2, 
                   (fromIntegral (y - y0) * h) + fromIntegral dah // 2 + h//2)
         -- putStrLn $ "pos2coord " ++ show rv
         return rv

data Exc a = Fail String | Return a

instance Monad Exc where
    Fail s >>= _   = Fail s
    Return a >>= f = f a
    return a       = Return a
    fail s         = Fail s

drawBoard :: State -> Gtk.Rectangle -> IO ()
drawBoard st@(State { boardRef = br, centerPos = cpr,
                      posSize = psr, drawingArea = da, goal = goal,
                      hilight = hlr, winner = winner }) _
    = do -- putStr "drawBoard: "
         b <- readIORef br
         (w,h) <- readIORef psr
         (x0,y0) <- readIORef cpr
         (daw',dah') <- Gtk.drawingAreaGetSize da
         hl <- readIORef hlr
         let daw = fromIntegral daw'
             dah = fromIntegral dah'
         dw <- Gtk.drawingAreaGetDrawWindow da
         let xs, ys :: [DrawCoord]
             xs = (takeWhile (>= 0)   [daw//2,daw//2-w..]) ++
                  (takeWhile (<= daw) [daw//2+w,daw//2+2*w..])
             ys = (takeWhile (>= 0)   [dah//2,dah//2-h..]) ++
                  (takeWhile (<= dah) [dah//2+h,dah//2+2*h..])
         -- putStrLn $ " " ++ show daw ++ " " ++ show dah ++ " "
         --              ++ show xs ++ " " ++ show ys
         wn <- readIORef winner
#ifdef USE_CAIRO
         Gtk.Cairo.renderWithDrawable dw Cairo.identityMatrix
#endif
         drawBackground dw wn
         drawGrid dw xs ys daw dah
         flip mapM_ hl $ \p ->
             do (x,y) <- pos2coord st p
                highlightCell dw x y w h
         sequence_ $ (\f -> foldr f [] (activeRectangle b)) $ \p xs ->
           case getMark b p of
             Nothing -> xs
             Just m  -> f m : xs
                 where f X = do (x,y) <- pos2coord st p
                                drawCross dw x y w h
                       f O = do (x,y) <- pos2coord st p
                                drawNought dw x y w h
         g <- readIORef goal
         flip mapM_ wn $ \(m,p,d) ->
           do (x1,y1) <- pos2coord st p
              (x2,y2) <- pos2coord st (move d (g-1) p)
              markWinningStraight dw x1 y1 x2 y2

drawBackground :: Gtk.DrawWindow -> [a] -> IO ()
#ifdef USE_CAIRO
drawBackground dw wn =
    Gtk.Cairo.renderWithDrawable dw $ do
      Cairo.save
      case wn of [] -> Cairo.setSourceRGB 1 1 1
                 _  -> Cairo.setSourceRGB 0.9 0.9 0.9
      Cairo.paint
      Cairo.restore
#else
drawBackground dw wn = do
  (w,h) <- Gtk.drawableGetSize dw
  gc <- Gtk.gcNew dw
  let rgb = case wn of [] -> 65535
                       _ -> 65535 - 6554
  Gtk.gcSetValues gc Gtk.newGCValues { Gtk.foreground = Gtk.Color rgb rgb rgb }
  Gtk.drawRectangle dw gc True 0 0 w h
#endif

drawGrid :: Gtk.DrawWindow -> [DrawCoord] -> [DrawCoord]
         -> DrawCoord -> DrawCoord
         -> IO ()
#ifdef USE_CAIRO
drawGrid dw xs ys daw dah =
    Gtk.Cairo.renderWithDrawable dw $ do
      Cairo.save
      Cairo.setSourceRGB 0.3 0.3 0.3
      flip mapM_ xs $ \x -> 
          do Cairo.newPath
             Cairo.moveTo x 0
             Cairo.lineTo x dah
             Cairo.stroke
      flip mapM_ ys $ \y ->
          do Cairo.newPath
             Cairo.moveTo 0 y
             Cairo.lineTo daw y
             Cairo.stroke
      Cairo.restore
#else
drawGrid dw xs ys daw dah = do
  gc <- Gtk.gcNew dw
  let rgb = 3*6554
  Gtk.gcSetValues gc Gtk.newGCValues { Gtk.foreground = Gtk.Color rgb rgb rgb }
  flip mapM_ xs $ \x -> Gtk.drawLine dw gc (x,0) (x,dah)
  flip mapM_ ys $ \y -> Gtk.drawLine dw gc (0,y) (daw,y)
#endif

highlightCell :: Gtk.DrawWindow -> DrawCoord -> DrawCoord
              -> DrawCoord -> DrawCoord
              -> IO ()
#ifdef USE_CAIRO
highlightCell dw x y w h =
    Gtk.Cairo.renderWithDrawable dw $ do
      Cairo.save
      Cairo.setSourceRGB 0.5 0.5 0.5
      Cairo.newPath
      Cairo.moveTo (x - w/2) (y - h/2)
      Cairo.lineTo (x - w/2) (y + h/2)
      Cairo.lineTo (x + w/2) (y + h/2)
      Cairo.lineTo (x + w/2) (y - h/2)
      Cairo.lineTo (x - w/2) (y - h/2)
      Cairo.fill
      Cairo.restore
#else
highlightCell dw x y w h = do
  gc <- Gtk.gcNew dw
  let rgb = 5*6554
  Gtk.gcSetValues gc Gtk.newGCValues { Gtk.foreground = Gtk.Color rgb rgb rgb }
  Gtk.drawRectangle dw gc True (x - w//2) (y - h//2) w h
#endif

drawCross :: Gtk.DrawWindow -> DrawCoord -> DrawCoord -> DrawCoord -> DrawCoord
          -> IO ()
#ifdef USE_CAIRO
drawCross dw x y w h = Gtk.Cairo.renderWithDrawable dw $ do
                         Cairo.save
                         Cairo.identityMatrix
                         Cairo.setSourceRGB 0 1 0
                         Cairo.setLineWidth 4
                         Cairo.newPath
                         Cairo.moveTo (x - w/4) (y - h/4)
                         Cairo.lineTo (x + w/4) (y + h/4)
                         Cairo.moveTo (x - w/4) (y + h/4)
                         Cairo.lineTo (x + w/4) (y - h/4)
                         Cairo.stroke
                         Cairo.restore
#else
drawCross dw x y w h = do
  gc <- Gtk.gcNew dw
  Gtk.gcSetValues gc Gtk.newGCValues { Gtk.foreground = Gtk.Color 0 65535 0,
                                       Gtk.lineWidth = 4 }
  Gtk.drawLine dw gc (x - w//4, y - w//4) (x + w//4, y + w // 4)
  Gtk.drawLine dw gc (x + w//4, y - w//4) (x - w//4, y + w // 4)
#endif

drawNought :: Gtk.DrawWindow -> DrawCoord -> DrawCoord -> DrawCoord -> DrawCoord
           -> IO ()
#ifdef USE_CAIRO
drawNought dw x y w h = Gtk.Cairo.renderWithDrawable dw $ do
                          Cairo.save
                          Cairo.identityMatrix
                          Cairo.setSourceRGB 1 0 0
                          Cairo.setLineWidth 4
                          Cairo.newPath
                          Cairo.arc x y (min (w/4) (h/4)) 0 (2*pi)
                          Cairo.stroke
#else
drawNought dw x y w h = do
  gc <- Gtk.gcNew dw
  Gtk.gcSetValues gc Gtk.newGCValues { Gtk.foreground = Gtk.Color 65535 0 0,
                                       Gtk.lineWidth = 4 }
  let d = min (w//4) (h//4)
  Gtk.drawArc dw gc False (x-d) (y-d) (2*d) (2*d) 0 (64*360)
#endif

markWinningStraight :: Gtk.DrawWindow -> DrawCoord -> DrawCoord -> DrawCoord -> DrawCoord
                    -> IO ()
#ifdef USE_CAIRO
markWinningStraight dw x1 y1 x2 y2 =
              Gtk.Cairo.renderWithDrawable dw $ do
                Cairo.save
                Cairo.setSourceRGB 0 0 1
                Cairo.newPath
                Cairo.moveTo x1 y1
                Cairo.lineTo x2 y2
                Cairo.stroke
                Cairo.restore
#else
markWinningStraight dw x1 y1 x2 y2 = do
  gc <- Gtk.gcNew dw
  Gtk.gcSetValues gc Gtk.newGCValues { Gtk.foreground = Gtk.Color 0 0 65535,
                                       Gtk.lineWidth = 2 }
  Gtk.drawLine dw gc (x1,y1) (x2,y2)
#endif             

aboutDialog :: IO ()
aboutDialog = do ad <- Gtk.aboutDialogNew
                 Gtk.aboutDialogSetName ad "Unbounded Tic-Tac-Toe"
                 Gtk.aboutDialogSetVersion ad version
#ifdef ABOUT_COMMENT
                 Gtk.aboutDialogSetComments ad ABOUT_COMMENT
#endif
                 Gtk.aboutDialogSetCopyright ad $
                        "Copyright \xa9 2005 Antti-Juhani Kaijanaho\n" ++
                        "Some rights reserved, see the license for details."
                 Gtk.aboutDialogSetLicense ad (Just gpl)
                 Gtk.aboutDialogSetAuthors ad
                    ["Antti-Juhani Kaijanaho <antti-juhani@kaijanaho.info>"]
                 Gtk.aboutDialogSetLogo ad (Just xwins)
                 Gtk.dialogRun ad
                 Gtk.widgetDestroy ad
                 return ()

rulesDialog :: IO ()
rulesDialog = do d <- Gtk.dialogNew
                 Gtk.dialogAddButton d Gtk.stockClose Gtk.ResponseNone
                 vb <- Gtk.dialogGetUpper d
                 lbl <- Gtk.labelNew Nothing
                 Gtk.set lbl [Gtk.labelUseMarkup := True]
                 Gtk.labelSetLabel lbl rules
                 Gtk.labelSetLineWrap lbl True
                 Gtk.boxPackStart vb lbl Gtk.PackGrow 0
                 Gtk.widgetShow lbl
                 Gtk.dialogRun d
                 Gtk.widgetDestroy d
                 return ()

newDialog :: State -> IO NewResponse
newDialog st = do d <- Gtk.dialogNew
                  Gtk.dialogAddButton d Gtk.stockOk Gtk.ResponseOk
                  Gtk.dialogAddButton d Gtk.stockCancel Gtk.ResponseCancel
                  vb <- Gtk.dialogGetUpper d
                  xstb <- Gtk.radioButtonNewWithLabel "User starts"
                  ostb <- Gtk.radioButtonNewWithLabelFromWidget xstb
                          "Computer starts"
                  demb <- Gtk.radioButtonNewWithLabelFromWidget xstb
                          "Demo mode"
                  Gtk.boxPackStart vb xstb Gtk.PackNatural 0
                  Gtk.boxPackStart vb ostb Gtk.PackNatural 0
                  Gtk.boxPackStart vb demb Gtk.PackNatural 0
                  Gtk.widgetShow xstb
                  Gtk.widgetShow ostb
                  Gtk.widgetShow demb
                  hb <- Gtk.hBoxNew False 0
                  Gtk.boxPackStart vb hb Gtk.PackGrow 0
                  lbl <- Gtk.labelNew (Just "Length of winning sequence")
                  Gtk.boxPackStart hb lbl Gtk.PackNatural 0
                  sb <- Gtk.spinButtonNewWithRange 2 10 1
                  cgoal <- readIORef (goal st)
                  Gtk.spinButtonSetValue sb (fromIntegral cgoal)
                  Gtk.boxPackStart hb sb Gtk.PackNatural 0
                  Gtk.widgetShowAll hb
                  res <- Gtk.dialogRun d
                  xst <- Gtk.toggleButtonGetActive xstb
                  dem <- Gtk.toggleButtonGetActive demb
                  ngoal <- Gtk.spinButtonGetValueAsInt sb
                  Gtk.widgetDestroy d
                  case res of
                    Gtk.ResponseOk 
                      -> do writeIORef (goal st) ngoal
                            case dem of
                              True -> return Demo
                              False -> return $ case xst of
                                                  True  -> User
                                                  False -> Comp
                    _ -> return Cancel

rules :: String
rules = "<big><b>Rules</b></big>\n\n" ++
        "The game is played on an unbounded grid.  Each of the two players " ++
        "will add their mark (X for one player, O for the other) to some " ++
        "vacant cell in the grid.  The winner is the player who manages  " ++
        "first to put a certain number of their marks in sequence either " ++
        "horizontally, vertically or diagonally. This certain number, " ++
        "sometimes called the <i>goal</i>, is by default 5 and can be " ++
        "changed by the user."