A 90% complete chess engine

[Richard Frost]

Vastly improved, but still far to go.  No need to report bugs, as I'm well aware of them.

The plasma effect from B+, toned down, looks like marble to me. 

Cursor keys to move, or click piece and square to be moved to.  I really like the "special"
cursor that pops up if an illegal move is attempted.  Sound files optional, but I include
them anyway.  They're just Windows files, some renamed.  The JPG is required, as are
the PNG files from the previous post.

Code: QB64: [Select]

1. $CONSOLE
2.  
3. _TITLE "Chess"
4. DEFINT A-Z
5.  
6. CONST true = -1, false = 0, Rook = 1, Knight = 2, Bishop = 3, Queen = 4, King = 5, Pawn = 6
7. COMMON SHARED WorB, Move, Score, Index, opening, invert, i$, m$, lm$, msg$, abort, MaxRow, xq, yq, xc, yc, xm, ym, castle$, OtherK$
8. COMMON SHARED mkr, mkc, okr, okc, k$, MasterLevel, MasterLevel1, SaveWorB, GameFile$, check, incheck, debug, DebugR, DebugC, Start1!, Start2!
9. COMMON SHARED MaxElapse!, human, humanc, OnAuto, graphics, rflag, tlimit, boardwhite&, boardblack&, black&, red&, green&, blue&, white&, gray&
10. COMMON SHARED Enter$, Esc$, lf$, crlf$, debug$, pinit, takebackflag, tbc, waitflag, pause, cursoron!, quitflag, smode, vflag, MakeNoise
11. COMMON SHARED bri, hold!, dtime!, mtime!, altblack, epfc, epfr, eptc, eptr, eprc, eprr, best, best$, ep$, rick, lcount&, alpha$, ocount&
12.  
13. DIM SHARED l, p, b, q1, q2
14. l = 10: p = 6: b = 8: q1 = 300: q2 = 500
15. DIM SHARED b(b, b), t(b, b, l), o(b, b), tb(b, b, 10), castle$(l), Moves(l), Move$(l, q1), Score(l, q1)
16. DIM SHARED TieTo(l), Index(l, q1), prot(l), prot$(l, q1), x(p, q2), y(p, q2), c(12, q2), MoveLog$(q2)
17. DIM SHARED cp&(32), etime!(3), myr(32), myg(32), myb(32), icon&(10), emin, useidiot, main&, alfred!
18. DIM SHARED mcount&(10), du(p, 7), dd(p, 7), dl(p, 7), dr(p, 7), value(p), alphal$(8)
19. DIM SHARED showthink, history, showlegalf, showprotf
20.  
21. DIM SHARED abuff(30000)
22. 'DIM SHARED debug$(2)
23.  
24. DIM SHARED s1(b, b), s2(b, b), s3(b, b), s4(b, b), s5(b, b), s9(b, b) '                  saving board state for recursion
25. DIM SHARED m(9) AS _MEM
26. m(0) = _MEM(b(0, 0))
27. m(1) = _MEM(s1(0, 0))
28. m(2) = _MEM(s2(0, 0))
29. m(3) = _MEM(s3(0, 0))
30. m(4) = _MEM(s4(0, 0))
31. m(5) = _MEM(s5(0, 0))
32. m(9) = _MEM(s9(0, 0))
33.  
34. rick = _FILEEXISTS("rick.")
35. IF INSTR(COMMAND$ + " ", "rick") THEN debug = true
36. _CONSOLE OFF
37.  
38. begin:
39. Init
40. OPEN "chess.txt" FOR OUTPUT AS #2
41. DO
42.     _ICON icon&(1) '                                                 chess.png
43.     SaveWorB = WorB
44.  
45.     mking = 5: oking = 11
46.     IF humanc = 0 THEN SWAP mking, oking
47.     FOR r = 1 TO 8
48.         FOR c = 1 TO 8
49.             IF b(c, r) = mking THEN mkr = r: mkc = c
50.             IF b(c, r) = oking THEN okr = r: okc = c
51.         NEXT c
52.     NEXT r
53.     ks$ = alphal$(mkc) + CHR$(48 + mkr)
54.  
55.     redo:
56.     SaveForTakeBack
57.     Reset_To_Zero
58.     IF Moves(0) = 0 THEN msg$ = "Stalemate": GOTO yoyo
59.     Start1! = TIMER: Start2! = Start1!
60.     DebugR = 99
61.  
62.     IF human AND (humanc = WorB) OR (human = 2) THEN '               2 is two humans
63.         IF human = 2 THEN invert = -(WorB = 0)
64.         DO
65.             pinit = 0 '                                              nudge for the graphics, vary it a little
66.             HumanMove '                                              get a move
67.             IF LEN(msg$) THEN GOTO yoyo
68.             IF takebackflag THEN
69.                 TakeBack '                                           restores board & castling status
70.                 PlotBoard
71.                 takebackflag = 0
72.                 GOTO redo
73.             END IF
74.             sm$ = m$
75.             _MEMCOPY m(0), m(0).OFFSET, m(0).SIZE TO m(9), m(9).OFFSET '         save board
76.             MoveIt m$, false
77.             WorB = WorB XOR 1
78.             CheckBoard 1
79.             WorB = WorB XOR 1
80.             m$ = sm$
81.             _MEMCOPY m(9), m(9).OFFSET, m(9).SIZE TO m(0), m(0).OFFSET '     restore board
82.             IF Score <> 777 THEN
83.                 FOR i = 1 TO Moves(0) '                              check against legal list
84.                     IF m$ = Move$(0, i) THEN EXIT DO '               move found, skip more checking
85.                 NEXT i
86.             END IF
87.             alfred! = TIMER + 5
88.             IF MakeNoise THEN PlaySound "bad"
89.         LOOP
90.     ELSE
91.         abort = false
92.         DebugR = 99
93.         rflag = true '                                               flag in recursion to stop displaying board
94.         best = -99999
95.         Center 0, "", true
96.         MasterLevel = 2 '                                            fast check in case slow aborted
97.         Recurse 1 '                                                  try all moves & responses
98.         TakeBest 0, true '
99.         ShowBest
100.         IF (Score < -700) OR (Score > 500) THEN
101.             rflag = 0
102.             IF Moves(0) THEN msg$ = "Checkmate!" ELSE msg$ = "Stalemate!"
103.             msg$ = msg$ + STR$(Score)
104.             GOTO yoyo
105.         END IF
106.         MasterLevel = MasterLevel1 '                                 slow check
107.         FOR i = 1 TO MasterLevel: Moves(i) = 0: NEXT
108.         Recurse 1 '                                                  try all moves & responses
109.         IF MakeNoise THEN PlaySound "ding"
110.         TakeBest 0, true '
111.         ShowBest
112.         rflag = false
113.         Center 0, "", true
114.         IF abort THEN _MEMCOPY m(1), m(1).OFFSET, m(1).SIZE TO m(0), m(0).OFFSET '         restore board
115.         IF msg$ = "abort" THEN msg$ = ""
116.         IF LEN(msg$) THEN WorBs = WorB + 1: GOTO yoyo
117.     END IF
118.  
119.     IF LEN(msg$) THEN GOTO yoyo
120.  
121.     WorB = SaveWorB
122.  
123.     sm$ = m$: m2$ = m$ '                                             save move for display in case modified for castling
124.     IF m$ = "O-O" THEN '                                             castle kingside
125.         IF WorB THEN
126.             m$ = "e1g1": m2$ = "h1f1"
127.         ELSE
128.             m$ = "e8g8": m2$ = "h8f8"
129.         END IF
130.     END IF
131.     IF m$ = "O-O-O" THEN '                                           castle queenside
132.         IF WorB THEN
133.             m$ = "e1c1": m2$ = "a1c1"
134.         ELSE
135.             m$ = "e8c8": m2$ = "a8d8"
136.         END IF
137.     END IF
138.  
139.     IF human <> 1 THEN GOTO doit '                                   people playing, or computer playing itself
140.  
141.     waitflag = 1
142.     _ICON icon&(2) '                                                 clockx or clockx2
143.  
144.     fr = VAL(MID$(m$, 2, 1)) '                                       from row (or rank)
145.     IF invert THEN fr = 9 - fr '                                     invert means black at bottom
146.     fc = INSTR(alpha$, LEFT$(m$, 1)) '                               from column
147.  
148.     IF invert THEN fc = 9 - fc
149.  
150.     tr = VAL(MID$(m$, 4, 1)) '                                       row or rank
151.     IF invert THEN tr = 9 - tr '                                     black at bottom
152.     tc = INSTR(alpha$, MID$(m$, 3, 1)) '                             column
153.     IF invert THEN tc = 9 - tc
154.  
155.     DO: _LIMIT 100
156.         'IF (itime! = 0) OR (TIMER > itime!) THEN
157.         '    iname = iname XOR 1
158.         '    _ICON icon&(iname + 2) '                                clockx or clockx2
159.         '    itime! = TIMER + .5
160.         'END IF
161.         KeyScan 1, 1 '                                               plotscreen, _display
162.         Cursor fr, fc, 0
163.         Cursor tr, tc, 0
164.         IF WorB = humanc THEN EXIT DO
165.     LOOP UNTIL (i$ = Enter$) OR (human = 0) OR LEN(msg$)
166.  
167.     waitflag = 0
168.  
169.     doit:
170.     m$ = sm$
171.     lm$ = m$
172.     MoveIt m$, true
173.     AddMove
174.     PlotScreen true
175.     _DISPLAY
176.  
177.     check = false
178.     CheckBoard 0
179.     IF Score = 777 THEN check = true: TempMess "Check!", 2
180.  
181.     'check = 0: incheck = 0
182.  
183.     'check = false: z = Level XOR 1
184.     'k1$ = MID$(alpha$, mkc, 1) + CHR$(48 + mkr) '                   location of King
185.     'k2$ = MID$(alpha$, okc, 1) + CHR$(48 + okr) '                   location of King
186.     'ic = 0
187.     'FOR i = 1 TO Moves(0) '                                         can any opponent piece move there?
188.     '    s$ = RIGHT$(Move$(z, 0), 2)
189.     '    IF k1$ = s$ THEN ic = 1 '                                   in check
190.     '    IF k2$ = s$ THEN ic = 2 '                                   in check
191.     'NEXT i
192.     'IF ic THEN
193.     '    check = true
194.     '    ic$ = CHR$(48 + ic) + " Check!"
195.     '    TempMess ic$
196.     'END IF
197.  
198.     WorB = SaveWorB XOR 1 '                                          toggle white/black
199. LOOP UNTIL Move = 500
200.  
201. IF Move = 500 THEN msg$ = "Over 500 moves...."
202. PRINT #1, ""
203. PRINT #1, msg$
204.  
205. yoyo:
206. Playagain msg$
207. msg$ = ""
208. CLS
209. IF i$ = "n" THEN GOTO begin '                                        n for new game
210. IF WorBs THEN
211.     WorB = WorBs - 1: WorBs = 0
212.     WorB = WorB XOR 1
213. END IF
214. PlotScreen true
215. GOTO redo
216.  
217. o1:
218. DATA e2e4,e7e5,g1f3,b8c6,f1b5,a7a6,b5a4,b7b5,a4b3,g8f6,b1c3,f8e7,f3g5,h7h6
219. 'DATA g5f7,O-O
220. 'DATA f7d8,g8h7
221. DATA end
222.  
223. Setup:
224. DATA 1,2,3,4,5,3,2,1
225. DATA 6,6,6,6,6,6,6,6
226. DATA 0,0,0,0,0,0,0,0
227. DATA 0,0,0,0,0,0,0,0
228. DATA 0,0,0,0,0,0,0,0
229. DATA 0,0,0,0,0,0,0,0
230. DATA 12,12,12,12,12,12,12,12
231. DATA 7,8,9,10,11,9,8,7
232.  
233. test:
234. DATA 0,0,0,0,0,0,0,0
235. DATA 0,0,0,0,0,0,0,0
236. DATA 0,0,0,0,0,0,0,0
237. DATA 0,11,0,0,0,0,0,0
238. DATA 0,7,0,12,0,0,0,0
239. DATA 0,0,0,0,0,0,0,0
240. DATA 9,0,0,0,6,0,0,0
241. DATA 5,9,0,0,0,0,0,0
242.  
243. Legal:
244. '      udlr,udlr,udlr,udlr,udlr,udlr,udlr,udlr
245. DATA R,7000,0700,0070,0007,0000,0000,0000,0000
246. DATA N,2010,2001,0210,0201,1020,1002,0120,0102
247. DATA B,7070,7007,0770,0707,0000,0000,0000,0000
248. DATA Q,7000,0700,0070,0007,7070,7007,0770,0707
249. DATA K,1000,0100,0010,0001,1010,1001,0110,0101
250. DATA P,1000,1001,1010,0000,0000,0000,0000,0000
251.  
252. hg:
253. '                   1         2         3         4         5
254. '          12345678901234567890123456789012345678901234567890
255. DATA "01","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
256. DATA "02","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
257. DATA "03","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
258. DATA "04","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
259. DATA "05","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
260. DATA "06","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
261. DATA "07","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
262. DATA "08","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
263. DATA "09","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
264. DATA "10","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
265. DATA "11","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
266. DATA "12","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
267. DATA "13","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
268. DATA "14","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
269. DATA "15","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
270. DATA "16","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
271. DATA "17","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
272. DATA "18","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
273. DATA "19","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
274. DATA "20","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
275. DATA "21","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
276. DATA "22","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
277. DATA "23","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
278. DATA "24","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
279. DATA "25","               XXXXXXXXXXXXXXXXXXXX               "
280. DATA "26","                XXXXXXXXXXXXXXXXXX                "
281. DATA "27","                 XXXXXXXXXXXXXXXX                 "
282. DATA "28","                  XXXXXXXXXXXXXX                  "
283. DATA "29","                   XXXXXXXXXXXX                   "
284. DATA "30","                    XXXXXXXXXX                    "
285. DATA "31","                     XXXXXXXX                     "
286. DATA "32","                      XXXXXX                      "
287.  
288. DATA "33","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
289. DATA "34","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
290. DATA "35","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
291. DATA "36","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
292. DATA "37","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
293. DATA "38","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
294. DATA "39","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
295. DATA "40","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
296. DATA "41","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
297. DATA "42","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
298. DATA "43","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
299. DATA "44","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
300. DATA "45","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
301. DATA "46","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
302. DATA "47","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
303. DATA "48","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
304. DATA "49","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
305. DATA "50","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
306. DATA "51","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
307. DATA "52","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
308. DATA "53","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
309. DATA "54","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
310. DATA "55","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
311. DATA "56","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
312. DATA "57","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
313. DATA "58","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
314. DATA "59","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
315. DATA "51","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
316. DATA "60","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
317. DATA "61","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
318. DATA "62","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
319. DATA "63","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
320. DATA "64","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
321.  
322. PiecePatterns:
323. DATA ........................
324. DATA ........................
325. DATA ........................
326. DATA ........................
327. DATA ....X..XX..XX..XX..X....
328. DATA ....X..XX..XX..XX..X....
329. DATA ....X..XX..XX..XX..X....
330. DATA ....X..XX..XX..XX..X....
331. DATA ....X..XX..XX..XX..X....
332. DATA .....X.XX..XX..XX.X.....
333. DATA ......XXXXXXXXXXXX......
334. DATA .....XX..........XX.....
335. DATA ......X.XXXXXXXX.X......
336. DATA ......X.XXXXXXXX.X......
337. DATA ......X.XXXXXXXX.X......
338. DATA ......X.XXXXXXXX.X......
339. DATA .....X............X.....
340. DATA .....X..XXXXXXXX..X.....
341. DATA ....X..............X....
342. DATA ...X..XXXXXXXXXXXX..X...
343. DATA ...X................X...
344. DATA ...XXXXXXXXXXXXXXXXXX...
345.  
346. DATA ........................
347. DATA ........................
348. DATA ........................
349. DATA ........................
350. DATA ............XXX.........
351. DATA ..........XX.X.X........
352. DATA .........X..X.X.XX......
353. DATA ........X.X.XX.X..X.....
354. DATA .......X.XXXX.X.X..X....
355. DATA .......X.X...XXX.X..X...
356. DATA .....X..XX..X.XXX.X.X...
357. DATA ....X.XXXXXXX.XXX.X..X..
358. DATA ...X.XXXXXX.X..XX.X..X..
359. DATA ...X.XX..XXX.X.XX.X..X..
360. DATA ....X..XXXX..X.XX.X..X..
361. DATA .....XX..X..X.XXX.X..X..
362. DATA ........X..XX.XX.XX.X...
363. DATA .......X..XX.XX.XX.X....
364. DATA ......XXXXXXXXXXXXXX....
365. DATA .....X..............X...
366. DATA ....X................X..
367. DATA .....XXXXXXXXXXXXXXXX...
368.  
369. DATA ........................
370. DATA ........................
371. DATA ........................
372. DATA ............X...........
373. DATA ...........X.X..........
374. DATA ..........X.X.X.........
375. DATA ........X...XX..X.......
376. DATA .......X..X..XX..X......
377. DATA .......X.XXX..XX.X......
378. DATA .......X.XXXX..X.X......
379. DATA ........X.......X.......
380. DATA .......XX.X.X.X.XX......
381. DATA ......X...........X.....
382. DATA .......X.XXX.XX.XX......
383. DATA ........X.XX.XX.X.......
384. DATA .......X.XXX.XXX.X......
385. DATA .......X.XXX.XXX.X......
386. DATA ......X.X.......X.X.....
387. DATA .....X.XXXXX.XXXXX.X....
388. DATA .....X.XXXXX.XXXXX.X....
389. DATA .....X.............X....
390. DATA ......XXXXXXXXXXXXX.....
391.  
392. DATA ............X...........
393. DATA ...........X.X..........
394. DATA .....X....X.X.X....X....
395. DATA ....X.X.XX.XXX..X.X.X...
396. DATA ...X.X.X..XX.XXX.X.X.X..
397. DATA ...X.XX.XXX.X.XXX.XX.X..
398. DATA ...X.XXX.X.XXX.X.XXX.X..
399. DATA ...X.XXXX.XXXXX.XXXX.X..
400. DATA ....X.XXXXXX..XXXXX.X...
401. DATA .....X.XXXXX..XXXX.X....
402. DATA .....X.............X....
403. DATA ......XXXXXXXXXXXXX.....
404. DATA ....X...............X...
405. DATA ......XX.XXXXXXX.XX.....
406. DATA .......X.X.XXX.X.X......
407. DATA ......X.XX.XXX.XX.X.....
408. DATA ......X.XX.XXX.XX.X.....
409. DATA .....XXXXXXXXXXXXXXX....
410. DATA ....X...............X...
411. DATA ...X..XX.XX.XX.XX.X..X..
412. DATA ...X.................X..
413. DATA ....XXXXXXXXXXXXXXXXX...
414.  
415. DATA ...........XX...........
416. DATA .........XX..XX.........
417. DATA .......XX.X..X.XX.......
418. DATA .....XX.X......X.XX.....
419. DATA ....X..XX.X..X.XX..X....
420. DATA ...X...XXXX..XXXX...X...
421. DATA ..X...XX........XX...X..
422. DATA .X..XXX.XXX..XXX.XXX..X.
423. DATA X..XXX..XXX..XXX..XXX..X
424. DATA X.XXXX..XXX..XXXX.XXXX.X
425. DATA X.XXXX.XXXX..XXXX.XXXX.X
426. DATA X.XXXX..XXXXXXXX..XXXX.X
427. DATA .X.XXXX..XXXXXX..XXXX.X.
428. DATA .X..XXXX..XXXX..XXXX..X.
429. DATA ..X..XXXX......XXXX..X..
430. DATA ...X....X......X....X...
431. DATA ...XXXXXXXXXXXXXXXXXX...
432. DATA ..X..................X..
433. DATA .X..XXXXXXXXXXXXXXXX..X.
434. DATA .X..XXXXXXXXXXXXXXXX..X.
435. DATA ..X..................X..
436. DATA ...XXXXXXXXXXXXXXXXXX...
437.  
438. DATA ........................
439. DATA ........................
440. DATA ........................
441. DATA ..........XXXX..........
442. DATA .........X....X.........
443. DATA ........X.XXXX.X........
444. DATA ........X.XXXX.X........
445. DATA .........X....X.........
446. DATA ........XXXXXXXX........
447. DATA .......X........X.......
448. DATA ........XXXXXXXX........
449. DATA .........X.XX.X.........
450. DATA .........X.XX.X.........
451. DATA .........X.XX.X.........
452. DATA ........X..XX..X........
453. DATA .......X..XXXX..X.......
454. DATA ......X.XXXXXXXX.X......
455. DATA ......X.XXXXXXXX.X......
456. DATA .....X............X.....
457. DATA ......XXXXXXXXXXXX......
458. DATA ........................
459. DATA ........................
460.  
461. rgb:
462. DATA 0,0,0,0,""
463. 'DATA 1,20,50,0,"board white"
464. DATA 1,30,60,20,"board white"
465. DATA 2,1,1,1,"board black"
466. DATA 3,50,50,50,"white bright"
467. DATA 4,12,12,30,"white hightlight"
468. DATA 5,0,0,0,"black bright"
469. 'DATA 6,32,32,32,"black highlight"
470. DATA 6,50,12,12,"black highlight"
471. DATA 7,63,0,0,"red"
472. DATA 8,0,63,0,"green"
473. DATA 9,0,0,63,"blue"
474. DATA 10,50,50,50,"white"
475. DATA 11,20,20,20,""
476. DATA 12,20,20,20,""
477. DATA 13,40,10,30,""
478. DATA 14,25,25,25,"gray"
479. DATA 15,30,30,30,"printing"
480.  
481. cmenu:
482. DATA "1 Board white"
483. DATA "2 Board black"
484. DATA "3 W piece main"
485. DATA "4 W piece trim"
486. DATA "5 B piece main"
487. DATA "6 B piece trim"
488.  
489. Oops:
490. gronk = gronk + 1
491. IF gronk < 100 THEN
492.     RESUME
493. ELSE
494.     PRINT "Error "; DATE$; "  "; TIME$;
495.     END
496. END IF
497.  
498. SUB AddIt (Level, tm$, Score)
499.     IF rflag THEN mcount&(Level) = mcount&(Level) + 1
500.     Moves(Level) = Moves(Level) + 1 '                                count ok
501.     Move$(Level, Moves(Level)) = tm$ '                               save move
502.     Score(Level, Moves(Level)) = Score
503.     Index(Level, Moves(Level)) = TieTo(Level)
504. END SUB
505.  
506. SUB AddMove
507.  
508.     IF WorB THEN '                                                   white=1, black=0
509.         Move = Move + 1 '                                            number the moves
510.         PRINT #1, RIGHT$("  " + STR$(Move), 3);
511.         PRINT #1, RIGHT$(SPACE$(10) + m$, 7);
512.         MoveLog$(Move) = SPACE$(15)
513.         MID$(MoveLog$(Move), 1, 3) = Rjust$(Move, 3)
514.         MID$(MoveLog$(Move), 5, LEN(m$)) = m$
515.     ELSE
516.         MID$(MoveLog$(Move), 11, LEN(m$)) = m$
517.         PRINT #1, " "; m$
518.         IF (Move MOD 5) = 0 THEN PRINT #1, ""
519.     END IF
520.  
521. END SUB
522.  
523. SUB Center (tr, t$, highlight)
524.     IF t$ = "" THEN
525.         IF rflag THEN
526.             t$ = "           Quit   spacebar:move now   Noise           "
527.         ELSE
528.             t$ = "Quit Resign Back Color Invert Setup Mode Noise Graphic"
529.         END IF
530.     END IF
531.     z = _WIDTH \ 2 - LEN(t$) * 4 + 8
532.     SELECT CASE tr
533.         CASE IS = -1
534.             y = ym - 40
535.         CASE IS = 0
536.             y = ym - 18
537.         CASE ELSE
538.             y = tr / (ym / 16) * ym
539.     END SELECT
540.     LINE (0, ym)-(xm - 1, ym - 18), black&, BF
541.     COLOR white&
542.     _PRINTSTRING (z, y), t$
543.     IF highlight THEN
544.         COLOR cp&(1)
545.         FOR i = 1 TO LEN(t$)
546.             c$ = MID$(t$, i, 1)
547.             IF (c$ = UCASE$(c$)) AND (c$ <> ":") THEN
548.                 _PRINTSTRING (z + (i - 1) * 8, y), c$
549.             END IF
550.         NEXT
551.     END IF
552.     COLOR white&
553. END SUB
554.  
555. SUB ChangeColors
556.     LINE (0, 500)-(xm, ym), black&, BF '                             clear lower area
557.     k = 1
558.     DO
559.         RESTORE cmenu
560.         FOR i = 1 TO 6
561.             READ t$
562.             tx = 40 + INT((i - 1) / 2) * 150
563.             ty = 540 + ((i - 1) MOD 2) * 16
564.             IF i = k THEN COLOR white& ELSE COLOR gray& '            highlight palette for change
565.             _PRINTSTRING (tx, ty), t$
566.         NEXT i
567.         COLOR white&
568.         t$ = "rgb:down   RGB:up  Esc:exit"
569.         tx = _WIDTH \ 2 - LEN(t$) * 4 + 8
570.         _PRINTSTRING (tx, _HEIGHT - 20), t$
571.  
572.         FOR i = 1 TO 3 '                                             show 3 colors lines
573.             x1 = xc - xq * 4: x2 = xc + xq * 4
574.             y1 = yc + yq * 4 + 20 + i * 8: y2 = y1 + 4
575.             LINE (x1, y1)-(x2, y2), black&, BF
576.             LINE (x1, y1)-(x2, y2), gray&, B
577.             IF i = 1 THEN j = myr(k): tc& = red&
578.             IF i = 2 THEN j = myg(k): tc& = green&
579.             IF i = 3 THEN j = myb(k): tc& = blue&
580.             j = j / 255 * xq * 8
581.             LINE (x1, y1)-(x1 + j, y2), tc&, BF
582.         NEXT i
583.  
584.         _DISPLAY
585.  
586.         DO: _LIMIT 10: i$ = INKEY$: LOOP UNTIL LEN(i$) '             wait for key
587.         IF i$ = Esc$ THEN EXIT DO '                                  done
588.         IF i$ = "" THEN i$ = " " '                                   so instr doesn't bomb
589.         p = INSTR("123456", i$): IF p THEN k = p '                   select palette
590.  
591.         z = 10
592.         SELECT CASE i$
593.             CASE IS = "r" '                                          red down
594.                 myr(k) = myr(k) - z
595.                 IF myr(k) < 0 THEN myr(k) = 0
596.             CASE IS = "g" '                                          green down
597.                 myg(k) = myg(k) - z
598.                 IF myg(k) < 0 THEN myg(k) = 0
599.             CASE IS = "b" '                                          blue down
600.                 myb(k) = myb(k) - z
601.                 IF myb(k) < 0 THEN myb(k) = 0
602.             CASE IS = "R" '                                          red up
603.                 myr(k) = myr(k) + z
604.                 IF myr(k) > 255 THEN myr(k) = 255
605.             CASE IS = "G" '                                          green up
606.                 myg(k) = myg(k) + z
607.                 IF myg(k) > 255 THEN myg(k) = 255
608.             CASE IS = "B" '                                          blue up
609.                 myb(k) = myb(k) + z
610.                 IF myb(k) > 255 THEN myb(k) = 255
611.         END SELECT
612.  
613.         ColorWrite
614.         Colorassign
615.         PlotScreen false
616.     LOOP
617.  
618.     LINE (0, 500)-(xm, ym), black&, BF
619.  
620. END SUB
621.  
622. SUB CheckBoard (Level)
623.     Moves(Level) = 0
624.     prot(Level) = 0
625.  
626.     FOR r = 1 TO 8
627.         FOR c = 1 TO 8
628.             mp = b(c, r)
629.             mc = -(mp > 6) - (mp = 0) * 2 '                          evaluates to 0 black 1 white 2 empty
630.             mp = mp + (mp > 6) * 6
631.             IF mc = WorB THEN
632.                 TryMove Level, c, r, mp, mc
633.             END IF
634.         NEXT
635.     NEXT
636.  
637.     IF Level > 1 THEN GOTO nocastle '                                only do for current move (speed)
638.  
639.     cq = true: ck = true '                                           castling
640.  
641.     IF WorB THEN rn$ = "1" ELSE rn$ = "8"
642.     rn = VAL(rn$)
643.     tp = b(5, rn): tp = tp + (tp > 6) * 6 '                          e1 (white) or e8 (black)
644.     IF tp <> King THEN cq = 0: ck = 0: GOTO nocastle '               no King here
645.  
646.     t$ = "e" + rn$ '                                                 King home spot algebraic
647.     FOR lm = 1 TO Moves(1) '                                         can any opponent piece move there?
648.         IF t$ = RIGHT$(Move$(1, lm), 2) THEN cq = 0: ck = 0: GOTO nocastle ' must be in check
649.     NEXT lm
650.  
651.     ' WHITE                      BLACK
652.     ' 8 R N B Q K B N R          1 R N B K Q B N R
653.     ' 7 P P P P P P P P          2 P P P P P P P P
654.     ' 6                          3
655.     ' 5                          4
656.     ' 4                          5
657.     ' 3                          6
658.     ' 2 P P P P P P P P          7 P P P P P P P P
659.     ' 1 R N B Q K B N R          8 R N B K Q B N R
660.     '   a b c d e f g h            h g f e d c b a
661.  
662.     FOR castle = 1 TO 2 '                                            queenside, then kingside
663.  
664.         'debug$(castle) = ""
665.         nr = 0 '   no rook
666.         pr = 0 '   prior condition
667.         ne = 0 '   not empty
668.         co = 0 '   controlled space
669.  
670.         '                 bbww
671.         ' castle$ format "QKQK" blank if ok, X if nulled by King or Rook move
672.         IF MID$(castle$, WorB * 2 + castle, 1) <> " " THEN pr = castle: GOTO nocando '  prior condition
673.  
674.         IF castle = 1 THEN cn = 1 ELSE cn = 8 '                      column number
675.         p = b(cn, rn): p = p + (p > 6) * 6
676.         IF p <> Rook THEN nr = 1: GOTO nocando
677.  
678.         '                         bcd              fg
679.         IF castle = 1 THEN ca$ = "234" ELSE ca$ = "67" '             column number
680.         FOR cs = 1 TO LEN(ca$) '                                     look at spaces between king and rook
681.             cn = VAL(MID$(ca$, cs, 1))
682.             IF b(cn, rn) > 0 THEN ne = castle: GOTO nocando '        not empty
683.  
684.             IF NOT ((cs = 1) AND (castle = 1)) THEN '                queenside knight
685.                 t$ = MID$(alpha$, cn, 1) + rn$ '                     controlled square?
686.                 IF Level THEN lm = 0 ELSE lm = 1
687.                 FOR i = 1 TO Moves(lm) '                             see what can move here
688.                     IF t$ = RIGHT$(Move$(lm, i), 2) THEN
689.                         'debug$(castle) = Move$(lm, i)
690.                         co = castle: EXIT FOR ' yes
691.                     END IF
692.                 NEXT i
693.             END IF
694.         NEXT cs
695.         nocando:
696.         'debug$(castle) = debug$(castle) + STR$(nr) + STR$(pr) + STR$(ne) + STR$(co)
697.         IF (nr + pr + ne + co) THEN '                                non-zero means some test failed
698.             IF castle = 1 THEN cq = false ELSE ck = false
699.         END IF
700.     NEXT castle
701.  
702.     IF ck THEN AddIt Level, "O-O", 12
703.     IF cq THEN AddIt Level, "O-O-O", 13
704.  
705.     'LOCATE 34 + WorB, 45: PRINT "*"; castle$; "* ";
706.     'PRINT MID$("K ", ck + 2, 1);
707.     'PRINT MID$("Q ", cq + 2, 1); cq; ck;
708.  
709.     nocastle:
710.     TakeBest Level, false
711. END SUB
712.  
713. SUB Colorassign
714.     tf$ = "ccolor.dat"
715.     tf = FREEFILE
716.     IF _FILEEXISTS(tf$) THEN
717.         OPEN tf$ FOR INPUT AS #tf
718.         INPUT #tf, bri
719.         IF bri = 0 THEN bri = obri
720.         IF bri < 2 THEN bri = 2
721.         FOR i = 0 TO 31
722.             INPUT #tf, myr(i), myg(i), myb(i)
723.             cp&(i) = _RGB32(myr(i) * bri, myg(i) * bri, myb(i) * bri)
724.         NEXT
725.         CLOSE #tf
726.     ELSE
727.         bri = 4
728.         RESTORE rgb
729.         FOR i = 0 TO 31
730.             IF i < 16 THEN
731.                 READ PalNum, myr(i), myg(i), myb(i), Desc$
732.             ELSE
733.                 myr(i) = 32: myg(i) = 32: myb(i) = 32
734.             END IF
735.             cp&(i) = _RGB32(myr(i) * bri, myg(i) * bri, myb(i) * bri)
736.         NEXT
737.         ColorWrite
738.     END IF
739.     CLOSE #tf
740.     black& = cp&(0)
741.     boardwhite& = cp&(1)
742.     boardblack& = cp&(2)
743.     red& = cp&(7)
744.     green& = cp&(8)
745.     blue& = cp&(9)
746.     white& = _RGB32(155, 155, 155)
747.     gray& = _RGB32(40, 40, 40)
748.     COLOR gray&
749.     IF altblack THEN cp&(6) = _RGB32(32 * bri, 32 * bri, 32 * bri)
750. END SUB
751.  
752. SUB ColorWrite
753.     tf$ = "ccolor.dat"
754.     tf = FREEFILE
755.     OPEN tf$ FOR OUTPUT AS #tf
756.     PRINT #tf, bri
757.     FOR i = 0 TO 31
758.         PRINT #tf, myr(i); ","; myg(i); ","; myb(i)
759.     NEXT
760.     CLOSE #tf
761. END SUB
762.  
763. SUB Cursor (br, bc, fl) STATIC
764.     DIM garr(8000)
765.     IF (bc < 1) OR (br < 1) OR (bc > 8) OR (br > 8) THEN EXIT SUB
766.     x1 = xc + (bc - 5) * xq: x2 = x1 + xq
767.     y1 = yc + (4 - br) * yq: y2 = y1 + yq
768.     GET (x1, y1)-(x2, y2), garr()
769.     IF (ctime! = 0) OR (TIMER > ctime!) THEN xx = xx XOR 1: ctime! = TIMER + .25
770.     IF xx THEN
771.         IF useidiot OR (TIMER < alfred!) THEN PUT (x1 + 2, y1 + 2), abuff(), PSET ELSE PUT (x1, y1), garr(), PRESET
772.     END IF
773.     IF fl THEN _PRINTSTRING (x1 + 16, y1 + 36), "To?"
774.     _DISPLAY
775. END SUB
776.  
777. SUB DispStats
778.  
779.     IF waitflag = 0 THEN
780.         IF rflag = 0 THEN tc = humanc ELSE tc = 1 - humanc
781.         etime!(tc) = etime!(tc) + TIMER - Start2!
782.         etime!(2) = TIMER - Start1! + hold! '                        current move
783.         hold! = 0
784.         IF etime!(2) > etime!(tc) THEN etime!(2) = etime!(tc)
785.         etime!(3) = etime!(0) + etime!(1) '                          game total
786.         emin = etime!(2) \ 60
787.     END IF
788.     Start2! = TIMER
789.  
790.     IF (dtime! = 0) OR (TIMER > dtime!) THEN
791.  
792.         'IF rick AND (vflag = 0) THEN
793.         '    LOCATE 1, 4
794.         '    PRINT Moves(0);
795.         '    FOR i = 1 TO 3
796.         '        PRINT mcount&(i);
797.         '    NEXT i
798.         '    LOCATE 2, 4
799.         '    FOR i = 0 TO 3
800.         '        PRINT Moves(i);
801.         '    NEXT i
802.         'END IF
803.  
804.         'IF tlimit > 0 THEN t$ = LTRIM$(STR$(tlimit)) + "m" ELSE t$ = "unlimited"
805.         't$ = "Time: " + t$
806.         'LOCATE 2, 4: PRINT t$;
807.  
808.         tcount& = Moves(0) + mcount&(1) + mcount&(2) + mcount&(3)
809.         mps& = tcount& - ocount&
810.         IF mps& <= 100 THEN mps& = omps& ELSE opms& = mps&
811.         t$ = "   " + STR$(mps&)
812.         tx = _WIDTH - LEN(t$) * 8 - 10
813.         IF mps& THEN _PRINTSTRING (tx, 2), t$
814.  
815.         t$ = STR$(tcount&)
816.         tx = _WIDTH - LEN(t$) * 8 - 10
817.         _PRINTSTRING (tx, 16), t$
818.  
819.         ShowTime 32, etime!(0), "Black"
820.         ShowTime 33, etime!(1), "White"
821.         ShowTime 34, etime!(3), "Game"
822.         ShowTime 35, etime!(2), "Move"
823.  
824.         ocount& = tcount&
825.         dtime! = TIMER + 1
826.     END IF
827.  
828.     IF (showthink = 0) OR (smode < 2) THEN _DISPLAY
829.  
830. END SUB
831.  
832. DEFSNG A-Z
833. FUNCTION f_pl (n1, n2, n3) '                                         plasma function
834.     f_pl = _RGB32(n1 * 255, n2 * 255, n3 * 255)
835. END FUNCTION
836.  
837. DEFINT A-Z
838. SUB Init
839.     xm = 600: ym = 200
840.     main& = _NEWIMAGE(xm, ym, 32)
841.     SCREEN main&
842.     _DELAY .2
843.     _SCREENMOVE _MIDDLE
844.     _DELAY .2
845.  
846.     RANDOMIZE TIMER '                                                seed generator
847.     Colorassign '                                                    red&, green&, etc, easier to use than palette numbers
848.  
849.     alpha$ = "abcdefgh"
850.     castle$ = SPACE$(4) '                                            flags QKQK (B then W)
851.     crlf$ = Enter$ + lf$
852.     Enter$ = CHR$(13)
853.     Esc$ = CHR$(27) '                                                to quit program
854.     graphics = 3 '                                                   graphics for white squares (0-3)
855.     lcount& = 0 '                                                    line counter for debug output
856.     lf$ = CHR$(10) '                                                 line feed
857.     Move = 0
858.     MakeNoise = 1
859.     showthink = 1
860.     WorB = 1 '                                                       white=1, black=0
861.     xq = 56: yq = 56
862.     xc = 248: yc = 256 '                                             center of board
863.  
864.     FOR i = 1 TO 8
865.         alphal$(i) = MID$(alpha$, i, 1)
866.     NEXT i
867.  
868.     FOR i = 0 TO 3: etime!(i) = 0: NEXT '                            sides, total, current
869.  
870.     RESTORE PiecePatterns '                                          bit images
871.     FOR p = 1 TO 6 '                                                 RNBQKP
872.         n = 0
873.         FOR y = 0 TO 21 ' 22 rows
874.             READ d$
875.             p1 = INSTR(d$ + "X", "X") '                              find first "on" bit
876.             FOR t = LEN(d$) TO 1 STEP -1 '                           find last "on" bit
877.                 IF MID$(d$, t, 1) = "X" THEN
878.                     p2 = t
879.                     EXIT FOR
880.                 END IF
881.             NEXT t
882.             FOR x = p1 TO p2
883.                 pixel = INSTR(".X", MID$(d$, x, 1))
884.                 n = n + 1
885.                 IF pixel = 2 THEN c = 3 ELSE c = 4
886.                 x(p, n) = x + 1
887.                 y(p, n) = y + 2
888.                 c(p, n) = c
889.                 IF pixel = 2 THEN c = 5 ELSE c = 6
890.                 c(p + 6, n) = c
891.             NEXT x
892.         NEXT y
893.         c(p, 0) = n
894.         FOR scram = 1 TO 256 '                                       scramble (moves nicer)
895.             c1 = RND * (c(p, 0) - 1) + 1 '                           any bit
896.             c2 = RND * (c(p, 0) - 1) + 1 '                           any other bit
897.             SWAP x(p, c1), x(p, c2)
898.             SWAP y(p, c1), y(p, c2)
899.             SWAP c(p, c1), c(p, c2) '                                black
900.             SWAP c(p + 6, c1), c(p + 6, c2) '                        white
901.         NEXT scram
902.     NEXT p
903.  
904.     RESTORE Legal '                                                  define how piece moves
905.     FOR p = 1 TO 6 '                                                 RNBQKP
906.         READ p$ '                                                    piece, not saved
907.         FOR t = 0 TO 7 '                                             8 each
908.             READ udlr$
909.             du(p, t) = VAL(MID$(udlr$, 1, 1)) '                      direction up
910.             dd(p, t) = VAL(MID$(udlr$, 2, 1)) '                      direction down
911.             dl(p, t) = VAL(MID$(udlr$, 3, 1)) '                      direction left
912.             dr(p, t) = VAL(MID$(udlr$, 4, 1)) '                      direction right
913.         NEXT t
914.     NEXT p
915.  
916.     FOR i = 1 TO 6
917.         '                    RNBQKP
918.         value(i) = VAL(MID$("533901", i, 1)) '                       point value for capture
919.     NEXT i
920.  
921.     RESTORE Setup '                                                  initial board position
922.     FOR r = 8 TO 1 STEP -1 '                                         row
923.         FOR c = 1 TO 8 '                                             column
924.             READ b(c, r) '                                           board
925.             o(c, r) = b(c, r) '                                      initial setup
926.         NEXT c
927.     NEXT r
928.  
929.     gm = 0: n = 0
930.     IF LEN(GameFile$) > 0 THEN ReadGame
931.     gm = 0
932.  
933.     CLOSE
934.     newf:
935.     f = f + 1
936.     f$ = "ch" + RIGHT$("0000000" + LTRIM$(STR$(f)), 6) + ".alg" '    save game for analysis
937.     IF _FILEEXISTS(f$) THEN GOTO newf
938.  
939.     OPEN f$ FOR OUTPUT AS #1 '                                       algrebraic moves
940.     MasterLevel1 = VAL(COMMAND$) '                                   only 4 really tested....2 is plenty stupid, odds not tested!
941.     IF MasterLevel1 = 0 THEN MasterLevel1 = 4
942.  
943.     FOR i = 0 TO 3
944.         SELECT CASE i
945.             CASE IS = 0
946.                 f$ = "alfred.jpg" '                                  Alfred E. Neuman
947.             CASE IS = 1
948.                 f$ = "chess.png"
949.             CASE IS = 2
950.                 f$ = "clockx.png"
951.             CASE IS = 3
952.                 f$ = "clockx2.png"
953.         END SELECT
954.         IF _FILEEXISTS(f$) = 0 THEN '                                accomodate Linux, which cares about case
955.             f$ = UCASE$(f$) '                                        now try uppercase
956.             IF _FILEEXISTS(f$) = 0 THEN SYSTEM '                     so it really isn't there
957.         END IF
958.         li1:
959.         icon&(i) = _LOADIMAGE(f$)
960.         IF icon&(i) >= -1 THEN _DELAY .2: GOTO li1
961.     NEXT i
962.     _ICON icon&(1)
963.     _DELAY .2
964.  
965.     _SOURCE icon&(0) '                                               Alfred E. Neuman
966.     _DISPLAY '                                                       hide idiot
967.     _PUTIMAGE
968.     GET (0, 0)-(52, 53), abuff(0)
969.  
970.     CLS
971.     _DELAY .2
972.     Menubox
973.     Center 6, "White  Black  Humans  Computer", 1
974.     Center 0, "Quit or Esc to exit", 1
975.     _DISPLAY
976.     DO: _LIMIT 10
977.         i$ = INKEY$
978.         IF i$ = "" THEN i$ = " "
979.         IF (LCASE$(i$) = "q") OR (i$ = Esc$) THEN SYSTEM
980.         p = INSTR("bwhc", i$)
981.     LOOP UNTIL p
982.     SELECT CASE p
983.         CASE IS = 1 '                                                player is black
984.             human = 1: humanc = 0: invert = 1
985.         CASE IS = 2 '                                                player is white
986.             human = 1: humanc = 1
987.         CASE IS = 3 '                                                human vs. human
988.             human = 2
989.         CASE IS = 4 '                                                computer vs. computer, just watch
990.             human = 0: OnAuto = 1
991.     END SELECT
992.  
993.     'IF human <> 2 THEN
994.     '    tlimit = 0
995.     '    DO
996.     '        CLS
997.     '        Menubox
998.     '        Center 6, "Time limit in minutes?  (0 unlimited)", 0
999.     '        Center 8, STR$(tlimit), 0
1000.     '        Center 0, "Quit or Esc to exit", 1
1001.     '        _DISPLAY
1002.     '        DO: _LIMIT 10
1003.     '            i$ = INKEY$
1004.     '        LOOP UNTIL LEN(i$)
1005.     '        IF (LCASE$(i$) = "q") OR (i$ = Esc$) THEN SYSTEM
1006.     '        IF i$ = CHR$(8) THEN tlimit = tlimit / 10
1007.     '        p = INSTR("0123456789", i$): IF p THEN tlimit = tlimit * 10 + p - 1
1008.     '    LOOP UNTIL i$ = Enter$
1009.     'END IF
1010.  
1011.     'IF rick THEN smode = 2
1012.     ScreenInit
1013.     PlotBoard
1014. END SUB
1015.  
1016. SUB HumanMove STATIC
1017.     cursoron! = TIMER + 3
1018.     IF cc = 0 THEN
1019.         rr = 7
1020.         cc = 5 + (WorB = 0)
1021.     END IF
1022.     FOR i = 0 TO 1
1023.         DO: _LIMIT 30
1024.             IF vflag THEN ShowValid cc, rr
1025.             KeyScan 1, 0 '                                           plotscreen, no _display
1026.             IF rr < 1 THEN rr = 1
1027.             IF rr > 8 THEN rr = 8
1028.             IF cc < 1 THEN cc = 1
1029.             IF cc > 8 THEN cc = 8
1030.             IF cursoron! > TIMER THEN Cursor 9 - rr, cc, i
1031.             IF takebackflag OR LEN(msg$) THEN EXIT SUB
1032.             WHILE _MOUSEINPUT
1033.                 mx = _MOUSEX
1034.                 my = _MOUSEY
1035.                 xx = (mx - xc - (4 * xq) + xq \ 2) / xq + 8
1036.                 yy = (my - yc - (4 * yq) + yq \ 2) / yq + 8
1037.                 IF (xx > 0) AND (xx < 9) AND (yy > 0) AND (yy < 9) THEN rr = yy: cc = xx
1038.                 IF _MOUSEBUTTON(1) OR _MOUSEBUTTON(2) THEN i$ = Enter$
1039.             WEND
1040.             IF LEN(i$) = 2 THEN
1041.                 kk = ASC(RIGHT$(i$, 1))
1042.                 cc = cc + (kk = 75) - (kk = 77) '                    left right
1043.                 rr = rr + (kk = 72) - (kk = 80) '                    up down
1044.             END IF
1045.         LOOP UNTIL i$ = Enter$
1046.         IF i = 0 THEN
1047.             fr = rr: fc = cc
1048.             IF invert THEN fr = 9 - fr: fc = 9 - fc
1049.         ELSE
1050.             tr = rr: tc = cc
1051.             IF invert THEN tr = 9 - tr: tc = 9 - tc
1052.         END IF
1053.     NEXT i
1054.  
1055.     fs$ = alphal$(fc) + LTRIM$(STR$(9 - fr))
1056.     ts$ = alphal$(tc) + LTRIM$(STR$(9 - tr))
1057.     m$ = fs$ + ts$
1058.     IF m$ = "e1g1" THEN m$ = "O-O"
1059.     IF m$ = "e1c1" THEN m$ = "O-O-O"
1060.     IF m$ = "e8g8" THEN m$ = "O-O"
1061.     IF m$ = "e8c8" THEN m$ = "O-O-O"
1062. END SUB
1063.  
1064. SUB KeyScan (kf1, kf2) STATIC '                                      plotscreen, _display
1065.     TempMess "", 0
1066.     DispStats
1067.     dot = 0
1068.     i$ = INKEY$
1069.     IF LEN(i$) THEN
1070.         cursoron! = TIMER + 2
1071.     END IF
1072.     IF LEN(i$) = 1 THEN
1073.         IF (LCASE$(i$) = "q") OR (i$ = Esc$) THEN abort = 9: msg$ = "Quit!"
1074.         IF i$ = Enter$ THEN EXIT SUB
1075.         IF i$ = " " THEN msg$ = "abort": abort = 1: EXIT SUB '       move now
1076.         c = INSTR("123456789ABCDEF0", i$) '                          experiment with colors
1077.         IF c > 0 THEN
1078.             IF c = 16 THEN
1079.                 c = 2
1080.                 myr(c) = 0: myg(c) = 0: myb(c) = 0
1081.             ELSE
1082.                 myr(c) = RND * 64: myg(c) = RND * 64: myb(c) = RND * 64
1083.             END IF
1084.             cp&(c) = _RGB32(myr(c) * bri, myg(c) * bri, myb(c) * bri)
1085.             ColorWrite
1086.             Colorassign
1087.             PlotBoard
1088.         END IF
1089.         IF i$ = "a" THEN OnAuto = NOT (OnAuto) '                     not currently in use
1090.         IF i$ = "b" THEN takebackflag = 1
1091.         IF i$ = "c" THEN ChangeColors
1092.         IF i$ = "g" THEN '                                           change white square graphics scheme
1093.             graphics = (graphics + 1) MOD 4
1094.             IF graphics = 0 THEN PlotBoard
1095.             t$ = "Mode" + STR$(graphics + 1) + " of 4"
1096.             TempMess t$, 2
1097.         END IF
1098.         IF i$ = "G" THEN pinit = pinit XOR 1 '                       adjust current white square graphics
1099.         IF i$ = "h" THEN dot = 1: history = history XOR 1
1100.         IF i$ = "i" THEN invert = invert XOR 1: PlotBoard '          flip board around
1101.         IF i$ = "I" THEN
1102.             useidiot = useidiot XOR 1
1103.             t$ = "Idiot " + OnOff$(useidiot)
1104.             TempMess t$, 2
1105.         END IF
1106.         IF i$ = "l" THEN dot = 1: showlegalf = showlegalf XOR 1
1107.         IF i$ = "L" THEN '                                           look at log file
1108.             CLOSE #2
1109.             SHELL _DONTWAIT "notepad chess.txt"
1110.             OPEN "chess.txt" FOR APPEND AS #2
1111.         END IF
1112.         IF i$ = "m" THEN '                                           screen mode
1113.             smode = (smode + 1) MOD 3
1114.             ScreenInit
1115.         END IF
1116.         IF i$ = "n" THEN '                                           sound effects
1117.             MakeNoise = MakeNoise XOR 1
1118.             t$ = "Sound " + OnOff$(MakeNoise)
1119.             TempMess t$, 2
1120.         END IF
1121.         IF i$ = "p" THEN dot = 1: showprotf = showprotf XOR 1
1122.         IF i$ = "P" THEN
1123.             pause = pause XOR 1
1124.             IF pause THEN
1125.                 LOCATE 2, 29: PRINT "PAUSED";
1126.                 _DISPLAY
1127.                 hold! = TIMER - etime!(2)
1128.                 SLEEP
1129.                 Start1! = TIMER
1130.                 LOCATE 2, 29: PRINT SPACE$(10);
1131.                 _DISPLAY '
1132.             END IF
1133.         END IF
1134.         IF (rflag = 0) AND (i$ = "r") THEN abort = 2: msg$ = "Resign!"
1135.         IF i$ = "s" THEN Setup '                                     setup
1136.         IF i$ = "t" THEN dot = 1: showthink = showthink XOR 1
1137.         IF i$ = "v" THEN '                                           show valid moves at top left
1138.             vflag = vflag XOR 1
1139.             LOCATE 2, 4: PRINT SPACE$(40);
1140.             _DISPLAY
1141.         END IF
1142.         IF i$ = "x" AND MakeNoise THEN PlaySound "ding" '            sound test
1143.         IF i$ = "X" THEN
1144.             SHELL _HIDE "del ccolor.dat" '                           kill color file
1145.             ColorWrite
1146.             Colorassign
1147.             PlotBoard
1148.         END IF
1149.         'IF i$ = "y" THEN itest '                                    see how bad icon problem is
1150.         IF i$ = "z" THEN
1151.             altblack = altblack XOR 1
1152.             Colorassign
1153.             CLS
1154.             PlotBoard
1155.             TempMess "Alternate black " + OnOff(altblack), 2
1156.         END IF
1157.         i$ = ""
1158.     END IF
1159.     IF LEN(i$) = 2 THEN
1160.         k = ASC(RIGHT$(i$, 1))
1161.         wbri = bri
1162.         bri = bri - (k = 73) + (k = 81) '                            brightness PgUp/PgDn
1163.         IF bri < 2 THEN bri = 2
1164.         IF bri > 4 THEN bri = 4
1165.         IF bri <> wbri THEN '                                        was changed
1166.             ColorWrite
1167.             Colorassign
1168.             TempMess "Brightness" + STR$(bri), 1
1169.         END IF
1170.     END IF
1171.  
1172.     IF kf1 THEN PlotScreen true
1173.     IF dot THEN DebugR = 99: TextInfo ""
1174.     IF kf2 THEN _DISPLAY
1175. END SUB
1176.  
1177. FUNCTION Make4$ (t$)
1178.     Make4$ = LEFT$(t$ + SPACE$(4), 4)
1179. END FUNCTION
1180.  
1181. SUB LogThinking () STATIC
1182.     ts = 0: z1$ = "": z2$ = ""
1183.     FOR t = 1 TO 3
1184.         ti = TieTo(t)
1185.         z1$ = z1$ + Make4$(Move$(t - 1, ti)) + " "
1186.         z2$ = z2$ + Rjust$(Score(t - 1, ti), 3) + " "
1187.         ts = ts + Score(t - 1, ti)
1188.     NEXT t
1189.     ts = ts - Score
1190.     zz$ = z1$ + Make4$(m$) + z2$ + Rjust$(Score, 3) + " " + Rjust$(ts, 4)
1191.     PRINT #2, zz$
1192.     TextInfo zz$
1193. END SUB
1194.  
1195. SUB Menubox
1196.     tx = _WIDTH \ 2: ty = _HEIGHT \ 2
1197.     xs = 200: ys = 70
1198.     x1 = tx - xs: y1 = ty - ys
1199.     x2 = tx + xs: y2 = ty + ys
1200.  
1201.     LINE (x1, y1 + 20)-(x2, y2 - 20), _RGBA(1, 1, 1, 220), BF
1202.     FOR q = 2 TO 20 STEP 4
1203.         LINE (x1 - q + 0, y1 + q + 0)-(x2 + q + 0, y2 - q + 0), cp&(1), B
1204.         LINE (x1 - q + 1, y1 + q + 1)-(x2 + q + 1, y2 - q + 1), cp&(1), B
1205.     NEXT q
1206. END SUB
1207.  
1208. SUB MoveIt (m$, real)
1209.     IF m$ = ep$ THEN '                                               epfc, epfr, eptc, eptr, eprc, eprr
1210.         Plotpiece fc, fr, tc, tr
1211.         b(epfc, epfr) = 0
1212.         b(eprc, eprr) = 0
1213.         b(eptc, eptr) = 6 + WorB * 6
1214.         EXIT SUB
1215.     END IF
1216.  
1217.     IF m$ = "res" THEN EXIT SUB '                                    resign?
1218.     fs$ = LEFT$(m$, 2) '                                             from square
1219.     ts$ = RIGHT$(m$, 2) '                                            to square
1220.     tzz = 1 - (LEFT$(m$, 1) = "O") - (L1$ = "e") '                   two moves for a castle
1221.  
1222.     FOR pass = 1 TO tzz
1223.  
1224.         IF m$ = "O-O" THEN '                                         castle Kingside
1225.             IF WorB = 1 THEN '                                       white
1226.                 IF pass = 1 THEN '                                   first move of KS castle
1227.                     fs$ = "e1": ts$ = "g1"
1228.                 ELSE '                                               else 2nd
1229.                     fs$ = "h1": ts$ = "f1"
1230.                 END IF
1231.             ELSE '                                                   black castle
1232.                 IF pass = 1 THEN
1233.                     fs$ = "e8": ts$ = "g8"
1234.                 ELSE
1235.                     fs$ = "h8": ts$ = "f8"
1236.                 END IF
1237.             END IF
1238.         END IF
1239.         IF m$ = "O-O-O" THEN '                                       castle Queenside
1240.             IF WorB THEN '                                           white
1241.                 IF pass = 1 THEN
1242.                     fs$ = "e1": ts$ = "c1"
1243.                 ELSE
1244.                     fs$ = "a1": ts$ = "d1"
1245.                 END IF
1246.             ELSE
1247.                 IF pass = 1 THEN
1248.                     fs$ = "e8": ts$ = "c8"
1249.                 ELSE
1250.                     fs$ = "a8": ts$ = "d8"
1251.                 END IF
1252.             END IF
1253.         END IF
1254.         fc = INSTR(alpha$, LEFT$(fs$, 1)) '                          from column
1255.         fr = VAL(RIGHT$(fs$, 1)) '                                   from row
1256.         pm = b(fc, fr) '                                             piece to move
1257.         p = pm + (pm > 6) * 6
1258.         tc = INSTR(alpha$, LEFT$(ts$, 1)) '                          to column
1259.         tr = VAL(RIGHT$(ts$, 1)) '                                   to row
1260.         b(tc, tr) = pm '                                             move piece in array
1261.         b(fc, fr) = 0 '                                              blank old array spot
1262.         IF real THEN
1263.             IF b(c, r) = o(c, r) THEN o(c, r) = -1
1264.             Plotpiece fc, fr, tc, tr
1265.             IF p = King THEN MID$(castle$, WorB * 2 + 1, 2) = "XX"
1266.             IF p = Rook THEN
1267.                 IF WorB THEN
1268.                     IF (fc = 1) AND (fr = 1) THEN MID$(castle$, 3, 1) = "X"
1269.                     IF (fc = 1) AND (fr = 8) THEN MID$(castle$, 4, 1) = "X"
1270.                 ELSE
1271.                     IF (fc = 8) AND (fr = 1) THEN MID$(castle$, 1, 1) = "X"
1272.                     IF (fc = 8) AND (fr = 8) THEN MID$(castle$, 2, 1) = "X"
1273.                 END IF
1274.             END IF
1275.         END IF
1276.         IF (p = Pawn) AND ((tr = 1) OR (tr = 8)) THEN
1277.             b(tc, tr) = Queen - (pm > 6) * 6 '                       promote to queen
1278.             IF real THEN Plotpiece tc, tr, tc, tr '                  show queen
1279.         END IF
1280.     NEXT pass
1281. END SUB
1282.  
1283. DEFINT A-Z
1284. FUNCTION OnOff$ (v)
1285.     OnOff$ = MID$("OFFON ", v * 3 + 1, 3)
1286. END FUNCTION
1287.  
1288. DEFSNG A-Z
1289. SUB Plasma STATIC
1290.     TYPE xy
1291.         x AS SINGLE
1292.         y AS SINGLE
1293.         dx AS SINGLE
1294.         dy AS SINGLE
1295.     END TYPE
1296.  
1297.     IF pinit% = 0 THEN
1298.         DIM c(360) AS _UNSIGNED LONG, p(10) AS xy, f(10)
1299.         r = RND: g = RND: b = RND: i% = 0: q = .5
1300.         FOR n% = 1 TO 5
1301.             r1 = r: g1 = g: b1 = b
1302.             DO: r = RND: LOOP UNTIL ABS(r - r1) > q
1303.             DO: g = RND: LOOP UNTIL ABS(g - g1) > q
1304.             DO: b = RND: LOOP UNTIL ABS(g - g1) > q
1305.             FOR m% = 0 TO 17: m1% = 17 - m%
1306.                 f1 = (m% * r) / 18: f2 = (m% * g) / 18: f3 = (m% * b) / 18: c(i%) = f_pl(f1, f2, f3): i% = i% + 1
1307.             NEXT
1308.             FOR m% = 0 TO 17: m1% = 17 - m%
1309.                 f1 = (m% + m1% * r) / 18: f2 = (m% + m1% * g) / 18: f3 = (m% + m1% * b) / 18: c(i%) = f_pl(f1, f2, f3): i% = i% + 1
1310.             NEXT
1311.             FOR m% = 0 TO 17: m1% = 17 - m%
1312.                 f1 = (m1% + m% * r) / 18: f2 = (m1% + m% * g) / 18: f3 = (m1% + m% * b) / 18: c(i%) = f_pl(f1, f2, f3): i% = i% + 1
1313.             NEXT
1314.             FOR m% = 0 TO 17: m1% = 17 - m%
1315.                 f1 = (m1% * r) / 18: f2 = (m1% * g) / 18: f3 = (m1% * b) / 18: c(i%) = f_pl(f1, f2, f3): i% = i% + 1
1316.             NEXT
1317.         NEXT
1318.  
1319.         FOR n% = 0 TO 5
1320.             p(n%).x = RND * xm%: p(n%).y = RND * ym%: p(n%).dx = RND * 2 - 1: p(n%).dy = RND * 2 - 1
1321.             f(n%) = RND * .1
1322.         NEXT
1323.  
1324.         xm2% = 8 * xq%: ym2% = xm2%: x1% = xc% - 4 * xq%: y1% = yc% - 4 * yq%: x2% = xc% + 4 * xq%: y2% = yc% + 4 * yq%:
1325.         pinit% = 1
1326.     END IF
1327.  
1328.     FOR n% = 0 TO 5
1329.         p(n%).x = p(n%).x + p(n%).dx
1330.         IF p(n%).x > xm2% OR p(n%).x < 0 THEN p(n%).dx = -p(n%).dx
1331.         p(n%).y = p(n%).y + p(n%).dy
1332.         IF p(n%).y > ym2% OR p(n%).y < 0 THEN p(n%).dy = -p(n%).dy
1333.     NEXT
1334.  
1335.     IF graphics% = 2 THEN z% = 1 ELSE z% = 2
1336.  
1337.     FOR y% = y1% TO y2% STEP z%
1338.         FOR x% = x1% TO x2% STEP z%
1339.             p& = POINT(x%, y%)
1340.             'IF (p& = boardwhite&) OR (p& = boardblack&) THEN
1341.             IF (p& = boardwhite&) THEN
1342.                 d = 0
1343.                 FOR n% = 0 TO 5
1344.                     dx = x% - p(n%).x: dy = y% - p(n%).y
1345.                     k = SQR(dx * dx + dy * dy)
1346.                     d = d + (SIN(k * f(n%)) + 1) / 2
1347.                 NEXT
1348.                 PSET (x%, y%), c(d * 60)
1349.             END IF
1350.         NEXT
1351.         '_DELAY .001
1352.     NEXT
1353. END SUB
1354.  
1355. DEFINT A-Z
1356. SUB Playagain (t$)
1357.     Menubox
1358.     COLOR _RGBA32(222, 222, 222, 255), _RGBA32(1, 1, 1, 0)
1359.     Center 18, t$, 0
1360.     IF INSTR("QR", LEFT$(t$, 1)) THEN '                              Quit or Resign
1361.         Center 20, "Resume    New game     Quit", 1
1362.         ks$ = "rn"
1363.     ELSE
1364.         Center 20, "New game     Quit", 1
1365.         ks$ = "rn" '                                                 take out r when working properly (false checkmates)
1366.     END IF
1367.     _DISPLAY
1368.     COLOR _RGBA(155, 155, 155, 255), _RGBA32(0, 0, 0, 255)
1369.  
1370.     DO: _LIMIT 10
1371.         i$ = INKEY$
1372.         IF i$ = "" THEN i$ = " "
1373.         IF (i$ = Esc$) OR (LCASE$(i$) = "q") THEN SYSTEM
1374.         IF human = 0 THEN i$ = "n"
1375.     LOOP UNTIL INSTR(ks$, i$)
1376. END SUB
1377.  
1378. DEFSNG A-Z
1379. SUB PlaySound (f$) STATIC '         ding,tada,notify,windows xp hardware fail, etc\
1380.     CONST CACHE = 441 '             minimal detected frequency for analyzer is 100 Hz, so this is enought value (with 44100 biterate)
1381.     TYPE head
1382.         chunk AS STRING * 4 '       4 bytes  (RIFF)
1383.         size AS LONG '              4 bytes  (?E??)
1384.         fomat AS STRING * 4 '       4 bytes  (WAVE)
1385.         sub1 AS STRING * 4 '        4 bytes  (fmt )
1386.         subchunksize AS LONG '      4 bytes  (lo / hi), $00000010 for PCM audio
1387.         format AS STRING * 2 '      2 bytes  (0001 = standard PCM, 0101 = IBM mu-law, 0102 = IBM a-law, 0103 = IBM AVC ADPCM)
1388.         channels AS INTEGER '       2 bytes  (1 = mono, 2 = stereo)
1389.         rate AS LONG '              4 bytes  (sample rate, standard is 44100)
1390.         ByteRate AS LONG '          4 bytes  (= sample rate * number of channels * (bits per channel /8))
1391.         Block AS INTEGER '          2 bytes  (block align = number of channels * bits per sample /8)
1392.         Bits AS INTEGER '           2 bytes  (bits per sample. 8 = 8, 16 = 16)
1393.         subchunk2 AS STRING * 4 '   4 bytes  ("data")  contains begin audio samples
1394.     END TYPE '                     40 bytes  total
1395.     TYPE Wav16S
1396.         Left AS INTEGER
1397.         Right AS INTEGER
1398.     END TYPE
1399.     REDIM scache(CACHE) AS Wav16S
1400.     DIM H AS head
1401.     ch = FREEFILE
1402.     f$ = f$ + ".wav"
1403.     IF _FILEEXISTS(f$) = 0 THEN EXIT SUB
1404.     OPEN f$ FOR BINARY AS #ch
1405.     GET #ch, , H
1406.     block = H.Block
1407.     RATE = H.rate
1408.     chan = H.channels
1409.     bits = H.Bits
1410.     L = _SNDOPENRAW
1411.     R = _SNDOPENRAW
1412.     REDIM scache(CACHE) AS Wav16S
1413.     DO WHILE NOT EOF(ch)
1414.         GET #ch, , scache()
1415.         FOR P = 0 TO CACHE
1416.             lef = scache(P).Left
1417.             IF chan = 1 THEN righ = lef ELSE righ = scache(P).Right
1418.             lef = lef / RATE
1419.             righ = righ / RATE
1420.             IF RATE > 44100 THEN frekvence = RATE ELSE frekvence = 44100
1421.             FOR plll = 1 TO frekvence / RATE
1422.                 _SNDRAW lef, L
1423.                 _SNDRAW righ, R
1424.             NEXT plll
1425.         NEXT
1426.     LOOP
1427.     CLOSE ch
1428. END SUB
1429.  
1430. DEFINT A-Z
1431. SUB PlotBoard
1432.     FOR zr = 1 TO 8
1433.         FOR zc = 1 TO 8
1434.             IF rflag = 0 THEN Plotpiece zc, zr, zc, zr
1435.         NEXT zc
1436.     NEXT zr
1437. END SUB
1438.  
1439. SUB Plotpiece (fc, fr, tc, tr)
1440.     x1 = xc + (fc - 5) * xq
1441.     x2 = xc + (tc - 5) * xq
1442.     y1 = yc + (4 - fr) * yq
1443.     y2 = yc + (4 - tr) * yq
1444.     p = b(tc, tr)
1445.     IF invert THEN p = b(9 - tc, 9 - tr)
1446.     IF p > 6 THEN wb = 1: p = p - 6
1447.     i = p - (wb = 0) * 6
1448.  
1449.     FOR ps = 0 TO 1
1450.         IF ps = 0 THEN
1451.             c = fr + fc: tx = x1: ty = y1
1452.         ELSE
1453.             c = tr + tc: tx = x2: ty = y2
1454.         END IF
1455.         IF c MOD 2 THEN
1456.             LINE (tx, ty)-(tx + xq, ty + yq), boardwhite&, BF
1457.         ELSE
1458.             LINE (tx, ty)-(tx + xq, ty + yq), boardblack&, BF '      black square
1459.             LINE (tx, ty)-(tx + xq, ty + yq), boardwhite&, B '       border
1460.         END IF
1461.     NEXT ps
1462.  
1463.     FOR t = 1 TO c(p, 0)
1464.         tx = x1 + x(p, t) * 2
1465.         ty = y1 + y(p, t) * 2
1466.         LINE (tx, ty)-STEP(1, 1), cp&(c(i, t)), B
1467.     NEXT t
1468. END SUB
1469.  
1470. SUB PlotScreen (lflag) STATIC
1471.     PlotBoard
1472.     TextInfo ""
1473.     r = _RED32(boardwhite&) \ 2 '                                    legend, dim a-h, 1-8 along sides
1474.     g = _GREEN32(boardwhite&) \ 2
1475.     b = _BLUE32(boardwhite&) \ 2
1476.     COLOR _RGB32(r, g, b)
1477.     FOR i = 1 TO 8
1478.         IF invert THEN z = i ELSE z = 9 - i
1479.         n$ = LTRIM$(STR$(z))
1480.         IF invert THEN z = 9 - i ELSE z = i
1481.         a$ = alphal$(z)
1482.         nx = xc - 4 * xq - 12
1483.         ny = yc + (i - 4) * yq - 34
1484.         ax = xc + (i - 5) * xq + 22
1485.         ay = yc + 4 * yq + 3
1486.         _PRINTSTRING (nx, ny), n$
1487.         _PRINTSTRING (ax, ay), a$
1488.     NEXT i
1489.     COLOR white&
1490.  
1491.     IF lflag THEN Center 0, "", 1
1492.  
1493.     IF graphics = 0 THEN EXIT SUB
1494.     IF graphics > 1 THEN
1495.         Plasma
1496.         EXIT SUB
1497.     END IF
1498.  
1499.     br = 255
1500.     zz = (zz + 1) MOD 50: IF zz = 1 THEN r! = RND: g! = RND: b! = RND
1501.     x1 = xc - 4 * xq
1502.     y1 = yc - 4 * yq
1503.     x2 = x1 + 8 * xq
1504.     y2 = y1 + 8 * yq
1505.     FOR sy = y1 TO y2
1506.         FOR sx = x1 TO x2
1507.             p& = POINT(sx, sy)
1508.             IF p& = boardwhite& THEN
1509.                 z = ABS((sx - xc - xq \ 2) * (sy - yc - yq \ 2))
1510.                 PSET (sx, sy), _RGB32(br * SIN(.1 * r! * z + zz), br * SIN(.155 * g! * z + zz), br * SIN(2 * b! * z + zz))
1511.             END IF
1512.     NEXT sx: NEXT sy
1513. END SUB
1514.  
1515. SUB ReadGame
1516.     DIM g$(500)
1517.     CLS
1518.     OPEN GameFile$ FOR INPUT AS #8
1519.     WHILE NOT (EOF(8))
1520.         INPUT #8, mn, m1$, m2$
1521.         gm = gm + 1: g$(gm) = LTRIM$(m1$)
1522.         gm = gm + 1: g$(gm) = LTRIM$(m2$)
1523.         PRINT m1$; "*"; m2$
1524.     WEND
1525.     CLOSE #8
1526.     _DISPLAY
1527.     SLEEP
1528.     CLS
1529.     _DISPLAY
1530. END SUB
1531.  
1532. SUB Recurse (Level)
1533.     IF abort OR (Level = MasterLevel) THEN EXIT SUB
1534.     FOR t = 1 TO Moves(Level - 1)
1535.  
1536.         IF Level = 1 THEN '                                                              progress bar
1537.             x1 = xc - 4 * xq: x2 = xc + 4 * xq
1538.             y1 = yc + 4 * yq + 20
1539.             z1 = Moves(Level - 1): z2 = z1 - (z1 = 0)
1540.             xx = (z1 - t + 1) / z2 * (x2 - x1)
1541.             IF xx < x1 THEN xx = x1
1542.             IF xx > x2 THEN xx = x2
1543.             LINE (x1, y1)-(x2, y1), black&
1544.             IF (xx - x1) > 2 THEN LINE (x1, y1)-(xx, y1), cp&(1)
1545.  
1546.             'x1 = 290: x2 = x1 + 50
1547.             'y1 = 508: y2 = y1 + 64
1548.             'LINE (x1, y1)-(x2, y2), _RGB32(222, 0, 0), B
1549.  
1550.         END IF
1551.  
1552.         WorB = SaveWorB
1553.         IF (Level MOD 2) = 1 THEN WorB = WorB XOR 1
1554.         TieTo(Level) = t
1555.         IF ABS(Score(0, t)) <> 777 THEN
1556.             _MEMCOPY m(0), m(0).OFFSET, m(0).SIZE TO m(Level), m(Level).OFFSET '         save board
1557.             m$ = Move$(Level - 1, t)
1558.             MoveIt m$, false
1559.             lm1 = Level - 1
1560.             CheckBoard Level
1561.             Recurse Level + 1
1562.             TakeBest Level, false
1563.             i = Index
1564.             Score = Score(Level, 1)
1565.             levm1 = Level - 1
1566.             IF Score(levm1, 1) <> 777 THEN Score(levm1, i) = Score(levm1, i) - Score
1567.             IF Level = (MasterLevel - 1) THEN
1568.                 KeyScan 0, 0 '                                                           no plotscreen or _display
1569.                 'IF (tlimit > 0) AND (emin >= tlimit) THEN abort = true
1570.                 IF abort THEN EXIT SUB
1571.                 IF smode = 2 THEN LogThinking
1572.             END IF
1573.             _MEMCOPY m(Level), m(Level).OFFSET, m(Level).SIZE TO m(0), m(0).OFFSET '     restore board
1574.         END IF
1575.     NEXT t
1576. END SUB
1577.  
1578. SUB Reset_To_Zero
1579.     WorB = WorB XOR 1 '      reverse who's moving
1580.     CheckBoard 1 '           need to know what opponent can do to ensre legal castling
1581.     WorB = WorB XOR 1 '      restore playing color
1582.     CheckBoard 0 '           determine legal moves
1583. END SUB
1584.  
1585. FUNCTION Rjust$ (t, n)
1586.     Rjust$ = RIGHT$("   " + STR$(t), n)
1587. END FUNCTION
1588.  
1589. SUB SaveForTakeBack STATIC '                                         use MEM later to move arrays
1590.     FOR i = 10 TO 1 STEP -1
1591.         castle$(i) = castle$(i - 1)
1592.         FOR r = 1 TO 8
1593.             FOR c = 1 TO 8
1594.                 tb(c, r, i) = tb(c, r, i - 1)
1595.             NEXT c
1596.         NEXT r
1597.     NEXT i
1598.     castle$(0) = castle$
1599.     FOR r = 1 TO 8
1600.         FOR c = 1 TO 8
1601.             tb(c, r, 0) = b(c, r)
1602.         NEXT c
1603.     NEXT r
1604.     tbc = tbc + 1
1605.     IF tbc > 10 THEN tbc = 10
1606.  
1607. END SUB
1608.  
1609. SUB ScreenInit
1610.     xm = 480: ym = 600
1611.     MaxRow = ym \ 16 - 2
1612.     k = 99
1613.     SELECT CASE smode
1614.         CASE IS = 0
1615.             SCREEN _NEWIMAGE(xm, ym), 32
1616.             _SCREENMOVE _DESKTOPWIDTH \ 2 - xm \ 2, _DESKTOPHEIGHT \ 2 - ym \ 2
1617.         CASE IS = 1
1618.             _SCREENMOVE 780, 20
1619.         CASE IS = 2
1620.             SCREEN _NEWIMAGE(800, 600), 32
1621.             _SCREENMOVE 472, 20
1622.     END SELECT
1623.     _ALLOWFULLSCREEN _SQUAREPIXELS , _SMOOTH
1624. END SUB
1625.  
1626. SUB Setup
1627.     t1$ = "rnbkqp:black      clear:one     spacebar:flip"
1628.     t2$ = "RNBKQP:white      Clear:all          Esc:exit"
1629.  
1630.     LINE (0, 500)-(xm, ym), black&, BF
1631.     cc = 1: rr = 8
1632.     DO
1633.         Center -1, t1$, 0
1634.         Center 0, t2$, 0
1635.         _DISPLAY
1636.         DO: _LIMIT 20
1637.             PlotBoard
1638.             z = z XOR 1
1639.             IF z THEN Cursor 9 - rr, cc, 0
1640.             i$ = INKEY$: z = LEN(i$)
1641.         LOOP UNTIL z
1642.         SELECT CASE z
1643.             CASE IS = 1
1644.                 r2 = 9 - rr
1645.                 IF i$ = Esc$ THEN EXIT DO
1646.                 IF (i$ = CHR$(9)) OR (i$ = "c") THEN b(cc, r2) = 0 ' Del or "c" to delete piece
1647.                 IF i$ = "C" THEN '                                   delete all pieces
1648.                     FOR c = 1 TO 8: FOR r = 1 TO 8
1649.                             b(c, r) = 0
1650.                     NEXT: NEXT
1651.                 END IF
1652.                 p = INSTR("rnbqkpRNBQKP", i$)
1653.                 IF p THEN b(cc, r2) = p '                            set piece by letter
1654.                 IF INSTR(" t", i$) THEN '                            t or space toggle color
1655.                     mp = b(cc, r2)
1656.                     IF mp < 7 THEN mp = mp + 6 ELSE mp = mp - 6
1657.                     b(cc, r2) = mp
1658.                 END IF
1659.                 IF i$ = "x" THEN
1660.                     FOR c = 1 TO 8
1661.                         FOR r = 1 TO 8
1662.                             t = b(c, r)
1663.                             IF t THEN
1664.                                 IF t < 7 THEN t = t + 6 ELSE t = t - 6
1665.                                 s9(c, r) = t
1666.                             END IF
1667.                         NEXT r
1668.                     NEXT c
1669.                     FOR c = 1 TO 8
1670.                         FOR r = 1 TO 8
1671.                             b(c, 9 - r) = s9(c, r)
1672.                         NEXT r
1673.                     NEXT c
1674.                 END IF
1675.                 IF i$ = "z" THEN
1676.                     RESTORE test
1677.                     FOR r = 1 TO 8
1678.                         FOR c = 1 TO 8
1679.                             READ b(c, r)
1680.                     NEXT: NEXT
1681.                 END IF
1682.             CASE IS = 2
1683.                 kk = ASC(RIGHT$(i$, 1))
1684.                 cc = cc + (kk = 75) - (kk = 77) '                    left right
1685.                 rr = rr + (kk = 72) - (kk = 80) '                    up down
1686.                 IF rr < 1 THEN rr = 1
1687.                 IF rr > 8 THEN rr = 8
1688.                 IF cc < 1 THEN cc = 1
1689.                 IF cc > 8 THEN cc = 8
1690.         END SELECT
1691.     LOOP
1692.     LINE (0, 500)-(xm, ym), black&, BF
1693.     '                        board probably changed - reinitialize legal moves
1694.     Reset_To_Zero
1695. END SUB
1696.  
1697. SUB ShowBest
1698.     yy = 505
1699.     ty = yy
1700.     tx = 24
1701.     FOR t = 1 TO 15
1702.         IF t <= Moves(0) THEN
1703.             t$ = Make4$(Move$(0, t)) + Rjust$(Score(0, t), 5)
1704.             FOR i = 1 TO LEN(t$) '                                   shift "g" up 2 pixels
1705.                 c$ = MID$(t$, i, 1)
1706.                 y2 = ty + (c$ = "g") * 2
1707.                 _PRINTSTRING (tx + (i - 1) * 8, y2), c$
1708.             NEXT
1709.         END IF
1710.         ty = ty + 14
1711.         IF ty > 570 THEN ty = yy: tx = tx + 80
1712.     NEXT t
1713. END SUB
1714.  
1715. SUB ShowMe (dr, dc, t$)
1716.     EXIT SUB
1717.     sr = CSRLIN '                                                    save row
1718.     sc = POS(0) '                                                    save column
1719.     IF (dr > 0) AND (dr < MaxRow) AND (dc > 0) AND (dc < 76) THEN
1720.         LOCATE dr, dc '                                              display row & column
1721.         PRINT t$;
1722.     END IF
1723.     LOCATE sr, sc '                                                  restore to old location
1724. END SUB
1725.  
1726. SUB ShowTime (trow, z!, Desc$)
1727.     t! = z!
1728.     SELECT CASE t!
1729.         CASE IS > 3600
1730.             unit$ = "h"
1731.             t! = t! / 3600
1732.         CASE IS > 60
1733.             unit$ = "m"
1734.             t! = t! / 60
1735.         CASE ELSE
1736.             unit$ = "s"
1737.     END SELECT
1738.     x1 = 414
1739.     x2 = x1 - (LEN(Desc$) + 1) * 8
1740.     yy = trow / (600 / 16) * 600 - 4
1741.     t! = INT(t! * 1000) / 1000
1742.     t$ = LTRIM$(STR$(t!))
1743.     IF INSTR(t$, ".") = 0 THEN
1744.         IF t! < 1 THEN t$ = "." + t$ ELSE t$ = t$ + "."
1745.     END IF
1746.     zz = 0
1747.     WHILE INSTR(t$, ".") <> (LEN(t$) - 3)
1748.         t$ = t$ + "0"
1749.         zz = zz + 1
1750.         IF zz > 5 THEN GOTO dammit
1751.     WEND
1752.     dammit:
1753.  
1754.     IF LEFT$(t$, 1) = "." THEN t$ = "0" + t$
1755.     t$ = RIGHT$(SPACE$(10) + t$, 6)
1756.     _PRINTSTRING (x1, yy), t$ + unit$
1757.     _PRINTSTRING (x2, yy), Desc$
1758. END SUB
1759.  
1760. SUB ShowValid (cc, rr) '                                             show valid moves for piece at cursor
1761.  
1762.     IF (cc < 0) OR (rr < 0) OR (cc > 8) OR (rr > 8) THEN EXIT SUB
1763.     tc = cc: tr = rr
1764.     IF invert THEN tc = 9 - tc: tr = 9 - tr
1765.     mp = b(tc, tr): mp = mp + (mp > 6) * 6
1766.     z$ = alphal$(tc) + LTRIM$(STR$(9 - tr))
1767.     t$ = z$ + ":"
1768.     FOR i = 1 TO Moves(0)
1769.         IF z$ = LEFT$(Move$(0, i), 2) THEN t$ = t$ + " " + RIGHT$(Move$(0, i), 2)
1770.         IF (mp = King) AND (LEFT$(Move$(0, i), 1) = "O") THEN t$ = t$ + " " + Move$(0, i)
1771.     NEXT i
1772.     'IF (tc = epfc) AND (tr = epfc) THEN t$ = t$ + " ep"
1773.  
1774.     sw = _WIDTH \ 8 - 3
1775.     LOCATE 2, 4: PRINT SPACE$(sw);
1776.     LOCATE 2, 4: PRINT LEFT$(t$, sw);
1777.     IF LEN(t$) > sw THEN PRINT "..";
1778.  
1779. END SUB
1780.  
1781. SUB TakeBack '                                                       use MEM to move arrays? speed not an issue here
1782.     IF tbc < 2 THEN EXIT SUB
1783.     IF MakeNoise THEN PlaySound "tb" '                               so your mom knows you're cheating  :)
1784.     castle$ = castle$(2)
1785.     FOR r = 1 TO 8
1786.         FOR c = 1 TO 8
1787.             b(c, r) = tb(c, r, 2)
1788.         NEXT c
1789.     NEXT r
1790.     FOR i = 0 TO 9
1791.         castle$(i) = castle$(i + 1)
1792.         FOR r = 1 TO 8
1793.             FOR c = 1 TO 8
1794.                 tb(c, r, i) = tb(c, r, i + 1)
1795.             NEXT c
1796.         NEXT r
1797.     NEXT i
1798.     tbc = tbc - 1
1799.     Reset_To_Zero
1800. END SUB
1801.  
1802. SUB TakeBest (Level, final)
1803.  
1804.     IF final THEN '                                                  feeble attempt to vary response when scores equal
1805.         upto = 10
1806.         IF upto > Moves(Level) THEN upto = Moves(Level)
1807.         FOR scram = 0 TO 199
1808.             s1 = RND * updo + 1
1809.             s2 = RND * upto + 1
1810.             SWAP Score(Level, s1), Score(Level, s2)
1811.             SWAP Move$(Level, s1), Move$(Level, s2)
1812.             SWAP Index(Level, s1), Index(Level, s2)
1813.         NEXT scram
1814.     END IF
1815.  
1816.     passes = 0
1817.     ReSort:
1818.     Score = -999 '                                                   assume no moves
1819.     DO
1820.         Sorted = true
1821.         FOR s = 2 TO Moves(Level)
1822.             IF Score(Level, s - 1) < Score(Level, s) THEN
1823.                 Sorted = false
1824.                 SWAP Score(Level, s - 1), Score(Level, s)
1825.                 SWAP Move$(Level, s - 1), Move$(Level, s)
1826.                 SWAP Index(Level, s - 1), Index(Level, s)
1827.             END IF
1828.         NEXT s
1829.     LOOP UNTIL Sorted
1830.  
1831.     m$ = Move$(Level, 1)
1832.     Score = Score(Level, 1)
1833.     Index = Index(Level, 1)
1834.  
1835.     IF final AND (Level < 2) THEN
1836.         IF Score = -777 THEN '                                       in check, no escape
1837.             abort = 3: msg$ = "Checkmate!"
1838.         ELSEIF Score = -999 THEN '                                   no moves
1839.             abort = 3: msg$ = "Stalemate!"
1840.         END IF
1841.  
1842.         tm = Moves(1)
1843.         FOR lb = 1 TO 9 '                                            stop repeats
1844.             IF tm > 8 THEN
1845.                 IF INSTR(MoveLog$(tm - lb), m$) THEN
1846.                     'SOUND 888, 1
1847.                     Score(1, 1) = Score(1, 1) - 10
1848.                     passes = passes + 1
1849.                     IF passes < 5 THEN GOTO ReSort '                 repeat may be only move
1850.                 END IF
1851.             END IF
1852.         NEXT lb
1853.     END IF
1854.  
1855.     IF (Level = 1) AND (Score = 777) THEN Score(0, TieTo(1)) = -777
1856. END SUB
1857.  
1858. SUB TextInfo (zz$)
1859.     IF smode <> 2 THEN EXIT SUB
1860.  
1861.     t$ = "History Thinking Legal Protection"
1862.     LOCATE 3, 61
1863.     FOR i = 1 TO LEN(t$)
1864.         c$ = MID$(t$, i, 1)
1865.         IF c$ = UCASE$(c$) THEN COLOR cp&(1) ELSE COLOR white&
1866.         PRINT c$;
1867.     NEXT
1868.     COLOR white&
1869.  
1870.     'LOCATE 1, 4: PRINT showthink; history; showlegalf; showprotf;
1871.  
1872.     z = 0
1873.     IF showthink THEN z = 1
1874.     IF history THEN z = 2
1875.     IF showlegalf THEN z = 3
1876.     IF showprotf THEN z = 4
1877.     IF z = 0 THEN EXIT SUB
1878.  
1879.     IF DebugR > MaxRow THEN
1880.         _DISPLAY
1881.         DebugR = 3: DebugC = 61
1882.         FOR r = DebugR TO MaxRow
1883.             LOCATE r, DebugC
1884.             PRINT SPACE$(100 - DebugC);
1885.         NEXT r
1886.     END IF
1887.  
1888.     SELECT CASE z
1889.         CASE IS = 1
1890.             DebugR = DebugR + 1
1891.             LOCATE DebugR, DebugC
1892.             PRINT zz$;
1893.             IF DebugR = MaxRow THEN DebugR = 99
1894.         CASE IS = 2
1895.             BeginAt = Move - 28
1896.             IF BeginAt < 1 THEN BeginAt = 1
1897.             tr = 4
1898.             FOR i = BeginAt TO Move
1899.                 LOCATE tr, DebugC
1900.                 PRINT MoveLog$(i);
1901.                 tr = tr + 1
1902.                 IF tr > MaxRow THEN EXIT FOR
1903.             NEXT i
1904.         CASE IS = 3
1905.             FOR i = 1 TO Moves(0)
1906.                 tr = i + 3
1907.                 IF tr > MaxRow THEN EXIT FOR
1908.                 LOCATE tr, 63
1909.                 PRINT USING "## "; i;
1910.                 PRINT Move$(0, i);
1911.             NEXT i
1912.             FOR i = 1 TO Moves(1)
1913.                 tr = i + 3
1914.                 IF tr > MaxRow THEN EXIT FOR
1915.                 LOCATE tr, 73
1916.                 PRINT USING "## "; i;
1917.                 PRINT Move$(1, i);
1918.             NEXT i
1919.         CASE IS = 4
1920.             FOR i = 1 TO prot(0)
1921.                 tr = i + 3
1922.                 IF tr > MaxRow THEN EXIT FOR
1923.                 LOCATE tr, 63
1924.                 PRINT USING "## "; i;
1925.                 PRINT prot$(0, i);
1926.             NEXT i
1927.             FOR i = 1 TO prot(1)
1928.                 tr = i + 3
1929.                 IF tr > MaxRow THEN EXIT FOR
1930.                 LOCATE tr, 73
1931.                 PRINT USING "## "; i;
1932.                 PRINT prot$(1, i);
1933.             NEXT i
1934.     END SELECT
1935. END SUB
1936.  
1937. SUB TryMove (Level, fc, fr, mp, mc) '                                from row, from column
1938.     IF mc = 1 THEN s = -1 ELSE s = 1 '                               direction a pawn moves
1939.     incheck = (mc = SaveWorB) AND check
1940.  
1941.     '                  rnbqkp
1942.     nmoves = VAL(MID$("373772", mp, 1))
1943.  
1944.     FOR n = 0 TO nmoves '                                            possible 8 dirs
1945.         du = du(mp, n): dd = dd(mp, n): dl = dl(mp, n): dr = dr(mp, n)
1946.         IF mp <> Knight THEN du = SGN(du) * s: dd = SGN(dd) * s: dl = SGN(dl) * s: dr = SGN(dr) * s
1947.         IF du(mp, 0) = 7 THEN TrySq = 7 ELSE TrySq = 1
1948.         IF (mp = Pawn) AND (n = 0) THEN '                            pawn first move?
1949.             IF (fr = 2) AND (WorB = 1) THEN TrySq = 2 '              gambit for white
1950.             IF (fr = 7) AND (WorB = 0) THEN TrySq = 2 '              gambit for black
1951.         END IF
1952.         tc = fc: tr = fr '                                           row, column
1953.         fs$ = alphal$(fc) + CHR$(48 + fr) '                          from square
1954.         cap = false
1955.         FOR sq = 1 TO TrySq '                                        up to 7 steps in current direction
1956.             Score = 0 '                                              must init
1957.             tc = tc - dl + dr '                                      column=column-left+right
1958.             tr = tr - du + dd '                                      row=row-up+down
1959.             IF (tr < 1) OR (tr > 8) OR (tc < 1) OR (tc > 8) THEN EXIT FOR
1960.             ts$ = alphal$(tc) + CHR$(48 + tr) '                      to square
1961.             IF fs$ = ts$ THEN SYSTEM
1962.             cp = b(tc, tr) '                                         capture piece
1963.             cc = -(cp > 6) - (cp = 0) * 2 '                          capture color
1964.             cp = cp + (cp > 6) * 6
1965.             IF mc = cc THEN '                                        own piece
1966.                 prot(Level) = prot(Level) + 1
1967.                 IF prot(Level) < q1 THEN prot$(Level, prot(Level)) = fs$ + ts$
1968.                 IF (mp = Pawn) AND (n = 0) THEN EXIT FOR
1969.                 IF mp = Knight THEN GOTO nsquare ELSE EXIT FOR
1970.             ELSEIF (mc XOR 1) = cc THEN '                            capture
1971.                 IF (mp = Pawn) AND (n = 0) THEN EXIT FOR '           no diag, no cap!
1972.                 cap = true
1973.                 Score = Score + value(cp) * 10
1974.                 IF value(cp) = 0 THEN Score = 777 '                  king capture
1975.             ELSE
1976.                 IF (mp = Pawn) AND (n > 0) THEN EXIT FOR
1977.             END IF
1978.  
1979.             IF mp = King THEN
1980.                 IF Level = 0 THEN lm = 1 ELSE lm = 0 '               wonka
1981.                 'FOR i = 1 TO Moves(lm) '                            can any opponent piece move there?
1982.                 '    s$ = RIGHT$(Move$(lm, i), 2)
1983.                 'IF ts$ = s$ THEN GOTO nsquare '                     would be moving into check
1984.                 'NEXT
1985.                 FOR i = 1 TO prot(lm) '                              opponent piece protecting?
1986.                     s$ = RIGHT$(prot$(lm, i), 2)
1987.                     IF ts$ = s$ THEN GOTO nsquare '                  would be moving into check
1988.                 NEXT
1989.                 IF incheck THEN
1990.                     Score = Score + 20
1991.                 ELSE
1992.                     IF Move < 30 THEN Score = Score - 4 '            usually not good to be moving the King
1993.                 END IF
1994.             ELSE
1995.                 dis1 = ABS(fr - okr) + ABS(fc - okc) '               get closer to king
1996.                 dis2 = ABS(tr - okr) + ABS(tc - okc)
1997.                 Score = Score + dis1 - dis2
1998.                 IF Move < 20 THEN
1999.                     dir = SGN((fr - tr) * s)
2000.                     IF dir = 1 THEN Score = Score + 2 '              move ahead at begin & mid game
2001.                 END IF
2002.  
2003.                 ' priority to getting a piece off the bottom rank
2004.                 IF (fr = 1) AND (tr > 1) AND (WorB = 1) THEN Score = Score + 1
2005.                 IF (fr = 8) AND (tf < 8) AND (WorB = 0) THEN Score = Score + 1
2006.                 IF mp <> Rook THEN '                                 priority to getting a piece first moved
2007.                     IF b(fc, fr) = o(fc, fr) THEN Score = Score + 1
2008.                 END IF
2009.             END IF
2010.             's1 = Score
2011.  
2012.             'IF (Score <> 777) AND (NOT (incheck)) THEN
2013.  
2014.             IF mp = Pawn THEN
2015.                 Score = Score + TrySq
2016.                 IF (tr = 1) OR (tr = 8) THEN '                       promote pawn
2017.                     Score = Score + 99
2018.                 END IF
2019.             END IF
2020.             'END IF
2021.             'IF s1 = 777 THEN Score = s1
2022.  
2023.             AddIt Level, fs$ + ts$, Score
2024.  
2025.             IF cap AND (mp = Pawn) AND (n = 0) THEN EXIT FOR
2026.             IF cap AND (mp <> Knight) THEN EXIT FOR
2027.             nsquare:
2028.         NEXT sq
2029.     NEXT n
2030.  
2031.     IF mp = Pawn THEN '                                              en passant
2032.         IF WorB THEN othp = 6 ELSE othp = 12 '                       opponent pawn
2033.         l1 = 7 + (WorB = 0) * 5 '                                    rank 7 for white, 2 for black
2034.         l2 = 5 - (WorB = 0) '                                        rank 5 for white, 6 for black
2035.     END IF
2036.     IF (mp = Pawn) AND (fr = l2) AND (Level < 2) THEN
2037.         FOR z = -1 TO 1 STEP 2 '                                     look each side
2038.             lc = fc + z '                                            look column
2039.             IF (lc > 0) AND (lc < 9) THEN '                          in bounds of board
2040.                 IF b(lc, fr) = othp THEN '                           it is a pawn
2041.                     tc$ = alphal$(lc)
2042.                     tm$ = tc$ + CHR$(48 + l1) + tc$ + CHR$(48 + l2) '  form coordinate
2043.                     IF tm$ = lm$ THEN '                              yes, add e.p. to list of legal moves
2044.                         epfc = fc: epfr = fr '                       en passant from row, column
2045.                         eptc = lc: eptr = fr - s '                   en passant to row, column
2046.                         eprc = lc: eprr = fr '                       en passant remove piece
2047.                         ep$ = alphal$(epfc) + CHR$(48 + epfr) + alphal$(eptc) + CHR$(48 + eptr)
2048.                         AddIt Level, ep$, 1 '                        add with score of 1
2049.                     END IF
2050.                 END IF
2051.             END IF
2052.         NEXT z
2053.     END IF
2054.  
2055. END SUB
2056.  
2057. SUB TempMess (t$, secs) STATIC
2058.     'EXIT SUB
2059.     zz = 100: x1 = xc - zz: x2 = xc + zz
2060.     IF (LEN(t$) > 0) AND (t$ <> current$) THEN
2061.         x = xc - LEN(t$) * 4
2062.         y = 12
2063.         LINE (x1, 0)-(x2, 28), black&, BF
2064.         _PRINTSTRING (x, y), t$
2065.         _DISPLAY
2066.         current$ = t$
2067.         mtime! = TIMER + secs
2068.     END IF
2069.     IF (mtime! > 0) AND (TIMER > mtime!) THEN
2070.         LINE (x1, 0)-(x2, 28), black&, BF
2071.         _DISPLAY
2072.         mtime! = 0
2073.     END IF
2074. END SUB
2075.  
2076.  

