summaryrefslogtreecommitdiff
path: root/progs/demo/X11/gobang/redraw.hs
diff options
context:
space:
mode:
Diffstat (limited to 'progs/demo/X11/gobang/redraw.hs')
-rw-r--r--progs/demo/X11/gobang/redraw.hs160
1 files changed, 160 insertions, 0 deletions
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
+
generated by cgit v1.2.3 (git 2.46.0) at 2024-09-16 19:26:54 +0000