module Redraw where
import Xlib
import Utilities
may_redraw :: Bool -> XInfo -> GameState -> IO ()
may_redraw ok xinfo state = if ok then redraw xinfo state else returnIO ()
redraw :: XInfo -> GameState -> IO ()
redraw xinfo state =
let (XInfo display window gcontext gcontext2 gcontextp) = xinfo
in
xDrawRectangle (XDrawWindow window) gcontext2 (XRect 0 0 900 600) True
`thenIO` \ _ ->
drawBoard xinfo `thenIO` \ () ->
xDrawGlyphs (XDrawWindow window) gcontextp (XPoint 610 65) "Player 1"
`thenIO` \ _ ->
xDrawGlyphs (XDrawWindow window) gcontextp (XPoint 620 125) "Clock 1"
`thenIO` \ _ ->
xDrawGlyphs (XDrawWindow window) gcontextp (XPoint 610 205) "Player 2"
`thenIO` \ _ ->
xDrawGlyphs (XDrawWindow window) gcontextp (XPoint 620 265) "Clock 2"
`thenIO` \ _ ->
xDrawRectangle (XDrawWindow window) gcontext (XRect 700 45 130 30) False
`thenIO` \ () ->
xDrawRectangle (XDrawWindow window) gcontext (XRect 700 105 90 30) False
`thenIO` \ () ->
xDrawRectangle (XDrawWindow window) gcontext (XRect 700 185 130 30) False
`thenIO` \() ->
xDrawRectangle (XDrawWindow window) gcontext (XRect 700 245 90 30) False
`thenIO` \() ->
button 700 330 "New players" xinfo `thenIO` \() ->
button 700 360 "New game" xinfo `thenIO` \() ->
button 700 390 "Undo" xinfo `thenIO` \() ->
button 700 420 "Load" xinfo `thenIO` \() ->
button 700 450 "Save" xinfo `thenIO` \() ->
button 700 480 "Quit" xinfo `thenIO` \() ->
helpButton xinfo `thenIO` \ _ ->
xDrawRectangle (XDrawWindow window) gcontext (XRect 615 535 250 30) False
`thenIO` \ _ ->
let (GameState player1 player2 board steps weight1 weight2 time
numbersteps promptString next_player) = state
in
xMArrayLookup time 0 `thenIO` \ lstm0 ->
xMArrayLookup time 1 `thenIO` \ lstm1 ->
showtime 705 270 (lstm1) xinfo `thenIO` \() ->
showtime 705 130 (lstm0) xinfo `thenIO` \() ->
xMArrayLookup player1 0 `thenIO` \ player1_name ->
xDrawGlyphs (XDrawWindow window) gcontextp (XPoint 710 65) player1_name
`thenIO` \ _ ->
xMArrayLookup player2 0 `thenIO` \ player2_name ->
xDrawGlyphs (XDrawWindow window) gcontextp (XPoint 710 205) player2_name
`thenIO` \ _ ->
xMArrayLookup promptString 0 `thenIO` \ ps ->
xDrawGlyphs (XDrawWindow window) gcontext (XPoint 620 550) ps
`thenIO` \ _ ->
xMArrayLookup next_player 0 `thenIO` \ next_player_num ->
(if (next_player_num == 1)
then xDrawGlyph (XDrawWindow window) gcontextp (XPoint 850 70) '<'
else xDrawGlyph (XDrawWindow window) gcontextp (XPoint 850 210) '<')
`thenIO` \ _ ->
drawPieces 1 1 board xinfo `thenIO` \ _ ->
returnIO ()
drawHelp (XInfo display window gcontext gcontext2 gcontextp) =
xDrawRectangle (XDrawWindow window) gcontext2 (XRect 100 100 300 200) True
`thenIO` \ _ ->
xDrawRectangle (XDrawWindow window) gcontext (XRect 100 100 300 200) False
`thenIO` \ _ ->
xDrawRectangle (XDrawWindow window) gcontext (XRect 102 102 296 196) False
`thenIO` \ _ ->
xDrawRectangle (XDrawWindow window) gcontext (XRect 200 230 100 60) False
`thenIO` \ _ ->
xDrawRectangle (XDrawWindow window) gcontext (XRect 202 232 96 56) False
`thenIO` \ _ ->
xDrawGlyphs (XDrawWindow window) gcontextp (XPoint 240 265) "OK"
`thenIO` \ _ ->
xDrawGlyphs (XDrawWindow window) gcontext (XPoint 120 120)
"Two players in turn place black and white"
`thenIO` \ _ ->
xDrawGlyphs (XDrawWindow window) gcontext (XPoint 120 135)
"pieces on the board. The winner is the"
`thenIO` \ _ ->
xDrawGlyphs (XDrawWindow window) gcontext (XPoint 120 150)
"player who first makes five consecutive"
`thenIO` \ _ ->
xDrawGlyphs (XDrawWindow window) gcontext (XPoint 120 165)
"pieces in either vertical, horizontal or"
`thenIO` \ _ ->
xDrawGlyphs (XDrawWindow window) gcontext (XPoint 120 180)
"diagonal directions."
`thenIO` \ _ ->
xDrawGlyphs (XDrawWindow window) gcontext (XPoint 120 200)
"To play with a robot, type \"computer\" as"
`thenIO` \ _ ->
xDrawGlyphs (XDrawWindow window) gcontext (XPoint 120 215)
"the name of another player."
drawBoard (XInfo display window gcontext gcontext2 gcontextp) =
drawvlines 30 30 1 `thenIO` \() ->
drawhlines 30 30 1 `thenIO` \() ->
drawmarks where
drawvlines :: Int -> Int -> Int -> IO ()
drawvlines x y z
| z <= 19
= xDrawLine (XDrawWindow window) gcontext
(XPoint x y) (XPoint x (y+30*18)) `thenIO` \() ->
drawvlines (x+30) y (z+1)
| otherwise
= returnIO ()
drawhlines :: Int -> Int -> Int -> IO ()
drawhlines x y z
| z <= 19
= xDrawLine (XDrawWindow window) gcontext
(XPoint x y) (XPoint (x+30*18) y) `thenIO` \() ->
drawhlines x (y+30) (z+1)
| otherwise
= returnIO ()
drawmarks :: IO ()
drawmarks =
map2IO (\x y ->
xDrawArc (XDrawWindow window) gcontext
(XArc x y 6 6 (-1.0) 6.283) True)
(map (\x -> 30 + x*30-3) [3,9,15,3,9,15,3,9,15])
(map (\x -> 30 + x*30-3) [3,3,3,9,9,9,15,15,15])
`thenIO` \ _ -> returnIO ()
map2IO :: (a -> b -> IO c) -> [a] -> [b] -> IO [c]
map2IO f [] [] = returnIO []
map2IO f (x:xs) (z:zs) = f x z `thenIO` \ y ->
map2IO f xs zs `thenIO` \ ys ->
returnIO (y:ys)
drawPieces 20 _ board xinfo = returnIO ()
drawPieces x 20 board xinfo = drawPieces (x+1) 1 board xinfo
drawPieces x y board xinfo =
xMArrayLookup board ((x-1)*19 + y-1) `thenIO` \ piece ->
(if (piece == 1 || piece == 2)
then drawPiece x y xinfo (piece == 1)
else returnIO ()) `thenIO` \ _ ->
drawPieces x (y+1) board xinfo
drawPiece x y (XInfo display window gcontext gcontext2 _ ) is_black =
(if is_black then returnIO ()
else xDrawArc (XDrawWindow window) gcontext2
(XArc (30*x-10) (30*y-10) 20 20
(-1.0) 6.283)
True) `thenIO` \ _ ->
xDrawArc (XDrawWindow window) gcontext
(XArc (30*x-10) (30*y-10) 20 20
(-1.0) 6.283)
is_black `thenIO` \ _ ->
xDisplayForceOutput display