[TempodiBasic]

Sorry Richard I have been not able to try and see your new release of your chess.bas because it doesn't run well, it starts with a console window that close itself quickly lasting a void file named Ch00000X.alg where X is a progressive number in each call to the exe.

[TempodiBasic]

Ah! I look into your code and I can see that after the Ch0000X.alg file you load the images for the program!
So I download again also the old images posted before in this thread.
nothing ..... I get the same... let's see better...

Yes I can see that now you load chess.pgn and not chess3.pgn as previous filename of chess.
Ok now it runs!
See later !

[Richard Frost]

Sorry for the filename change.  Rather silly of me.  I should stop uploading
stuff at the end of the day when my brain is fried.   

Also, the external files aren't really necessary and I should enable the program
to run without them.  Changing the icon is how I alert the user it's their move
(even with sound turned off).  Alfred is a bit 'o fun - shows up as the cursor when
an illegal move is attempted.

[Richard Frost]

O-tay, this is the current version, and the external files are ALL optional now,
and checked to see if they exist in upper or lower case.

Code: QB64: [Select]

1. _TITLE "Chess"
2. DEFINT A-Z
3. CONST true = -1, false = 0, Rook = 1, Knight = 2, Bishop = 3, Queen = 4, King = 5, Pawn = 6
4. ' sort these alphabetically and document them, dummy
5. COMMON SHARED WorB, Move, Score, Index, opening, invert, i$, m$, lm$, msg$, abort, MaxRow, xq, yq, xc, yc, xm, ym, castle$, OtherK$
6. COMMON SHARED mkr, mkc, okr, okc, k$, MasterLevel, MasterLevel1, SaveWorB, GameFile$, check, incheck, debug, DebugR, DebugC, Start1!, Start2!
7. COMMON SHARED MaxElapse!, human, humanc, OnAuto, graphics, rflag, tlimit, boardwhite&, boardblack&, black&, red&, green&, blue&, white&, gray&
8. COMMON SHARED Enter$, Esc$, lf$, crlf$, debug$, pinit, takebackflag, tbc, waitflag, pause, cursoron!, quitflag, smode, vflag, MakeNoise
9. COMMON SHARED bri, hold!, dtime!, mtime!, altblack, epfc, epfr, eptc, eptr, eprc, eprr, best, best$, ep$, rick, lcount&, alpha$, ocount&
10. COMMON SHARED iflag, showthink, history, showlegalf, showprotf, bscore, maxtime&, l, p, b, q1, q2, emin, useidiot, main&, alfred!
11. COMMON SHARED fg0&, bg0&, bg1&, bg2&
12. l = 10: p = 6: b = 8: q1 = 300: q2 = 500
13. DIM SHARED b(b, b), t(b, b, l), o(b, b), tb(b, b, 10), castle$(l), Moves(l), Move$(l, q1), Score(l, q1), TieTo(l), Index(l, q1), prot(l), prot$(l, q1)
14. DIM SHARED x(p, q2), y(p, q2), c(12, q2), MoveLog$(q2), cp&(32), etime!(3), myr(32), myg(32), myb(32), icon&(10), mcount&(10), du(p, 7), dd(p, 7)
15. DIM SHARED dl(p, 7), dr(p, 7), value(p), alphal$(8), abuff(30000), s1(b, b), s2(b, b), s3(b, b), s4(b, b), s5(b, b), s9(b, b)
16. DIM SHARED m(9) AS _MEM
17. m(0) = _MEM(b(0, 0))
18. m(1) = _MEM(s1(0, 0)): m(2) = _MEM(s2(0, 0)): m(3) = _MEM(s3(0, 0)): m(4) = _MEM(s4(0, 0)): m(5) = _MEM(s5(0, 0)): m(9) = _MEM(s9(0, 0))
19.  
20. rick = _FILEEXISTS("rick.")
21. MasterLevel1 = VAL(COMMAND$) '                                       only 4 really tested....2 is plenty stupid, odds not tested!
22. IF MasterLevel1 = 0 THEN MasterLevel1 = 4
23.  
24. begin:
25. Init
26. OPEN "chess.txt" FOR OUTPUT AS #2
27. DO
28.     IF icon&(1) <> 0 THEN _ICON icon&(1) '                           chess.png
29.     SaveWorB = WorB
30.  
31.     mking = 5: oking = 11
32.     IF humanc = 0 THEN SWAP mking, oking
33.     FOR r = 1 TO 8
34.         FOR c = 1 TO 8
35.             IF b(c, r) = mking THEN mkr = r: mkc = c
36.             IF b(c, r) = oking THEN okr = r: okc = c
37.         NEXT c
38.     NEXT r
39.     ks$ = alphal$(mkc) + CHR$(48 + mkr)
40.  
41.     IF WorB = humanc THEN SaveForTakeBack
42.  
43.     redo:
44.     Reset_To_Zero
45.     IF Moves(0) = 0 THEN msg$ = "Stalemate": GOTO yoyo
46.     Start1! = TIMER: Start2! = Start1!
47.     DebugR = 99
48.  
49.     IF human AND (humanc = WorB) OR (human = 2) THEN '               2 is two humans
50.         IF (iflag = 0) AND (human = 2) THEN invert = -(WorB = 0)
51.         DO
52.             pinit = 0 '                                              nudge for the graphics, vary it a little
53.             _MOUSESHOW
54.             HumanMove '                                              get a move
55.             _MOUSEHIDE
56.             IF LEN(msg$) THEN GOTO yoyo
57.             IF takebackflag THEN
58.                 TakeBack '                                           restores board & castling status
59.                 PlotBoard
60.                 takebackflag = 0
61.                 GOTO redo
62.             END IF
63.             sm$ = m$
64.             _MEMCOPY m(0), m(0).OFFSET, m(0).SIZE TO m(9), m(9).OFFSET '         save board
65.             MoveIt m$, false
66.             WorB = WorB XOR 1
67.             CheckBoard 1
68.             WorB = WorB XOR 1
69.             m$ = sm$
70.             _MEMCOPY m(9), m(9).OFFSET, m(9).SIZE TO m(0), m(0).OFFSET '     restore board
71.             IF Score <> 777 THEN
72.                 FOR i = 1 TO Moves(0) '                              check against legal list
73.                     IF m$ = Move$(0, i) THEN EXIT DO '               move found, skip more checking
74.                 NEXT i
75.             END IF
76.             alfred! = TIMER + 5: IF alfred! > maxtime& THEN alfred! = 0
77.             IF MakeNoise THEN PlaySound "bad"
78.         LOOP
79.     ELSE
80.         abort = false
81.         DebugR = 99
82.         rflag = true '                                               flag in recursion to stop displaying board
83.         bscore = -9999
84.         Center 0, "", true
85.         MasterLevel = 2 '                                            fast check in case slow aborted
86.         Recurse 1 '                                                  try all moves & responses
87.         TakeBest 0, true '
88.         ShowBest
89.         IF (Score < -700) OR (Score > 500) THEN
90.             rflag = 0
91.             IF Moves(0) THEN msg$ = "Checkmate!" ELSE msg$ = "Stalemate!"
92.             msg$ = msg$ + STR$(Score)
93.             GOTO yoyo
94.         END IF
95.         MasterLevel = MasterLevel1 '                                 slow check
96.         FOR i = 1 TO MasterLevel: Moves(i) = 0: NEXT
97.         Recurse 1 '                                                  try all moves & responses
98.         IF MakeNoise THEN PlaySound "ding"
99.         TakeBest 0, true '
100.         ShowBest
101.         rflag = false
102.         Center 0, "", true
103.         IF abort THEN _MEMCOPY m(1), m(1).OFFSET, m(1).SIZE TO m(0), m(0).OFFSET '         restore board
104.         IF msg$ = "abort" THEN msg$ = ""
105.         IF LEN(msg$) THEN WorBs = WorB + 1: GOTO yoyo
106.     END IF
107.  
108.     IF LEN(msg$) THEN GOTO yoyo
109.  
110.     WorB = SaveWorB
111.  
112.     sm$ = m$: m2$ = m$ '                                             save move for display in case modified for castling
113.     IF m$ = "O-O" THEN '                                             castle kingside
114.         IF WorB THEN
115.             m$ = "e1g1": m2$ = "h1f1"
116.         ELSE
117.             m$ = "e8g8": m2$ = "h8f8"
118.         END IF
119.     END IF
120.     IF m$ = "O-O-O" THEN '                                           castle queenside
121.         IF WorB THEN
122.             m$ = "e1c1": m2$ = "a1c1"
123.         ELSE
124.             m$ = "e8c8": m2$ = "a8d8"
125.         END IF
126.     END IF
127.  
128.     IF human <> 1 THEN GOTO doit '                                   people playing, or computer playing itself
129.  
130.     waitflag = 1
131.     IF icon&(2) THEN _ICON icon&(2) '                                clockx or clockx2
132.  
133.     FlashMove true
134.  
135.     waitflag = 0
136.  
137.     doit:
138.     m$ = sm$
139.     lm$ = m$
140.     MoveIt m$, true
141.     AddMove
142.     PlotScreen true
143.     _DISPLAY
144.  
145.     check = false
146.     CheckBoard 0
147.     IF Score = 777 THEN check = true: TempMess "Check!", 2
148.  
149.     'check = 0: incheck = 0
150.  
151.     'check = false: z = Level XOR 1
152.     'k1$ = MID$(alpha$, mkc, 1) + CHR$(48 + mkr) '                   location of King
153.     'k2$ = MID$(alpha$, okc, 1) + CHR$(48 + okr) '                   location of King
154.     'ic = 0
155.     'FOR i = 1 TO Moves(0) '                                         can any opponent piece move there?
156.     '    s$ = RIGHT$(Move$(z, 0), 2)
157.     '    IF k1$ = s$ THEN ic = 1 '                                   in check
158.     '    IF k2$ = s$ THEN ic = 2 '                                   in check
159.     'NEXT i
160.     'IF ic THEN
161.     '    check = true
162.     '    ic$ = CHR$(48 + ic) + " Check!"
163.     '    TempMess ic$
164.     'END IF
165.  
166.     WorB = SaveWorB XOR 1 '                                          toggle white/black
167. LOOP UNTIL Move = 500
168.  
169. IF Move = 500 THEN msg$ = "Over 500 moves...."
170. PRINT #1, ""
171. PRINT #1, msg$
172.  
173. yoyo:
174. Playagain msg$
175. msg$ = ""
176. CLS 0, bg0&
177. IF i$ = "n" THEN GOTO begin '                                        n for new game
178. IF WorBs THEN
179.     WorB = WorBs - 1: WorBs = 0
180.     WorB = WorB XOR 1
181. END IF
182. PlotScreen true
183. GOTO redo
184.  
185. o1:
186. DATA e2e4,e7e5,g1f3,b8c6,f1b5,a7a6,b5a4,b7b5,a4b3,g8f6,b1c3,f8e7,f3g5,h7h6
187. 'DATA g5f7,O-O
188. 'DATA f7d8,g8h7
189. DATA end
190.  
191. Setup:
192. DATA 1,2,3,4,5,3,2,1
193. DATA 6,6,6,6,6,6,6,6
194. DATA 0,0,0,0,0,0,0,0
195. DATA 0,0,0,0,0,0,0,0
196. DATA 0,0,0,0,0,0,0,0
197. DATA 0,0,0,0,0,0,0,0
198. DATA 12,12,12,12,12,12,12,12
199. DATA 7,8,9,10,11,9,8,7
200.  
201. test:
202. DATA 0,0,0,0,0,0,0,0
203. DATA 0,0,0,0,0,0,0,0
204. DATA 0,0,0,0,0,0,0,0
205. DATA 0,11,0,0,0,0,0,0
206. DATA 0,7,0,12,0,0,0,0
207. DATA 0,0,0,0,0,0,0,0
208. DATA 9,0,0,0,6,0,0,0
209. DATA 5,9,0,0,0,0,0,0
210.  
211. Legal:
212. '      udlr,udlr,udlr,udlr,udlr,udlr,udlr,udlr
213. DATA R,7000,0700,0070,0007,0000,0000,0000,0000
214. DATA N,2010,2001,0210,0201,1020,1002,0120,0102
215. DATA B,7070,7007,0770,0707,0000,0000,0000,0000
216. DATA Q,7000,0700,0070,0007,7070,7007,0770,0707
217. DATA K,1000,0100,0010,0001,1010,1001,0110,0101
218. DATA P,1000,1001,1010,0000,0000,0000,0000,0000
219.  
220. hg:
221. '                   1         2         3         4         5
222. '          12345678901234567890123456789012345678901234567890
223. DATA "01","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
224. DATA "02","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
225. DATA "03","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
226. DATA "04","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
227. DATA "05","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
228. DATA "06","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
229. DATA "07","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
230. DATA "08","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
231. DATA "09","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
232. DATA "10","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
233. DATA "11","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
234. DATA "12","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
235. DATA "13","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
236. DATA "14","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
237. DATA "15","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
238. DATA "16","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
239. DATA "17","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
240. DATA "18","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
241. DATA "19","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
242. DATA "20","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
243. DATA "21","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
244. DATA "22","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
245. DATA "23","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
246. DATA "24","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
247. DATA "25","               XXXXXXXXXXXXXXXXXXXX               "
248. DATA "26","                XXXXXXXXXXXXXXXXXX                "
249. DATA "27","                 XXXXXXXXXXXXXXXX                 "
250. DATA "28","                  XXXXXXXXXXXXXX                  "
251. DATA "29","                   XXXXXXXXXXXX                   "
252. DATA "30","                    XXXXXXXXXX                    "
253. DATA "31","                     XXXXXXXX                     "
254. DATA "32","                      XXXXXX                      "
255.  
256. DATA "33","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
257. DATA "34","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
258. DATA "35","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
259. DATA "36","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
260. DATA "37","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
261. DATA "38","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
262. DATA "39","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
263. DATA "40","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
264. DATA "41","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
265. DATA "42","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
266. DATA "43","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
267. DATA "44","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
268. DATA "45","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
269. DATA "46","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
270. DATA "47","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
271. DATA "48","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
272. DATA "49","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
273. DATA "50","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
274. DATA "51","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
275. DATA "52","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
276. DATA "53","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
277. DATA "54","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
278. DATA "55","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
279. DATA "56","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
280. DATA "57","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
281. DATA "58","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
282. DATA "59","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
283. DATA "51","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
284. DATA "60","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
285. DATA "61","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
286. DATA "62","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
287. DATA "63","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
288. DATA "64","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
289.  
290. PiecePatterns:
291. DATA ........................
292. DATA ........................
293. DATA ........................
294. DATA ........................
295. DATA ....X..XX..XX..XX..X....
296. DATA ....X..XX..XX..XX..X....
297. DATA ....X..XX..XX..XX..X....
298. DATA ....X..XX..XX..XX..X....
299. DATA ....X..XX..XX..XX..X....
300. DATA .....X.XX..XX..XX.X.....
301. DATA ......XXXXXXXXXXXX......
302. DATA .....XX..........XX.....
303. DATA ......X.XXXXXXXX.X......
304. DATA ......X.XXXXXXXX.X......
305. DATA ......X.XXXXXXXX.X......
306. DATA ......X.XXXXXXXX.X......
307. DATA .....X............X.....
308. DATA .....X..XXXXXXXX..X.....
309. DATA ....X..............X....
310. DATA ...X..XXXXXXXXXXXX..X...
311. DATA ...X................X...
312. DATA ...XXXXXXXXXXXXXXXXXX...
313.  
314. DATA ........................
315. DATA ........................
316. DATA ........................
317. DATA ........................
318. DATA ............XXX.........
319. DATA ..........XX.X.X........
320. DATA .........X..X.X.XX......
321. DATA ........X.X.XX.X..X.....
322. DATA .......X.XXXX.X.X..X....
323. DATA .......X.X...XXX.X..X...
324. DATA .....X..XX..X.XXX.X.X...
325. DATA ....X.XXXXXXX.XXX.X..X..
326. DATA ...X.XXXXXX.X..XX.X..X..
327. DATA ...X.XX..XXX.X.XX.X..X..
328. DATA ....X..XXXX..X.XX.X..X..
329. DATA .....XX..X..X.XXX.X..X..
330. DATA ........X..XX.XX.XX.X...
331. DATA .......X..XX.XX.XX.X....
332. DATA ......XXXXXXXXXXXXXX....
333. DATA .....X..............X...
334. DATA ....X................X..
335. DATA .....XXXXXXXXXXXXXXXX...
336.  
337. DATA ........................
338. DATA ........................
339. DATA ........................
340. DATA ............X...........
341. DATA ...........X.X..........
342. DATA ..........X.X.X.........
343. DATA ........X...XX..X.......
344. DATA .......X..X..XX..X......
345. DATA .......X.XXX..XX.X......
346. DATA .......X.XXXX..X.X......
347. DATA ........X.......X.......
348. DATA .......XX.X.X.X.XX......
349. DATA ......X...........X.....
350. DATA .......X.XXX.XX.XX......
351. DATA ........X.XX.XX.X.......
352. DATA .......X.XXX.XXX.X......
353. DATA .......X.XXX.XXX.X......
354. DATA ......X.X.......X.X.....
355. DATA .....X.XXXXX.XXXXX.X....
356. DATA .....X.XXXXX.XXXXX.X....
357. DATA .....X.............X....
358. DATA ......XXXXXXXXXXXXX.....
359.  
360. DATA ............X...........
361. DATA ...........X.X..........
362. DATA .....X....X.X.X....X....
363. DATA ....X.X.XX.XXX..X.X.X...
364. DATA ...X.X.X..XX.XXX.X.X.X..
365. DATA ...X.XX.XXX.X.XXX.XX.X..
366. DATA ...X.XXX.X.XXX.X.XXX.X..
367. DATA ...X.XXXX.XXXXX.XXXX.X..
368. DATA ....X.XXXXXX..XXXXX.X...
369. DATA .....X.XXXXX..XXXX.X....
370. DATA .....X.............X....
371. DATA ......XXXXXXXXXXXXX.....
372. DATA ....X...............X...
373. DATA ......XX.XXXXXXX.XX.....
374. DATA .......X.X.XXX.X.X......
375. DATA ......X.XX.XXX.XX.X.....
376. DATA ......X.XX.XXX.XX.X.....
377. DATA .....XXXXXXXXXXXXXXX....
378. DATA ....X...............X...
379. DATA ...X..XX.XX.XX.XX.X..X..
380. DATA ...X.................X..
381. DATA ....XXXXXXXXXXXXXXXXX...
382.  
383. DATA ...........XX...........
384. DATA .........XX..XX.........
385. DATA .......XX.X..X.XX.......
386. DATA .....XX.X......X.XX.....
387. DATA ....X..XX.X..X.XX..X....
388. DATA ...X...XXXX..XXXX...X...
389. DATA ..X...XX........XX...X..
390. DATA .X..XXX.XXX..XXX.XXX..X.
391. DATA X..XXX..XXX..XXX..XXX..X
392. DATA X.XXXX..XXX..XXXX.XXXX.X
393. DATA X.XXXX.XXXX..XXXX.XXXX.X
394. DATA X.XXXX..XXXXXXXX..XXXX.X
395. DATA .X.XXXX..XXXXXX..XXXX.X.
396. DATA .X..XXXX..XXXX..XXXX..X.
397. DATA ..X..XXXX......XXXX..X..
398. DATA ...X....X......X....X...
399. DATA ...XXXXXXXXXXXXXXXXXX...
400. DATA ..X..................X..
401. DATA .X..XXXXXXXXXXXXXXXX..X.
402. DATA .X..XXXXXXXXXXXXXXXX..X.
403. DATA ..X..................X..
404. DATA ...XXXXXXXXXXXXXXXXXX...
405.  
406. DATA ........................
407. DATA ........................
408. DATA ........................
409. DATA ..........XXXX..........
410. DATA .........X....X.........
411. DATA ........X.XXXX.X........
412. DATA ........X.XXXX.X........
413. DATA .........X....X.........
414. DATA ........XXXXXXXX........
415. DATA .......X........X.......
416. DATA ........XXXXXXXX........
417. DATA .........X.XX.X.........
418. DATA .........X.XX.X.........
419. DATA .........X.XX.X.........
420. DATA ........X..XX..X........
421. DATA .......X..XXXX..X.......
422. DATA ......X.XXXXXXXX.X......
423. DATA ......X.XXXXXXXX.X......
424. DATA .....X............X.....
425. DATA ......XXXXXXXXXXXX......
426. DATA ........................
427. DATA ........................
428.  
429. rgb:
430. DATA 0,0,0,0,""
431. 'DATA 1,20,50,0,"board white"
432. DATA 1,30,60,20,"board white"
433. DATA 2,1,1,1,"board black"
434. DATA 3,50,50,50,"white bright"
435. DATA 4,12,12,30,"white hightlight"
436. DATA 5,0,0,0,"black bright"
437. 'DATA 6,32,32,32,"black highlight"
438. DATA 6,50,12,12,"black highlight"
439. DATA 7,63,0,0,"red"
440. DATA 8,0,63,0,"green"
441. DATA 9,0,0,63,"blue"
442. DATA 10,50,50,50,"white"
443. DATA 11,20,20,20,""
444. DATA 12,20,20,20,""
445. DATA 13,40,10,30,""
446. DATA 14,25,25,25,"gray"
447. DATA 15,30,30,30,"printing"
448.  
449. cmenu:
450. DATA "1 Board white"
451. DATA "2 Board black"
452. DATA "3 W piece main"
453. DATA "4 W piece trim"
454. DATA "5 B piece main"
455. DATA "6 B piece trim"
456.  
457. Oops:
458. gronk = gronk + 1
459. IF gronk < 100 THEN
460.     RESUME
461. ELSE
462.     PRINT "Error "; DATE$; "  "; TIME$;
463.     END
464. END IF
465.  
466. SUB AddIt (Level, tm$, Score)
467.     IF rflag THEN mcount&(Level) = mcount&(Level) + 1
468.     Moves(Level) = Moves(Level) + 1 '                                count ok
469.     Move$(Level, Moves(Level)) = tm$ '                               save move
470.     Score(Level, Moves(Level)) = Score
471.     Index(Level, Moves(Level)) = TieTo(Level)
472. END SUB
473.  
474. SUB AddMove
475.  
476.     IF WorB THEN '                                                   white=1, black=0
477.         Move = Move + 1 '                                            number the moves
478.         PRINT #1, RIGHT$("  " + STR$(Move), 3);
479.         PRINT #1, RIGHT$(SPACE$(10) + m$, 7);
480.         MoveLog$(Move) = SPACE$(15)
481.         MID$(MoveLog$(Move), 1, 3) = Rjust$(Move, 3)
482.         MID$(MoveLog$(Move), 5, LEN(m$)) = m$
483.     ELSE
484.         MID$(MoveLog$(Move), 11, LEN(m$)) = m$
485.         PRINT #1, " "; m$
486.         IF (Move MOD 5) = 0 THEN PRINT #1, ""
487.     END IF
488.  
489. END SUB
490.  
491. SUB Center (tr, t$, highlight)
492.     IF t$ = "" THEN
493.         IF rflag THEN
494.             t$ = "           Quit   spacebar:move now   Noise           "
495.         ELSE
496.             t$ = "Quit Resign Back Color Invert Setup Mode Noise Graphic"
497.         END IF
498.     END IF
499.     z = _WIDTH \ 2 - LEN(t$) * 4 + 8
500.     SELECT CASE tr
501.         CASE IS = -1
502.             y = ym - 40
503.         CASE IS = 0
504.             y = ym - 18
505.         CASE ELSE
506.             y = tr / (ym / 16) * ym
507.     END SELECT
508.     LINE (0, ym)-(xm - 1, ym - 18), bg0&, BF
509.     'COLOR white&
510.     _PRINTSTRING (z, y), t$
511.     IF highlight THEN
512.         tr = _RED32(cp&(1))
513.         tg = _GREEN32(cp&(1))
514.         tb = _BLUE32(cp&(1))
515.         COLOR _RGB32(255 - tr, 255 - tg, 255 - tb)
516.         FOR i = 1 TO LEN(t$)
517.             c$ = MID$(t$, i, 1)
518.             IF (c$ = UCASE$(c$)) AND (c$ <> ":") THEN
519.                 _PRINTSTRING (z + (i - 1) * 8, y), c$
520.             END IF
521.         NEXT
522.     END IF
523.     COLOR fg0&, bg0&
524. END SUB
525.  
526. SUB ChangeColors
527.     LINE (0, 500)-(xm, ym), bg0&, BF '                               clear lower area
528.     k = 1
529.     DO
530.         RESTORE cmenu
531.         FOR i = 1 TO 6
532.             READ t$
533.             tx = 40 + INT((i - 1) / 2) * 150
534.             ty = 540 + ((i - 1) MOD 2) * 16
535.             IF i = k THEN COLOR white& ELSE COLOR gray& '            highlight palette for change
536.             _PRINTSTRING (tx, ty), t$
537.         NEXT i
538.         COLOR fg0&, bg0&
539.         t$ = "rgb:down   RGB:up  Esc:exit"
540.         tx = _WIDTH \ 2 - LEN(t$) * 4 + 8
541.         _PRINTSTRING (tx, _HEIGHT - 20), t$
542.  
543.         FOR i = 1 TO 3 '                                             show 3 colors lines
544.             x1 = xc - xq * 4: x2 = xc + xq * 4
545.             y1 = yc + yq * 4 + 20 + i * 8: y2 = y1 + 4
546.             LINE (x1, y1)-(x2, y2), black&, BF
547.             LINE (x1, y1)-(x2, y2), gray&, B
548.             IF i = 1 THEN j = myr(k): tc& = red&
549.             IF i = 2 THEN j = myg(k): tc& = green&
550.             IF i = 3 THEN j = myb(k): tc& = blue&
551.             j = j / 255 * xq * 8
552.             LINE (x1, y1)-(x1 + j, y2), tc&, BF
553.         NEXT i
554.  
555.         _DISPLAY
556.  
557.         DO: _LIMIT 10: i$ = INKEY$: LOOP UNTIL LEN(i$) '             wait for key
558.         IF i$ = Esc$ THEN EXIT DO '                                  done
559.         IF i$ = "" THEN i$ = " " '                                   so instr doesn't bomb
560.         p = INSTR("123456", i$): IF p THEN k = p '                   select palette
561.  
562.         z = 10
563.         SELECT CASE i$
564.             CASE IS = "r" '                                          red down
565.                 myr(k) = myr(k) - z
566.                 IF myr(k) < 0 THEN myr(k) = 0
567.             CASE IS = "g" '                                          green down
568.                 myg(k) = myg(k) - z
569.                 IF myg(k) < 0 THEN myg(k) = 0
570.             CASE IS = "b" '                                          blue down
571.                 myb(k) = myb(k) - z
572.                 IF myb(k) < 0 THEN myb(k) = 0
573.             CASE IS = "R" '                                          red up
574.                 myr(k) = myr(k) + z
575.                 IF myr(k) > 255 THEN myr(k) = 255
576.             CASE IS = "G" '                                          green up
577.                 myg(k) = myg(k) + z
578.                 IF myg(k) > 255 THEN myg(k) = 255
579.             CASE IS = "B" '                                          blue up
580.                 myb(k) = myb(k) + z
581.                 IF myb(k) > 255 THEN myb(k) = 255
582.         END SELECT
583.  
584.         ColorWrite
585.         Colorassign
586.         PlotScreen false
587.     LOOP
588.  
589.     LINE (0, 500)-(xm, ym), black&, BF
590.  
591. END SUB
592.  
593. SUB CheckBoard (Level)
594.     Moves(Level) = 0
595.     prot(Level) = 0
596.  
597.     FOR r = 1 TO 8
598.         FOR c = 1 TO 8
599.             mp = b(c, r)
600.             mc = -(mp > 6) - (mp = 0) * 2 '                          evaluates to 0 black 1 white 2 empty
601.             mp = mp + (mp > 6) * 6
602.             IF mc = WorB THEN
603.                 TryMove Level, c, r, mp, mc
604.             END IF
605.         NEXT
606.     NEXT
607.  
608.     IF Level > 1 THEN GOTO nocastle '                                only do for current move (speed)
609.  
610.     cq = true: ck = true '                                           castling
611.  
612.     IF WorB THEN rn$ = "1" ELSE rn$ = "8"
613.     rn = VAL(rn$)
614.     tp = b(5, rn): tp = tp + (tp > 6) * 6 '                          e1 (white) or e8 (black)
615.     IF tp <> King THEN cq = 0: ck = 0: GOTO nocastle '               no King here
616.  
617.     t$ = "e" + rn$ '                                                 King home spot algebraic
618.     FOR lm = 1 TO Moves(1) '                                         can any opponent piece move there?
619.         IF t$ = RIGHT$(Move$(1, lm), 2) THEN cq = 0: ck = 0: GOTO nocastle ' must be in check
620.     NEXT lm
621.  
622.     ' WHITE                      BLACK
623.     ' 8 R N B Q K B N R          1 R N B K Q B N R
624.     ' 7 P P P P P P P P          2 P P P P P P P P
625.     ' 6                          3
626.     ' 5                          4
627.     ' 4                          5
628.     ' 3                          6
629.     ' 2 P P P P P P P P          7 P P P P P P P P
630.     ' 1 R N B Q K B N R          8 R N B K Q B N R
631.     '   a b c d e f g h            h g f e d c b a
632.  
633.     FOR castle = 1 TO 2 '                                            queenside, then kingside
634.  
635.         'debug$(castle) = ""
636.         nr = 0 '   no rook
637.         pr = 0 '   prior condition
638.         ne = 0 '   not empty
639.         co = 0 '   controlled space
640.  
641.         '                 bbww
642.         ' castle$ format "QKQK" blank if ok, X if nulled by King or Rook move
643.         IF MID$(castle$, WorB * 2 + castle, 1) <> " " THEN pr = castle: GOTO nocando '  prior condition
644.  
645.         IF castle = 1 THEN cn = 1 ELSE cn = 8 '                      column number
646.         p = b(cn, rn): p = p + (p > 6) * 6
647.         IF p <> Rook THEN nr = 1: GOTO nocando
648.  
649.         '                         bcd              fg
650.         IF castle = 1 THEN ca$ = "234" ELSE ca$ = "67" '             column number
651.         FOR cs = 1 TO LEN(ca$) '                                     look at spaces between king and rook
652.             cn = VAL(MID$(ca$, cs, 1))
653.             IF b(cn, rn) > 0 THEN ne = castle: GOTO nocando '        not empty
654.  
655.             IF NOT ((cs = 1) AND (castle = 1)) THEN '                queenside knight
656.                 t$ = MID$(alpha$, cn, 1) + rn$ '                     controlled square?
657.                 IF Level THEN lm = 0 ELSE lm = 1
658.                 FOR i = 1 TO Moves(lm) '                             see what can move here
659.                     IF t$ = RIGHT$(Move$(lm, i), 2) THEN
660.                         'debug$(castle) = Move$(lm, i)
661.                         co = castle: EXIT FOR ' yes
662.                     END IF
663.                 NEXT i
664.             END IF
665.         NEXT cs
666.         nocando:
667.         'debug$(castle) = debug$(castle) + STR$(nr) + STR$(pr) + STR$(ne) + STR$(co)
668.         IF (nr + pr + ne + co) THEN '                                non-zero means some test failed
669.             IF castle = 1 THEN cq = false ELSE ck = false
670.         END IF
671.     NEXT castle
672.  
673.     IF ck THEN AddIt Level, "O-O", 12
674.     IF cq THEN AddIt Level, "O-O-O", 13
675.  
676.     'LOCATE 34 + WorB, 45: PRINT "*"; castle$; "* ";
677.     'PRINT MID$("K ", ck + 2, 1);
678.     'PRINT MID$("Q ", cq + 2, 1); cq; ck;
679.  
680.     nocastle:
681.     TakeBest Level, false
682. END SUB
683.  
684. SUB Colorassign
685.     tf$ = "ccolor.dat"
686.     tf = FREEFILE
687.     IF _FILEEXISTS(tf$) THEN
688.         OPEN tf$ FOR INPUT AS #tf
689.         INPUT #tf, bri
690.         IF bri = 0 THEN bri = obri
691.         IF bri < 2 THEN bri = 2
692.         FOR i = 0 TO 31
693.             INPUT #tf, myr(i), myg(i), myb(i)
694.             cp&(i) = _RGB32(myr(i) * bri, myg(i) * bri, myb(i) * bri)
695.         NEXT
696.         CLOSE #tf
697.     ELSE
698.         bri = 4
699.         RESTORE rgb
700.         FOR i = 0 TO 31
701.             IF i < 16 THEN
702.                 READ PalNum, myr(i), myg(i), myb(i), Desc$
703.             ELSE
704.                 myr(i) = 32: myg(i) = 32: myb(i) = 32
705.             END IF
706.             cp&(i) = _RGB32(myr(i) * bri, myg(i) * bri, myb(i) * bri)
707.         NEXT
708.         ColorWrite
709.     END IF
710.     CLOSE #tf
711.     black& = cp&(0)
712.     boardwhite& = cp&(1)
713.     boardblack& = cp&(2)
714.     red& = cp&(7)
715.     green& = cp&(8)
716.     blue& = cp&(9)
717.     white& = _RGB32(155, 155, 155)
718.     gray& = _RGB32(40, 40, 40)
719.     IF altblack THEN cp&(6) = _RGB32(32 * bri, 32 * bri, 32 * bri)
720. END SUB
721.  
722. SUB ColorWrite
723.     tf$ = "ccolor.dat"
724.     tf = FREEFILE
725.     OPEN tf$ FOR OUTPUT AS #tf
726.     PRINT #tf, bri
727.     FOR i = 0 TO 31
728.         PRINT #tf, myr(i); ","; myg(i); ","; myb(i)
729.     NEXT
730.     CLOSE #tf
731. END SUB
732.  
733. SUB Cursor (br, bc, fl) STATIC
734.     DIM garr(8000)
735.     IF (bc < 1) OR (br < 1) OR (bc > 8) OR (br > 8) THEN EXIT SUB
736.     x1 = xc + (bc - 5) * xq: x2 = x1 + xq
737.     y1 = yc + (4 - br) * yq: y2 = y1 + yq
738.     GET (x1, y1)-(x2, y2), garr()
739.     IF (ctime! = 0) OR (TIMER > ctime!) THEN
740.         xx = xx XOR 1
741.         ctime! = TIMER + .25
742.         IF ctime! > maxtime& THEN ctime! = 0
743.     END IF
744.     IF xx THEN
745.         IF (useidiot AND (icon&(0) <> 0)) OR (TIMER < alfred!) THEN PUT (x1 + 2, y1 + 2), abuff(), PSET ELSE PUT (x1, y1), garr(), PRESET
746.     END IF
747.     IF fl THEN _PRINTSTRING (x1 + 16, y1 + 36), "To?"
748.     _DISPLAY
749. END SUB
750.  
751. DEFINT A-Z
752. SUB DispStats
753.  
754.     IF waitflag = 0 THEN
755.         IF rflag = 0 THEN tc = humanc ELSE tc = 1 - humanc
756.         IF human = 2 THEN tc = WorB
757.         t! = TIMER - Start2!: IF t! < 0 THEN t! = t! + maxtime&
758.         etime!(tc) = etime!(tc) + t!
759.         etime!(2) = TIMER - Start1! + hold! '                        current move
760.         hold! = 0
761.         IF etime!(2) > etime!(tc) THEN etime!(2) = etime!(tc)
762.         etime!(3) = etime!(0) + etime!(1) '                          game total
763.         emin = etime!(2) \ 60
764.     END IF
765.     Start2! = TIMER
766.  
767.     IF (dtime! = 0) OR (TIMER > dtime!) THEN
768.  
769.         'IF rick AND (vflag = 0) THEN
770.         '    LOCATE 1, 4
771.         '    PRINT Moves(0);
772.         '    FOR i = 1 TO 3
773.         '        PRINT mcount&(i);
774.         '    NEXT i
775.         '    LOCATE 2, 4
776.         '    FOR i = 0 TO 3
777.         '        PRINT Moves(i);
778.         '    NEXT i
779.         'END IF
780.  
781.         'IF tlimit > 0 THEN t$ = LTRIM$(STR$(tlimit)) + "m" ELSE t$ = "unlimited"
782.         't$ = "Time: " + t$
783.         'LOCATE 2, 4: PRINT t$;
784.  
785.         IF human <> 2 THEN
786.             IF rick THEN LOCATE 1, 4: PRINT best$; bscore; "        ";
787.             tcount& = Moves(0) + mcount&(1) + mcount&(2) + mcount&(3)
788.             mps& = tcount& - ocount&
789.             IF mps& <= 100 THEN mps& = omps& ELSE opms& = mps&
790.             t$ = "   " + STR$(mps&)
791.             tx = _WIDTH - LEN(t$) * 8 - 10
792.             IF mps& THEN _PRINTSTRING (tx, 2), t$
793.  
794.             t$ = STR$(tcount&)
795.             tx = _WIDTH - LEN(t$) * 8 - 10
796.             _PRINTSTRING (tx, 16), t$
797.  
798.             'bg2& = _RGB32(0, 70, 70)
799.             'LINE (351, 504)-(xm - 8, ym - 22), bg2&, BF
800.             COLOR fg0&, bg0&
801.             ShowTime 32, etime!(0), "Black"
802.             ShowTime 33, etime!(1), "White"
803.             ShowTime 34, etime!(3), "Game"
804.             ShowTime 35, etime!(2), "Move"
805.             'COLOR white&, black&
806.         END IF
807.  
808.         ocount& = tcount&
809.         dtime! = TIMER + 1: IF dtime! > maxtime& THEN dtime! = 0
810.     END IF
811.  
812.     IF (showthink = 0) OR (smode < 2) THEN _DISPLAY
813.  
814. END SUB
815.  
816. DEFSNG A-Z
817. FUNCTION f_pl (n1, n2, n3) '                                         plasma function
818.     f_pl = _RGB32(n1 * 255, n2 * 255, n3 * 255)
819. END FUNCTION
820.  
821. DEFINT A-Z
822. SUB FlashMove (eflag)
823.     fr = VAL(MID$(m$, 2, 1)) '                                       from row (or rank)
824.     IF invert THEN fr = 9 - fr '                                     invert means black at bottom
825.     fc = INSTR(alpha$, LEFT$(m$, 1)) '                               from column
826.  
827.     IF invert THEN fc = 9 - fc
828.  
829.     tr = VAL(MID$(m$, 4, 1)) '                                       row or rank
830.     IF invert THEN tr = 9 - tr '                                     black at bottom
831.     tc = INSTR(alpha$, MID$(m$, 3, 1)) '                             column
832.     IF invert THEN tc = 9 - tc
833.  
834.     DO: _LIMIT 100
835.         'IF (itime! = 0) OR (TIMER > itime!) THEN
836.         '    iname = iname XOR 1
837.         '    _ICON icon&(iname + 2) '                                clockx or clockx2
838.         '    itime! = TIMER + .5
839.         'END IF
840.         KeyScan 1, 1 '                                               plotscreen, _display
841.         Cursor fr, fc, 0
842.         Cursor tr, tc, 0
843.         IF eflag AND (WorB = humanc) THEN EXIT DO
844.     LOOP UNTIL (i$ = Enter$) OR (human = 0) OR LEN(msg$)
845. END SUB
846.  
847. SUB Init
848.     xm = 600: ym = 200
849.     main& = _NEWIMAGE(xm, ym, 32)
850.     SCREEN main&
851.     _DELAY .2
852.     _SCREENMOVE _MIDDLE
853.     _DELAY .2
854.  
855.     RANDOMIZE TIMER '                                                seed generator
856.     Colorassign '                                                    red&, green&, etc, easier to use than palette numbers
857.  
858.     alpha$ = "abcdefgh"
859.  
860.     q = 120
861.     bg0& = _RGB32(q, q, q)
862.     fg0& = black&
863.     SWAP bg0&, fg0&
864.     castle$ = SPACE$(4) '                                            flags QKQK (B then W)
865.     crlf$ = Enter$ + lf$
866.     Enter$ = CHR$(13)
867.     Esc$ = CHR$(27) '                                                to quit program
868.     graphics = 3 '                                                   graphics for white squares (0-3)
869.     lcount& = 0 '                                                    line counter for debug output
870.     lf$ = CHR$(10) '                                                 line feed
871.     maxtime& = 86400
872.     Move = 0
873.     MakeNoise = 1
874.     showthink = 1
875.     WorB = 1 '                                                       white=1, black=0
876.     xq = 56: yq = 56
877.     xc = 248: yc = 256 '                                             center of board
878.  
879.     COLOR fg0&, bg0&
880.     FOR i = 1 TO 8
881.         alphal$(i) = MID$(alpha$, i, 1)
882.     NEXT i
883.  
884.     FOR i = 0 TO 3: etime!(i) = 0: NEXT '                            sides, total, current
885.  
886.     RESTORE PiecePatterns '                                          bit images
887.     FOR p = 1 TO 6 '                                                 RNBQKP
888.         n = 0
889.         FOR y = 0 TO 21 ' 22 rows
890.             READ d$
891.             p1 = INSTR(d$ + "X", "X") '                              find first "on" bit
892.             FOR t = LEN(d$) TO 1 STEP -1 '                           find last "on" bit
893.                 IF MID$(d$, t, 1) = "X" THEN
894.                     p2 = t
895.                     EXIT FOR
896.                 END IF
897.             NEXT t
898.             FOR x = p1 TO p2
899.                 pixel = INSTR(".X", MID$(d$, x, 1))
900.                 n = n + 1
901.                 IF pixel = 2 THEN c = 3 ELSE c = 4
902.                 x(p, n) = x + 1
903.                 y(p, n) = y + 2
904.                 c(p, n) = c
905.                 IF pixel = 2 THEN c = 5 ELSE c = 6
906.                 c(p + 6, n) = c
907.             NEXT x
908.         NEXT y
909.         c(p, 0) = n
910.         FOR scram = 1 TO 256 '                                       scramble (moves nicer)
911.             c1 = RND * (c(p, 0) - 1) + 1 '                           any bit
912.             c2 = RND * (c(p, 0) - 1) + 1 '                           any other bit
913.             SWAP x(p, c1), x(p, c2)
914.             SWAP y(p, c1), y(p, c2)
915.             SWAP c(p, c1), c(p, c2) '                                black
916.             SWAP c(p + 6, c1), c(p + 6, c2) '                        white
917.         NEXT scram
918.     NEXT p
919.  
920.     RESTORE Legal '                                                  define how piece moves
921.     FOR p = 1 TO 6 '                                                 RNBQKP
922.         READ p$ '                                                    piece, not saved
923.         FOR t = 0 TO 7 '                                             8 each
924.             READ udlr$
925.             du(p, t) = VAL(MID$(udlr$, 1, 1)) '                      direction up
926.             dd(p, t) = VAL(MID$(udlr$, 2, 1)) '                      direction down
927.             dl(p, t) = VAL(MID$(udlr$, 3, 1)) '                      direction left
928.             dr(p, t) = VAL(MID$(udlr$, 4, 1)) '                      direction right
929.         NEXT t
930.     NEXT p
931.  
932.     FOR i = 1 TO 6
933.         '                    RNBQKP
934.         value(i) = VAL(MID$("533901", i, 1)) '                       point value for capture
935.     NEXT i
936.  
937.     RESTORE Setup '                                                  initial board position
938.     FOR r = 8 TO 1 STEP -1 '                                         row
939.         FOR c = 1 TO 8 '                                             column
940.             READ b(c, r) '                                           board
941.             o(c, r) = b(c, r) '                                      initial setup
942.         NEXT c
943.     NEXT r
944.  
945.     gm = 0: n = 0
946.     IF LEN(GameFile$) > 0 THEN ReadGame
947.     gm = 0
948.  
949.     CLOSE
950.     newf:
951.     f = f + 1
952.     f$ = "ch" + RIGHT$("0000000" + LTRIM$(STR$(f)), 6) + ".alg" '    save game for analysis
953.     IF _FILEEXISTS(f$) THEN GOTO newf
954.  
955.     OPEN f$ FOR OUTPUT AS #1 '                                       algrebraic moves
956.  
957.     FOR i = 0 TO 3
958.         SELECT CASE i
959.             CASE IS = 0
960.                 f$ = "alfred.jpg" '                                  Alfred E. Neuman
961.             CASE IS = 1
962.                 f$ = "chess.png"
963.             CASE IS = 2
964.                 f$ = "clockx.png"
965.             CASE IS = 3
966.                 f$ = "clockx2.png"
967.         END SELECT
968.         isthere = true
969.         IF _FILEEXISTS(f$) = 0 THEN '                                accomodate Linux, which cares about case
970.             f$ = UCASE$(f$) '                                        now try uppercase
971.             IF _FILEEXISTS(f$) = 0 THEN isthere = false
972.         END IF
973.         IF isthere THEN
974.             li1:
975.             icon&(i) = _LOADIMAGE(f$)
976.             IF icon&(i) >= -1 THEN _DELAY .2: GOTO li1
977.         END IF
978.     NEXT i
979.     IF icon&(1) <> 0 THEN
980.         _ICON icon&(1)
981.         _DELAY .2
982.     END IF
983.  
984.     IF icon&(0) <> 0 THEN
985.         _SOURCE icon&(0) '                                               Alfred E. Neuman
986.         _DISPLAY '                                                       hide idiot
987.         _PUTIMAGE
988.         GET (0, 0)-(52, 53), abuff(0)
989.     END IF
990.  
991.     CLS 0, bg0&
992.     _DELAY .2
993.     Menubox
994.     Center 6, "White  Black  Humans  Computer", 1
995.     Center 0, "Quit or Esc to exit", 1
996.     _DISPLAY
997.     DO: _LIMIT 10
998.         i$ = INKEY$
999.         IF i$ = "" THEN i$ = " "
1000.         IF (LCASE$(i$) = "q") OR (i$ = Esc$) THEN SYSTEM
1001.         p = INSTR("bwhc", i$)
1002.     LOOP UNTIL p
1003.     SELECT CASE p
1004.         CASE IS = 1 '                                                player is black
1005.             human = 1: humanc = 0: invert = 1
1006.         CASE IS = 2 '                                                player is white
1007.             human = 1: humanc = 1
1008.         CASE IS = 3 '                                                human vs. human
1009.             human = 2
1010.         CASE IS = 4 '                                                computer vs. computer, just watch
1011.             human = 0: OnAuto = 1
1012.     END SELECT
1013.  
1014.     'IF human <> 2 THEN
1015.     '    tlimit = 0
1016.     '    DO
1017.     '        CLS
1018.     '        Menubox
1019.     '        Center 6, "Time limit in minutes?  (0 unlimited)", 0
1020.     '        Center 8, STR$(tlimit), 0
1021.     '        Center 0, "Quit or Esc to exit", 1
1022.     '        _DISPLAY
1023.     '        DO: _LIMIT 10
1024.     '            i$ = INKEY$
1025.     '        LOOP UNTIL LEN(i$)
1026.     '        IF (LCASE$(i$) = "q") OR (i$ = Esc$) THEN SYSTEM
1027.     '        IF i$ = CHR$(8) THEN tlimit = tlimit / 10
1028.     '        p = INSTR("0123456789", i$): IF p THEN tlimit = tlimit * 10 + p - 1
1029.     '    LOOP UNTIL i$ = Enter$
1030.     'END IF
1031.  
1032.     'IF rick THEN smode = 2
1033.     ScreenInit
1034.     PlotBoard
1035. END SUB
1036.  
1037. SUB HumanMove STATIC
1038.     cursoron! = TIMER + 3: IF cursoron! > maxtime& THEN cursoron! = 0
1039.     IF cc = 0 THEN
1040.         rr = 7
1041.         cc = 5 + (WorB = 0)
1042.     END IF
1043.     FOR i = 0 TO 1
1044.         DO: _LIMIT 30
1045.             IF vflag THEN ShowValid cc, rr
1046.             KeyScan 1, 0 '                                           plotscreen, no _display
1047.             IF rr < 1 THEN rr = 1
1048.             IF rr > 8 THEN rr = 8
1049.             IF cc < 1 THEN cc = 1
1050.             IF cc > 8 THEN cc = 8
1051.             IF cursoron! > TIMER THEN Cursor 9 - rr, cc, i
1052.             IF takebackflag OR LEN(msg$) THEN EXIT SUB
1053.             WHILE _MOUSEINPUT
1054.                 mx = _MOUSEX
1055.                 my = _MOUSEY
1056.                 xx = (mx - xc - (4 * xq) + xq \ 2) / xq + 8
1057.                 yy = (my - yc - (4 * yq) + yq \ 2) / yq + 8
1058.                 IF (xx > 0) AND (xx < 9) AND (yy > 0) AND (yy < 9) THEN rr = yy: cc = xx
1059.                 IF _MOUSEBUTTON(1) OR _MOUSEBUTTON(2) THEN i$ = Enter$
1060.             WEND
1061.             IF LEN(i$) = 2 THEN
1062.                 kk = ASC(RIGHT$(i$, 1))
1063.                 cc = cc + (kk = 75) - (kk = 77) '                    left right
1064.                 rr = rr + (kk = 72) - (kk = 80) '                    up down
1065.             END IF
1066.         LOOP UNTIL i$ = Enter$
1067.         IF i = 0 THEN
1068.             fr = rr: fc = cc
1069.             IF invert THEN fr = 9 - fr: fc = 9 - fc
1070.         ELSE
1071.             tr = rr: tc = cc
1072.             IF invert THEN tr = 9 - tr: tc = 9 - tc
1073.         END IF
1074.     NEXT i
1075.  
1076.     fs$ = alphal$(fc) + LTRIM$(STR$(9 - fr))
1077.     ts$ = alphal$(tc) + LTRIM$(STR$(9 - tr))
1078.     m$ = fs$ + ts$
1079.     IF m$ = "e1g1" THEN m$ = "O-O"
1080.     IF m$ = "e1c1" THEN m$ = "O-O-O"
1081.     IF m$ = "e8g8" THEN m$ = "O-O"
1082.     IF m$ = "e8c8" THEN m$ = "O-O-O"
1083. END SUB
1084.  
1085. SUB KeyScan (kf1, kf2) STATIC '                                      plotscreen, _display
1086.     TempMess "", 0
1087.     DispStats
1088.     dot = 0
1089.     i$ = INKEY$
1090.     IF LEN(i$) THEN
1091.         cursoron! = TIMER + 2
1092.         IF cursoron! > maxtime& THEN cursoron! = 0
1093.     END IF
1094.     IF LEN(i$) = 1 THEN
1095.         IF (LCASE$(i$) = "q") OR (i$ = Esc$) THEN abort = 9: msg$ = "Quit!"
1096.         IF i$ = Enter$ THEN EXIT SUB
1097.         IF i$ = " " THEN msg$ = "abort": abort = 1: EXIT SUB '       move now
1098.         c = INSTR("123456789ABCDEF0", i$) '                          experiment with colors
1099.         IF c > 0 THEN
1100.             IF c = 16 THEN
1101.                 c = 2
1102.                 myr(c) = 0: myg(c) = 0: myb(c) = 0
1103.             ELSE
1104.                 myr(c) = RND * 64: myg(c) = RND * 64: myb(c) = RND * 64
1105.             END IF
1106.             cp&(c) = _RGB32(myr(c) * bri, myg(c) * bri, myb(c) * bri)
1107.             ColorWrite
1108.             Colorassign
1109.             PlotBoard
1110.         END IF
1111.         IF i$ = "a" THEN OnAuto = NOT (OnAuto) '                     not currently in use
1112.         IF i$ = "b" THEN takebackflag = 1
1113.         IF i$ = "c" THEN ChangeColors
1114.         IF i$ = "d" THEN SWAP fg0&, bg0&: CLS 0, bg0&
1115.         IF i$ = "f" THEN PlayFile
1116.         IF i$ = "g" THEN '                                           change white square graphics scheme
1117.             graphics = (graphics + 1) MOD 4
1118.             IF graphics = 0 THEN PlotBoard
1119.             t$ = "Mode" + STR$(graphics + 1) + " of 4"
1120.             TempMess t$, 2
1121.         END IF
1122.         IF i$ = "G" THEN pinit = pinit XOR 1 '                       adjust current white square graphics
1123.         IF i$ = "h" THEN dot = 1: history = history XOR 1
1124.         IF i$ = "i" THEN '                                           flip board around
1125.             IF human = 2 THEN
1126.                 iflag = iflag XOR 1
1127.             ELSE
1128.                 invert = invert XOR 1
1129.                 PlotBoard
1130.             END IF
1131.         END IF
1132.         IF i$ = "I" THEN
1133.             useidiot = useidiot XOR 1
1134.             t$ = "Idiot " + OnOff$(useidiot)
1135.             TempMess t$, 2
1136.         END IF
1137.         IF i$ = "l" THEN dot = 1: showlegalf = showlegalf XOR 1
1138.         IF i$ = "L" THEN '                                           look at log file
1139.             CLOSE #2
1140.             SHELL _DONTWAIT "notepad chess.txt"
1141.             OPEN "chess.txt" FOR APPEND AS #2
1142.         END IF
1143.         IF i$ = "m" THEN '                                           screen mode
1144.             smode = (smode + 1) MOD 3
1145.             ScreenInit
1146.         END IF
1147.         IF i$ = "n" THEN '                                           sound effects
1148.             MakeNoise = MakeNoise XOR 1
1149.             t$ = "Sound " + OnOff$(MakeNoise)
1150.             TempMess t$, 2
1151.         END IF
1152.         IF i$ = "p" THEN dot = 1: showprotf = showprotf XOR 1
1153.         IF i$ = "P" THEN
1154.             pause = pause XOR 1
1155.             IF pause THEN
1156.                 LOCATE 2, 29: PRINT "PAUSED";
1157.                 _DISPLAY
1158.                 t! = TIMER - etime!(2)
1159.                 IF t! < 0 THEN t! = t! + maxtime&
1160.                 hold! = t!
1161.                 SLEEP
1162.                 Start1! = TIMER
1163.                 LOCATE 2, 29: PRINT SPACE$(10);
1164.                 _DISPLAY '
1165.             END IF
1166.         END IF
1167.         IF (rflag = 0) AND (i$ = "r") THEN abort = 2: msg$ = "Resign!"
1168.         IF i$ = "s" THEN Setup '                                     setup
1169.         IF i$ = "t" THEN dot = 1: showthink = showthink XOR 1
1170.         IF i$ = "v" THEN '                                           show valid moves at top left
1171.             vflag = vflag XOR 1
1172.             LOCATE 2, 4: PRINT SPACE$(40);
1173.             _DISPLAY
1174.         END IF
1175.         IF i$ = "x" AND MakeNoise THEN PlaySound "ding" '            sound test
1176.         IF i$ = "X" THEN
1177.             SHELL _HIDE "del ccolor.dat" '                           kill color file
1178.             ColorWrite
1179.             Colorassign
1180.             PlotBoard
1181.         END IF
1182.         'IF i$ = "y" THEN itest '                                    see how bad icon problem is
1183.         IF i$ = "z" THEN
1184.             altblack = altblack XOR 1
1185.             Colorassign
1186.             'CLS 0, bg0&
1187.             PlotBoard
1188.             TempMess "Alternate black " + OnOff(altblack), 2
1189.         END IF
1190.         i$ = ""
1191.     END IF
1192.     IF LEN(i$) = 2 THEN
1193.         k = ASC(RIGHT$(i$, 1))
1194.         wbri = bri
1195.         bri = bri - (k = 73) + (k = 81) '                            brightness PgUp/PgDn
1196.         IF bri < 2 THEN bri = 2
1197.         IF bri > 4 THEN bri = 4
1198.         IF bri <> wbri THEN '                                        was changed
1199.             ColorWrite
1200.             Colorassign
1201.             TempMess "Brightness" + STR$(bri), 1
1202.         END IF
1203.     END IF
1204.  
1205.     IF kf1 THEN PlotScreen true
1206.     IF dot THEN DebugR = 99: TextInfo ""
1207.     IF kf2 THEN _DISPLAY
1208. END SUB
1209.  
1210. FUNCTION Make4$ (t$)
1211.     Make4$ = LEFT$(t$ + SPACE$(4), 4)
1212. END FUNCTION
1213.  
1214. DEFINT A-Z
1215. SUB LogThinking () STATIC
1216.     ts = 0: z1$ = "": z2$ = ""
1217.     FOR t = 1 TO 3
1218.         ti = TieTo(t)
1219.         z1$ = z1$ + Make4$(Move$(t - 1, ti)) + " "
1220.         z2$ = z2$ + Rjust$(Score(t - 1, ti), 3) + " "
1221.         ts = ts + Score(t - 1, ti)
1222.     NEXT t
1223.     ts = ts - Score
1224.     zz$ = z1$ + Make4$(m$) + z2$ + Rjust$(Score, 3) + " " + Rjust$(ts, 4)
1225.     PRINT #2, zz$
1226.  
1227.     zz = Score(0, 1)
1228.     z$ = Move$(0, 1)
1229.     IF zz >= bscore THEN
1230.         bscore = zz
1231.         IF zz = bscore THEN best$ = best$ + " " + z$ ELSE best$ = z$
1232.     END IF
1233.  
1234.     TextInfo zz$
1235. END SUB
1236.  
1237. SUB Menubox
1238.     tx = _WIDTH \ 2: ty = _HEIGHT \ 2
1239.     xs = 200: ys = 70
1240.     x1 = tx - xs: y1 = ty - ys
1241.     x2 = tx + xs: y2 = ty + ys
1242.  
1243.     LINE (x1, y1 + 20)-(x2, y2 - 20), _RGBA(1, 1, 1, 220), BF
1244.     FOR q = 2 TO 20 STEP 4
1245.         LINE (x1 - q + 0, y1 + q + 0)-(x2 + q + 0, y2 - q + 0), cp&(1), B
1246.         LINE (x1 - q + 1, y1 + q + 1)-(x2 + q + 1, y2 - q + 1), cp&(1), B
1247.     NEXT q
1248. END SUB
1249.  
1250. SUB MoveIt (m$, real)
1251.     IF m$ = ep$ THEN '                                               epfc, epfr, eptc, eptr, eprc, eprr
1252.         Plotpiece fc, fr, tc, tr
1253.         b(epfc, epfr) = 0
1254.         b(eprc, eprr) = 0
1255.         b(eptc, eptr) = 6 + WorB * 6
1256.         EXIT SUB
1257.     END IF
1258.  
1259.     IF m$ = "res" THEN EXIT SUB '                                    resign?
1260.     fs$ = LEFT$(m$, 2) '                                             from square
1261.     ts$ = RIGHT$(m$, 2) '                                            to square
1262.     tzz = 1 - (LEFT$(m$, 1) = "O") - (L1$ = "e") '                   two moves for a castle
1263.  
1264.     FOR pass = 1 TO tzz
1265.  
1266.         IF m$ = "O-O" THEN '                                         castle Kingside
1267.             IF WorB = 1 THEN '                                       white
1268.                 IF pass = 1 THEN '                                   first move of KS castle
1269.                     fs$ = "e1": ts$ = "g1"
1270.                 ELSE '                                               else 2nd
1271.                     fs$ = "h1": ts$ = "f1"
1272.                 END IF
1273.             ELSE '                                                   black castle
1274.                 IF pass = 1 THEN
1275.                     fs$ = "e8": ts$ = "g8"
1276.                 ELSE
1277.                     fs$ = "h8": ts$ = "f8"
1278.                 END IF
1279.             END IF
1280.         END IF
1281.         IF m$ = "O-O-O" THEN '                                       castle Queenside
1282.             IF WorB THEN '                                           white
1283.                 IF pass = 1 THEN
1284.                     fs$ = "e1": ts$ = "c1"
1285.                 ELSE
1286.                     fs$ = "a1": ts$ = "d1"
1287.                 END IF
1288.             ELSE
1289.                 IF pass = 1 THEN
1290.                     fs$ = "e8": ts$ = "c8"
1291.                 ELSE
1292.                     fs$ = "a8": ts$ = "d8"
1293.                 END IF
1294.             END IF
1295.         END IF
1296.         fc = INSTR(alpha$, LEFT$(fs$, 1)) '                          from column
1297.         fr = VAL(RIGHT$(fs$, 1)) '                                   from row
1298.         pm = b(fc, fr) '                                             piece to move
1299.         p = pm + (pm > 6) * 6
1300.         tc = INSTR(alpha$, LEFT$(ts$, 1)) '                          to column
1301.         tr = VAL(RIGHT$(ts$, 1)) '                                   to row
1302.         b(tc, tr) = pm '                                             move piece in array
1303.         b(fc, fr) = 0 '                                              blank old array spot
1304.         IF real THEN
1305.             IF b(c, r) = o(c, r) THEN o(c, r) = -1
1306.             Plotpiece fc, fr, tc, tr
1307.             IF p = King THEN MID$(castle$, WorB * 2 + 1, 2) = "XX"
1308.             IF p = Rook THEN
1309.                 IF WorB THEN
1310.                     IF (fc = 1) AND (fr = 1) THEN MID$(castle$, 3, 1) = "X"
1311.                     IF (fc = 1) AND (fr = 8) THEN MID$(castle$, 4, 1) = "X"
1312.                 ELSE
1313.                     IF (fc = 8) AND (fr = 1) THEN MID$(castle$, 1, 1) = "X"
1314.                     IF (fc = 8) AND (fr = 8) THEN MID$(castle$, 2, 1) = "X"
1315.                 END IF
1316.             END IF
1317.         END IF
1318.         IF (p = Pawn) AND ((tr = 1) OR (tr = 8)) THEN
1319.             b(tc, tr) = Queen - (pm > 6) * 6 '                       promote to queen
1320.             IF real THEN Plotpiece tc, tr, tc, tr '                  show queen
1321.         END IF
1322.     NEXT pass
1323. END SUB
1324.  
1325. DEFINT A-Z
1326. FUNCTION OnOff$ (v)
1327.     OnOff$ = MID$("OFFON ", v * 3 + 1, 3)
1328. END FUNCTION
1329.  
1330. DEFSNG A-Z
1331. SUB Plasma STATIC
1332.     TYPE xy
1333.         x AS SINGLE
1334.         y AS SINGLE
1335.         dx AS SINGLE
1336.         dy AS SINGLE
1337.     END TYPE
1338.  
1339.     IF pinit% = 0 THEN
1340.         DIM c(360) AS _UNSIGNED LONG, p(10) AS xy, f(10)
1341.         r = RND: g = RND: b = RND: i% = 0: q = .5
1342.         FOR n% = 1 TO 5
1343.             r1 = r: g1 = g: b1 = b
1344.             DO: r = RND: LOOP UNTIL ABS(r - r1) > q
1345.             DO: g = RND: LOOP UNTIL ABS(g - g1) > q
1346.             DO: b = RND: LOOP UNTIL ABS(g - g1) > q
1347.             FOR m% = 0 TO 17: m1% = 17 - m%
1348.                 f1 = (m% * r) / 18: f2 = (m% * g) / 18: f3 = (m% * b) / 18: c(i%) = f_pl(f1, f2, f3): i% = i% + 1
1349.             NEXT
1350.             FOR m% = 0 TO 17: m1% = 17 - m%
1351.                 f1 = (m% + m1% * r) / 18: f2 = (m% + m1% * g) / 18: f3 = (m% + m1% * b) / 18: c(i%) = f_pl(f1, f2, f3): i% = i% + 1
1352.             NEXT
1353.             FOR m% = 0 TO 17: m1% = 17 - m%
1354.                 f1 = (m1% + m% * r) / 18: f2 = (m1% + m% * g) / 18: f3 = (m1% + m% * b) / 18: c(i%) = f_pl(f1, f2, f3): i% = i% + 1
1355.             NEXT
1356.             FOR m% = 0 TO 17: m1% = 17 - m%
1357.                 f1 = (m1% * r) / 18: f2 = (m1% * g) / 18: f3 = (m1% * b) / 18: c(i%) = f_pl(f1, f2, f3): i% = i% + 1
1358.             NEXT
1359.         NEXT
1360.  
1361.         FOR n% = 0 TO 5
1362.             p(n%).x = RND * xm%: p(n%).y = RND * ym%: p(n%).dx = RND * 2 - 1: p(n%).dy = RND * 2 - 1
1363.             f(n%) = RND * .1
1364.         NEXT
1365.  
1366.         xm2% = 8 * xq%: ym2% = xm2%: x1% = xc% - 4 * xq%: y1% = yc% - 4 * yq%: x2% = xc% + 4 * xq%: y2% = yc% + 4 * yq%:
1367.         pinit% = 1
1368.     END IF
1369.  
1370.     FOR n% = 0 TO 5
1371.         p(n%).x = p(n%).x + p(n%).dx
1372.         IF p(n%).x > xm2% OR p(n%).x < 0 THEN p(n%).dx = -p(n%).dx
1373.         p(n%).y = p(n%).y + p(n%).dy
1374.         IF p(n%).y > ym2% OR p(n%).y < 0 THEN p(n%).dy = -p(n%).dy
1375.     NEXT
1376.  
1377.     IF graphics% = 2 THEN z% = 1 ELSE z% = 2
1378.  
1379.     FOR y% = y1% TO y2% STEP z%
1380.         FOR x% = x1% TO x2% STEP z%
1381.             p& = POINT(x%, y%)
1382.             'IF (p& = boardwhite&) OR (p& = boardblack&) THEN
1383.             IF (p& = boardwhite&) THEN
1384.                 d = 0
1385.                 FOR n% = 0 TO 5
1386.                     dx = x% - p(n%).x: dy = y% - p(n%).y
1387.                     k = SQR(dx * dx + dy * dy)
1388.                     d = d + (SIN(k * f(n%)) + 1) / 2
1389.                 NEXT
1390.                 PSET (x%, y%), c(d * 60)
1391.             END IF
1392.         NEXT
1393.         '_DELAY .001
1394.     NEXT
1395. END SUB
1396.  
1397. DEFINT A-Z
1398. SUB Playagain (t$)
1399.     Menubox
1400.     COLOR _RGBA32(222, 222, 222, 255), _RGBA32(1, 1, 1, 0)
1401.     Center 18, t$, 0
1402.     IF INSTR("QR", LEFT$(t$, 1)) THEN '                              Quit or Resign
1403.         Center 20, "Resume    New game     Quit", 1
1404.         ks$ = "rn"
1405.     ELSE
1406.         Center 20, "New game     Quit", 1
1407.         ks$ = "rn" '                                                 take out r when working properly (false checkmates)
1408.     END IF
1409.     _DISPLAY
1410.     'COLOR _RGBA(155, 155, 155, 255), _RGBA32(0, 0, 0, 255)
1411.     COLOR fg0&, bg0&
1412.  
1413.     DO: _LIMIT 10
1414.         i$ = INKEY$
1415.         IF i$ = "" THEN i$ = " "
1416.         IF (i$ = Esc$) OR (LCASE$(i$) = "q") THEN SYSTEM
1417.         IF human = 0 THEN i$ = "n"
1418.     LOOP UNTIL INSTR(ks$, i$)
1419. END SUB
1420.  
1421. SUB PlayFile
1422.     tryagain:
1423.     LOCATE 1, 1: PRINT SPACE$(20);
1424.     LOCATE 1, 1: INPUT f$
1425.     IF f$ = "" THEN EXIT SUB
1426.     f$ = f$ + ".alg"
1427.     IF NOT (_FILEEXISTS(f$)) THEN GOTO tryagain
1428.     LOCATE 1, 1: PRINT SPACE$(20);
1429.     tf = FREEFILE
1430.     OPEN f$ FOR INPUT AS #tf
1431.     WHILE NOT (EOF(tf))
1432.         LINE INPUT #tf, t$
1433.         IF LEN(LTRIM$(t$)) THEN
1434.             t$ = t$ + SPACE$(20)
1435.             FOR WorB = 1 TO 0 STEP -1
1436.                 m$ = RTRIM$(LTRIM$(MID$(t$, 12 - WorB * 6, 5)))
1437.                 IF m$ = SPACE$(5) THEN GOTO pbdone
1438.                 FlashMove false
1439.                 MoveIt m$, true
1440.                 PlotScreen true
1441.                 _DISPLAY
1442.                 IF (i$ = "q") OR (i$ = Esc$) THEN SYSTEM
1443.                 IF i$ = " " THEN i$ = "": GOTO pbdone
1444.             NEXT WorB
1445.         END IF
1446.     WEND
1447.     pbdone:
1448.     LOCATE 1, 1: PRINT SPACE$(20):
1449.     CLOSE #tf
1450.     IF MakeNoise THEN PlaySound "ding"
1451. END SUB
1452.  
1453. DEFSNG A-Z
1454. SUB PlaySound (f$) STATIC '         ding,tada,notify,windows xp hardware fail, etc.
1455.     CONST CACHE = 441 '             minimal detected frequency for analyzer is 100 Hz, so this is enought value (with 44100 biterate)
1456.     TYPE head
1457.         chunk AS STRING * 4 '       4 bytes  (RIFF)
1458.         size AS LONG '              4 bytes  (?E??)
1459.         fomat AS STRING * 4 '       4 bytes  (WAVE)
1460.         sub1 AS STRING * 4 '        4 bytes  (fmt )
1461.         subchunksize AS LONG '      4 bytes  (lo / hi), $00000010 for PCM audio
1462.         format AS STRING * 2 '      2 bytes  (0001 = standard PCM, 0101 = IBM mu-law, 0102 = IBM a-law, 0103 = IBM AVC ADPCM)
1463.         channels AS INTEGER '       2 bytes  (1 = mono, 2 = stereo)
1464.         rate AS LONG '              4 bytes  (sample rate, standard is 44100)
1465.         ByteRate AS LONG '          4 bytes  (= sample rate * number of channels * (bits per channel /8))
1466.         Block AS INTEGER '          2 bytes  (block align = number of channels * bits per sample /8)
1467.         Bits AS INTEGER '           2 bytes  (bits per sample. 8 = 8, 16 = 16)
1468.         subchunk2 AS STRING * 4 '   4 bytes  ("data")  contains begin audio samples
1469.     END TYPE '                     40 bytes  total
1470.     TYPE Wav16S
1471.         Left AS INTEGER
1472.         Right AS INTEGER
1473.     END TYPE
1474.     REDIM scache(CACHE) AS Wav16S
1475.     DIM H AS head
1476.     ch = FREEFILE
1477.     f$ = f$ + ".wav"
1478.     IF _FILEEXISTS(f$) = 0 THEN EXIT SUB
1479.     OPEN f$ FOR BINARY AS #ch
1480.     GET #ch, , H
1481.     block = H.Block
1482.     RATE = H.rate
1483.     chan = H.channels
1484.     bits = H.Bits
1485.     L = _SNDOPENRAW
1486.     R = _SNDOPENRAW
1487.     REDIM scache(CACHE) AS Wav16S
1488.     DO WHILE NOT EOF(ch)
1489.         GET #ch, , scache()
1490.         FOR P = 0 TO CACHE
1491.             lef = scache(P).Left
1492.             IF chan = 1 THEN righ = lef ELSE righ = scache(P).Right
1493.             lef = lef / RATE
1494.             righ = righ / RATE
1495.             IF RATE > 44100 THEN frekvence = RATE ELSE frekvence = 44100
1496.             FOR plll = 1 TO frekvence / RATE
1497.                 _SNDRAW lef, L
1498.                 _SNDRAW righ, R
1499.             NEXT plll
1500.         NEXT
1501.     LOOP
1502.     CLOSE ch
1503. END SUB
1504.  
1505. DEFINT A-Z
1506. SUB PlotBoard
1507.     FOR zr = 1 TO 8
1508.         FOR zc = 1 TO 8
1509.             IF rflag = 0 THEN Plotpiece zc, zr, zc, zr
1510.         NEXT zc
1511.     NEXT zr
1512. END SUB
1513.  
1514. SUB Plotpiece (fc, fr, tc, tr)
1515.     x1 = xc + (fc - 5) * xq
1516.     x2 = xc + (tc - 5) * xq
1517.     y1 = yc + (4 - fr) * yq
1518.     y2 = yc + (4 - tr) * yq
1519.     p = b(tc, tr)
1520.     IF invert THEN p = b(9 - tc, 9 - tr)
1521.     IF p > 6 THEN wb = 1: p = p - 6
1522.     i = p - (wb = 0) * 6
1523.  
1524.     FOR ps = 0 TO 1
1525.         IF ps = 0 THEN
1526.             c = fr + fc: tx = x1: ty = y1
1527.         ELSE
1528.             c = tr + tc: tx = x2: ty = y2
1529.         END IF
1530.         IF c MOD 2 THEN
1531.             LINE (tx, ty)-(tx + xq, ty + yq), boardwhite&, BF
1532.         ELSE
1533.             LINE (tx, ty)-(tx + xq, ty + yq), boardblack&, BF '      black square
1534.             LINE (tx, ty)-(tx + xq, ty + yq), boardwhite&, B '       border
1535.         END IF
1536.     NEXT ps
1537.  
1538.     FOR t = 1 TO c(p, 0)
1539.         tx = x1 + x(p, t) * 2
1540.         ty = y1 + y(p, t) * 2
1541.         LINE (tx, ty)-STEP(1, 1), cp&(c(i, t)), B
1542.     NEXT t
1543. END SUB
1544.  
1545. SUB PlotScreen (lflag) STATIC
1546.     'CLS 0, bg0&
1547.     PlotBoard
1548.     TextInfo ""
1549.     r = _RED32(boardwhite&) \ 2 '                                    legend, dim a-h, 1-8 along sides
1550.     g = _GREEN32(boardwhite&) \ 2
1551.     b = _BLUE32(boardwhite&) \ 2
1552.     COLOR _RGB32(r, g, b)
1553.     FOR i = 1 TO 8
1554.         IF invert THEN z = i ELSE z = 9 - i
1555.         n$ = LTRIM$(STR$(z))
1556.         IF invert THEN z = 9 - i ELSE z = i
1557.         a$ = alphal$(z)
1558.         nx = xc - 4 * xq - 12
1559.         ny = yc + (i - 4) * yq - 34
1560.         ax = xc + (i - 5) * xq + 23
1561.         ay = yc + 4 * yq + 3
1562.         _PRINTSTRING (nx, ny), n$
1563.         _PRINTSTRING (ax, ay), a$
1564.     NEXT i
1565.     COLOR fg0&, bg0&
1566.  
1567.     IF lflag THEN Center 0, "", 1
1568.  
1569.     IF graphics = 0 THEN EXIT SUB
1570.     IF graphics > 1 THEN
1571.         Plasma
1572.         EXIT SUB
1573.     END IF
1574.  
1575.     br = 255
1576.     zz = (zz + 1) MOD 50: IF zz = 1 THEN r! = RND: g! = RND: b! = RND
1577.     x1 = xc - 4 * xq
1578.     y1 = yc - 4 * yq
1579.     x2 = x1 + 8 * xq
1580.     y2 = y1 + 8 * yq
1581.     FOR sy = y1 TO y2
1582.         FOR sx = x1 TO x2
1583.             p& = POINT(sx, sy)
1584.             IF p& = boardwhite& THEN
1585.                 z = ABS((sx - xc - xq \ 2) * (sy - yc - yq \ 2))
1586.                 PSET (sx, sy), _RGB32(br * SIN(.1 * r! * z + zz), br * SIN(.155 * g! * z + zz), br * SIN(2 * b! * z + zz))
1587.             END IF
1588.     NEXT sx: NEXT sy
1589. END SUB
1590.  
1591. SUB ReadGame
1592.     DIM g$(500)
1593.     CLS
1594.     OPEN GameFile$ FOR INPUT AS #8
1595.     WHILE NOT (EOF(8))
1596.         INPUT #8, mn, m1$, m2$
1597.         gm = gm + 1: g$(gm) = LTRIM$(m1$)
1598.         gm = gm + 1: g$(gm) = LTRIM$(m2$)
1599.         PRINT m1$; "*"; m2$
1600.     WEND
1601.     CLOSE #8
1602.     _DISPLAY
1603.     SLEEP
1604.     CLS
1605.     _DISPLAY
1606. END SUB
1607.  
1608. SUB Recurse (Level)
1609.     IF abort OR (Level = MasterLevel) THEN EXIT SUB
1610.  
1611.     FOR t = 1 TO Moves(Level - 1)
1612.  
1613.         IF Level = 1 THEN '                                                              progress bar
1614.             x1 = xc - 4 * xq: x2 = xc + 4 * xq
1615.             y1 = yc + 4 * yq + 20
1616.             z1 = Moves(Level - 1): z2 = z1 - (z1 = 0)
1617.             xx = (z1 - t + 1) / z2 * (x2 - x1)
1618.             IF xx < x1 THEN xx = x1
1619.             IF xx > x2 THEN xx = x2
1620.             LINE (x1, y1)-(x2, y1), bg0&
1621.             IF (xx - x1) > 2 THEN LINE (x1, y1)-(xx, y1), cp&(1)
1622.  
1623.             'x1 = 290: x2 = x1 + 50
1624.             'y1 = 508: y2 = y1 + 64
1625.             'LINE (x1, y1)-(x2, y2), _RGB32(222, 0, 0), B
1626.         END IF
1627.         WorB = SaveWorB
1628.         IF (Level MOD 2) = 1 THEN WorB = WorB XOR 1
1629.         TieTo(Level) = t
1630.         IF ABS(Score(0, t)) <> 777 THEN
1631.             _MEMCOPY m(0), m(0).OFFSET, m(0).SIZE TO m(Level), m(Level).OFFSET '         save board
1632.             m$ = Move$(Level - 1, t)
1633.             MoveIt m$, false
1634.             lm1 = Level - 1
1635.             CheckBoard Level
1636.             Recurse Level + 1
1637.             TakeBest Level, false
1638.             i = Index
1639.             Score = Score(Level, 1)
1640.             levm1 = Level - 1
1641.             IF Score(levm1, 1) <> 777 THEN Score(levm1, i) = Score(levm1, i) - Score
1642.             IF Level = (MasterLevel - 1) THEN
1643.                 KeyScan 0, 0 '                                                           no plotscreen or _display
1644.                 'IF (tlimit > 0) AND (emin >= tlimit) THEN abort = true
1645.                 IF abort THEN EXIT SUB
1646.                 LogThinking
1647.             END IF
1648.             _MEMCOPY m(Level), m(Level).OFFSET, m(Level).SIZE TO m(0), m(0).OFFSET '     restore board
1649.         END IF
1650.     NEXT t
1651. END SUB
1652.  
1653. SUB Reset_To_Zero
1654.     WorB = WorB XOR 1 '      reverse who's moving
1655.     CheckBoard 1 '           need to know what opponent can do to ensre legal castling
1656.     WorB = WorB XOR 1 '      restore playing color
1657.     CheckBoard 0 '           determine legal moves
1658. END SUB
1659.  
1660. FUNCTION Rjust$ (t, n)
1661.     Rjust$ = RIGHT$("   " + STR$(t), n)
1662. END FUNCTION
1663.  
1664. SUB SaveForTakeBack STATIC '                                         use MEM later to move arrays
1665.     FOR i = 10 TO 1 STEP -1
1666.         castle$(i) = castle$(i - 1)
1667.         FOR r = 1 TO 8
1668.             FOR c = 1 TO 8
1669.                 tb(c, r, i) = tb(c, r, i - 1)
1670.             NEXT c
1671.         NEXT r
1672.     NEXT i
1673.     castle$(0) = castle$
1674.     FOR r = 1 TO 8
1675.         FOR c = 1 TO 8
1676.             tb(c, r, 0) = b(c, r)
1677.         NEXT c
1678.     NEXT r
1679.     tbc = tbc + 1
1680.     IF tbc > 10 THEN tbc = 10
1681.  
1682. END SUB
1683.  
1684. SUB ScreenInit
1685.     xm = 480: ym = 600
1686.     MaxRow = ym \ 16 - 2
1687.     k = 99
1688.     SELECT CASE smode
1689.         CASE IS = 0
1690.             SCREEN _NEWIMAGE(xm, ym), 32
1691.             _SCREENMOVE _DESKTOPWIDTH \ 2 - xm \ 2, _DESKTOPHEIGHT \ 2 - ym \ 2
1692.         CASE IS = 1
1693.             _SCREENMOVE 780, 20
1694.         CASE IS = 2
1695.             SCREEN _NEWIMAGE(800, 600), 32
1696.             _SCREENMOVE 472, 20
1697.     END SELECT
1698.     _ALLOWFULLSCREEN _SQUAREPIXELS , _SMOOTH
1699. END SUB
1700.  
1701. SUB Setup
1702.     t1$ = "rnbkqp:black      clear:one     spacebar:flip"
1703.     t2$ = "RNBKQP:white      Clear:all          Esc:exit"
1704.  
1705.     LINE (0, 500)-(xm, ym), black&, BF
1706.     cc = 1: rr = 8
1707.     DO
1708.         Center -1, t1$, 0
1709.         Center 0, t2$, 0
1710.         _DISPLAY
1711.         DO: _LIMIT 20
1712.             PlotBoard
1713.             z = z XOR 1
1714.             IF z THEN Cursor 9 - rr, cc, 0
1715.             i$ = INKEY$: z = LEN(i$)
1716.         LOOP UNTIL z
1717.         SELECT CASE z
1718.             CASE IS = 1
1719.                 r2 = 9 - rr
1720.                 IF i$ = Esc$ THEN EXIT DO
1721.                 IF (i$ = CHR$(9)) OR (i$ = "c") THEN b(cc, r2) = 0 ' Del or "c" to delete piece
1722.                 IF i$ = "C" THEN '                                   delete all pieces
1723.                     FOR c = 1 TO 8: FOR r = 1 TO 8
1724.                             b(c, r) = 0
1725.                     NEXT: NEXT
1726.                 END IF
1727.                 p = INSTR("rnbqkpRNBQKP", i$)
1728.                 IF p THEN b(cc, r2) = p '                            set piece by letter
1729.                 IF INSTR(" t", i$) THEN '                            t or space toggle color
1730.                     mp = b(cc, r2)
1731.                     IF mp < 7 THEN mp = mp + 6 ELSE mp = mp - 6
1732.                     b(cc, r2) = mp
1733.                 END IF
1734.                 IF i$ = "x" THEN
1735.                     FOR c = 1 TO 8
1736.                         FOR r = 1 TO 8
1737.                             t = b(c, r)
1738.                             IF t THEN
1739.                                 IF t < 7 THEN t = t + 6 ELSE t = t - 6
1740.                                 s9(c, r) = t
1741.                             END IF
1742.                         NEXT r
1743.                     NEXT c
1744.                     FOR c = 1 TO 8
1745.                         FOR r = 1 TO 8
1746.                             b(c, 9 - r) = s9(c, r)
1747.                         NEXT r
1748.                     NEXT c
1749.                 END IF
1750.                 IF i$ = "z" THEN
1751.                     RESTORE test
1752.                     FOR r = 1 TO 8
1753.                         FOR c = 1 TO 8
1754.                             READ b(c, r)
1755.                     NEXT: NEXT
1756.                 END IF
1757.             CASE IS = 2
1758.                 kk = ASC(RIGHT$(i$, 1))
1759.                 cc = cc + (kk = 75) - (kk = 77) '                    left right
1760.                 rr = rr + (kk = 72) - (kk = 80) '                    up down
1761.                 IF rr < 1 THEN rr = 1
1762.                 IF rr > 8 THEN rr = 8
1763.                 IF cc < 1 THEN cc = 1
1764.                 IF cc > 8 THEN cc = 8
1765.         END SELECT
1766.     LOOP
1767.     LINE (0, 500)-(xm, ym), black&, BF
1768.     '                        board probably changed - reinitialize legal moves
1769.     Reset_To_Zero
1770. END SUB
1771.  
1772. SUB ShowBest
1773.     'bg1& = _RGB32(0, 90, 0)
1774.     'LINE (22, 504)-(350, ym - 22), bg1&, BF
1775.  
1776.     yy = 505
1777.     ty = yy
1778.     tx = 29
1779.     FOR t = 1 TO 20
1780.         IF t <= Moves(0) THEN
1781.             t$ = Make4$(Move$(0, t)) + Rjust$(Score(0, t), 5)
1782.             FOR i = 1 TO LEN(t$) '                                   shift "g" up 2 pixels
1783.                 c$ = MID$(t$, i, 1)
1784.                 y2 = ty + (c$ = "g") * 2
1785.                 _PRINTSTRING (tx + (i - 1) * 8, y2), c$
1786.             NEXT
1787.         END IF
1788.         ty = ty + 14
1789.         IF ty > 570 THEN ty = yy: tx = tx + 80
1790.     NEXT t
1791. END SUB
1792.  
1793. SUB ShowMe (dr, dc, t$)
1794.     EXIT SUB
1795.     sr = CSRLIN '                                                    save row
1796.     sc = POS(0) '                                                    save column
1797.     IF (dr > 0) AND (dr < MaxRow) AND (dc > 0) AND (dc < 76) THEN
1798.         LOCATE dr, dc '                                              display row & column
1799.         PRINT t$;
1800.     END IF
1801.     LOCATE sr, sc '                                                  restore to old location
1802. END SUB
1803.  
1804. SUB ShowTime (trow, z!, Desc$)
1805.     t! = z!
1806.     SELECT CASE t!
1807.         CASE IS > 3600
1808.             unit$ = "h"
1809.             t! = t! / 3600
1810.         CASE IS > 60
1811.             unit$ = "m"
1812.             t! = t! / 60
1813.         CASE ELSE
1814.             unit$ = "s"
1815.     END SELECT
1816.     x1 = 408
1817.     x2 = x1 - (LEN(Desc$) + 1) * 8
1818.     yy = trow / (600 / 16) * 600 - 4
1819.     t! = INT(t! * 1000) / 1000
1820.     t$ = LTRIM$(STR$(t!))
1821.     IF INSTR(t$, ".") = 0 THEN
1822.         IF t! < 1 THEN t$ = "." + t$ ELSE t$ = t$ + "."
1823.     END IF
1824.     zz = 0
1825.     WHILE INSTR(t$, ".") <> (LEN(t$) - 3)
1826.         t$ = t$ + "0"
1827.         zz = zz + 1
1828.         IF zz > 5 THEN GOTO dammit
1829.     WEND
1830.     dammit:
1831.  
1832.     IF LEFT$(t$, 1) = "." THEN t$ = "0" + t$
1833.     t$ = RIGHT$(SPACE$(10) + t$, 6)
1834.     _PRINTSTRING (x1, yy), t$ + unit$
1835.     _PRINTSTRING (x2, yy), Desc$
1836. END SUB
1837.  
1838. SUB ShowValid (cc, rr) '                                             show valid moves for piece at cursor
1839.  
1840.     IF (cc < 0) OR (rr < 0) OR (cc > 8) OR (rr > 8) THEN EXIT SUB
1841.     tc = cc: tr = rr
1842.     IF invert THEN tc = 9 - tc: tr = 9 - tr
1843.     mp = b(tc, tr): mp = mp + (mp > 6) * 6
1844.     z$ = alphal$(tc) + LTRIM$(STR$(9 - tr))
1845.     t$ = z$ + ":"
1846.     FOR i = 1 TO Moves(0)
1847.         IF z$ = LEFT$(Move$(0, i), 2) THEN t$ = t$ + " " + RIGHT$(Move$(0, i), 2)
1848.         IF (mp = King) AND (LEFT$(Move$(0, i), 1) = "O") THEN t$ = t$ + " " + Move$(0, i)
1849.     NEXT i
1850.     'IF (tc = epfc) AND (tr = epfc) THEN t$ = t$ + " ep"
1851.  
1852.     sw = _WIDTH \ 8 - 3
1853.     LOCATE 2, 4: PRINT SPACE$(sw);
1854.     LOCATE 2, 4: PRINT LEFT$(t$, sw);
1855.     IF LEN(t$) > sw THEN PRINT "..";
1856.  
1857. END SUB
1858.  
1859. SUB TakeBack '                                                       use MEM to move arrays? speed not an issue here
1860.     IF tbc < 2 THEN EXIT SUB
1861.     IF MakeNoise THEN PlaySound "tb" '                               so your mom knows you're cheating  :)
1862.     castle$ = castle$(2)
1863.     FOR r = 1 TO 8
1864.         FOR c = 1 TO 8
1865.             b(c, r) = tb(c, r, 2)
1866.         NEXT c
1867.     NEXT r
1868.     FOR i = 0 TO 9
1869.         castle$(i) = castle$(i + 1)
1870.         FOR r = 1 TO 8
1871.             FOR c = 1 TO 8
1872.                 tb(c, r, i) = tb(c, r, i + 1)
1873.             NEXT c
1874.         NEXT r
1875.     NEXT i
1876.     tbc = tbc - 1
1877.     Reset_To_Zero
1878. END SUB
1879.  
1880. SUB TakeBest (Level, final)
1881.  
1882.     IF final THEN '                                                  feeble attempt to vary response when scores equal
1883.         upto = 10
1884.         IF upto > Moves(Level) THEN upto = Moves(Level)
1885.         FOR scram = 0 TO 199
1886.             s1 = RND * updo + 1
1887.             s2 = RND * upto + 1
1888.             SWAP Score(Level, s1), Score(Level, s2)
1889.             SWAP Move$(Level, s1), Move$(Level, s2)
1890.             SWAP Index(Level, s1), Index(Level, s2)
1891.         NEXT scram
1892.     END IF
1893.  
1894.     passes = 0
1895.     ReSort:
1896.     Score = -999 '                                                   assume no moves
1897.     DO
1898.         Sorted = true
1899.         FOR s = 2 TO Moves(Level)
1900.             IF Score(Level, s - 1) < Score(Level, s) THEN
1901.                 Sorted = false
1902.                 SWAP Score(Level, s - 1), Score(Level, s)
1903.                 SWAP Move$(Level, s - 1), Move$(Level, s)
1904.                 SWAP Index(Level, s - 1), Index(Level, s)
1905.             END IF
1906.         NEXT s
1907.     LOOP UNTIL Sorted
1908.  
1909.     m$ = Move$(Level, 1)
1910.     Score = Score(Level, 1)
1911.     Index = Index(Level, 1)
1912.  
1913.     best$ = Move$(0, 1)
1914.     bscore = Score(0, 1)
1915.  
1916.     IF final AND (Level < 2) THEN
1917.         IF Score = -777 THEN '                                       in check, no escape
1918.             abort = 3: msg$ = "Checkmate!"
1919.         ELSEIF Score = -999 THEN '                                   no moves
1920.             abort = 3: msg$ = "Stalemate!"
1921.         END IF
1922.  
1923.         tm = Moves(1)
1924.         FOR lb = 1 TO 9 '                                            stop repeats
1925.             IF tm > 8 THEN
1926.                 IF INSTR(MoveLog$(tm - lb), m$) THEN
1927.                     'SOUND 888, 1
1928.                     Score(1, 1) = Score(1, 1) - 10
1929.                     passes = passes + 1
1930.                     IF passes < 5 THEN GOTO ReSort '                 repeat may be only move
1931.                 END IF
1932.             END IF
1933.         NEXT lb
1934.     END IF
1935.  
1936.     IF (Level = 1) AND (Score = 777) THEN Score(0, TieTo(1)) = -777
1937. END SUB
1938.  
1939. SUB TextInfo (zz$)
1940.     IF smode <> 2 THEN EXIT SUB
1941.  
1942.     t$ = "History Thinking Legal Protection"
1943.     LOCATE 3, 61
1944.     FOR i = 1 TO LEN(t$)
1945.         c$ = MID$(t$, i, 1)
1946.         IF c$ = UCASE$(c$) THEN COLOR cp&(1) ELSE COLOR white&
1947.         PRINT c$;
1948.     NEXT
1949.     COLOR fg0&, bg0&
1950.  
1951.     'LOCATE 1, 4: PRINT showthink; history; showlegalf; showprotf;
1952.  
1953.     z = 0
1954.     IF showthink THEN z = 1
1955.     IF history THEN z = 2
1956.     IF showlegalf THEN z = 3
1957.     IF showprotf THEN z = 4
1958.     IF z = 0 THEN EXIT SUB
1959.  
1960.     IF DebugR > MaxRow THEN
1961.         _DISPLAY
1962.         DebugR = 3: DebugC = 61
1963.         FOR r = DebugR TO MaxRow
1964.             LOCATE r, DebugC
1965.             PRINT SPACE$(100 - DebugC);
1966.         NEXT r
1967.     END IF
1968.  
1969.     SELECT CASE z '                                                  thinking
1970.         CASE IS = 1
1971.             DebugR = DebugR + 1
1972.             LOCATE DebugR, DebugC
1973.             PRINT zz$;
1974.             IF DebugR = MaxRow THEN DebugR = 99
1975.         CASE IS = 2 '                                                move log
1976.             BeginAt = Move - 28
1977.             IF BeginAt < 1 THEN BeginAt = 1
1978.             tr = 4
1979.             FOR i = BeginAt TO Move
1980.                 LOCATE tr, DebugC
1981.                 PRINT MoveLog$(i);
1982.                 tr = tr + 1
1983.                 IF tr > MaxRow THEN EXIT FOR
1984.             NEXT i
1985.         CASE IS = 3 '                                                legal
1986.             FOR i = 1 TO Moves(0)
1987.                 tr = i + 3
1988.                 IF tr > MaxRow THEN EXIT FOR
1989.                 LOCATE tr, 63
1990.                 PRINT USING "## "; i;
1991.                 PRINT Move$(0, i);
1992.             NEXT i
1993.             FOR i = 1 TO Moves(1)
1994.                 tr = i + 3
1995.                 IF tr > MaxRow THEN EXIT FOR
1996.                 LOCATE tr, 73
1997.                 PRINT USING "## "; i;
1998.                 PRINT Move$(1, i);
1999.             NEXT i
2000.         CASE IS = 4 '                                                protected
2001.             FOR i = 1 TO prot(0)
2002.                 tr = i + 3
2003.                 IF tr > MaxRow THEN EXIT FOR
2004.                 LOCATE tr, 63
2005.                 PRINT USING "## "; i;
2006.                 PRINT prot$(0, i);
2007.             NEXT i
2008.             FOR i = 1 TO prot(1)
2009.                 tr = i + 3
2010.                 IF tr > MaxRow THEN EXIT FOR
2011.                 LOCATE tr, 73
2012.                 PRINT USING "## "; i;
2013.                 PRINT prot$(1, i);
2014.             NEXT i
2015.     END SELECT
2016. END SUB
2017.  
2018. SUB TryMove (Level, fc, fr, mp, mc) '                                from row, from column
2019.     IF mc = 1 THEN s = -1 ELSE s = 1 '                               direction a pawn moves
2020.     incheck = (mc = SaveWorB) AND check
2021.  
2022.     '                  rnbqkp
2023.     nmoves = VAL(MID$("373772", mp, 1))
2024.  
2025.     FOR n = 0 TO nmoves '                                            possible 8 dirs
2026.         du = du(mp, n): dd = dd(mp, n): dl = dl(mp, n): dr = dr(mp, n)
2027.         IF mp <> Knight THEN du = SGN(du) * s: dd = SGN(dd) * s: dl = SGN(dl) * s: dr = SGN(dr) * s
2028.         IF du(mp, 0) = 7 THEN TrySq = 7 ELSE TrySq = 1
2029.         IF (mp = Pawn) AND (n = 0) THEN '                            pawn first move?
2030.             IF (fr = 2) AND (WorB = 1) THEN TrySq = 2 '              gambit for white
2031.             IF (fr = 7) AND (WorB = 0) THEN TrySq = 2 '              gambit for black
2032.         END IF
2033.         tc = fc: tr = fr '                                           row, column
2034.         fs$ = alphal$(fc) + CHR$(48 + fr) '                          from square
2035.         cap = false
2036.         FOR sq = 1 TO TrySq '                                        up to 7 steps in current direction
2037.             Score = 0 '                                              must init
2038.             tc = tc - dl + dr '                                      column=column-left+right
2039.             tr = tr - du + dd '                                      row=row-up+down
2040.             IF (tr < 1) OR (tr > 8) OR (tc < 1) OR (tc > 8) THEN EXIT FOR
2041.             ts$ = alphal$(tc) + CHR$(48 + tr) '                      to square
2042.             IF fs$ = ts$ THEN SYSTEM
2043.             cp = b(tc, tr) '                                         capture piece
2044.             cc = -(cp > 6) - (cp = 0) * 2 '                          capture color
2045.             cp = cp + (cp > 6) * 6
2046.             IF mc = cc THEN '                                        own piece
2047.                 prot(Level) = prot(Level) + 1
2048.                 IF prot(Level) < q1 THEN prot$(Level, prot(Level)) = fs$ + ts$
2049.                 IF (mp = Pawn) AND (n = 0) THEN EXIT FOR
2050.                 IF mp = Knight THEN GOTO nsquare ELSE EXIT FOR
2051.             ELSEIF (mc XOR 1) = cc THEN '                            capture
2052.                 IF (mp = Pawn) AND (n = 0) THEN EXIT FOR '           no diag, no cap!
2053.                 cap = true
2054.                 Score = Score + value(cp) * 10
2055.                 IF value(cp) = 0 THEN Score = 777 '                  king capture
2056.             ELSE
2057.                 IF (mp = Pawn) AND (n > 0) THEN EXIT FOR
2058.             END IF
2059.  
2060.             IF mp = King THEN
2061.                 IF Level = 0 THEN lm = 1 ELSE lm = 0 '               wonka
2062.                 'FOR i = 1 TO Moves(lm) '                            can any opponent piece move there?
2063.                 '    s$ = RIGHT$(Move$(lm, i), 2)
2064.                 'IF ts$ = s$ THEN GOTO nsquare '                     would be moving into check
2065.                 'NEXT
2066.                 FOR i = 1 TO prot(lm) '                              opponent piece protecting?
2067.                     s$ = RIGHT$(prot$(lm, i), 2)
2068.                     IF ts$ = s$ THEN GOTO nsquare '                  would be moving into check
2069.                 NEXT
2070.                 IF incheck THEN
2071.                     Score = Score + 20
2072.                 ELSE
2073.                     IF Move < 30 THEN Score = Score - 4 '            usually not good to be moving the King
2074.                 END IF
2075.             ELSE
2076.                 dis1 = ABS(fr - okr) + ABS(fc - okc) '               get closer to king
2077.                 dis2 = ABS(tr - okr) + ABS(tc - okc)
2078.                 Score = Score + dis1 - dis2
2079.                 IF Move < 20 THEN
2080.                     dir = SGN((fr - tr) * s)
2081.                     IF dir = 1 THEN Score = Score + 2 '              move ahead at begin & mid game
2082.                 END IF
2083.  
2084.                 ' priority to getting a piece off the bottom rank
2085.                 IF (fr = 1) AND (tr > 1) AND (WorB = 1) THEN Score = Score + 1
2086.                 IF (fr = 8) AND (tf < 8) AND (WorB = 0) THEN Score = Score + 1
2087.                 IF mp <> Rook THEN '                                 priority to getting a piece first moved
2088.                     IF b(fc, fr) = o(fc, fr) THEN Score = Score + 1
2089.                 END IF
2090.             END IF
2091.             's1 = Score
2092.  
2093.             'IF (Score <> 777) AND (NOT (incheck)) THEN
2094.  
2095.             IF mp = Pawn THEN
2096.                 Score = Score + TrySq
2097.                 IF (tr = 1) OR (tr = 8) THEN '                       promote pawn
2098.                     Score = Score + 99
2099.                 END IF
2100.             END IF
2101.             'END IF
2102.             'IF s1 = 777 THEN Score = s1
2103.  
2104.             AddIt Level, fs$ + ts$, Score
2105.  
2106.             IF cap AND (mp = Pawn) AND (n = 0) THEN EXIT FOR
2107.             IF cap AND (mp <> Knight) THEN EXIT FOR
2108.             nsquare:
2109.         NEXT sq
2110.     NEXT n
2111.  
2112.     IF mp = Pawn THEN '                                              en passant
2113.         IF WorB THEN othp = 6 ELSE othp = 12 '                       opponent pawn
2114.         l1 = 7 + (WorB = 0) * 5 '                                    rank 7 for white, 2 for black
2115.         l2 = 5 - (WorB = 0) '                                        rank 5 for white, 6 for black
2116.     END IF
2117.     IF (mp = Pawn) AND (fr = l2) AND (Level < 2) THEN
2118.         FOR z = -1 TO 1 STEP 2 '                                     look each side
2119.             lc = fc + z '                                            look column
2120.             IF (lc > 0) AND (lc < 9) THEN '                          in bounds of board
2121.                 IF b(lc, fr) = othp THEN '                           it is a pawn
2122.                     tc$ = alphal$(lc)
2123.                     tm$ = tc$ + CHR$(48 + l1) + tc$ + CHR$(48 + l2) '  form coordinate
2124.                     IF tm$ = lm$ THEN '                              yes, add e.p. to list of legal moves
2125.                         epfc = fc: epfr = fr '                       en passant from row, column
2126.                         eptc = lc: eptr = fr - s '                   en passant to row, column
2127.                         eprc = lc: eprr = fr '                       en passant remove piece
2128.                         ep$ = alphal$(epfc) + CHR$(48 + epfr) + alphal$(eptc) + CHR$(48 + eptr)
2129.                         AddIt Level, ep$, 1 '                        add with score of 1
2130.                     END IF
2131.                 END IF
2132.             END IF
2133.         NEXT z
2134.     END IF
2135.  
2136. END SUB
2137.  
2138. SUB TempMess (t$, secs) STATIC
2139.     'EXIT SUB
2140.     zz = 100: x1 = xc - zz: x2 = xc + zz
2141.     IF (LEN(t$) > 0) AND (t$ <> current$) THEN
2142.         x = xc - LEN(t$) * 4
2143.         y = 12
2144.         LINE (x1, 0)-(x2, 28), black&, BF
2145.         _PRINTSTRING (x, y), t$
2146.         _DISPLAY
2147.         current$ = t$
2148.         mtime! = TIMER + secs: IF mtime! > maxtime& THEN mtime! = 0
2149.     END IF
2150.     IF (mtime! > 0) AND (TIMER > mtime!) THEN
2151.         LINE (x1, 0)-(x2, 28), black&, BF
2152.         _DISPLAY
2153.         mtime! = 0
2154.     END IF
2155. END SUB
2156.  
2157.  

