diff --git a/RELEASE-NOTES b/RELEASE-NOTES
--- a/RELEASE-NOTES
+++ b/RELEASE-NOTES
@@ -1,3 +1,10 @@
+hstzaar 0.8 30/06/2011
+- fixed crash on clicking Cancel button of file dialogs
+- fixed incorrect behaviour of AI Level 2 (wrong comparison)
+- added a command-line option to specify glade data directory
+- fused game and history references in GUI code;
+ should reduce the number of screen redraw events
+
hstzaar 0.7 17/06/2011
- improved AI:
level 0 does material evaluation only
diff --git a/data/hstzaar.glade b/data/hstzaar.glade
deleted file mode 100644
--- a/data/hstzaar.glade
+++ /dev/null
@@ -1,208 +0,0 @@
-
-
-
-
-
- HsTZAAR
- 600
- 600
-
-
- True
-
-
-
- False
- 0
-
-
-
-
- True
- 0
- 0
- none
-
-
-
-
-
-
- label_item
-
-
-
-
- 1
-
-
-
-
- True
- True
-
-
- True
- end
-
-
- 0
-
-
-
-
- True
- 2
-
-
- 1
-
-
-
-
- False
- 2
-
-
-
-
-
-
diff --git a/hstzaar.cabal b/hstzaar.cabal
--- a/hstzaar.cabal
+++ b/hstzaar.cabal
@@ -1,5 +1,5 @@
name: hstzaar
-version: 0.7
+version: 0.8
category: Game
@@ -22,7 +22,7 @@
build-type: Simple
cabal-version: >= 1.6
-data-files: data/hstzaar.glade
+data-files: hstzaar.glade
extra-source-files:
RELEASE-NOTES
@@ -35,6 +35,7 @@
base >= 4 && < 5,
haskell98,
filepath >= 1.1,
+ directory >= 1.0,
containers,
gtk >=0.11,
cairo >= 0.11,
diff --git a/hstzaar.glade b/hstzaar.glade
new file mode 100644
--- /dev/null
+++ b/hstzaar.glade
@@ -0,0 +1,208 @@
+
+
+
+
+
+ HsTZAAR
+ 600
+ 600
+
+
+ True
+
+
+
+ False
+ 0
+
+
+
+
+ True
+ 0
+ 0
+ none
+
+
+
+
+
+
+ label_item
+
+
+
+
+ 1
+
+
+
+
+ True
+ True
+
+
+ True
+ end
+
+
+ 0
+
+
+
+
+ True
+ 2
+
+
+ 1
+
+
+
+
+ False
+ 2
+
+
+
+
+
+
diff --git a/src/AI.hs b/src/AI.hs
--- a/src/AI.hs
+++ b/src/AI.hs
@@ -24,7 +24,7 @@
level2 = AI { name = "Level 2"
, description = "Minimaxing alpha-beta depth 2-4 (eval1)"
, strategy = (withNPieces $ \numpieces ->
- if numpieces>30 then
+ if numpieces<30 then
minimaxStrategy 4 eval1
else
minimaxStrategy 2 eval1
diff --git a/src/GUI.hs b/src/GUI.hs
--- a/src/GUI.hs
+++ b/src/GUI.hs
@@ -13,7 +13,7 @@
import Data.IntMap (IntMap, (!))
import Data.List (minimumBy, sortBy)
import Control.Concurrent
-import Control.Monad (when, filterM)
+import Control.Monad (when, filterM, liftM, mplus, msum)
import System.IO
import System.FilePath
import System.Random hiding (next)
@@ -45,12 +45,12 @@
| Finish -- game ended
deriving (Eq, Show, Read)
--- | reference to a game
-type GameRef = Var Game
--- | reference to the history
-type HistRef = Var (History Game)
+-- | pair of current game and history
+type GameHist = (Game,History Game)
+-- | reference to a game and history
+type GameRef = Var GameHist
-- | initialize a game, given a starting board
initGame :: Board -> Game
@@ -84,18 +84,18 @@
}
-- | main GUI entry point
-gui :: String -> IO ()
-gui gladepath =
+gui :: FilePath -> IO ()
+gui path =
do initGUI
- gui <- loadGlade gladepath
- gameRef <- Var.new (initGame startingBoard)
- histRef <- Var.new $ History.init (initGame startingBoard)
- connect_events gui gameRef histRef
+ gui <- loadGlade path
+ let g = initGame startingBoard
+ gameRef <- Var.new (g, History.init g)
+ connect_events gui gameRef
-- timer event for running other threads
timeoutAdd (yield >> return True) 50
-- timer event for updating the progress bar
- timeoutAdd (Var.get gameRef >>=
- updateProgress gui >>
+ timeoutAdd (Var.get gameRef >>= \(g,_) ->
+ updateProgress gui g >>
return True) 100
-- start event loop
mainGUI
@@ -103,57 +103,54 @@
-- | load GUI elements from XML glade file
-loadGlade gladepath =
- do out <- xmlNew gladepath
- when (out==Nothing) (error $ "failed to load glade file " ++ show gladepath)
- let Just xml = out
- mw <- xmlGetWidget xml castToWindow "mainwindow"
- fr <- xmlGetWidget xml castToFrame "frame1"
- sb <- xmlGetWidget xml castToStatusbar "statusbar"
- pb <- xmlGetWidget xml castToProgressBar "progressbar"
- mn <- xmlGetWidget xml castToMenuItem "menu_item_new"
- mo <- xmlGetWidget xml castToMenuItem "menu_item_open"
- ms <- xmlGetWidget xml castToMenuItem "menu_item_save"
- -- msa<- xmlGetWidget xml castToMenuItem "menu_item_save_as"
- mq <- xmlGetWidget xml castToMenuItem "menu_item_quit"
- mun<- xmlGetWidget xml castToMenuItem "menu_item_undo"
- mre<- xmlGetWidget xml castToMenuItem "menu_item_redo"
- mpa<- xmlGetWidget xml castToMenuItem "menu_item_pass"
- msh<- xmlGetWidget xml castToCheckMenuItem "menu_item_show_heights"
- msm<- xmlGetWidget xml castToCheckMenuItem "menu_item_show_moves"
- mrs<- xmlGetWidget xml castToCheckMenuItem "menu_item_random_start"
+loadGlade :: FilePath -> IO GUI
+loadGlade path =
+ do out <- xmlNew path
+ case out of
+ Nothing -> error ("unable to open glade file " ++ show path)
+ Just xml ->
+ do mw <- xmlGetWidget xml castToWindow "mainwindow"
+ fr <- xmlGetWidget xml castToFrame "frame1"
+ sb <- xmlGetWidget xml castToStatusbar "statusbar"
+ pb <- xmlGetWidget xml castToProgressBar "progressbar"
+ mn <- xmlGetWidget xml castToMenuItem "menu_item_new"
+ mo <- xmlGetWidget xml castToMenuItem "menu_item_open"
+ ms <- xmlGetWidget xml castToMenuItem "menu_item_save"
+ mq <- xmlGetWidget xml castToMenuItem "menu_item_quit"
+ mun<- xmlGetWidget xml castToMenuItem "menu_item_undo"
+ mre<- xmlGetWidget xml castToMenuItem "menu_item_redo"
+ mpa<- xmlGetWidget xml castToMenuItem "menu_item_pass"
+ msh<- xmlGetWidget xml castToCheckMenuItem "menu_item_show_heights"
+ msm<- xmlGetWidget xml castToCheckMenuItem "menu_item_show_moves"
+ mrs<- xmlGetWidget xml castToCheckMenuItem "menu_item_random_start"
+ -- fill in dynamic parts
+ bd <- drawingAreaNew
+ containerAdd fr bd
+ m<- xmlGetWidget xml castToMenu "menu_ai"
+ r <- radioMenuItemNewWithLabel (name $ snd $ head aiPlayers)
+ menuAttach m r 0 1 0 1
+ rs <- sequence [do w<-radioMenuItemNewWithLabelFromWidget r (name $ snd t)
+ menuAttach m w 0 1 i (i+1)
+ return w
+ | (t,i)<-zip (tail aiPlayers) [1..]]
+ -- open/save file dialogs
+ ff <- fileFilterNew
+ fileFilterSetName ff "Tzaar saved games (*.tza)"
+ fileFilterAddPattern ff "*.tza"
+ opf <- fileChooserDialogNew (Just "Open saved game") Nothing FileChooserActionOpen
+ [("Cancel",ResponseCancel),("Open",ResponseOk)]
+ fileChooserAddFilter opf ff
+ svf <- fileChooserDialogNew (Just "Save game") Nothing FileChooserActionSave
+ [("Cancel",ResponseCancel),("Save",ResponseOk)]
+ fileChooserAddFilter svf ff
+ cid <- statusbarGetContextId sb "status"
+ widgetShowAll mw
+ return (GUI mw bd sb pb mn mo ms mq mun mre mpa
+ msh msm mrs (zip (r:rs) (map snd aiPlayers)) opf svf cid)
- -- fill in dynamic parts
- bd <- drawingAreaNew
- containerAdd fr bd
-
- m<- xmlGetWidget xml castToMenu "menu_ai"
- r <- radioMenuItemNewWithLabel (name $ snd $ head aiPlayers)
- menuAttach m r 0 1 0 1
- rs <- sequence [do w<-radioMenuItemNewWithLabelFromWidget r (name $ snd t)
- menuAttach m w 0 1 i (i+1)
- return w
- | (t,i)<-zip (tail aiPlayers) [1..]]
- -- open/save file dialogs
- ff <- fileFilterNew
- fileFilterSetName ff "Tzaar saved games (*.tza)"
- fileFilterAddPattern ff "*.tza"
- opf <- fileChooserDialogNew (Just "Open saved game") Nothing FileChooserActionOpen
- [("Cancel",ResponseCancel),("Open",ResponseOk)]
- fileChooserAddFilter opf ff
- svf <- fileChooserDialogNew (Just "Save game") Nothing FileChooserActionSave
- [("Cancel",ResponseCancel),("Save",ResponseOk)]
- fileChooserAddFilter svf ff
-
- cid <- statusbarGetContextId sb "status"
- -- statusbarPush sb cid "Ready"
- widgetShowAll mw
- return (GUI mw bd sb pb mn mo ms mq mun mre mpa
- msh msm mrs (zip (r:rs) (map snd aiPlayers)) opf svf cid)
-
-- | connect event handlers for GUI elements
-connect_events gui gameRef histRef
+connect_events gui gameRef
= do onExpose (canvas gui) $ \x ->
do drawCanvas gui gameRef
return (eventSent x)
@@ -161,74 +158,69 @@
do mp<-getPosition (canvas gui) (eventX x) (eventY x)
case mp of
Nothing -> return (eventSent x)
- Just p -> do clickPosition gui gameRef histRef p
+ Just p -> do clickPosition gui gameRef p
return (eventSent x)
onDestroy (mainwin gui) mainQuit
onActivateLeaf (menu_item_quit gui) mainQuit
- onActivateLeaf (menu_item_new gui) $ newGame gui gameRef histRef
+ onActivateLeaf (menu_item_new gui) $ newGame gui gameRef
onActivateLeaf (menu_item_open gui) $
do { answer<-fileDialogRun (open_file_chooser gui)
; case answer of
- Just path -> openGame gameRef histRef path
+ Just path -> openGame gameRef path
Nothing -> return ()
}
onActivateLeaf (menu_item_save gui) $
do { answer<-fileDialogRun (save_file_chooser gui)
; case answer of
- Just path -> saveGame gameRef histRef
- (replaceExtension path ".tza")
+ Just path -> saveGame gameRef (replaceExtension path ".tza")
Nothing -> return ()
}
- onActivateLeaf (menu_item_undo gui) $ moveUndo gameRef histRef
- onActivateLeaf (menu_item_redo gui) $ moveRedo gameRef histRef
+ onActivateLeaf (menu_item_undo gui) $ moveUndo gameRef
+ onActivateLeaf (menu_item_redo gui) $ moveRedo gameRef
- onActivateLeaf (menu_item_pass gui) (movePass gui gameRef histRef)
+ onActivateLeaf (menu_item_pass gui) (movePass gui gameRef)
onActivateLeaf (menu_item_show_heights gui) $ redrawCanvas (canvas gui)
onActivateLeaf (menu_item_show_moves gui) $ redrawCanvas (canvas gui)
-- set callback to update the widgets and redraw the canvas
- Var.watch gameRef $
- \g -> do { h<-Var.get histRef
- ; updateWidgets gui g h
- ; redrawCanvas (canvas gui)
- }
- Var.watch histRef $
- \h -> do { g<-Var.get gameRef
- ; updateWidgets gui g h }
+ Var.watch gameRef $ \gh ->
+ do { updateWidgets gui gh
+ ; redrawCanvas (canvas gui)
+ }
-- | start a new game
-newGame :: GUI -> GameRef -> HistRef -> IO ()
-newGame gui gameRef histRef
+newGame :: GUI -> GameRef -> IO ()
+newGame gui gameRef
= do r <- checkMenuItemGetActive (menu_item_random_start gui)
b <- if r then randomBoardIO else return startingBoard
- Var.set gameRef (initGame b)
- Var.set histRef (History.init $ initGame b)
+ Var.set gameRef (initGame b, History.init $ initGame b)
-- | open a saved game
-openGame :: GameRef -> HistRef -> FilePath -> IO ()
-openGame gameRef histRef filepath
+openGame :: GameRef -> FilePath -> IO ()
+openGame gameRef filepath
= withFile filepath ReadMode $ \handle ->
do txt <- hGetContents handle
case reads txt of
- (((g,h), _): _) -> Var.set gameRef g >>
- Var.set histRef h
- _ -> putStrLn ("WARNING: couldn't parse file " ++ show filepath)
+ ((gh,_): _) -> Var.set gameRef gh
+ _ -> putStrLn ("WARNING: couldn't parse game file " ++ show filepath)
-- | write a game file
-saveGame :: GameRef -> HistRef -> FilePath -> IO ()
-saveGame gameRef histRef filepath
+saveGame :: GameRef -> FilePath -> IO ()
+saveGame gameRef filepath
= withFile filepath WriteMode $ \handle ->
- do g<-Var.get gameRef
- h<-Var.get histRef
- hPrint handle (g,h)
+ Var.get gameRef >>= hPrint handle
fileDialogRun :: FileChooserDialog -> IO (Maybe FilePath)
-fileDialogRun w = do {dialogRun w ; widgetHide w; fileChooserGetFilename w}
-
+fileDialogRun w = do { r<-dialogRun w
+ ; widgetHide w
+ ; case r of
+ ResponseOk -> fileChooserGetFilename w
+ _ -> return Nothing
+ }
-- | get the selected AI player
@@ -248,8 +240,8 @@
-- | update widgets sensitivity
-updateWidgets :: GUI -> Game -> History Game -> IO ()
-updateWidgets gui g h
+updateWidgets :: GUI -> GameHist -> IO ()
+updateWidgets gui (g,h)
= do { widgetSetSensitive (menu_item_undo gui) $
s/=Wait2 && not (History.atStart h)
; widgetSetSensitive (menu_item_redo gui) $
@@ -281,55 +273,53 @@
-- | pass the 2nd move of a turn
-movePass :: GUI -> GameRef -> HistRef -> IO ()
-movePass gui gameRef histRef
- = do g <- Var.get gameRef
+movePass :: GUI -> GameRef -> IO ()
+movePass gui gameRef
+ = do (g,h) <- Var.get gameRef
let b = board g
case state g of
Wait0 | move b==2 ->
- dispatch gui gameRef histRef (makeMove Pass g)
+ dispatch gui gameRef (makeMove Pass g) h
_ -> return ()
-moveUndo :: GameRef -> HistRef -> IO ()
-moveUndo gameRef histRef
- = do h <- Var.get histRef
+moveUndo :: GameRef -> IO ()
+moveUndo gameRef
+ = do (_,h) <- Var.get gameRef
when (not $ History.atStart h) $
- do Var.set histRef (History.previous h)
- Var.set gameRef (History.get $ History.previous h)
+ let h' = History.previous h
+ in Var.set gameRef (History.get h', h')
-moveRedo :: GameRef -> HistRef -> IO ()
-moveRedo gameRef histRef
- = do h <- Var.get histRef
+moveRedo :: GameRef -> IO ()
+moveRedo gameRef
+ = do (_,h) <- Var.get gameRef
when (not $ History.atEnd h) $
- do Var.set histRef (History.next h)
- Var.set gameRef (History.get $ History.next h)
+ let h' = History.next h
+ in Var.set gameRef (History.get h', h')
-- | handle a button click on a board position
-clickPosition :: GUI -> GameRef -> HistRef -> Position -> IO ()
-clickPosition gui gameRef histRef p
- = do g <- Var.get gameRef
+clickPosition :: GUI -> GameRef -> Position -> IO ()
+clickPosition gui gameRef p
+ = do (g,h) <- Var.get gameRef
let moves = nextMoves (board g)
case state g of
Start0 | p`startMove`moves ->
- Var.set gameRef $ g {state=Start1 p}
+ Var.set gameRef (g {state=Start1 p}, h)
Start1 p' | p'==p ->
- Var.set gameRef $ g {state=Start0}
+ Var.set gameRef (g {state=Start0}, h)
Start1 p' | (Capture p' p)`elem`moves ->
- dispatch gui gameRef histRef $
- makeMove Pass (makeMove (Capture p' p) g)
+ dispatch gui gameRef
+ (makeMove Pass $ makeMove (Capture p' p) g) h
Wait0 | p`startMove`moves ->
- Var.set gameRef $ g {state=Wait1 p, trail=[]}
+ Var.set gameRef (g {state=Wait1 p, trail=[]}, h)
Wait1 p' | p'==p ->
- Var.set gameRef $ g {state=Wait0}
+ Var.set gameRef (g {state=Wait0}, h)
Wait1 p' | (Capture p' p)`elem`moves ->
- dispatch gui gameRef histRef $
- makeMove (Capture p' p) g
+ dispatch gui gameRef (makeMove (Capture p' p) g) h
Wait1 p' | (Stack p' p)`elem`moves ->
- dispatch gui gameRef histRef $
- makeMove (Stack p' p) g
+ dispatch gui gameRef (makeMove (Stack p' p) g) h
_ -> return ()
@@ -340,16 +330,15 @@
notNull [p' | Stack p' _<-moves, p'==p]
-- | dispatch a move
-dispatch :: GUI -> GameRef -> HistRef -> Game -> IO ()
-dispatch gui gameRef histRef g
+dispatch :: GUI -> GameRef -> Game -> History Game -> IO ()
+dispatch gui gameRef g h
= case state g of
- Wait0 -> Var.modify histRef (History.record g') >>
- Var.set gameRef g
- Finish -> Var.modify histRef (History.record g') >>
- Var.set gameRef g
- Wait2 -> Var.set gameRef g >>
- forkIO runAI >> return ()
- _ -> Var.set gameRef g
+ Wait0 -> Var.set gameRef (g, History.record g' h)
+ Finish -> Var.set gameRef (g, History.record g' h)
+ Wait2 -> Var.set gameRef (g,h) >>
+ forkIO runAI >>
+ return ()
+ _ -> Var.set gameRef (g,h)
where
g' = g { trail=[] }
-- run the AI player asynchronously
@@ -361,8 +350,7 @@
; let g' = makeMove m2 $ makeMove m1 $ g { trail=[] }
-- force evaluation in this thread
; m1 `seq` m2 `seq`
- Var.modify histRef (History.record g')
- ; Var.set gameRef g'
+ Var.set gameRef (g', History.record g' h)
}
makeMove :: Move -> Game -> Game
@@ -391,7 +379,7 @@
b2 <- checkMenuItemGetActive (menu_item_show_moves gui)
(w,h)<-widgetGetSize (canvas gui)
drawin <- widgetGetDrawWindow (canvas gui)
- g <- Var.get gameRef
+ (g,_) <- Var.get gameRef
renderWithDrawable drawin $
renderWithSimilarSurface ContentColor w h $
\tmp ->
diff --git a/src/Main.hs b/src/Main.hs
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -8,23 +8,32 @@
import GUI
import Tournament
import Tests
+import Data.List (intersperse)
import System
import System.Random
import System.Console.GetOpt
import System.Exit
import Control.Monad (when)
+import System.Directory
+import System.FilePath
data Flag = Seed Int
| NumMatches Int
+ | DataDir FilePath
| RunTests
deriving Show
options :: [OptDescr Flag]
-options = [Option ['s'] ["seed"] (ReqArg (Seed . read) "SEED") "random number seed",
- Option ['n'] ["matches"] (ReqArg (NumMatches . read) "N") "number of matches (for AI tournaments)",
- Option ['T'] ["tests"] (NoArg RunTests) "run QuickCheck tests"
+options = [Option ['s'] ["seed"] (ReqArg (Seed . read) "SEED")
+ "random number seed",
+ Option ['n'] ["matches"] (ReqArg (NumMatches . read) "N")
+ "number of matches (for AI tournaments)",
+ Option ['d'] ["dir"] (ReqArg DataDir "DATADIR")
+ "data directory",
+ Option ['T'] ["tests"] (NoArg RunTests)
+ "run QuickCheck tests"
]
parseArgs :: [String] -> IO ([Flag],[String])
@@ -41,27 +50,28 @@
-- default number of matches for AI tournaments
-defMatches :: Int
-defMatches = 10
+matches :: Int
+matches = 10
-processFlags :: [Flag] -> IO Int
-processFlags flags = process flags defMatches
+processFlags :: [Flag] -> IO ()
+processFlags = mapM_ process
where
- process [] m = return m
- process (RunTests:flags) m = run_tests >> exitSuccess
- process (Seed s:flags) m = setStdGen (mkStdGen s) >> process flags m
- process (NumMatches n:flags) _ = process flags n
+ process RunTests = run_tests >> exitSuccess
+ process (Seed s) = setStdGen (mkStdGen s)
+ process _ = return ()
main :: IO ()
main = do argv<-getArgs
(flags, argv')<- parseArgs argv
- numMatches <- processFlags flags
+ processFlags flags
+ dir <- getDataDir
+ let numMatches = last (matches : [n | NumMatches n <- flags])
+ let gladepath = last (dir : [d | DataDir d <- flags]) "hstzaar.glade"
--
case argv' of
- [] -> do gladepath <- getDataFileName "data/hstzaar.glade"
- gui gladepath
+ [] -> gui gladepath
[a1,a2] | a1`elem`ais && a2`elem`ais->
do let numboards = max 1 (numMatches`div`2)
rndgen <- getStdGen