1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
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
|