[TempodiBasic]

Hi Richard
thanks for fast reply

I must say that after putting all files in the same folder of chess.bas it runs ok!

here 2 little feedback if you like to get feedback otherwise don't read my following thoughts:

1 I find it very improved except for opening game, not it sees checkmate and it is able to castle, now there is mouse support except for menu. Just some trouble with Alfred, he's fun, but he sometimes doesn't let make the move.

 

2  if I minimize to windows bar, when I recall the window it doesn't draw itself see screenshot

 

3  Sorry I'm not able to count, if I press Spacebar I get the messagebox with New Game and Quit option... but if I make a mistake pressing spacebar I cannot go back to the game.

Thanks to share and to improve

[Richard Frost]

It's easy to get out of synch when using the arrow keys as to the "from" and "to".
Just press Enter again on the piece, then the cursor will say "To?".  When using
the mouse there's no indication of from/to - debating if that's good or not.  Some
might like it - less distraction from the position. 

There's no book lookup for opening moves.  That I'll have to add, eventually.
Plays a pretty good game considering how minimal the scoring is in SUB TryMove.
There are still bugs - esp. that it allows you to be checked and ignore it!
When that happens I go into Setup mode, put pieces where they should be,
and resume play.  For now.  Until the bugs are fixed.

Pressing the spacebar is meant to abort further thinking by the computer.  If pressed
during your turn, indeed, the New Game or Quit menu shows.  Pressing "r" there will
return to the game.  That's a bug - will add "r" to that menu.  Maybe it should be "c"
for Continue so it doesn't get mixed up with "r" for resign. 

