blob: 1b55553ebb9c0936a84d59bf9e41414227156919 (
about) (
plain)
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
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
|
module Weights where
import Xlib
import Utilities
xlookup :: XMArray Int -> Int -> Int -> IO Int
xlookup keyboard x y =
if (x < 1 || x > 19 || y < 1 || y > 19)
then returnIO (-2)
else xMArrayLookup keyboard ((x-1)*19+(y-1))
draw_unit :: XMArray Int -> XMArray Int -> XMArray Int -> Int -> Int -> IO()
draw_unit keyboard weight1 weight2 x y =
let
update_weight :: XMArray Int->Int->Int->Int->Int->Int->Int->IO()
update_weight weight counter player x y incr_x incr_y
| x>=1 && x<=19 && y>=1 && y<=19 && counter<=4 =
cpt_weight x y player `thenIO` \wt ->
xMArrayUpdate weight ((x-1)*19+(y-1)) wt `thenIO` \() ->
update_weight weight (counter+1) player (x+incr_x) (y+incr_y)
incr_x incr_y
| otherwise = returnIO ()
----------------------------------------------------------------------------
pattern0 :: Int -> Int -> Int -> Int -> Int -> Int -> Bool
pattern0 a b c d e p | a==p && b==p && c==p && d==p && e==p = True
| otherwise = False
----------------------------------------------------------------------------
pattern1 :: Int -> Int -> Int -> Int -> Int -> Int -> Int -> Bool
pattern1 a b c d e f p | (a==0) && (b==p) && (c==p) && (d==p) && (e==p) &&
(f==0) = True
| otherwise = False
----------------------------------------------------------------------------
pattern2 :: Int -> Int -> Int -> Int -> Int -> Int -> Bool
pattern2 a b c d e p | (a==0 && b==p && c==p && d==p && e==p)||
(a==p && b==p && c==p && d==p && e==0) = True
| otherwise = False
----------------------------------------------------------------------------
pattern3 :: Int -> Int -> Int -> Int -> Int -> Int -> Bool
pattern3 a b c d e p | (a==0 && b==p && c==p && d==p && e==0) = True
| otherwise = False
----------------------------------------------------------------------------
pattern4 :: Int -> Int -> Int -> Int -> Int -> Bool
pattern4 a b c d p | (a==0 && b==p && c==p && d==p) ||
(a==p && b==p && c==p && d==0) = True
| otherwise = False
----------------------------------------------------------------------------
pattern5 :: Int -> Int -> Int -> Int -> Int -> Int -> Int -> Bool
pattern5 a b c d e f p | (a==0 && b==p && c==p && d==0 && e==p &&
f==0) ||
(a==0 && b==p && c==0 && d==p && e==p &&
f==0) = True
| otherwise = False
----------------------------------------------------------------------------
pattern6 :: Int -> Int -> Int -> Int -> Int -> Int -> Bool
pattern6 a b c d e p | (a==0 && b==p && c==p && d==0 && e==p) ||
(a==0 && b==p && c==0 && d==p && e==p) ||
(a==p && b==p && c==0 && d==p && e==0) ||
(a==p && b==0 && c==p && d==p && e==0) = True
| otherwise = False
----------------------------------------------------------------------------
pattern7 :: Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int-> Bool
pattern7 a b c d e f g p | (a==0 && b==p && c==0 && d==p && e==0 &&
f==p && g==0) = True
| otherwise = False
----------------------------------------------------------------------------
pattern8 :: Int -> Int -> Int -> Int -> Int -> Int -> Int -> Bool
pattern8 a b c d e f p | (a==0 && b==p && c==0 && d==p && e==0 &&
f==p) ||
(a==p && b==0 && c==p && d==0 && e==p &&
f==0) = True
| otherwise = False
----------------------------------------------------------------------------
pattern9 :: Int -> Int -> Int -> Int -> Int -> Bool
pattern9 a b c d p | (a==0 && b==p && c==p && d==0) = True
| otherwise = False
----------------------------------------------------------------------------
pattern10 :: Int -> Int -> Int -> Int -> Bool
pattern10 a b c p | (a==0 && b==p && c==p) ||
(a==p && b==p && c==0) = True
| otherwise = False
----------------------------------------------------------------------------
pattern11 :: Int -> Int -> Int -> Int -> Int -> Int -> Bool
pattern11 a b c d e p | (a==0 && b==p && c==0 && d==p && e==0) = True
| otherwise = False
----------------------------------------------------------------------------
pattern12 :: Int -> Int -> Int -> Int -> Int -> Bool
pattern12 a b c d p | (a==0 && b==p && c==0 && d==p) ||
(a==p && b==0 && c==p && d==0) = True
| otherwise = False
----------------------------------------------------------------------------
direct1 :: Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int ->
Int -> Int -> Int -> Int -> Int -> Int
direct1 x y pl ptN1 ptN2 ptN3 ptN4 ptN5 pt ptP1 ptP2 ptP3 ptP4 ptP5
| (pattern0 ptN4 ptN3 ptN2 ptN1 pt pl) ||
(pattern0 ptN3 ptN2 ptN1 pt ptP1 pl) ||
(pattern0 ptN2 ptN1 pt ptP1 ptP2 pl) ||
(pattern0 ptN1 pt ptP1 ptP2 ptP3 pl) ||
(pattern0 pt ptP1 ptP2 ptP3 ptP4 pl) = 200
| (pattern1 ptN4 ptN3 ptN2 ptN1 pt ptP1 pl) ||
(pattern1 ptN3 ptN2 ptN1 pt ptP1 ptP2 pl) ||
(pattern1 ptN2 ptN1 pt ptP1 ptP2 ptP3 pl) ||
(pattern1 ptN1 pt ptP1 ptP2 ptP3 ptP4 pl) = 40
| (pattern2 ptN4 ptN3 ptN2 ptN1 pt pl) ||
(pattern2 ptN3 ptN2 ptN1 pt ptP1 pl) ||
(pattern2 ptN2 ptN1 pt ptP1 ptP2 pl) ||
(pattern2 ptN1 pt ptP1 ptP2 ptP3 pl) = 13
| (pattern3 ptN3 ptN2 ptN1 pt ptP1 pl) ||
(pattern3 ptN2 ptN1 pt ptP1 ptP2 pl) ||
(pattern3 ptN1 pt ptP1 ptP2 ptP3 pl) = 10
| (pattern4 ptN3 ptN2 ptN1 pt pl) ||
(pattern4 ptN2 ptN1 pt ptP1 pl) ||
(pattern4 ptN1 pt ptP1 ptP2 pl) = 8
| (pattern5 ptN4 ptN3 ptN2 ptN1 pt ptP1 pl) ||
(pattern5 ptN3 ptN2 ptN1 pt ptP1 ptP2 pl) ||
(pattern5 ptN2 ptN1 pt ptP1 ptP2 ptP3 pl) ||
(pattern5 ptN1 pt ptP1 ptP2 ptP3 ptP4 pl) = 9
| (pattern6 ptN4 ptN3 ptN2 ptN1 pt pl) ||
(pattern6 ptN3 ptN2 ptN1 pt ptP1 pl) ||
(pattern6 ptN2 ptN1 pt ptP1 ptP2 pl) ||
(pattern6 ptN1 pt ptP1 ptP2 ptP3 pl) = 7
| (pattern7 ptN5 ptN4 ptN3 ptN2 ptN1 pt ptP1 pl) ||
(pattern7 ptN4 ptN3 ptN2 ptN1 pt ptP1 ptP2 pl) ||
(pattern7 ptN3 ptN2 ptN1 pt ptP1 ptP2 ptP3 pl) ||
(pattern7 ptN2 ptN1 pt ptP1 ptP2 ptP3 ptP4 pl) ||
(pattern7 ptN1 pt ptP1 ptP2 ptP3 ptP4 ptP5 pl) = 6
| (pattern8 ptN5 ptN4 ptN3 ptN2 ptN1 pt pl) ||
(pattern8 ptN4 ptN3 ptN2 ptN1 pt ptP1 pl) ||
(pattern8 ptN3 ptN2 ptN1 pt ptP1 ptP2 pl) ||
(pattern8 ptN2 ptN1 pt ptP1 ptP2 ptP3 pl) ||
(pattern8 ptN1 pt ptP1 ptP2 ptP3 ptP4 pl) ||
(pattern8 pt ptP1 ptP2 ptP3 ptP4 ptP5 pl) = 5
| (pattern9 ptN2 ptN1 pt ptP1 pl) ||
(pattern9 ptN1 pt ptP1 ptP2 pl) = 4
| (pattern10 ptN2 ptN1 pt pl) ||
(pattern10 ptN1 pt ptP1 pl) ||
(pattern10 pt ptP1 ptP2 pl) = 2
| (pattern11 ptN3 ptN2 ptN1 pt ptP1 pl) ||
(pattern11 ptN2 ptN1 pt ptP1 ptP2 pl) ||
(pattern11 ptN1 pt ptP1 ptP2 ptP3 pl) = 3
| (pattern12 ptN3 ptN2 ptN1 pt pl) ||
(pattern12 ptN2 ptN1 pt ptP1 pl) ||
(pattern12 ptN1 pt ptP1 ptP2 pl) ||
(pattern12 pt ptP1 ptP2 ptP3 pl) = 1
| otherwise = 0
----------------------------------------------------------------------------
direct2 :: Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int ->
Int -> Int -> Int -> Int -> Int -> Int
direct2 x y pl ptN1 ptN2 ptN3 ptN4 ptN5 pt ptP1 ptP2 ptP3 ptP4 ptP5
| (pattern0 ptN4 ptN3 ptN2 ptN1 pt pl) ||
(pattern0 ptN3 ptN2 ptN1 pt ptP1 pl) ||
(pattern0 ptN2 ptN1 pt ptP1 ptP2 pl) ||
(pattern0 ptN1 pt ptP1 ptP2 ptP3 pl) ||
(pattern0 pt ptP1 ptP2 ptP3 ptP4 pl) = 200
| otherwise = 0
-----------------------------------------------------------------------------
cpt_weight :: Int -> Int -> Int -> IO Int
cpt_weight x y player =
xMArrayLookup keyboard ((x-1)*19+(y-1)) `thenIO` \(unit) ->
if (unit /= 0)
then returnIO (-1)
else xlookup keyboard x (y-1) `thenIO` \(xyN1) ->
xlookup keyboard x (y-2) `thenIO` \(xyN2) ->
xlookup keyboard x (y-3) `thenIO` \(xyN3) ->
xlookup keyboard x (y-4) `thenIO` \(xyN4) ->
xlookup keyboard x (y-5) `thenIO` \(xyN5) ->
xlookup keyboard x (y+1) `thenIO` \(xyP1) ->
xlookup keyboard x (y+2) `thenIO` \(xyP2) ->
xlookup keyboard x (y+3) `thenIO` \(xyP3) ->
xlookup keyboard x (y+4) `thenIO` \(xyP4) ->
xlookup keyboard x (y+5) `thenIO` \(xyP5) ->
xlookup keyboard (x-1) y `thenIO` \(xN1y) ->
xlookup keyboard (x-2) y `thenIO` \(xN2y) ->
xlookup keyboard (x-3) y `thenIO` \(xN3y) ->
xlookup keyboard (x-4) y `thenIO` \(xN4y) ->
xlookup keyboard (x-5) y `thenIO` \(xN5y) ->
xlookup keyboard (x+1) y `thenIO` \(xP1y) ->
xlookup keyboard (x+2) y `thenIO` \(xP2y) ->
xlookup keyboard (x+3) y `thenIO` \(xP3y) ->
xlookup keyboard (x+4) y `thenIO` \(xP4y) ->
xlookup keyboard (x+5) y `thenIO` \(xP5y) ->
xlookup keyboard (x-1) (y-1) `thenIO` \(xN1yN1)->
xlookup keyboard (x-2) (y-2) `thenIO` \(xN2yN2) ->
xlookup keyboard (x-3) (y-3) `thenIO` \(xN3yN3) ->
xlookup keyboard (x-4) (y-4) `thenIO` \(xN4yN4) ->
xlookup keyboard (x-5) (y-5) `thenIO` \(xN5yN5) ->
xlookup keyboard (x+1) (y+1) `thenIO` \(xP1yP1) ->
xlookup keyboard (x+2) (y+2) `thenIO` \(xP2yP2) ->
xlookup keyboard (x+3) (y+3) `thenIO` \(xP3yP3) ->
xlookup keyboard (x+4) (y+4) `thenIO` \(xP4yP4) ->
xlookup keyboard (x+5) (y+5) `thenIO` \(xP5yP5) ->
xlookup keyboard (x-1) (y+1) `thenIO` \(xN1yP1) ->
xlookup keyboard (x-2) (y+2) `thenIO` \(xN2yP2) ->
xlookup keyboard (x-3) (y+3) `thenIO` \(xN3yP3) ->
xlookup keyboard (x-4) (y+4) `thenIO` \(xN4yP4) ->
xlookup keyboard (x-5) (y+5) `thenIO` \(xN5yP5) ->
xlookup keyboard (x+1) (y-1) `thenIO` \(xP1yN1) ->
xlookup keyboard (x+2) (y-2) `thenIO` \(xP2yN2) ->
xlookup keyboard (x+3) (y-3) `thenIO` \(xP3yN3) ->
xlookup keyboard (x+4) (y-4) `thenIO` \(xP4yN4) ->
xlookup keyboard (x+5) (y-5) `thenIO` \(xP5yN5) ->
returnIO ( (direct1 x y player xyN1 xyN2 xyN3 xyN4 xyN5 player
xyP1 xyP2 xyP3 xyP4 xyP5) +
(direct1 x y player xN1y xN2y xN3y xN4y xN5y player
xP1y xP2y xP3y xP4y xP5y) +
(direct1 x y player xN1yN1 xN2yN2 xN3yN3 xN4yN4
xN5yN5 player xP1yP1 xP2yP2 xP3yP3 xP4yP4
xP5yP5) +
(direct1 x y player xN1yP1 xN2yP2 xN3yP3 xN4yP4
xN5yP5 player xP1yN1 xP2yN2 xP3yN3 xP4yN4
xP5yN5) )
-----------------------------------------------------------------------------
-- | 1111 && no_block = 20
-- | 1111 && one_block = 13
-- | 111 && no_block = 10
-- | 111 && one_block = 8
-- | 11 1 or 1 11 && no_block = 9
-- | 11 1 or 1 11 && one_block =7
-- | 1 1 1 && no_block = 6
-- | 1 1 1 && one_block= 5
-- | 11 && no_block = 4
-- | 11 && one_block =2
-- | 1 1 && no_block =3
-- | 1 1 && one_block=1
in
update_weight weight1 0 1 x y 1 1 `thenIO` \() ->
update_weight weight2 0 2 x y 1 1 `thenIO` \() ->
update_weight weight1 0 1 x y 1 (-1) `thenIO` \() ->
update_weight weight2 0 2 x y 1 (-1) `thenIO` \() ->
update_weight weight1 0 1 x y (-1) (-1) `thenIO` \() ->
update_weight weight2 0 2 x y (-1) (-1) `thenIO` \() ->
update_weight weight1 0 1 x y (-1) 1 `thenIO` \() ->
update_weight weight2 0 2 x y (-1) 1 `thenIO` \() ->
update_weight weight1 0 1 x y 0 1 `thenIO` \() ->
update_weight weight2 0 2 x y 0 1 `thenIO` \() ->
update_weight weight1 0 1 x y 0 (-1) `thenIO` \() ->
update_weight weight2 0 2 x y 0 (-1) `thenIO` \() ->
update_weight weight1 0 1 x y (-1) 0 `thenIO` \() ->
update_weight weight2 0 2 x y (-1) 0 `thenIO` \() ->
update_weight weight1 0 1 x y 1 0 `thenIO` \() ->
update_weight weight2 0 2 x y 1 0 `thenIO` \() ->
returnIO ()
human_unit :: XMArray Int -> Int -> Int -> IO(Bool)
human_unit keyboard x y =
let
pattern0 :: Int -> Int -> Int -> Int -> Int -> Bool
pattern0 a b c d e | a==b && b==c && c==d && d==e = True
| otherwise = False
direct3 :: Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int ->
Int
direct3 ptN1 ptN2 ptN3 ptN4 pt ptP1 ptP2 ptP3 ptP4
| (pattern0 ptN4 ptN3 ptN2 ptN1 pt) ||
(pattern0 ptN3 ptN2 ptN1 pt ptP1) ||
(pattern0 ptN2 ptN1 pt ptP1 ptP2) ||
(pattern0 ptN1 pt ptP1 ptP2 ptP3) ||
(pattern0 pt ptP1 ptP2 ptP3 ptP4) = 200
| otherwise = 0
in
xlookup keyboard x y `thenIO` \(xy) ->
xlookup keyboard x (y-1) `thenIO` \(xyN1) ->
xlookup keyboard x (y-2) `thenIO` \(xyN2) ->
xlookup keyboard x (y-3) `thenIO` \(xyN3) ->
xlookup keyboard x (y-4) `thenIO` \(xyN4) ->
xlookup keyboard x (y+1) `thenIO` \(xyP1) ->
xlookup keyboard x (y+2) `thenIO` \(xyP2) ->
xlookup keyboard x (y+3) `thenIO` \(xyP3) ->
xlookup keyboard x (y+4) `thenIO` \(xyP4) ->
xlookup keyboard (x-1) y `thenIO` \(xN1y) ->
xlookup keyboard (x-2) y `thenIO` \(xN2y) ->
xlookup keyboard (x-3) y `thenIO` \(xN3y) ->
xlookup keyboard (x-4) y `thenIO` \(xN4y) ->
xlookup keyboard (x+1) y `thenIO` \(xP1y) ->
xlookup keyboard (x+2) y `thenIO` \(xP2y) ->
xlookup keyboard (x+3) y `thenIO` \(xP3y) ->
xlookup keyboard (x+4) y `thenIO` \(xP4y) ->
xlookup keyboard (x-1) (y-1) `thenIO` \(xN1yN1)->
xlookup keyboard (x-2) (y-2) `thenIO` \(xN2yN2) ->
xlookup keyboard (x-3) (y-3) `thenIO` \(xN3yN3) ->
xlookup keyboard (x-4) (y-4) `thenIO` \(xN4yN4) ->
xlookup keyboard (x+1) (y+1) `thenIO` \(xP1yP1) ->
xlookup keyboard (x+2) (y+2) `thenIO` \(xP2yP2) ->
xlookup keyboard (x+3) (y+3) `thenIO` \(xP3yP3) ->
xlookup keyboard (x+4) (y+4) `thenIO` \(xP4yP4) ->
xlookup keyboard (x-1) (y+1) `thenIO` \(xN1yP1) ->
xlookup keyboard (x-2) (y+2) `thenIO` \(xN2yP2) ->
xlookup keyboard (x-3) (y+3) `thenIO` \(xN3yP3) ->
xlookup keyboard (x-4) (y+4) `thenIO` \(xN4yP4) ->
xlookup keyboard (x+1) (y-1) `thenIO` \(xP1yN1) ->
xlookup keyboard (x+2) (y-2) `thenIO` \(xP2yN2) ->
xlookup keyboard (x+3) (y-3) `thenIO` \(xP3yN3) ->
xlookup keyboard (x+4) (y-4) `thenIO` \(xP4yN4) ->
xlookup keyboard (x+1) y `thenIO` \(xP1y) ->
xlookup keyboard (x+2) y `thenIO` \(xP2y) ->
xlookup keyboard (x+3) y `thenIO` \(xP3y) ->
xlookup keyboard (x+4) y `thenIO` \(xP4y) ->
if ((direct3 xyN1 xyN2 xyN3 xyN4 xy xyP1 xyP2 xyP3 xyP4) +
(direct3 xN1y xN2y xN3y xN4y xy xP1y xP2y xP3y xP4y) +
(direct3 xN1yN1 xN2yN2 xN3yN3 xN4yN4 xy xP1yP1 xP2yP2 xP3yP3 xP4yP4) +
(direct3 xN1yP1 xN2yP2 xN3yP3 xN4yP4 xy xP1yN1 xP2yN2 xP3yN3 xP4yN4))
>=200
then returnIO (True)
else returnIO (False)
|
