From 4e987026148fe65c323afbc93cd560c07bf06b3f Mon Sep 17 00:00:00 2001 From: Yale AI Dept Date: Wed, 14 Jul 1993 13:08:00 -0500 Subject: Import to github. --- progs/demo/X11/gobang/redraw.hs | 160 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 160 insertions(+) create mode 100644 progs/demo/X11/gobang/redraw.hs (limited to 'progs/demo/X11/gobang/redraw.hs') diff --git a/progs/demo/X11/gobang/redraw.hs b/progs/demo/X11/gobang/redraw.hs new file mode 100644 index 0000000..9ec772f --- /dev/null +++ b/progs/demo/X11/gobang/redraw.hs @@ -0,0 +1,160 @@ +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 + -- cgit v1.2.3