Probably not a good idea to run this thing against itself unattended - uses too much CPU.

This is the ultimate project for me, something I've always wanted that I can work on for
the rest of my life.  QB4.5 didn't have the oomph for it.  QB64 sure does!

It's fun to play with the colors!  A shortcut for changing the primary color is "1".   :)  And
the graphics can be given a kick to re-initialize with "G" (not "g" which changes the mode).

[Adrian]

Hi bplus snd Tempodibasic,

Wow.... it’s been a long while since i checked the forums here. Thanks fir the memories of trying to work on a chess program 😄

Cheers,
Adrian

[bplus]

@Adrian   OMG! How are you? Have you worked any more on Chess?

Richard Frost has a pretty nice one going, been working on it for awhile now.

Welcome!

[STxAxTIC]

Dude this topic was so old, I was like "man who made most of a chess engine"... Scrolled to the first post and was VERY disappointed.

[bplus]

Dude this topic was so old, I was like "man who made most of a chess engine"... Scrolled to the first post and was VERY disappointed.

LOL! I look at some of my old posts and wonder too!

@Adrian
Richard Frost is regularly updating his Chess Program here: https://www.qb64.org/forum/index.php?topic=2437.msg116514#msg116514

but the last "stable" version is in Games Board, last I heard there is a bug in current version at least a week ago.

[TempodiBasic]

Hi Adrian
welcome back !
Have you worked on something else than chess in this time?

[Adrian]

Hi bplus and TempodiBasic,

Ive taken a long hiatus from basic programming and chess programming, so nothing done since we last chatted here.

@bplus Richard’s program looks great, good to see others posting their chess programs like Romnichess. I’ve also seen other didactic chess programs on the www ported to QB64 like Huo Chess.

Going forward, maybe its time for me to revisit chess programming again, for fun. Have some ideas to try out.