1 ' Checkers game (unfinished)
\r
2 ' by Svjatoslav Agejenko 2001
\r
5 DECLARE SUB compki (m%, h%, x1%, y1%)
\r
6 DECLARE SUB compgo2 (h%)
\r
7 DECLARE SUB compgo (h%)
\r
8 DECLARE SUB humngo (h%)
\r
11 DECLARE SUB thinkc ()
\r
12 DECLARE SUB thinkh ()
\r
13 DECLARE SUB cmd (a$)
\r
14 DECLARE SUB freet ()
\r
15 DECLARE SUB prn (x%, y%, c%, a$)
\r
16 DECLARE SUB msg (a$, c)
\r
17 DECLARE SUB getfnt ()
\r
18 DECLARE SUB playg ()
\r
20 DECLARE SUB start ()
\r
21 DECLARE SUB mklau ()
\r
22 DECLARE SUB showr (x, y)
\r
24 Dim Shared font(0 To 7, 0 To 7, 0 To 255)
\r
25 Dim Shared siz, fi, ri, rs
\r
27 Dim Shared humx1, humy1, humx2, humy2
\r
28 Dim Shared sug, smax
\r
29 Dim Shared npos As Long
\r
30 Dim Shared cx1, cy1, cx2, cy2
\r
32 siz = 6 ' Board size
\r
35 smax = 3 ' thinking depth
\r
38 Dim Shared lau(-1 To siz + 2, -1 To siz + 2)
\r
55 For b = 1 To Len(a$)
\r
56 c$ = Right$(Left$(a$, b), 1)
\r
58 If e = 0 Then d = d + 1: e = 1
\r
62 sona$(d) = sona$(d) + c$
\r
65 If e = 1 Then d = d - 1
\r
69 Select Case sona$(1)
\r
71 If humx1 > 0 Then msg "move replaced", 14
\r
73 humx1 = Asc(Left$(sona$(2), 1)) - 64
\r
74 If humx1 > 32 Then humx1 = humx1 - 32
\r
75 humy1 = Val(Right$(sona$(2), Len(sona$(2)) - 1))
\r
76 humx2 = Asc(Left$(sona$(3), 1)) - 64
\r
77 If humx2 > 32 Then humx2 = humx2 - 32
\r
78 humy2 = Val(Right$(sona$(3), Len(sona$(2)) - 1))
\r
81 msg "h - display help screen", 14
\r
82 msg "q - to quit", 14
\r
83 msg "m <from> <to> - make move", 14
\r
84 msg "n - no. positions processed", 14
\r
90 b$ = "positions processed:" + Str$(npos)
\r
98 If sug > smax Then h = 0: GoTo 6
\r
102 If sug = 1 Then h1 = -2000 Else h1 = -1000
\r
104 'cx1 = x: cy1 = y: cx2 = x - 1: cy2 = y + 1
\r
108 For y = 1 To siz ' check for eating
\r
110 If lau(x, y) = 1 Then
\r
112 If (lau(x - 1, y + 1) = 2) And (lau(x - 2, y + 2) = 0) Then
\r
113 Swap lau(x, y), lau(x - 2, y + 2)
\r
114 lau(x - 1, y + 1) = 0
\r
115 compki m1, h2, x - 2, y + 2
\r
116 lau(x - 1, y + 1) = 2
\r
117 Swap lau(x, y), lau(x - 2, y + 2)
\r
119 If m1 > m Then m = m1: h1 = -1000
\r
121 If h2 + 1 > h1 Then
\r
123 If npos = 1 Then cx1 = x: cy1 = y: cx2 = x - 2: cy2 = y + 2
\r
130 If (lau(x + 1, y + 1) = 2) And (lau(x + 2, y + 2) = 0) Then
\r
131 Swap lau(x, y), lau(x + 2, y + 2)
\r
132 lau(x + 1, y + 1) = 0
\r
133 compki m1, h2, x + 2, y + 2
\r
134 lau(x + 1, y + 1) = 2
\r
135 Swap lau(x, y), lau(x + 2, y + 2)
\r
137 If m1 > m Then m = m1: h1 = -1000
\r
139 If h2 + 1 > h1 Then
\r
141 If npos = 1 Then cx1 = x: cy1 = y: cx2 = x + 2: cy2 = y + 2
\r
148 If (lau(x - 1, y - 1) = 2) And (lau(x - 2, y - 2) = 0) Then
\r
149 Swap lau(x, y), lau(x - 2, y - 2)
\r
150 lau(x - 1, y - 1) = 0
\r
151 compki m1, h2, x - 2, y - 2
\r
152 lau(x - 1, y - 1) = 2
\r
153 Swap lau(x, y), lau(x - 2, y - 2)
\r
155 If m1 > m Then m = m1: h1 = -1000
\r
157 If h2 + 1 > h1 Then
\r
159 If npos = 1 Then cx1 = x: cy1 = y: cx2 = x - 2: cy2 = y - 2
\r
166 If (lau(x + 1, y - 1) = 2) And (lau(x + 2, y - 2) = 0) Then
\r
167 Swap lau(x, y), lau(x + 2, y - 2)
\r
168 lau(x + 1, y - 1) = 0
\r
169 compki m1, h2, x + 2, y - 2
\r
170 lau(x + 1, y - 1) = 2
\r
171 Swap lau(x, y), lau(x + 2, y - 2)
\r
173 If m1 > m Then m = m1: h1 = -1000
\r
175 If h2 + 1 > h1 Then
\r
177 If npos = 1 Then cx1 = x: cy1 = y: cx2 = x + 2: cy2 = y - 2
\r
187 If c = 1 Then GoTo 9
\r
193 If (b = 1) And (npos = 1) Then
\r
194 cx3 = (cx1 + cx2) / 2
\r
195 cy3 = (cy1 + cy2) / 2
\r
199 Swap lau(cx1, cy1), lau(cx2, cy2)
\r
210 cx1 = 1: cy1 = 1: cx2 = 1: cy2 = 1
\r
215 msg "l��a ei saa", 4
\r
219 For y = 1 To siz ' unuseful move
\r
221 If lau(x, y) = 1 Then
\r
222 If lau(x - 1, y + 1) = 0 Then
\r
223 Swap lau(x, y), lau(x - 1, y + 1)
\r
225 Swap lau(x, y), lau(x - 1, y + 1)
\r
228 If sug = 1 Then cx1 = x: cy1 = y: cx2 = x - 1: cy2 = y + 1
\r
232 If lau(x + 1, y + 1) = 0 Then
\r
233 Swap lau(x, y), lau(x + 1, y + 1)
\r
235 Swap lau(x, y), lau(x + 1, y + 1)
\r
238 If sug = 1 Then cx1 = x: cy1 = y: cx2 = x + 1: cy2 = y + 1
\r
251 Sub compki (m, h, x1, y1)
\r
266 If a$ = Chr$(8) Then
\r
267 If Len(stri$) > 0 Then
\r
268 stri$ = Left$(stri$, Len(stri$) - 1): GoTo 3
\r
271 If a$ = Chr$(13) Then
\r
272 If Len(stri$) > 0 Then
\r
281 Line (400, 468)-(639, 479), 1, BF
\r
282 prn 405, 469, 14, stri$
\r
289 If (a > 5) And (a < 17) Then GoTo 2
\r
295 font(x, y, a) = Point(x, y)
\r
306 For y = siz To 1 Step -1
\r
307 For x = siz To 1 Step -1
\r
308 If lau(x, y) = 2 Then
\r
309 If lau(x - 1, y - 1) = 0 Then
\r
310 Swap lau(x, y), lau(x - 1, y - 1)
\r
312 Swap lau(x, y), lau(x - 1, y - 1)
\r
313 If h2 < h1 Then h1 = h2
\r
316 If lau(x + 1, y - 1) = 0 Then
\r
317 Swap lau(x, y), lau(x + 1, y - 1)
\r
319 Swap lau(x, y), lau(x + 1, y - 1)
\r
320 If h2 < h1 Then h1 = h2
\r
324 If (lau(x - 1, y - 1) = 1) And (lau(x - 2, y - 2) = 0) Then
\r
325 Swap lau(x, y), lau(x - 2, y - 2)
\r
326 lau(x - 1, y - 1) = 0
\r
328 lau(x - 1, y - 1) = 1
\r
329 Swap lau(x, y), lau(x - 2, y - 2)
\r
330 If h2 - 1 < h1 Then h1 = h2 - 1
\r
333 If (lau(x + 1, y - 1) = 1) And (lau(x + 2, y - 2) = 0) Then
\r
334 Swap lau(x, y), lau(x + 2, y - 2)
\r
335 lau(x + 1, y - 1) = 0
\r
337 lau(x + 1, y - 1) = 1
\r
338 Swap lau(x, y), lau(x + 2, y - 2)
\r
339 If h2 - 1 < h1 Then h1 = h2 - 1
\r
352 For y = -1 To siz + 2
\r
353 For x = -1 To siz + 2
\r
366 If (x + y + fi) / 2 = Int((x + y + fi) / 2) Then
\r
372 For y = siz - ri + 1 To siz
\r
374 If (x + y + fi) / 2 = Int((x + y + fi) / 2) Then
\r
383 Dim buf(1 To 10000)
\r
384 For x = 400 To 630 Step 40
\r
385 Get (x, 8)-(x + 39, 467), buf(1)
\r
386 Put (x, 0), buf(1), PSet
\r
388 Line (400, 460)-(639, 467), 0, BF
\r
389 prn 405, 460, c, a$
\r
405 Sub prn (x, y, c, a$)
\r
408 For a = 1 To Len(a$)
\r
409 b = Asc(Right$(Left$(a$, a), 1))
\r
412 If font(x2, y2, b) > 0 Then PSet (x2 + x1, y2 + y1), c
\r
428 prn ((x - 1) * rs + 12 + sp), 2, 10, Chr$(64 + x)
\r
429 prn ((x - 1) * rs + 12 + sp), siz * rs + 11, 10, Chr$(64 + x)
\r
434 a$ = Right$(a$, Len(a$) - 1)
\r
435 prn 15 - (Len(a$) * 8), (y - 1) * rs + sp + 7, 10, a$
\r
436 prn (siz * rs + 16), (y - 1) * rs + sp + 7, 10, a$
\r
443 If (x + y + fi) / 2 = Int((x + y + fi) / 2) Then c = 8 Else c = 7
\r
444 x1 = (x - 1) * rs + 15
\r
445 y1 = (y - 1) * rs + 10
\r
446 Line (x1, y1)-(x1 + rs - 1, y1 + rs - 1), c, BF
\r
447 If lau(x, y) > 0 Then
\r
449 If lau(x, y) = 1 Then c1 = 15 Else c1 = 14
\r
450 Circle (x1 + sp, y1 + sp), sp - 1, c1
\r
451 Paint (x1 + sp, y1 + sp), c1
\r
458 Line (399, 0)-(399, 479), 13
\r
459 msg "type 'h' for help", 14
\r
461 rs = Int(370 / siz)
\r
467 msg "computer turn", 14
\r
474 If cx1 = -1 Then msg "you won!", 10: msg "--------", 10: System
\r
476 If h <= -2 Then msg "oh no...", 10
\r
477 If h = -1 Then msg "oops!", 10
\r
478 If h = 1 Then msg "yess! I will eat soon!", 10
\r
479 If h >= 2 Then msg "HA HA HA YOU ARE IN TROUBLE!", 10
\r
482 If Abs(cx1 - cx2) = 2 Then
\r
483 cx3 = (cx1 + cx2) / 2
\r
484 cy3 = (cy1 + cy2) / 2
\r
489 Swap lau(cx1, cy1), lau(cx2, cy2)
\r
496 msg "your turn", 14
\r
499 If humx1 = 0 Then GoTo 5
\r
500 Swap lau(humx2, humy2), lau(humx1, humy1)
\r
503 If Abs(humx1 - humx2) = 2 Then
\r
504 cx3 = (humx1 + humx2) / 2
\r
505 cy3 = (humy1 + humy2) / 2
\r