Author Topic: A 90% complete chess engine  (Read 11010 times)

0 Members and 1 Guest are viewing this topic.

Offline Richard Frost

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

* alfred.JPG (Filesize: 1.82 KB, Dimensions: 53x54, Views: 417)
« Last Edit: February 26, 2020, 10:23:24 pm by Richard Frost »
It works better if you plug it in.

Offline TempodiBasic

  • Forum Resident
  • Posts: 1792
    • View Profile
Re: A 90% complete chess engine
« Reply #31 on: March 01, 2020, 10:17:34 am »
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.
« Last Edit: March 01, 2020, 10:19:04 am by TempodiBasic »
Programming isn't difficult, only it's  consuming time and coffee

Offline TempodiBasic

  • Forum Resident
  • Posts: 1792
    • View Profile
Re: A 90% complete chess engine
« Reply #32 on: March 01, 2020, 10:43:40 am »
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 !
Programming isn't difficult, only it's  consuming time and coffee

Offline Richard Frost

  • Seasoned Forum Regular
  • Posts: 316
  • Needle nardle noo. - Peter Sellers
    • View Profile
Re: A 90% complete chess engine
« Reply #33 on: March 01, 2020, 11:11:44 am »
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.
It works better if you plug it in.

Marked as best answer by STxAxTIC on March 01, 2020, 06:57:18 am

Offline Richard Frost

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

Offline TempodiBasic

  • Forum Resident
  • Posts: 1792
    • View Profile
Re: A 90% complete chess engine
« Reply #35 on: March 01, 2020, 12:46:39 pm »
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.

 
ChessWhite.jpg


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

 
ChessNoDrawWindow.jpg


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


Programming isn't difficult, only it's  consuming time and coffee

Offline Richard Frost

  • Seasoned Forum Regular
  • Posts: 316
  • Needle nardle noo. - Peter Sellers
    • View Profile
Re: A 90% complete chess engine
« Reply #36 on: March 01, 2020, 01:12:27 pm »
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).
« Last Edit: March 01, 2020, 01:14:49 pm by Richard Frost »
It works better if you plug it in.

Offline Adrian

  • Newbie
  • Posts: 39
    • View Profile
Re: A 90% complete chess engine
« Reply #37 on: December 18, 2020, 10:49:37 am »
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

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: A 90% complete chess engine
« Reply #38 on: December 18, 2020, 11:30:35 am »
@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!
« Last Edit: December 18, 2020, 11:31:38 am by bplus »

Offline STxAxTIC

  • Library Staff
  • Forum Resident
  • Posts: 1091
  • he lives
    • View Profile
Re: A 90% complete chess engine
« Reply #39 on: December 18, 2020, 11:45:58 am »
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.
You're not done when it works, you're done when it's right.

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: A 90% complete chess engine
« Reply #40 on: December 18, 2020, 11:58:23 am »
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.

Offline TempodiBasic

  • Forum Resident
  • Posts: 1792
    • View Profile
Re: A 90% complete chess engine
« Reply #41 on: December 18, 2020, 09:33:11 pm »
Hi Adrian
welcome back !
Have you worked on something else than chess in this time?
Programming isn't difficult, only it's  consuming time and coffee

Offline Adrian

  • Newbie
  • Posts: 39
    • View Profile
Re: A 90% complete chess engine
« Reply #42 on: December 18, 2020, 10:56:33 pm »
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.