hstzaar 0.1 → 0.2
raw patch · 3 files changed
+56/−42 lines, 3 files
Files
- hstzaar.cabal +2/−2
- src/AI.hs +11/−0
- src/GUI.hs +43/−40
hstzaar.cabal view
@@ -1,5 +1,5 @@ name: hstzaar-version: 0.1+version: 0.2 category: Game @@ -30,7 +30,7 @@ executable hstzaar hs-source-dirs: src main-is: Main.hs- other-modules: GUI Board AI.Utils AI.Lame AI.Minimax+ other-modules: GUI Board AI AI.Utils AI.Lame AI.Minimax build-depends: base >= 4 && < 5, containers,
+ src/AI.hs view
@@ -0,0 +1,11 @@+-- | Library of AI Players+module AI (ai_players) where++import Board++import AI.Lame+import AI.Minimax++ai_players :: [AI]+ai_players = [dyn1, dyn2, ply2, ply3, ply4, greedy, lame]+
src/GUI.hs view
@@ -168,10 +168,10 @@ redrawCanvas (canvas gui) onActivateLeaf (menu_item_undo gui) $ - do modifyIORef stateRef undoHistory+ do modifyIORef stateRef prevHistory redrawCanvas (canvas gui) onActivateLeaf (menu_item_redo gui) $ - do modifyIORef stateRef redoHistory+ do modifyIORef stateRef nextHistory redrawCanvas (canvas gui) onActivateLeaf (menu_item_pass gui) (movePass gui stateRef)@@ -243,33 +243,42 @@ notNull = not . null + -- handle undo and redo buttons-undoHistory :: State -> State-undoHistory s ++-- add to history+addHistory :: State -> State+addHistory s = s { history = s:history s, future = [] }+++-- should we record this state ?+recState :: State -> Bool+recState s = case stage s of+ Start0 -> True+ Wait0 -> True+ Wait2 m -> True+ Finish -> True+ _ -> False++++-- move backwards/foward in history+prevHistory :: State -> State+prevHistory s = case history s of [] -> s- (s':ss) -> s' {history=ss, future=r:future s}- where r = recState s+ (s':ss) -> s' {history=ss, future=if recState s then s:future s else future s} -redoHistory :: State -> State-redoHistory s ++nextHistory :: State -> State+nextHistory s = case future s of [] -> s- (s':ss) -> s' {history=r:history s, future=ss}- where r = recState s+ (s':ss) -> s' {history=if recState s then s:history s else history s, future=ss} --- "recordable state" projection-recState :: State -> State-recState s = s { stage = stage' }- where stage' = case stage s of- Start1 _ -> Start0- Wait1 _ -> Wait0- Wait3 m _ -> Wait2 m- _ -> stage s - -- pass the 2nd move of a turn movePass :: GUI -> StateRef -> IO () movePass gui stateRef @@ -471,34 +480,28 @@ let turns = fst $ unzip branches case stage s of Start0 | notNull [p0 | ((p0, _), _)<-turns, p0==p] -> - let s'= s { history = s : history s,- future = [],- stage = Start1 p }- in do writeIORef stateRef s'+ let s'= addHistory s+ in do writeIORef stateRef $ s' {stage=Start1 p} redrawCanvas cv- Start1 p0 | p0==p -> do writeIORef stateRef $ s {stage=Start0}+ Start1 p0 | p0==p -> do modifyIORef stateRef prevHistory redrawCanvas cv Start1 p0 | notNull [m | (m, _)<- turns, m==(p0,p)] -> dispatchTurn gui stateRef s ((p0,p),Nothing) --- Wait0 | notNull [p0 | ((p0, _), _)<-turns, p0==p] -> - let s'= s { history = s : history s,- future = [],- stage=Wait1 p }- in do writeIORef stateRef s'+ let s'= addHistory s + in do writeIORef stateRef $ s' {stage=Wait1 p} redrawCanvas cv- Wait1 p0 | p0==p -> do writeIORef stateRef $ s {stage=Wait0}+ Wait1 p0 | p0==p -> do modifyIORef stateRef prevHistory redrawCanvas cv Wait1 p0 | notNull [m | (m, _)<- turns, m==(p0,p)] -> do writeIORef stateRef $ s {stage=Wait2 (p0,p)} redrawCanvas cv Wait2 m | notNull [p0 | (m', Just (p0, _))<-turns, m==m', p0==p] -> - let s'=s { history = s : history s,- future = [],- stage = Wait3 m p } - in do writeIORef stateRef s'+ let s'= addHistory s+ in do writeIORef stateRef $ s' {stage=Wait3 m p} redrawCanvas cv- Wait3 m p0 | p0==p -> do writeIORef stateRef $ s {stage=Wait2 m}+ Wait3 m p0 | p0==p -> do modifyIORef stateRef prevHistory redrawCanvas cv Wait3 m p0 | t`elem`turns -> dispatchTurn gui stateRef s t where t = (m, Just (p0, p))@@ -510,9 +513,9 @@ dispatchTurn :: GUI -> StateRef -> State -> Turn -> IO () dispatchTurn gui stateRef s t | null branches' -- white wins- = let s' = s { stage = Finish, - bt = swapBoardTree bt', - stdGen = g }+ = let s' = addHistory $ s { stage = Finish, + bt = swapBoardTree bt', + stdGen = g } in do gui `pushMsg` "White wins" writeIORef stateRef s' redrawCanvas (canvas gui)@@ -526,9 +529,9 @@ where child = if null branches'' then- let s'= s { stage = Finish, - bt = bt'', - stdGen = g }+ let s'= addHistory $ s { stage = Finish, + bt = bt'', + stdGen = g } in do writeIORef stateRef s' redrawCanvas (canvas gui) gui `pushMsg` "Black wins"