1 ' Checkers game (unfinished)
\r
2 ' by Svjatoslav Agejenko 2001
\r
3 ' svjatoslavagejenko@gmail.com
\r
6 DECLARE SUB compki (m%, h%, x1%, y1%)
\r
7 DECLARE SUB compgo2 (h%)
\r
8 DECLARE SUB compgo (h%)
\r
9 DECLARE SUB humngo (h%)
\r
12 DECLARE SUB thinkc ()
\r
13 DECLARE SUB thinkh ()
\r
14 DECLARE SUB cmd (a$)
\r
15 DECLARE SUB freet ()
\r
16 DECLARE SUB prn (x%, y%, c%, a$)
\r
17 DECLARE SUB msg (a$, c)
\r
18 DECLARE SUB getfnt ()
\r
19 DECLARE SUB playg ()
\r
21 DECLARE SUB start ()
\r
22 DECLARE SUB mklau ()
\r
23 DECLARE SUB showr (x, y)
\r
25 DIM SHARED font(0 TO 7, 0 TO 7, 0 TO 255)
\r
26 DIM SHARED siz, fi, ri, rs
\r
28 DIM SHARED humx1, humy1, humx2, humy2
\r
29 DIM SHARED sug, smax
\r
30 DIM SHARED npos AS LONG
\r
31 DIM SHARED cx1, cy1, cx2, cy2
\r
33 siz = 6 ' Board size
\r
36 smax = 3 ' thinking depth
\r
39 DIM SHARED lau(-1 TO siz + 2, -1 TO siz + 2)
\r
56 FOR b = 1 TO LEN(a$)
\r
57 c$ = RIGHT$(LEFT$(a$, b), 1)
\r
59 IF e = 0 THEN d = d + 1: e = 1
\r
63 sona$(d) = sona$(d) + c$
\r
66 IF e = 1 THEN d = d - 1
\r
70 SELECT CASE sona$(1)
\r
72 IF humx1 > 0 THEN msg "move replaced", 14
\r
74 humx1 = ASC(LEFT$(sona$(2), 1)) - 64
\r
75 IF humx1 > 32 THEN humx1 = humx1 - 32
\r
76 humy1 = VAL(RIGHT$(sona$(2), LEN(sona$(2)) - 1))
\r
77 humx2 = ASC(LEFT$(sona$(3), 1)) - 64
\r
78 IF humx2 > 32 THEN humx2 = humx2 - 32
\r
79 humy2 = VAL(RIGHT$(sona$(3), LEN(sona$(2)) - 1))
\r
82 msg "h - display help screen", 14
\r
83 msg "q - to quit", 14
\r
84 msg "m <from> <to> - make move", 14
\r
85 msg "n - no. positions processed", 14
\r
91 b$ = "positions processed:" + STR$(npos)
\r
99 IF sug > smax THEN h = 0: GOTO 6
\r
103 IF sug = 1 THEN h1 = -2000 ELSE h1 = -1000
\r
105 'cx1 = x: cy1 = y: cx2 = x - 1: cy2 = y + 1
\r
109 FOR y = 1 TO siz ' check for eating
\r
111 IF lau(x, y) = 1 THEN
\r
113 IF (lau(x - 1, y + 1) = 2) AND (lau(x - 2, y + 2) = 0) THEN
\r
114 SWAP lau(x, y), lau(x - 2, y + 2)
\r
115 lau(x - 1, y + 1) = 0
\r
116 compki m1, h2, x - 2, y + 2
\r
117 lau(x - 1, y + 1) = 2
\r
118 SWAP lau(x, y), lau(x - 2, y + 2)
\r
120 IF m1 > m THEN m = m1: h1 = -1000
\r
122 IF h2 + 1 > h1 THEN
\r
124 IF npos = 1 THEN cx1 = x: cy1 = y: cx2 = x - 2: cy2 = y + 2
\r
131 IF (lau(x + 1, y + 1) = 2) AND (lau(x + 2, y + 2) = 0) THEN
\r
132 SWAP lau(x, y), lau(x + 2, y + 2)
\r
133 lau(x + 1, y + 1) = 0
\r
134 compki m1, h2, x + 2, y + 2
\r
135 lau(x + 1, y + 1) = 2
\r
136 SWAP lau(x, y), lau(x + 2, y + 2)
\r
138 IF m1 > m THEN m = m1: h1 = -1000
\r
140 IF h2 + 1 > h1 THEN
\r
142 IF npos = 1 THEN cx1 = x: cy1 = y: cx2 = x + 2: cy2 = y + 2
\r
149 IF (lau(x - 1, y - 1) = 2) AND (lau(x - 2, y - 2) = 0) THEN
\r
150 SWAP lau(x, y), lau(x - 2, y - 2)
\r
151 lau(x - 1, y - 1) = 0
\r
152 compki m1, h2, x - 2, y - 2
\r
153 lau(x - 1, y - 1) = 2
\r
154 SWAP lau(x, y), lau(x - 2, y - 2)
\r
156 IF m1 > m THEN m = m1: h1 = -1000
\r
158 IF h2 + 1 > h1 THEN
\r
160 IF npos = 1 THEN cx1 = x: cy1 = y: cx2 = x - 2: cy2 = y - 2
\r
167 IF (lau(x + 1, y - 1) = 2) AND (lau(x + 2, y - 2) = 0) THEN
\r
168 SWAP lau(x, y), lau(x + 2, y - 2)
\r
169 lau(x + 1, y - 1) = 0
\r
170 compki m1, h2, x + 2, y - 2
\r
171 lau(x + 1, y - 1) = 2
\r
172 SWAP lau(x, y), lau(x + 2, y - 2)
\r
174 IF m1 > m THEN m = m1: h1 = -1000
\r
176 IF h2 + 1 > h1 THEN
\r
178 IF npos = 1 THEN cx1 = x: cy1 = y: cx2 = x + 2: cy2 = y - 2
\r
188 IF c = 1 THEN GOTO 9
\r
194 IF (b = 1) AND (npos = 1) THEN
\r
195 cx3 = (cx1 + cx2) / 2
\r
196 cy3 = (cy1 + cy2) / 2
\r
200 SWAP lau(cx1, cy1), lau(cx2, cy2)
\r
211 cx1 = 1: cy1 = 1: cx2 = 1: cy2 = 1
\r
216 msg "l��a ei saa", 4
\r
220 FOR y = 1 TO siz ' unuseful move
\r
222 IF lau(x, y) = 1 THEN
\r
223 IF lau(x - 1, y + 1) = 0 THEN
\r
224 SWAP lau(x, y), lau(x - 1, y + 1)
\r
226 SWAP lau(x, y), lau(x - 1, y + 1)
\r
229 IF sug = 1 THEN cx1 = x: cy1 = y: cx2 = x - 1: cy2 = y + 1
\r
233 IF lau(x + 1, y + 1) = 0 THEN
\r
234 SWAP lau(x, y), lau(x + 1, y + 1)
\r
236 SWAP lau(x, y), lau(x + 1, y + 1)
\r
239 IF sug = 1 THEN cx1 = x: cy1 = y: cx2 = x + 1: cy2 = y + 1
\r
252 SUB compki (m, h, x1, y1)
\r
267 IF a$ = CHR$(8) THEN
\r
268 IF LEN(stri$) > 0 THEN
\r
269 stri$ = LEFT$(stri$, LEN(stri$) - 1): GOTO 3
\r
272 IF a$ = CHR$(13) THEN
\r
273 IF LEN(stri$) > 0 THEN
\r
282 LINE (400, 468)-(639, 479), 1, BF
\r
283 prn 405, 469, 14, stri$
\r
290 IF (a > 5) AND (a < 17) THEN GOTO 2
\r
296 font(x, y, a) = POINT(x, y)
\r
307 FOR y = siz TO 1 STEP -1
\r
308 FOR x = siz TO 1 STEP -1
\r
309 IF lau(x, y) = 2 THEN
\r
310 IF lau(x - 1, y - 1) = 0 THEN
\r
311 SWAP lau(x, y), lau(x - 1, y - 1)
\r
313 SWAP lau(x, y), lau(x - 1, y - 1)
\r
314 IF h2 < h1 THEN h1 = h2
\r
317 IF lau(x + 1, y - 1) = 0 THEN
\r
318 SWAP lau(x, y), lau(x + 1, y - 1)
\r
320 SWAP lau(x, y), lau(x + 1, y - 1)
\r
321 IF h2 < h1 THEN h1 = h2
\r
325 IF (lau(x - 1, y - 1) = 1) AND (lau(x - 2, y - 2) = 0) THEN
\r
326 SWAP lau(x, y), lau(x - 2, y - 2)
\r
327 lau(x - 1, y - 1) = 0
\r
329 lau(x - 1, y - 1) = 1
\r
330 SWAP lau(x, y), lau(x - 2, y - 2)
\r
331 IF h2 - 1 < h1 THEN h1 = h2 - 1
\r
334 IF (lau(x + 1, y - 1) = 1) AND (lau(x + 2, y - 2) = 0) THEN
\r
335 SWAP lau(x, y), lau(x + 2, y - 2)
\r
336 lau(x + 1, y - 1) = 0
\r
338 lau(x + 1, y - 1) = 1
\r
339 SWAP lau(x, y), lau(x + 2, y - 2)
\r
340 IF h2 - 1 < h1 THEN h1 = h2 - 1
\r
353 FOR y = -1 TO siz + 2
\r
354 FOR x = -1 TO siz + 2
\r
367 IF (x + y + fi) / 2 = INT((x + y + fi) / 2) THEN
\r
373 FOR y = siz - ri + 1 TO siz
\r
375 IF (x + y + fi) / 2 = INT((x + y + fi) / 2) THEN
\r
384 DIM buf(1 TO 10000)
\r
385 FOR x = 400 TO 630 STEP 40
\r
386 GET (x, 8)-(x + 39, 467), buf(1)
\r
387 PUT (x, 0), buf(1), PSET
\r
389 LINE (400, 460)-(639, 467), 0, BF
\r
390 prn 405, 460, c, a$
\r
406 SUB prn (x, y, c, a$)
\r
409 FOR a = 1 TO LEN(a$)
\r
410 b = ASC(RIGHT$(LEFT$(a$, a), 1))
\r
413 IF font(x2, y2, b) > 0 THEN PSET (x2 + x1, y2 + y1), c
\r
429 prn ((x - 1) * rs + 12 + sp), 2, 10, CHR$(64 + x)
\r
430 prn ((x - 1) * rs + 12 + sp), siz * rs + 11, 10, CHR$(64 + x)
\r
435 a$ = RIGHT$(a$, LEN(a$) - 1)
\r
436 prn 15 - (LEN(a$) * 8), (y - 1) * rs + sp + 7, 10, a$
\r
437 prn (siz * rs + 16), (y - 1) * rs + sp + 7, 10, a$
\r
444 IF (x + y + fi) / 2 = INT((x + y + fi) / 2) THEN c = 8 ELSE c = 7
\r
445 x1 = (x - 1) * rs + 15
\r
446 y1 = (y - 1) * rs + 10
\r
447 LINE (x1, y1)-(x1 + rs - 1, y1 + rs - 1), c, BF
\r
448 IF lau(x, y) > 0 THEN
\r
450 IF lau(x, y) = 1 THEN c1 = 15 ELSE c1 = 14
\r
451 CIRCLE (x1 + sp, y1 + sp), sp - 1, c1
\r
452 PAINT (x1 + sp, y1 + sp), c1
\r
459 LINE (399, 0)-(399, 479), 13
\r
460 msg "type 'h' for help", 14
\r
462 rs = INT(370 / siz)
\r
468 msg "computer turn", 14
\r
475 IF cx1 = -1 THEN msg "you won!", 10: msg "--------", 10: SYSTEM
\r
477 IF h <= -2 THEN msg "oh no...", 10
\r
478 IF h = -1 THEN msg "oops!", 10
\r
479 IF h = 1 THEN msg "yess! I will eat soon!", 10
\r
480 IF h >= 2 THEN msg "HA HA HA YOU ARE IN TROUBLE!", 10
\r
483 IF ABS(cx1 - cx2) = 2 THEN
\r
484 cx3 = (cx1 + cx2) / 2
\r
485 cy3 = (cy1 + cy2) / 2
\r
490 SWAP lau(cx1, cy1), lau(cx2, cy2)
\r
497 msg "your turn", 14
\r
500 IF humx1 = 0 THEN GOTO 5
\r
501 SWAP lau(humx2, humy2), lau(humx1, humy1)
\r
504 IF ABS(humx1 - humx2) = 2 THEN
\r
505 cx3 = (humx1 + humx2) / 2
\r
506 cy3 = (humy1 + humy2) / 2
\r