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
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
|
module Utilities where
import Xlib
import Weights
import Redraw
import Misc
data XInfo = XInfo XDisplay XWindow XGcontext XGcontext XGcontext
data GameState = GameState (XMArray String) (XMArray String) (XMArray Int)
(XMArray Int) (XMArray Int) (XMArray Int)
(XMArray Integer) (XMArray Int)
(XMArray String) (XMArray Int)
type GameCont = XInfo -> GameState -> IO ()
xMArrayToList :: XMArray a -> IO [a]
xMArrayToList a =
let la = xMArrayLength a
loop i a = if i == la then returnIO []
else xMArrayLookup a i `thenIO` \ x ->
loop (i+1) a `thenIO` \ xs ->
returnIO (x:xs)
in
loop 0 a
readGameState str =
let
[(board_lst, r1)] = reads str
[(weight1_lst, r2)] = reads r1
[(weight2_lst, r3)] = reads r2
[(steps_lst, r4)] = reads r3
[(player1_lst, r5)] = reads r4
[(player2_lst, r6)] = reads r5
[(time_lst, r7)] = reads r6
[(numbersteps_lst, r8)] = reads r7
[(promptString_lst, r9)] = reads r8
[(next_player_lst, [])] = reads r9
in
xMArrayCreate board_lst `thenIO` \ board ->
xMArrayCreate weight1_lst `thenIO` \ weight1 ->
xMArrayCreate weight2_lst `thenIO` \ weight2 ->
xMArrayCreate steps_lst `thenIO` \ steps ->
xMArrayCreate player1_lst `thenIO` \ player1 ->
xMArrayCreate player2_lst `thenIO` \ player2 ->
xMArrayCreate time_lst `thenIO` \ time ->
xMArrayCreate numbersteps_lst `thenIO` \ numbersteps ->
xMArrayCreate promptString_lst `thenIO` \ promptString ->
xMArrayCreate next_player_lst `thenIO` \ next_player ->
returnIO (GameState player1 player2 board steps weight1 weight2 time
numbersteps promptString next_player)
showGameState (GameState player1 player2 board steps weight1 weight2 time
numbersteps promptString next_player) =
xMArrayToList board `thenIO` \ board_lst ->
xMArrayToList weight1 `thenIO` \ weight1_lst ->
xMArrayToList weight2 `thenIO` \ weight2_lst ->
xMArrayToList steps `thenIO` \ steps_lst ->
xMArrayToList player1 `thenIO` \ player1_lst ->
xMArrayToList player2 `thenIO` \ player2_lst ->
xMArrayToList time `thenIO` \ time_lst ->
xMArrayToList numbersteps `thenIO` \ numbersteps_lst ->
xMArrayToList promptString `thenIO` \ promptString_lst ->
xMArrayToList next_player `thenIO` \ next_player_lst ->
let
str =(shows board_lst .
shows weight1_lst .
shows weight2_lst .
shows steps_lst .
shows player1_lst .
shows player2_lst .
shows time_lst .
shows numbersteps_lst .
shows promptString_lst .
shows next_player_lst) []
in
returnIO str
xMod :: Int -> Int -> Int
xMod x y | x >= y = xMod (x-y) y
| otherwise = x
xRes :: Int -> Int -> Int -> Int
xRes x y z | x >= y = xRes (x-y) y (z+1)
| otherwise = z
drawCmd :: String -> XInfo -> GameState -> IO ()
drawCmd a (XInfo display window gcontext gcontext2 gcontextp)
(GameState _ _ _ _ _ _ _ _ str _)
= xDrawRectangle (XDrawWindow window) gcontext2
(XRect 616 536 248 28) True `thenIO` \ () ->
xDrawGlyphs (XDrawWindow window) gcontext
(XPoint 620 550) a `thenIO` \ _ ->
xMArrayUpdate str 0 a `thenIO` \ _ ->
xDisplayForceOutput display
clearCmd :: XInfo -> GameState -> IO ()
clearCmd (XInfo display window gcontext gcontext2 gcontextp)
(GameState _ _ _ _ _ _ _ _ str _)
= xDrawRectangle (XDrawWindow window) gcontext2
(XRect 616 536 248 28) True `thenIO` \() ->
xMArrayUpdate str 0 "" `thenIO` \ _ ->
xDisplayForceOutput display
xPosition :: Int -> XPoint
xPosition a = (XPoint (xRes a 19 1) (1+ (xMod a 19)))
initArray :: XMArray a -> Int -> Int -> a -> IO ()
initArray mary x y z | x<y = xMArrayUpdate mary x z `thenIO` \() ->
initArray mary (x+1) y z
| otherwise = returnIO ()
getposition :: Int -> Int -> XMaybe (Int, Int)
getposition x y = let x1 = round ((fromIntegral x) / 30.0)
y1 = round ((fromIntegral y) / 30.0)
in
if (x1 < 1 || x1 > 19 || y1 < 1 || y1 > 19) then XNull
else XSome (x1, y1)
addZero :: Int -> String
addZero a | a < 10 = "0"
| otherwise = ""
printTime :: Int -> Int -> [Int] -> XInfo -> IO()
printTime x y zs (XInfo display window gcontext gcontext2 gcontextp)
= let s = head zs
m = head (tail zs)
h = head (tail (tail zs))
in xDrawRectangle (XDrawWindow window) gcontext2
(XRect (x-4) (y-24) 88 28) True `thenIO` \() ->
xDrawGlyphs (XDrawWindow window) gcontextp (XPoint x y)
((addZero h)++(show h)++":"++(addZero m)++(show m)++
":"++(addZero s)++(show s))
`thenIO` \(trash) ->
xDisplayForceOutput display
showtime :: Int -> Int -> Integer -> XInfo -> IO()
showtime x y z a =
let (curtm, c) = (decodeTime z (WestOfGMT 0))
in printTime x y curtm a
helpButton :: XInfo -> IO ()
helpButton (XInfo display window gcontext gcontext2 gcontextp) =
xDrawRectangle (XDrawWindow window) gcontext (XRect 800 420 70 70)
False `thenIO` \ _ ->
xDrawRectangle (XDrawWindow window) gcontext (XRect 802 422 66 66)
False `thenIO` \ _ ->
xDrawGlyphs (XDrawWindow window) gcontextp (XPoint 810 450) "About"
`thenIO` \ _ ->
xDrawGlyphs (XDrawWindow window) gcontext (XPoint 820 470) "Gobang"
`thenIO` \ _ ->
returnIO ()
ishelp :: Int -> Int -> Bool
ishelp x y = (x > 800 && x < 870 && y > 420 && y < 490)
button :: Int -> Int -> String -> XInfo -> IO()
button x y a (XInfo display window gcontext gcontext2 gcontextp) =
xDrawArc (XDrawWindow window) gcontext
(XArc (x-40) (y-10) 20 20 1.5708 4.7124) True `thenIO` \() ->
xDrawRectangle (XDrawWindow window) gcontext
(XRect (x-30) (y-10) 60 20) True `thenIO` \() ->
xDrawArc (XDrawWindow window) gcontext
(XArc (x+20) (y-10) 20 20 (-1.0) 6.283) True `thenIO` \() ->
xDrawGlyphs (XDrawWindow window) gcontext2
(XPoint (x-(length a * 3)) (y+4)) a `thenIO` \(trash) ->
xDisplayForceOutput display
-- a b are the location of the button, c d are the point where we press the
-- button.
buttonPress :: Int -> Int -> Int -> Int -> Bool
buttonPress a b c d | (abs (c-a))<=30 && (abs (d-b))<=10 = True
| (c-a+30)*(c-a+30)+(d-b)*(d-b)<=100 = True
| (c-a-30)*(c-a-30)+(d-b)*(d-b)<=100 = True
| otherwise = False
randmax :: XMArray Int -> Int -> Int -> [Int] -> IO Int
randmax a ind max mi | ind > 360 =
let lmi = length mi
in case lmi of
0 -> returnIO (-1)
1 -> returnIO (head mi)
_ -> random lmi `thenIO` \ i ->
returnIO (mi !! i)
| otherwise = xMArrayLookup a ind `thenIO` \ tt3 ->
if (tt3 > max)
then randmax a (ind+1) tt3 [ind]
else if (tt3 == max)
then randmax a (ind+1) max (ind:mi)
else randmax a (ind+1) max mi
robot :: XMArray Int -> XMArray Int -> XMArray Int -> IO XPoint
robot numbersteps weight1 weight2
= xMArrayLookup numbersteps 0 `thenIO` \(tt5) ->
if (tt5 == 0)
then returnIO (XPoint 10 10)
else
randmax weight1 0 0 [] `thenIO` \ tmp1 ->
randmax weight2 0 0 [] `thenIO` \ tmp2 ->
xMArrayLookup weight1 tmp1 `thenIO` \ tmp3 ->
xMArrayLookup weight2 tmp2 `thenIO` \ tmp4 ->
if (tmp3 >= 200)
then returnIO (xPosition tmp1)
else if (tmp3 > tmp4)
then returnIO (xPosition tmp1)
else returnIO (xPosition tmp2)
promptFor prompt xinfo state =
let (GameState player1 player2 board steps weight1 weight2 time
numbersteps promptString next_player) = state
(XInfo display window gcontext gcontext2 gcontextp) = xinfo
in
xDrawRectangle (XDrawWindow window) gcontext2
(XRect 616 536 248 28) True `thenIO` \() ->
xMArrayUpdate promptString 0 prompt `thenIO` \ _ ->
xDrawGlyphs (XDrawWindow window) gcontext (XPoint 620 550) prompt
`thenIO` \ _ ->
xDisplayForceOutput display `thenIO` \ _ ->
let h_base = (length prompt + 1) * 6 + 620
getString :: Int -> String -> IO String
getString h_pos sofar =
xGetEvent display `thenIO` \event ->
case (xEventType event) of
XButtonPressEvent ->
let (XPoint x y) = xEventPos event
in
(if ishelp x y then helpGame xinfo state
else xBell display 0)
`thenIO` \ _ ->
getString h_pos sofar
XExposureEvent ->
may_redraw (xEventCount event == 0) xinfo state `thenIO` \ _ ->
xDrawGlyphs (XDrawWindow window) gcontext (XPoint h_base 550) sofar
`thenIO` \ _ ->
xDrawRectangle (XDrawWindow window) gcontext
(XRect (h_base + 6 * h_pos) (550-10) 6 13) True
`thenIO` \ _ -> getString h_pos sofar
XKeyPressEvent ->
let code = xEventCode event
state = xEventState event
bs = if (sofar == "") then getString h_pos sofar
else xDrawRectangle (XDrawWindow window) gcontext2
(XRect (h_base + 6 * h_pos)
(550-10) 6 13)
True `thenIO` \ _ ->
xDrawRectangle (XDrawWindow window) gcontext
(XRect (h_base + 6 * (h_pos - 1))
(550-10) 6 13)
True `thenIO` \ _ ->
getString (h_pos-1) (take (length sofar - 1) sofar)
in
xKeycodeCharacter display code state `thenIO` \ char ->
case char of
(XSome '\r') -> returnIO sofar
(XSome '\DEL') -> bs
(XSome '\BS') -> bs
XNull -> getString h_pos sofar
(XSome c) -> xDrawRectangle (XDrawWindow window) gcontext2
(XRect (h_base + 6 * h_pos)
(550-10) 6 13)
True `thenIO` \ _ ->
xDrawGlyph (XDrawWindow window) gcontext
(XPoint (h_base + 6 * h_pos) 550) c
`thenIO` \ _ ->
xDrawRectangle (XDrawWindow window) gcontext
(XRect (h_base + 6 * (h_pos + 1))
(550-10) 6 13)
True `thenIO` \ _ ->
getString (h_pos + 1) (sofar ++ [c])
in
xDrawRectangle (XDrawWindow window) gcontext
(XRect h_base (550-10) 6 13) True
`thenIO` \ _ ->
getString 0 ""
helpGame xinfo@(XInfo display window gcontext gcontext2 gcontextp) state =
drawHelp xinfo `thenIO` \ _ ->
let
loop xinfo state =
xGetEvent display `thenIO` \ event ->
case (xEventType event) of
XExposureEvent -> may_redraw (xEventCount event == 0) xinfo state
`thenIO` \ _ ->
drawHelp xinfo `thenIO` \ _ ->
loop xinfo state
XButtonPressEvent ->
let (XPoint x y) = xEventPos event
in
if (x > 200 && x < 300 && y > 230 && y < 290)
then redraw xinfo state `thenIO` \ _ ->
returnIO ()
else loop xinfo state
_ -> xBell display 0 `thenIO` \ _ ->
loop xinfo state
in
loop xinfo state
|
