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

0 Members and 1 Guest are viewing this topic.

This topic contains a post which is marked as Best Answer. Press here if you would like to see it.

Offline STxAxTIC

  • Library Staff
  • Forum Resident
  • Posts: 1091
  • he lives
    • View Profile
A 90% complete chess engine
« on: January 24, 2020, 06:52:46 pm »
Sup all

So back in like 2014 I got the idea to make a chess engine. The whole dream lasted a day, 90% of which I spent discovering how the chess algorithm should work. End result is a working engine that plays (the same) game against itself. This is fully deterministic - no randomness. It's got all the pieces, most of the rules, all of the mechanics, except a few things:

* This ignores castling.
* This ignores check and checkmate.
* This ignores pawn promotion.

Because of the second incompleteness, the king dies early, but no big deal. The rest is completely there. It thinks 2 or 3 moves ahead at the moment. You can see what code to un-comment to generalize this and add more fake thinking.

I think some folks might need to be reminded of the so-called chess algorithm. Computers are stupid, they have no intuition, and certainly can't play chess like a person. What the computer does, with this program being an example, is to try *every* possible move available to *every* movable piece, with each result ending in a "score" that determines if the move is any good. The score is calculated from the pieces still left after a move. So the computer needs to do this immense tallying job in order to make the decision on which piece to move... for every single move.

Anyway, consider this yet another angle to the chess tutorial. My style was still flourishing in 2014 so forgive the code... It took me all night one night.

Code: QB64: [Select]
  1. '#lang "qb"
  2.  
  3. DIM SHARED BoardState(8, 8, 10) AS STRING
  4. DIM SHARED MoveListArray(99999, 10) AS STRING
  5. DIM SHARED MoveListArraySize(10)
  6.  
  7. DECLARE FUNCTION CalculateScore (TheColorIn$, GameLayerParIn)
  8. DECLARE SUB DoAMove (TheMoveIn$, GameLayerPar1In, GameLayerPar2In)
  9. DECLARE FUNCTION FindCoordinates$ (ThePieceIn$, GameLayerParIn)
  10. DECLARE SUB GenerateMoveList (TheColorIn$, GameLayerParIn, MoveListLayerIn)
  11. DECLARE SUB ListPieceMoves (ThePieceIn$, GameLayerParIn)
  12. DECLARE SUB PrintGame (GameLayerParIn)
  13. DECLARE SUB GetRowColMovesFull (PieceNameIn$, GameLayerParIn)
  14. DECLARE SUB GetDiagMovesFull (PieceNameIn$, GameLayerParIn)
  15. DECLARE SUB GetRowColMovesSingle (PieceNameIn$, GameLayerParIn)
  16. DECLARE SUB GetDiagMovesSingle (PieceNameIn$, GameLayerParIn)
  17. DECLARE SUB GetKnightMoves (PieceNameIn$, GameLayerParIn)
  18.  
  19.  
  20. ' Initialize chess board.
  21. FOR x = 1 TO 8
  22.     FOR y = 1 TO 8 STEP 1
  23.         BoardState(x, y, 0) = "0"
  24.     NEXT
  25.  
  26. ' Place pieces in their starting positions
  27. BoardState(1, 2, 0) = "WP1" ' White Pawn
  28. BoardState(2, 2, 0) = "WP2" ' White Pawn
  29. BoardState(3, 2, 0) = "WP3" ' White Pawn
  30. BoardState(4, 2, 0) = "WP4" ' White Pawn
  31. BoardState(5, 2, 0) = "WP5" ' White Pawn
  32. BoardState(6, 2, 0) = "WP6" ' White Pawn
  33. BoardState(7, 2, 0) = "WP7" ' White Pawn
  34. BoardState(8, 2, 0) = "WP8" ' White Pawn
  35. BoardState(1, 1, 0) = "WQR" ' White Queen Rook
  36. BoardState(2, 1, 0) = "WQN" ' White Queen Knight
  37. BoardState(3, 1, 0) = "WQB" ' White Queen Bishop
  38. BoardState(4, 1, 0) = "WQQ" ' White Queen
  39. BoardState(5, 1, 0) = "WKK" ' White King
  40. BoardState(6, 1, 0) = "WKB" ' White King Bishop
  41. BoardState(7, 1, 0) = "WKN" ' White King Knight
  42. BoardState(8, 1, 0) = "WKR" ' White King Rook
  43.  
  44. BoardState(1, 7, 0) = "BP1" ' Black Pawn
  45. BoardState(2, 7, 0) = "BP2" ' Black Pawn
  46. BoardState(3, 7, 0) = "BP3" ' Black Pawn
  47. BoardState(4, 7, 0) = "BP4" ' Black Pawn
  48. BoardState(5, 7, 0) = "BP5" ' Black Pawn
  49. BoardState(6, 7, 0) = "BP6" ' Black Pawn
  50. BoardState(7, 7, 0) = "BP7" ' Black Pawn
  51. BoardState(8, 7, 0) = "BP8" ' Black Pawn
  52. BoardState(1, 8, 0) = "BQR" ' Black Queen Rook
  53. BoardState(2, 8, 0) = "BQN" ' Black Queen Knight
  54. BoardState(3, 8, 0) = "BQB" ' Black Queen Bishop
  55. BoardState(4, 8, 0) = "BQQ" ' Black Queen
  56. BoardState(5, 8, 0) = "BKK" ' Black King
  57. BoardState(6, 8, 0) = "BKB" ' Black King Bishop
  58. BoardState(7, 8, 0) = "BKN" ' Black King Knight
  59. BoardState(8, 8, 0) = "BKR" ' Black King Rook
  60.  
  61. ' Show the board and wait for key.
  62. CALL PrintGame(0)
  63. LOCATE 20, 20: PRINT "Press any key to begin..."
  64. LOCATE 20, 20: PRINT "                         "
  65.  
  66. CurrentPlayer$ = "B": CurrentOpponent$ = "W"
  67.  
  68. TotalGameCalculations = 0
  69.  
  70.     IF CurrentPlayer$ = "W" THEN
  71.         CurrentPlayer$ = "B"
  72.         CurrentOpponent$ = "W"
  73.     ELSE
  74.         CurrentPlayer$ = "W"
  75.         CurrentOpponent$ = "B"
  76.     END IF
  77.  
  78.     BestCandidateMoveIndex = -1
  79.     BestScoreDifference = -999
  80.     OriginalScoreDifference = CalculateScore(CurrentPlayer$, 0) - CalculateScore(CurrentOpponent$, 3)
  81.  
  82.     CALL GenerateMoveList(CurrentPlayer$, 0, 0) '                    Using game 0 generate a move list called 0.
  83.     FOR i = 1 TO MoveListArraySize(0)
  84.         CALL DoAMove(MoveListArray(i, 0), 0, 1) '                    Do the ith move using list 0 taking game 0 to game 1.
  85.         CALL GenerateMoveList(CurrentOpponent$, 1, 1) '              Use game 1 to generate list 1.
  86.         FOR j = 1 TO MoveListArraySize(1)
  87.             CALL DoAMove(MoveListArray(j, 1), 1, 2) '                Do the jth move using list 1 taking game 1 to game 2.
  88.             CALL GenerateMoveList(CurrentPlayer$, 2, 2) '            Use game 2 to generate list 2.
  89.             FOR k = 1 TO MoveListArraySize(2)
  90.                 CALL DoAMove(MoveListArray(k, 2), 2, 3) '            Do the kth move using list 2 taking game 2 to game 3.
  91.              
  92.                 'CALL GenerateMoveList(CurrentOpponent$, 3, 3) '     Use game 3 to generate list 3.
  93.                 'FOR m = 1 TO MoveListArraySize(3)
  94.                 'CALL DoAMove(MoveListArray(m, 3), 3, 4) '           Do the kth move using list 3 taking game 3 to game 4.
  95.  
  96.                 ' This is a very simplistic "toy model" for computing the score for a given board state.
  97.                 ' This is meant to be improved upon and is really the heart of the engine.
  98.                 WScore = CalculateScore(CurrentPlayer$, 3)
  99.                 BScore = CalculateScore(CurrentOpponent$, 3)
  100.                 ScoreDiff = WScore - BScore
  101.                 IF ScoreDiff > BestScoreDifference THEN
  102.                     BestScoreDifference = ScoreDiff
  103.                     BestCandidateMoveIndex = i
  104.                 END IF
  105.                 TotalGameCalculations = TotalGameCalculations + 1
  106.                 LOCATE 20, 20: PRINT "Mini-games tried: "; TotalGameCalculations
  107.  
  108.                 'NEXT
  109.  
  110.             NEXT
  111.         NEXT
  112.     NEXT
  113.  
  114.     IF BestScoreDifference = -999 THEN EXIT DO
  115.  
  116.     CALL DoAMove(MoveListArray(BestCandidateMoveIndex, 0), 0, 9)
  117.  
  118.     FOR x = 1 TO 8
  119.         FOR y = 1 TO 8
  120.             BoardState(x, y, 0) = BoardState(x, y, 9)
  121.         NEXT
  122.     NEXT
  123.  
  124.     CALL PrintGame(0)
  125.  
  126.  
  127. ' '''''''''' '''''''''' '''''''''' '''''''''' ''''''''''
  128.  
  129. FUNCTION CalculateScore (TheColorIn AS STRING, GameLayerParIn)
  130.     DIM TCI AS STRING
  131.     TCI = TheColorIn
  132.     GameLayerParameter = GameLayerParIn
  133.     TheScore = 0
  134.     FOR x = 1 TO 8
  135.         FOR y = 1 TO 8
  136.             c$ = BoardState(x, y, GameLayerParameter)
  137.             IF c$ <> "0" AND LEFT$(c$, 1) = TCI THEN
  138.                 SELECT CASE MID$(c$, 3, 1)
  139.                     CASE "K"
  140.                         TheScore = TheScore + 1000
  141.                     CASE "Q"
  142.                         TheScore = TheScore + 80
  143.                     CASE "B"
  144.                         TheScore = TheScore + 30
  145.                     CASE "N"
  146.                         TheScore = TheScore + 30
  147.                     CASE "R"
  148.                         TheScore = TheScore + 50
  149.                     CASE ELSE
  150.                         TheScore = TheScore + 10
  151.                 END SELECT
  152.             END IF
  153.         NEXT
  154.     NEXT
  155.     CalculateScore = TheScore
  156.  
  157. ' '''''''''' '''''''''' '''''''''' '''''''''' ''''''''''
  158.  
  159. SUB DoAMove (TheMoveIn AS STRING, GameLayerPar1In, GameLayerPar2In)
  160.     DIM TheMove AS STRING
  161.     TheMove = TheMoveIn
  162.     GameLayerParameter1 = GameLayerPar1In
  163.     GameLayerParameter2 = GameLayerPar2In
  164.     ThePiece$ = LEFT$(TheMove, 3)
  165.     OldLocation$ = FindCoordinates$(ThePiece$, GameLayerParameter1)
  166.     OldXLoc = VAL(LEFT$(OldLocation$, 1))
  167.     OldYLoc = VAL(RIGHT$(OldLocation$, 1))
  168.     NewLocation$ = RIGHT$(TheMove, 2)
  169.     NewXLoc = VAL(LEFT$(NewLocation$, 1))
  170.     NewYLoc = VAL(RIGHT$(NewLocation$, 1))
  171.     FOR x = 1 TO 8
  172.         FOR y = 1 TO 8
  173.             BoardState(x, y, GameLayerParameter2) = BoardState(x, y, GameLayerParameter1)
  174.         NEXT
  175.     NEXT
  176.     BoardState(OldXLoc, OldYLoc, GameLayerParameter2) = "0"
  177.     BoardState(NewXLoc, NewYLoc, GameLayerParameter2) = ThePiece$
  178.  
  179. ' '''''''''' '''''''''' '''''''''' '''''''''' ''''''''''
  180.  
  181. FUNCTION FindCoordinates$ (ThePieceIn AS STRING, GameLayerParIn)
  182.     DIM ThePiece AS STRING
  183.     ThePiece = ThePieceIn
  184.     GameLayerParameter = GameLayerParIn
  185.     Temp$ = "-1"
  186.     FOR x = 1 TO 8
  187.         FOR y = 8 TO 1 STEP -1
  188.             IF BoardState(x, y, GameLayerParameter) = ThePiece THEN
  189.                 Temp$ = LTRIM$(STR$(x)) + LTRIM$(STR$(y))
  190.                 EXIT FOR
  191.             END IF
  192.         NEXT
  193.     NEXT
  194.     FindCoordinates$ = Temp$
  195.  
  196. ' '''''''''' '''''''''' '''''''''' '''''''''' ''''''''''
  197.  
  198. SUB GenerateMoveList (TheColorIn AS STRING, GameLayerParIn, MoveListLayerIn)
  199.     ' Creates a string and then an array from the string.
  200.     DIM TCI AS STRING
  201.     TCI = TheColorIn
  202.     GameLayerParameter = GameLayerParIn
  203.     MoveListLayer = MoveListLayerIn
  204.     'Temp$ = ""
  205.     'MoveCountIndex = 0
  206.     MoveListArraySize(MoveListLayer) = 0
  207.     FOR x = 1 TO 8
  208.         FOR y = 1 TO 8
  209.             c$ = BoardState(x, y, GameLayerParameter)
  210.             IF LEFT$(c$, 1) = TCI THEN
  211.                 CALL ListPieceMoves(c$, GameLayerParameter, MoveListLayer)
  212.             END IF
  213.         NEXT
  214.     NEXT
  215.  
  216. ' '''''''''' '''''''''' '''''''''' '''''''''' ''''''''''
  217.  
  218. SUB ListPieceMoves (ThePieceIn AS STRING, GameLayerParIn, MoveListLayerIn)
  219.     DIM ThePiece AS STRING
  220.     ThePiece = ThePieceIn
  221.     GameLayerParameter = GameLayerParIn
  222.     MoveListLayer = MoveListLayerIn
  223.  
  224.     ' Isolate last character.
  225.     TheLastChar$ = RIGHT$(ThePiece, 1)
  226.  
  227.     Temp$ = ""
  228.     SELECT CASE TheLastChar$
  229.         CASE "K" ' King
  230.             CALL GetDiagMovesSingle(ThePiece, GameLayerParameter, MoveListLayer)
  231.             CALL GetRowColMovesSingle(ThePiece, GameLayerParameter, MoveListLayer)
  232.         CASE "Q" ' Queen
  233.             CALL GetDiagMovesFull(ThePiece, GameLayerParameter, MoveListLayer)
  234.             CALL GetRowColMovesFull(ThePiece, GameLayerParameter, MoveListLayer)
  235.         CASE "R" ' Rook
  236.             CALL GetRowColMovesFull(ThePiece, GameLayerParameter, MoveListLayer)
  237.         CASE "N" ' Knight
  238.             CALL GetKnightMoves(ThePiece, GameLayerParameter, MoveListLayer)
  239.         CASE "B" ' Bishop
  240.             CALL GetDiagMovesFull(ThePiece, GameLayerParameter, MoveListLayer)
  241.         CASE ELSE ' It's a pawn. They are not ambi-directional so be careful.
  242.  
  243.             PlayerColor$ = LEFT$(ThePiece, 1)
  244.             SELECT CASE PlayerColor$
  245.                 CASE "W"
  246.                     OpponentColor$ = "B"
  247.                     PawnMoveDirection = 1
  248.                 CASE "B"
  249.                     OpponentColor$ = "W"
  250.                     PawnMoveDirection = -1
  251.             END SELECT
  252.  
  253.             CoordTemp$ = FindCoordinates$(ThePiece, GameLayerParameter)
  254.             XOrig = VAL(LEFT$(CoordTemp$, 1))
  255.             YOrig = VAL(RIGHT$(CoordTemp$, 1))
  256.  
  257.             Temp$ = ""
  258.  
  259.             ' Three standard pawn moves.
  260.             X = XOrig: Y = YOrig: X = X: Y = Y + PawnMoveDirection
  261.             IF X >= 1 AND X <= 8 AND Y >= 1 AND Y <= 8 THEN
  262.                 IF BoardState(X, Y, GameLayerParameter) = "0" THEN
  263.                     MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
  264.                     MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = ThePiece + LTRIM$(STR$(X)) + LTRIM$(STR$(Y))
  265.                 END IF
  266.             END IF
  267.  
  268.             X = XOrig: Y = YOrig: X = X + 1: Y = Y + PawnMoveDirection
  269.             IF X >= 1 AND X <= 8 AND Y >= 1 AND Y <= 8 THEN
  270.                 IF LEFT$(BoardState(X, Y, GameLayerParameter), 1) = OpponentColor$ THEN
  271.                     MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
  272.                     MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = ThePiece + LTRIM$(STR$(X)) + LTRIM$(STR$(Y))
  273.                 END IF
  274.             END IF
  275.  
  276.             X = XOrig: Y = YOrig: X = X - 1: Y = Y + PawnMoveDirection
  277.             IF X >= 1 AND X <= 8 AND Y >= 1 AND Y <= 8 THEN
  278.                 IF LEFT$(BoardState(X, Y, GameLayerParameter), 1) = OpponentColor$ THEN
  279.                     MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
  280.                     MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = ThePiece + LTRIM$(STR$(X)) + LTRIM$(STR$(Y))
  281.                 END IF
  282.             END IF
  283.  
  284.             ' Special case of first pawn move.
  285.             X = XOrig: Y = YOrig:
  286.             SELECT CASE PlayerColor$
  287.                 CASE "W"
  288.                     IF Y = 2 THEN
  289.                         X = XOrig: Y = YOrig: X = X: Y = Y + 2 * PawnMoveDirection
  290.                         IF BoardState(X, Y, GameLayerParameter) = "0" THEN
  291.                             MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
  292.                             MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = ThePiece + LTRIM$(STR$(X)) + LTRIM$(STR$(Y))
  293.                         END IF
  294.                     END IF
  295.                 CASE "B"
  296.                     IF Y = 7 THEN
  297.                         X = XOrig: Y = YOrig: X = X: Y = Y + 2 * PawnMoveDirection
  298.                         IF BoardState(X, Y, GameLayerParameter) = "0" THEN
  299.                             MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
  300.                             MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = ThePiece + LTRIM$(STR$(X)) + LTRIM$(STR$(Y))
  301.                         END IF
  302.                     END IF
  303.             END SELECT
  304.  
  305.     END SELECT
  306.  
  307. ' '''''''''' '''''''''' '''''''''' '''''''''' ''''''''''
  308.  
  309. SUB PrintGame (GameLayerParIn)
  310.     GameLayerParameter = GameLayerParIn
  311.     FOR x = 1 TO 8
  312.         FOR y = 1 TO 8
  313.             c$ = BoardState(x, 8 - y + 1, GameLayerParameter)
  314.             SELECT CASE c$
  315.                 CASE "0"
  316.                     LOCATE y * 2, x * 5: PRINT "0  "
  317.                 CASE ELSE
  318.                     LOCATE y * 2, x * 5: PRINT c$
  319.             END SELECT
  320.  
  321.             LOCATE y * 2, x * 3 + 50: PRINT LTRIM$(STR$(x)) + LTRIM$(STR$(8 - y + 1))
  322.  
  323.         NEXT
  324.     NEXT
  325.  
  326. ' '''''''''' '''''''''' '''''''''' '''''''''' ''''''''''
  327.  
  328. SUB GetRowColMovesFull (PieceNameIn AS STRING, GameLayerParIn, MoveListLayerIn)
  329.     PieceName$ = PieceNameIn
  330.     GameLayerParameter = GameLayerParIn
  331.     MoveListLayer = MoveListLayerIn
  332.     FirstLetter$ = LEFT$(PieceName$, 1)
  333.     Temp$ = FindCoordinates$(PieceName$, GameLayerParameter)
  334.     XOrig = VAL(LEFT$(Temp$, 1))
  335.     YOrig = VAL(RIGHT$(Temp$, 1))
  336.     X = XOrig
  337.     Y = YOrig
  338.     DO
  339.         X = X + 1
  340.         IF X <= 8 THEN
  341.             IF BoardState(X, Y, GameLayerParameter) = "0" THEN
  342.  
  343.                 MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
  344.                 MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(X)) + LTRIM$(STR$(Y))
  345.             ELSE
  346.                 IF FirstLetter$ <> LEFT$(BoardState(X, Y, GameLayerParameter), 1) THEN
  347.                     MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
  348.                     MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(X)) + LTRIM$(STR$(Y))
  349.                 END IF
  350.                 EXIT DO
  351.             END IF
  352.         END IF
  353.     LOOP UNTIL X > 8
  354.     X = XOrig
  355.     Y = YOrig
  356.     DO
  357.         X = X - 1
  358.         IF X >= 1 THEN
  359.             IF BoardState(X, Y, GameLayerParameter) = "0" THEN
  360.                 MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
  361.                 MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(X)) + LTRIM$(STR$(Y))
  362.             ELSE
  363.                 IF FirstLetter$ <> LEFT$(BoardState(X, Y, GameLayerParameter), 1) THEN
  364.                     MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
  365.                     MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(X)) + LTRIM$(STR$(Y))
  366.                 END IF
  367.                 EXIT DO
  368.             END IF
  369.         END IF
  370.     LOOP UNTIL X < 1
  371.     X = XOrig
  372.     Y = YOrig
  373.     DO
  374.         Y = Y + 1
  375.         IF Y <= 8 THEN
  376.             IF BoardState(X, Y, GameLayerParameter) = "0" THEN
  377.                 MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
  378.                 MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(X)) + LTRIM$(STR$(Y))
  379.             ELSE
  380.                 IF FirstLetter$ <> LEFT$(BoardState(X, Y, GameLayerParameter), 1) THEN
  381.                     MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
  382.                     MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(X)) + LTRIM$(STR$(Y))
  383.                 END IF
  384.                 EXIT DO
  385.             END IF
  386.         END IF
  387.     LOOP UNTIL Y > 8
  388.     X = XOrig
  389.     Y = YOrig
  390.     DO
  391.         Y = Y - 1
  392.         IF Y >= 1 THEN
  393.             IF BoardState(X, Y, GameLayerParameter) = "0" THEN
  394.                 MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
  395.                 MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(X)) + LTRIM$(STR$(Y))
  396.             ELSE
  397.                 IF FirstLetter$ <> LEFT$(BoardState(X, Y, GameLayerParameter), 1) THEN
  398.                     MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
  399.                     MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(X)) + LTRIM$(STR$(Y))
  400.                 END IF
  401.                 EXIT DO
  402.             END IF
  403.         END IF
  404.     LOOP UNTIL Y < 1
  405.  
  406.  
  407. ' '''''''''' '''''''''' '''''''''' '''''''''' ''''''''''
  408.  
  409. SUB GetDiagMovesFull (PieceNameIn AS STRING, GameLayerParIn, MoveListLayerIn)
  410.     PieceName$ = PieceNameIn
  411.     GameLayerParameter = GameLayerParIn
  412.     MoveListLayer = MoveListLayerIn
  413.     FirstLetter$ = LEFT$(PieceName$, 1)
  414.     Temp$ = FindCoordinates$(PieceName$, GameLayerParameter)
  415.     XOrig = VAL(LEFT$(Temp$, 1))
  416.     YOrig = VAL(RIGHT$(Temp$, 1))
  417.     X = XOrig
  418.     Y = YOrig
  419.     DO
  420.         X = X + 1
  421.         Y = Y + 1
  422.         IF X <= 8 AND Y <= 8 THEN
  423.             IF BoardState(X, Y, GameLayerParameter) = "0" THEN
  424.                 MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
  425.                 MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(X)) + LTRIM$(STR$(Y))
  426.             ELSE
  427.                 IF FirstLetter$ <> LEFT$(BoardState(X, Y, GameLayerParameter), 1) THEN
  428.                     MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
  429.                     MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(X)) + LTRIM$(STR$(Y))
  430.                 END IF
  431.                 EXIT DO
  432.             END IF
  433.         END IF
  434.     LOOP UNTIL X > 8 OR Y > 8
  435.     X = XOrig
  436.     Y = YOrig
  437.     DO
  438.         X = X - 1
  439.         Y = Y + 1
  440.         IF X >= 1 AND X <= 8 AND Y >= 1 AND Y <= 8 THEN
  441.             IF BoardState(X, Y, GameLayerParameter) = "0" THEN
  442.                 MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
  443.                 MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(X)) + LTRIM$(STR$(Y))
  444.             ELSE
  445.                 IF FirstLetter$ <> LEFT$(BoardState(X, Y, GameLayerParameter), 1) THEN
  446.                     MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
  447.                     MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(X)) + LTRIM$(STR$(Y))
  448.                 END IF
  449.                 EXIT DO
  450.             END IF
  451.         END IF
  452.     LOOP UNTIL X < 1 OR Y > 8
  453.     X = XOrig
  454.     Y = YOrig
  455.     DO
  456.         X = X - 1
  457.         Y = Y - 1
  458.         IF X >= 1 AND Y >= 1 THEN
  459.             IF BoardState(X, Y, GameLayerParameter) = "0" THEN
  460.                 MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
  461.                 MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(X)) + LTRIM$(STR$(Y))
  462.             ELSE
  463.                 IF FirstLetter$ <> LEFT$(BoardState(X, Y, GameLayerParameter), 1) THEN
  464.                     MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
  465.                     MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(X)) + LTRIM$(STR$(Y))
  466.                 END IF
  467.                 EXIT DO
  468.             END IF
  469.         END IF
  470.     LOOP UNTIL X < 1 OR Y < 1
  471.     X = XOrig
  472.     Y = YOrig
  473.     DO
  474.         X = X + 1
  475.         Y = Y - 1
  476.         IF X <= 8 AND Y >= 1 THEN
  477.             IF BoardState(X, Y, GameLayerParameter) = "0" THEN
  478.                 MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
  479.                 MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(X)) + LTRIM$(STR$(Y))
  480.             ELSE
  481.                 IF FirstLetter$ <> LEFT$(BoardState(X, Y, GameLayerParameter), 1) THEN
  482.                     MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
  483.                     MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(X)) + LTRIM$(STR$(Y))
  484.                 END IF
  485.                 EXIT DO
  486.             END IF
  487.         END IF
  488.     LOOP UNTIL X > 8 OR Y < 1
  489.  
  490.  
  491. ' '''''''''' '''''''''' '''''''''' '''''''''' ''''''''''
  492.  
  493. SUB GetRowColMovesSingle (PieceNameIn AS STRING, GameLayerParIn, MoveListLayerIn)
  494.     PieceName$ = PieceNameIn
  495.     GameLayerParameter = GameLayerParIn
  496.     MoveListLayer = MoveListLayerIn
  497.     FirstLetter$ = LEFT$(PieceName$, 1)
  498.     Temp$ = FindCoordinates$(PieceName$, GameLayerParameter)
  499.     XOrig = VAL(LEFT$(Temp$, 1))
  500.     YOrig = VAL(RIGHT$(Temp$, 1))
  501.     x = XOrig
  502.     Y = YOrig
  503.     x = x + 1
  504.     IF x <= 8 THEN
  505.         IF BoardState(x, Y, GameLayerParameter) = "0" THEN
  506.             MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
  507.             MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(x)) + LTRIM$(STR$(Y))
  508.         ELSE
  509.             IF FirstLetter$ <> LEFT$(BoardState(x, Y, GameLayerParameter), 1) THEN
  510.                 MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
  511.                 MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(x)) + LTRIM$(STR$(Y))
  512.             END IF
  513.         END IF
  514.     END IF
  515.     x = XOrig
  516.     Y = YOrig
  517.     x = x - 1
  518.     IF x >= 1 THEN
  519.         IF BoardState(x, Y, GameLayerParameter) = "0" THEN
  520.             MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
  521.             MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(x)) + LTRIM$(STR$(Y))
  522.         ELSE
  523.             IF FirstLetter$ <> LEFT$(BoardState(x, Y, GameLayerParameter), 1) THEN
  524.                 MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
  525.                 MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(x)) + LTRIM$(STR$(Y))
  526.             END IF
  527.         END IF
  528.     END IF
  529.     x = XOrig
  530.     Y = YOrig
  531.     Y = Y + 1
  532.     IF Y <= 8 THEN
  533.         IF BoardState(x, Y, GameLayerParameter) = "0" THEN
  534.             MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
  535.             MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(x)) + LTRIM$(STR$(Y))
  536.         ELSE
  537.             IF FirstLetter$ <> LEFT$(BoardState(x, Y, GameLayerParameter), 1) THEN
  538.                 MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
  539.                 MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(x)) + LTRIM$(STR$(Y))
  540.             END IF
  541.         END IF
  542.     END IF
  543.     x = XOrig
  544.     Y = YOrig
  545.     Y = Y - 1
  546.     IF Y >= 1 THEN
  547.         IF BoardState(x, Y, GameLayerParameter) = "0" THEN
  548.             MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
  549.             MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(x)) + LTRIM$(STR$(Y))
  550.         ELSE
  551.             IF FirstLetter$ <> LEFT$(BoardState(x, Y, GameLayerParameter), 1) THEN
  552.                 MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
  553.                 MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(x)) + LTRIM$(STR$(Y))
  554.             END IF
  555.         END IF
  556.     END IF
  557.  
  558.  
  559. ' '''''''''' '''''''''' '''''''''' '''''''''' ''''''''''
  560.  
  561. SUB GetDiagMovesSingle (PieceNameIn AS STRING, GameLayerParIn, MoveListLayerIn)
  562.     PieceName$ = PieceNameIn
  563.     GameLayerParameter = GameLayerParIn
  564.     MoveListLayer = MoveListLayerIn
  565.     FirstLetter$ = LEFT$(PieceName$, 1)
  566.     Temp$ = FindCoordinates$(PieceName$, GameLayerParameter)
  567.     XOrig = VAL(LEFT$(Temp$, 1))
  568.     YOrig = VAL(RIGHT$(Temp$, 1))
  569.     X = XOrig
  570.     Y = YOrig
  571.     X = X + 1
  572.     Y = Y + 1
  573.     IF X <= 8 AND Y <= 8 THEN
  574.         IF BoardState(X, Y, GameLayerParameter) = "0" THEN
  575.             MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
  576.             MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(X)) + LTRIM$(STR$(Y))
  577.         ELSE
  578.             IF FirstLetter$ <> LEFT$(BoardState(X, Y, GameLayerParameter), 1) THEN
  579.                 MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
  580.                 MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(X)) + LTRIM$(STR$(Y))
  581.             END IF
  582.         END IF
  583.     END IF
  584.     X = XOrig
  585.     Y = YOrig
  586.     X = X - 1
  587.     Y = Y + 1
  588.     IF X >= 1 AND X <= 8 AND Y >= 1 AND Y <= 8 THEN
  589.         IF BoardState(X, Y, GameLayerParameter) = "0" THEN
  590.             MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
  591.             MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(X)) + LTRIM$(STR$(Y))
  592.         ELSE
  593.             IF FirstLetter$ <> LEFT$(BoardState(X, Y, GameLayerParameter), 1) THEN
  594.                 MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
  595.                 MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(X)) + LTRIM$(STR$(Y))
  596.             END IF
  597.         END IF
  598.     END IF
  599.     X = XOrig
  600.     Y = YOrig
  601.     X = X - 1
  602.     Y = Y - 1
  603.     IF X >= 1 AND Y >= 1 THEN
  604.         IF BoardState(X, Y, GameLayerParameter) = "0" THEN
  605.             MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
  606.             MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(X)) + LTRIM$(STR$(Y))
  607.         ELSE
  608.             IF FirstLetter$ <> LEFT$(BoardState(X, Y, GameLayerParameter), 1) THEN
  609.                 MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
  610.                 MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(X)) + LTRIM$(STR$(Y))
  611.             END IF
  612.         END IF
  613.     END IF
  614.     X = XOrig
  615.     Y = YOrig
  616.     X = X + 1
  617.     Y = Y - 1
  618.     IF X <= 8 AND Y >= 1 THEN
  619.         IF BoardState(X, Y, GameLayerParameter) = "0" THEN
  620.             MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
  621.             MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(X)) + LTRIM$(STR$(Y))
  622.         ELSE
  623.             IF FirstLetter$ <> LEFT$(BoardState(X, Y, GameLayerParameter), 1) THEN
  624.                 MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
  625.                 MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(X)) + LTRIM$(STR$(Y))
  626.             END IF
  627.         END IF
  628.     END IF
  629.  
  630.  
  631. ' '''''''''' '''''''''' '''''''''' '''''''''' ''''''''''
  632.  
  633. SUB GetKnightMoves (PieceNameIn AS STRING, GameLayerParIn, MoveListLayerIn)
  634.     PieceName$ = PieceNameIn
  635.     GameLayerParameter = GameLayerParIn
  636.     MoveListLayer = MoveListLayerIn
  637.     FirstLetter$ = LEFT$(PieceName$, 1)
  638.     Temp$ = FindCoordinates$(PieceName$, GameLayerParameter)
  639.     XOrig = VAL(LEFT$(Temp$, 1))
  640.     YOrig = VAL(RIGHT$(Temp$, 1))
  641.  
  642.     X = XOrig: Y = YOrig: X = X + 2: Y = Y + 1
  643.     IF X >= 1 AND X <= 8 AND Y >= 1 AND Y <= 8 THEN
  644.         IF FirstLetter$ <> LEFT$(BoardState(X, Y, GameLayerParameter), 1) THEN
  645.             MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
  646.             MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(X)) + LTRIM$(STR$(Y))
  647.         END IF
  648.     END IF
  649.  
  650.     X = XOrig: Y = YOrig: X = X + 1: Y = Y + 2
  651.     IF X >= 1 AND X <= 8 AND Y >= 1 AND Y <= 8 THEN
  652.         IF FirstLetter$ <> LEFT$(BoardState(X, Y, GameLayerParameter), 1) THEN
  653.             MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
  654.             MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(X)) + LTRIM$(STR$(Y))
  655.         END IF
  656.     END IF
  657.  
  658.     X = XOrig: Y = YOrig: X = X - 1: Y = Y + 2
  659.     IF X >= 1 AND X <= 8 AND Y >= 1 AND Y <= 8 THEN
  660.         IF FirstLetter$ <> LEFT$(BoardState(X, Y, GameLayerParameter), 1) THEN
  661.             MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
  662.             MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(X)) + LTRIM$(STR$(Y))
  663.         END IF
  664.     END IF
  665.  
  666.     X = XOrig: Y = YOrig: X = X - 2: Y = Y + 1
  667.     IF X >= 1 AND X <= 8 AND Y >= 1 AND Y <= 8 THEN
  668.         IF FirstLetter$ <> LEFT$(BoardState(X, Y, GameLayerParameter), 1) THEN
  669.             MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
  670.             MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(X)) + LTRIM$(STR$(Y))
  671.         END IF
  672.     END IF
  673.  
  674.     X = XOrig: Y = YOrig: X = X - 2: Y = Y - 1
  675.     IF X >= 1 AND X <= 8 AND Y >= 1 AND Y <= 8 THEN
  676.         IF FirstLetter$ <> LEFT$(BoardState(X, Y, GameLayerParameter), 1) THEN
  677.             MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
  678.             MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(X)) + LTRIM$(STR$(Y))
  679.         END IF
  680.     END IF
  681.  
  682.     X = XOrig: Y = YOrig: X = X - 1: Y = Y - 2
  683.     IF X >= 1 AND X <= 8 AND Y >= 1 AND Y <= 8 THEN
  684.         IF FirstLetter$ <> LEFT$(BoardState(X, Y, GameLayerParameter), 1) THEN
  685.             MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
  686.             MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(X)) + LTRIM$(STR$(Y))
  687.         END IF
  688.     END IF
  689.  
  690.     X = XOrig: Y = YOrig: X = X + 1: Y = Y - 2
  691.     IF X >= 1 AND X <= 8 AND Y >= 1 AND Y <= 8 THEN
  692.         IF FirstLetter$ <> LEFT$(BoardState(X, Y, GameLayerParameter), 1) THEN
  693.             MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
  694.             MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(X)) + LTRIM$(STR$(Y))
  695.         END IF
  696.     END IF
  697.  
  698.     X = XOrig: Y = YOrig: X = X + 2: Y = Y - 1
  699.     IF X >= 1 AND X <= 8 AND Y >= 1 AND Y <= 8 THEN
  700.         IF FirstLetter$ <> LEFT$(BoardState(X, Y, GameLayerParameter), 1) THEN
  701.             MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
  702.             MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(X)) + LTRIM$(STR$(Y))
  703.         END IF
  704.     END IF
  705.  
  706.  
  707. ' '''''''''' '''''''''' '''''''''' '''''''''' ''''''''''
  708.  
« Last Edit: January 24, 2020, 10:12:25 pm by STxAxTIC »
You're not done when it works, you're done when it's right.

Offline Richard Frost

  • Seasoned Forum Regular
  • Posts: 316
  • Needle nardle noo. - Peter Sellers
    • View Profile
Re: A 90% complete chess engine
« Reply #1 on: January 24, 2020, 11:57:23 pm »
Here's mine.  It has lots of bugs, mainly that it doesn't recognize checkmate - you get to capture the King and
keep on playing.  Also, castling only seems to work for the white side.

I wrote this over 20 years ago, and am now converting it to QB64.  Hard to remember what my logic was back
then - lots of bits I've forgotten what they're for!  Anyway, "d" switches it to a big board, the move is highlighted
for review and the user presses a key to execute it, arrow keys and Enter to make your own move. 

This is the only code I've ever done that uses recursion.  The code is entirely mine, but I did steal the chess pieces
from somewhere, since I'm no artist.

The last subroutine evaluates the moves, and needs major expansion.  The priority is to get it working properly
first.  It plays suprisingly well with so few rules.  A text file is created of all the "thinking" should one be a masochist
and wish to review it.

Code: QB64: [Select]
  1. _TITLE "Chess"
  2. DEFINT A-Z
  3. CONST true = -1, false = 0
  4. CONST BoardWhite = 1, BoardBlack = 2
  5. CONST Rook = 1, Knight = 2, Bishop = 3, Queen = 4, King = 5, Pawn = 6
  6.  
  7. COMMON SHARED debug$
  8. COMMON SHARED WorB, Move, Score, Index, opening
  9. COMMON SHARED m$, i$, Enter$, Esc$, lf$, mess$
  10. COMMON SHARED fln '                                                  file line number, diagnostics
  11. COMMON SHARED fr, fc, tr, tc
  12. COMMON SHARED MaxRow
  13. COMMON SHARED xq, yq '                                               size of squares in pixels
  14. COMMON SHARED xc, yc '                                               top left of board
  15. COMMON SHARED WaitForKey
  16. COMMON SHARED Castle$, OtherK$, kr, kc, mkr, mkc
  17. COMMON SHARED MasterLevel, SaveWorB
  18. COMMON SHARED GameFile$, check, redo, redo$, b1, b2, b1$, b2$
  19. COMMON SHARED debug, DebugR, DebugC
  20. COMMON SHARED Start1&, Start2&, MaxElapse!
  21. COMMON SHARED human, humanc, OnAuto
  22. COMMON SHARED linesprinted&&
  23.  
  24. l = VAL(COMMAND$) '                                                  going beyond 6 plies takes a long time
  25. IF l = 0 THEN l = 4 '
  26. MasterLevel = l
  27. human = 1: humanc = 0 '                                              comment line out for autoplay
  28. debug = 1 '                                                          change to 0 or press "d" during play for bigger board
  29.  
  30. p = 6: b = 8: q1 = 200: q2 = 500
  31. DIM SHARED b(b, b), t(b, b, l), o(b, b), mp$(p, 7)
  32. DIM SHARED Moves(l), Move$(l, q1), Score(l, q1), TieTo(l), Index(l, q1)
  33. DIM SHARED x(p, q2), y(p, q2), c&(12, q2), MoveLog$(q2)
  34. DIM SHARED gm$(999), garr(31000), cp&(32)
  35.  
  36. OnAuto = NOT (OnAuto)
  37. Begin:
  38. Init
  39. opening = 1
  40.  
  41.     redo$ = ""
  42.     MiscInfo
  43.     'LINE (0, 0)-(945, _HEIGHT), _RGB(0, 0, 0), BF
  44.     SaveWorB = WorB
  45.     IF opening > 0 THEN
  46.         READ m$
  47.         IF m$ = "end" THEN opening = 0
  48.     END IF
  49.     IF opening = 0 THEN
  50.         IF Start1& = 0 THEN Start1& = TIMER
  51.         Start2& = TIMER
  52.         CheckBoard 0
  53.         IF Moves(0) = 0 THEN mess$ = "No legal moves."
  54.         IF LEN(mess$) > 0 THEN EXIT DO
  55.         IF human AND (humanc = WorB) THEN
  56.             woof:
  57.             HumanMove
  58.             ok = 0
  59.             FOR i = 1 TO Moves(0)
  60.                 IF m$ = Move$(0, i) THEN ok = 1: EXIT FOR
  61.             NEXT i
  62.             IF ok = 0 THEN SOUND 200, 1: GOTO woof
  63.         ELSE
  64.             fln = 0
  65.             DebugR = 999: DebugC = 1
  66.  
  67.             Recurse 1
  68.             TakeBest 0
  69.             IF debug THEN MovesRanked
  70.  
  71.             b1$ = m$
  72.             IF (Score(0, 1) = 777) AND (Score(1, 1) <> -777) THEN
  73.                 Score(0, 1) = 22
  74.                 TakeBest 0
  75.                 b1$ = m$
  76.             END IF
  77.             BoSave 0
  78.  
  79.             WorB = SaveWorB
  80.             CheckBoard 0
  81.             b1 = Score(0, 1)
  82.             MoveIt b1$, 0 '                                          make the move
  83.  
  84.             WorB = SaveWorB XOR 1 '                                  toggle player
  85.             CheckBoard 0 '                                           see what damage can be done
  86.             b2$ = m$
  87.             b2 = Score
  88.  
  89.             redo$ = STR$(b1) + STR$(b2 - 12)
  90.             IF (b1 < (b2 - 112)) OR (Score = 777) THEN '            I forgot WHAT this bit was!
  91.                 'IF Score = 777 THEN
  92.                 redo = true
  93.                 redo$ = "*" + STR$(b1) + STR$(b2 - 12)
  94.             END IF
  95.  
  96.             BoRestore 0
  97.             WorB = SaveWorB
  98.             m$ = b1$
  99.  
  100.             wonka:
  101.             IF redo THEN '                                           try again checking ALL
  102.                 sl = MasterLevel
  103.                 MasterLevel = 2
  104.                 WorB = SaveWorB
  105.                 CheckBoard 0
  106.                 Recurse 1 '                                          start over
  107.                 TakeBest 0
  108.                 IF debug THEN MovesRanked
  109.                 m$ = Move$(0, 1)
  110.                 MasterLevel = sl
  111.                 redo = false
  112.             END IF
  113.             WorB = SaveWorB
  114.             PlotAll
  115.  
  116.             fr = VAL(MID$(m$, 2, 1)) '                               from row
  117.             fc = INSTR("abcdefgh", LEFT$(m$, 1)) '                   from column
  118.             IF LEFT$(m$, 1) = "O" THEN fr = kr: fc = kc
  119.             x1 = xc + (fc - 5) * xq
  120.             y1 = yc + ((9 - fr) - 6) * yq
  121.             LINE (x1, y1)-STEP(xq, yq), _RGB(0, 255, 0), B
  122.             LINE (x1 + 1, y1 + 1)-STEP(xq - 2, yq - 2), _RGB(0, 255, 0), B
  123.  
  124.             IF LEFT$(m$, 1) <> "O" THEN
  125.                 tr = VAL(MID$(m$, 4, 1))
  126.                 tc = INSTR("abcdefgh", MID$(m$, 3, 1))
  127.                 x1 = xc + (tc - 5) * xq
  128.                 y1 = yc + ((9 - tr) - 6) * yq
  129.                 LINE (x1, y1)-STEP(xq, yq), _RGB(255, 255, 255), B
  130.             END IF
  131.  
  132.             'SOUND 333, 1
  133.             IF debug = 1 THEN
  134.                 MiscInfo
  135.                 RESTORE vlines
  136.                 DO
  137.                     READ x
  138.                     IF x = 0 THEN EXIT DO
  139.                     FOR i = -2 TO 2 STEP 4
  140.                         LINE (x + i, 0)-(x + i, _HEIGHT - 16), _RGB32(155, 0, 0)
  141.                     NEXT i
  142.                 LOOP
  143.             END IF
  144.  
  145.             DO: _LIMIT 10
  146.                 ScanKey
  147.                 IF i$ = "s" THEN i$ = "": SHELL _DONTWAIT "notepad chtemp.txt"
  148.             LOOP UNTIL LEN(i$)
  149.         END IF
  150.     END IF
  151.     WorB = SaveWorB
  152.     DispTime
  153.     MoveIt m$, -1
  154.     ShowAlgebraic m$
  155.  
  156.     IF opening = 0 THEN
  157.         check = false
  158.         CheckBoard 0
  159.         LOCATE 1, 8
  160.         IF Score = 777 THEN
  161.             check = true
  162.             PRINT "Check!";
  163.         ELSE
  164.             PRINT "      ";
  165.         END IF
  166.     END IF
  167.  
  168.     WorB = SaveWorB XOR 1 '                                          toggle white/black
  169.     IF LEN(GameFile$) > 0 THEN KeyGet
  170.     WaitForKey = true
  171. LOOP UNTIL Move = 500
  172.  
  173. IF Move = 500 THEN mess$ = "Over 500 moves...."
  174. LOCATE 1, 1: PRINT mess$;
  175.  
  176. vlines:
  177. DATA 226,467,707,950,0
  178.  
  179. o1:
  180. DATA e2e4,e7e5,g1f3,b8c6,f1b5,a7a6,b5a4,b7b5,a4b3,g8f6,b1c3,f8e7,f3g5,h7h6
  181. 'DATA g5f7,O-O
  182. 'DATA f7d8,g8h7
  183.  
  184. SetUp:
  185. DATA 1,2,3,4,5,3,2,1
  186. DATA 6,6,6,6,6,6,6,6
  187. DATA 0,0,0,0,0,0,0,0
  188. DATA 0,0,0,0,0,0,0,0
  189. DATA 0,0,0,0,0,0,0,0
  190. DATA 0,0,0,0,0,0,0,0
  191. DATA 12,12,12,12,12,12,12,12
  192. DATA 7,8,9,10,11,9,8,7
  193.  
  194. Legal:
  195. '      udlr,udlr,udlr,udlr,udlr,udlr,udlr,udlr
  196. DATA R,8000,0800,0080,0008,0000,0000,0000,0000
  197. DATA N,2010,2001,0210,0201,1020,1002,0120,0102
  198. DATA B,8080,8008,0880,0808,0000,0000,0000,0000
  199. DATA Q,8000,0800,0080,0008,8080,8008,0880,0808
  200. DATA K,1000,0100,0010,0001,1010,1001,0110,0101
  201. DATA P,1000,1001,1010,0000,0000,0000,0000,0000
  202.  
  203. PiecePatterns:
  204. DATA ........................
  205. DATA ........................
  206. DATA ........................
  207. DATA ........................
  208. DATA ....X..XX..XX..XX..X....
  209. DATA ....X..XX..XX..XX..X....
  210. DATA ....X..XX..XX..XX..X....
  211. DATA ....X..XX..XX..XX..X....
  212. DATA ....X..XX..XX..XX..X....
  213. DATA .....X.XX..XX..XX.X.....
  214. DATA ......XXXXXXXXXXXX......
  215. DATA .....XX..........XX.....
  216. DATA ......X.XXXXXXXX.X......
  217. DATA ......X.XXXXXXXX.X......
  218. DATA ......X.XXXXXXXX.X......
  219. DATA ......X.XXXXXXXX.X......
  220. DATA .....X............X.....
  221. DATA .....X..XXXXXXXX..X.....
  222. DATA ....X..............X....
  223. DATA ...X..XXXXXXXXXXXX..X...
  224. DATA ...X................X...
  225. DATA ...XXXXXXXXXXXXXXXXXX...
  226.  
  227. DATA ........................
  228. DATA ........................
  229. DATA ........................
  230. DATA ........................
  231. DATA ............XXX.........
  232. DATA ..........XX.X.X........
  233. DATA .........X..X.X.XX......
  234. DATA ........X.X.XX.X..X.....
  235. DATA .......X.XXXX.X.X..X....
  236. DATA .......X.X...XXX.X..X...
  237. DATA .....X..XX..X.XXX.X.X...
  238. DATA ....X.XXXXXXX.XXX.X..X..
  239. DATA ...X.XXXXXX.X..XX.X..X..
  240. DATA ...X.XX..XXX.X.XX.X..X..
  241. DATA ....X..XXXX..X.XX.X..X..
  242. DATA .....XX..X..X.XXX.X..X..
  243. DATA ........X..XX.XX.XX.X...
  244. DATA .......X..XX.XX.XX.X....
  245. DATA ......XXXXXXXXXXXXXX....
  246. DATA .....X..............X...
  247. DATA ....X................X..
  248. DATA .....XXXXXXXXXXXXXXXX...
  249.  
  250. DATA ........................
  251. DATA ........................
  252. DATA ........................
  253. DATA ............X...........
  254. DATA ...........X.X..........
  255. DATA ..........X.X.X.........
  256. DATA ........X...XX..X.......
  257. DATA .......X..X..XX..X......
  258. DATA .......X.XXX..XX.X......
  259. DATA .......X.XXXX..X.X......
  260. DATA ........X.......X.......
  261. DATA .......XX.X.X.X.XX......
  262. DATA ......X...........X.....
  263. DATA .......X.XXX.XX.XX......
  264. DATA ........X.XX.XX.X.......
  265. DATA .......X.XXX.XXX.X......
  266. DATA .......X.XXX.XXX.X......
  267. DATA ......X.X.......X.X.....
  268. DATA .....X.XXXXX.XXXXX.X....
  269. DATA .....X.XXXXX.XXXXX.X....
  270. DATA .....X.............X....
  271. DATA ......XXXXXXXXXXXXX.....
  272.  
  273. DATA ............X...........
  274. DATA ...........X.X..........
  275. DATA .....X....X.X.X....X....
  276. DATA ....X.X.XX.XXX..X.X.X...
  277. DATA ...X.X.X..XX.XXX.X.X.X..
  278. DATA ...X.XX.XXX.X.XXX.XX.X..
  279. DATA ...X.XXX.X.XXX.X.XXX.X..
  280. DATA ...X.XXXX.XXXXX.XXXX.X..
  281. DATA ....X.XXXXXX..XXXXX.X...
  282. DATA .....X.XXXXX..XXXX.X....
  283. DATA .....X.............X....
  284. DATA ......XXXXXXXXXXXXX.....
  285. DATA ....X...............X...
  286. DATA ......XX.XXXXXXX.XX.....
  287. DATA .......X.X.XXX.X.X......
  288. DATA ......X.XX.XXX.XX.X.....
  289. DATA ......X.XX.XXX.XX.X.....
  290. DATA .....XXXXXXXXXXXXXXX....
  291. DATA ....X...............X...
  292. DATA ...X..XX.XX.XX.XX.X..X..
  293. DATA ...X.................X..
  294. DATA ....XXXXXXXXXXXXXXXXX...
  295.  
  296. DATA ...........XX...........
  297. DATA .........XX..XX.........
  298. DATA .......XX.X..X.XX.......
  299. DATA .....XX.X......X.XX.....
  300. DATA ....X..XX.X..X.XX..X....
  301. DATA ...X...XXXX..XXXX...X...
  302. DATA ..X...XX........XX...X..
  303. DATA .X..XXX.XXX..XXX.XXX..X.
  304. DATA X..XXX..XXX..XXX..XXX..X
  305. DATA X.XXXX..XXX..XXXX.XXXX.X
  306. DATA X.XXXX.XXXX..XXXX.XXXX.X
  307. DATA X.XXXX..XXXXXXXX..XXXX.X
  308. DATA .X.XXXX..XXXXXX..XXXX.X.
  309. DATA .X..XXXX..XXXX..XXXX..X.
  310. DATA ..X..XXXX......XXXX..X..
  311. DATA ...X....X......X....X...
  312. DATA ...XXXXXXXXXXXXXXXXXX...
  313. DATA ..X..................X..
  314. DATA .X..XXXXXXXXXXXXXXXX..X.
  315. DATA .X..XXXXXXXXXXXXXXXX..X.
  316. DATA ..X..................X..
  317. DATA ...XXXXXXXXXXXXXXXXXX...
  318.  
  319. DATA ........................
  320. DATA ........................
  321. DATA ........................
  322. DATA ..........XXXX..........
  323. DATA .........X....X.........
  324. DATA ........X.XXXX.X........
  325. DATA ........X.XXXX.X........
  326. DATA .........X....X.........
  327. DATA ........XXXXXXXX........
  328. DATA .......X........X.......
  329. DATA ........XXXXXXXX........
  330. DATA .........X.XX.X.........
  331. DATA .........X.XX.X.........
  332. DATA .........X.XX.X.........
  333. DATA ........X..XX..X........
  334. DATA .......X..XXXX..X.......
  335. DATA ......X.XXXXXXXX.X......
  336. DATA ......X.XXXXXXXX.X......
  337. DATA .....X............X.....
  338. DATA ......XXXXXXXXXXXX......
  339. DATA ........................
  340. DATA ........................
  341.  
  342. rgb:
  343. DATA 0,0,0,0,""
  344. DATA 1,40,10,20,"board white"
  345. DATA 2,0,0,0,"board black"
  346. DATA 3,42,42,42,"white bright"
  347. DATA 4,2,2,2,"white highlight"
  348. DATA 5,0,0,0,"black bright"
  349. DATA 6,32,32,32,"black highlight"
  350. DATA 7,20,20,20,""
  351. DATA 8,20,20,20,""
  352. DATA 9,20,20,20,""
  353. DATA 10,20,20,20,""
  354. DATA 11,20,20,20,""
  355. DATA 12,20,20,20,""
  356. DATA 13,20,20,20,""
  357. DATA 14,20,20,20,""
  358. DATA 15,30,30,30,"printing"
  359.  
  360. SUB AddIt (Level, tm$, Score)
  361.     Moves(Level) = Moves(Level) + 1 '                                count ok
  362.     Move$(Level, Moves(Level)) = tm$ '                               save move
  363.     Score(Level, Moves(Level)) = Score
  364.     Index(Level, Moves(Level)) = TieTo(Level)
  365.  
  366. SUB BoRestore (Level)
  367.     FOR r = 1 TO 8
  368.         FOR c = 1 TO 8
  369.             b(r, c) = t(r, c, Level)
  370.         NEXT c
  371.     NEXT r
  372.  
  373. SUB BoSave (Level)
  374.     FOR r = 1 TO 8
  375.         FOR c = 1 TO 8
  376.             t(r, c, Level) = b(r, c)
  377.         NEXT c
  378.     NEXT r
  379.  
  380. SUB CheckBoard (Level)
  381.     Moves(Level) = 0
  382.  
  383.     OtherK = King - (WorB = 1) * 6 '                                 find location of kings
  384.     debug$ = STR$(King) + STR$(OtherK)
  385.     FOR fkr = 1 TO 8 '                                               row
  386.         FOR fkc = 1 TO 8 '                                           column
  387.             IF b(fkr, fkc) = 5 THEN mkr = fkr: mkc = fkc '           my king
  388.             IF b(fkr, fkc) = 11 THEN kr = fkr: kc = fkc '            opponent king
  389.         NEXT fkc
  390.     NEXT fkr
  391.  
  392.     FOR r = 1 TO 8 '                                                 row
  393.         ScanKey
  394.         FOR c = 1 TO 8 '                                             column
  395.             mp = b(r, c)
  396.             mc = -(mp > 6) - (mp = 0) * 2
  397.             IF mc = WorB THEN TryMove Level, r, c
  398.         NEXT c
  399.     NEXT r
  400.  
  401.     IF MID$(Castle$, WorB * 2 + 1, 1) = " " THEN cq = true ELSE cq = false
  402.     IF MID$(Castle$, WorB * 2 + 2, 1) = " " THEN ck = true ELSE ck = false
  403.  
  404.     FOR Castle = 0 TO 1 '                                            queenside, then kingside
  405.         IF Castle = 0 THEN cn$ = "2345" ELSE cn$ = "765"
  406.         IF WorB = 0 THEN rn$ = "8" ELSE rn$ = "1"
  407.         FOR cs = 1 TO LEN(cn$)
  408.             rn = VAL(rn$)
  409.             cn = VAL(MID$(cn$, cs, 1))
  410.             tp = b(rn, cn)
  411.             tp = tp + (tp > 6) * 6
  412.             IF (tp <> 0) AND (tp <> King) THEN
  413.                 IF Castle = 0 THEN cq = false ELSE ck = false
  414.             ELSE
  415.                 csq$ = MID$("abcdefgh", cn, 1) + rn$
  416.                 FOR lm = 1 TO Moves(1)
  417.                     IF csq$ = RIGHT$(Move$(1, lm), 2) THEN
  418.                         IF Castle = 0 THEN cq = false ELSE ck = false
  419.                     END IF
  420.                 NEXT lm
  421.             END IF
  422.         NEXT cs
  423.     NEXT Castle
  424.  
  425.     IF ck THEN AddIt Level, "O-O", 12
  426.     IF cq THEN AddIt Level, "O-O-O", 13
  427.  
  428.     ' LOCATE 26 + WorB, 30: PRINT "*"; Castle$; "*";
  429.     ' PRINT MID$("K ", ck + 2, 1);
  430.     ' PRINT MID$("Q ", cq + 2, 1);
  431.  
  432.     TakeBest Level
  433.  
  434. SUB MovesRanked '                                shows ranked eval at lower left
  435.     sr = 40
  436.     r = sr
  437.     c = 124
  438.     FOR t = 1 TO 120
  439.         IF c < 150 THEN
  440.             IF t <= Moves(0) THEN
  441.                 LOCATE r, c: PRINT SPACE$(8);
  442.                 LOCATE r, c
  443.                 PRINT Make4$(Move$(0, t)); rjust$(Score(0, t), 4);
  444.             END IF
  445.         END IF
  446.         r = r + 1
  447.         IF r > MaxRow THEN r = sr: c = c + 12
  448.     NEXT t
  449.  
  450. SUB MoveInfo (Level) STATIC
  451.     IF debug <> 1 THEN EXIT SUB
  452.     IF Level < 2 THEN
  453.         'DebugR = DebugR + 1
  454.         'EXIT SUB
  455.     END IF
  456.  
  457.     IF DebugR > MaxRow THEN
  458.         DebugR = 1
  459.         DebugC = 1
  460.         FOR r = 1 TO MaxRow
  461.             LOCATE DebugR, DebugC
  462.             'PRINT SPACE$(120 - DebugC);
  463.         NEXT r
  464.     END IF
  465.  
  466.     LOCATE DebugR, DebugC
  467.     ts = 0: s = 1
  468.     fln = fln + 1
  469.     tt$ = RIGHT$(SPACE$(5) + STR$(fln), 5)
  470.  
  471.     fprint tt$ + " "
  472.     FOR t = 1 TO Level
  473.         ti = TieTo(t)
  474.         IF t < 3 THEN PRINT Make4$(Move$(t - 1, ti)); rjust$(Score(t - 1, ti), 3); " ";
  475.         fprint Make4$(Move$(t - 1, ti)) + rjust$(Score(t - 1, ti), 3) + " "
  476.         ts = ts + Score(t - 1, ti) * s
  477.         s = -s
  478.     NEXT t
  479.     ts = ts + Score
  480.     PRINT Make4$(m$); rjust$(Score, 3); rjust$(ts, 4);
  481.     fprint Make4$(m$) + rjust$(Score, 3) + rjust$(ts, 4) + crlf$
  482.     DebugR = DebugR + 1
  483.     IF DebugR > MaxRow THEN
  484.         DebugR = 1
  485.         DebugC = DebugC + 30
  486.         IF DebugC > 120 THEN DebugC = 1
  487.     END IF
  488.  
  489. SUB DispTime
  490.     IF Start2& > 0 THEN
  491.         Elapse1! = TIMER - Start1&
  492.         Elapse2! = TIMER - Start2&
  493.         IF Elapse2! > MaxElapse! THEN MaxElapse! = Elapse2!
  494.         'ShowTime 1, Elapse1!, "Game:"
  495.         'ShowTime 2, Elapse2!, "This move:"
  496.         'ShowTime 3, MaxElapse!, "Max move:"
  497.     END IF
  498.  
  499. SUB FadePiece (fr, fc, tr, tc)
  500.     x1 = xc + (fc - 5) * xq
  501.     y1 = yc + ((9 - fr) - 6) * yq
  502.     x2 = xc + (tc - 5) * xq
  503.     y2 = yc + ((9 - tr) - 6) * yq
  504.     p = b(tr, tc)
  505.     IF p > 6 THEN wb = 1: p = p - 6
  506.     i = p - (wb = 0) * 6
  507.  
  508.     FOR ps = 0 TO 1
  509.         IF ps = 0 THEN
  510.             c = fr + fc: tx = x1: ty = y1
  511.         ELSE
  512.             c = tr + tc: tx = x2: ty = y2
  513.         END IF
  514.         IF (c MOD 2) = 1 THEN
  515.             LINE (tx, ty)-(tx + xq, ty + yq), cp&(BoardWhite), BF
  516.         ELSE
  517.             LINE (tx, ty)-(tx + xq, ty + yq), cp&(BoardBlack), BF '       black square
  518.             LINE (tx, ty)-(tx + xq, ty + yq), cp&(BoardWhite), B '        border
  519.         END IF
  520.     NEXT ps
  521.  
  522.     FOR t = 1 TO c&(p, 0)
  523.         IF debug = 1 THEN
  524.             tx = x2 + x(p, t)
  525.             ty = y2 + y(p, t)
  526.             PSET (tx, ty), c&(i, t)
  527.         ELSE
  528.             tx = x2 + x(p, t) * 3 - 2
  529.             ty = y2 + y(p, t) * 3
  530.             LINE (tx, ty)-STEP(3, 3), c&(i, t), BF
  531.         END IF
  532.         'PSET (tx, ty), tc&
  533.     NEXT t
  534.  
  535. SUB HumanMove
  536.     FOR i = 0 TO 1
  537.         IF i = 0 THEN
  538.             rr = 1: cc = 1
  539.         ELSE
  540.             rr = fr: cc = fc
  541.         END IF
  542.         mx = _MOUSEX
  543.         my = _MOUSEY
  544.         DO
  545.             'LOCATE 1, 1: PRINT "Move ";
  546.             x1 = xc + (cc - 5) * xq
  547.             x2 = xc + (cc - 4) * xq
  548.             y1 = yc + (rr - 6) * yq
  549.             y2 = yc + (rr - 5) * yq
  550.             IF debug < -2 THEN
  551.                 GET (x1, y1)-(x2, y2), garr()
  552.                 PUT (x1, y1), garr(), PRESET
  553.                 _DELAY .1
  554.                 PUT (x1, y1), garr(), PSET
  555.                 _DELAY .1
  556.             ELSE
  557.                 zz = zz XOR 1
  558.                 IF zz THEN tc& = _RGB32(0, 0, 0) ELSE tc& = _RGB32(0, 255, 0)
  559.                 LINE (x1, y1)-(x2, y2), tc&, B
  560.                 _DELAY .1
  561.                 LINE (x1, y1)-(x2, y2), _RGB32(0, 0, 0), B
  562.             END IF
  563.             'tmx = _MOUSEX: tmy = _MOUSEY
  564.             IF (ABS(mx - tmx) > 8) OR (ABS(my - tmy) > 8) THEN
  565.                 IF tmx > mx THEN cc = cc + 1
  566.                 IF tmx < mx THEN cc = cc - 1
  567.                 IF tmy > my THEN rr = rr + 1
  568.                 IF tmx < my THEN rr = rr - 1
  569.             END IF
  570.             'i$ = INKEY$
  571.             ScanKey
  572.             IF LEN(i$) = 2 THEN
  573.                 kk = ASC(RIGHT$(i$, 1))
  574.                 cc = cc + (kk = 75) - (kk = 77) '                    left right
  575.                 rr = rr + (kk = 72) - (kk = 80) '                    up down
  576.             END IF
  577.             IF rr < 1 THEN rr = 1
  578.             IF rr > 8 THEN rr = 8
  579.             IF cc < 1 THEN cc = 1
  580.             IF cc > 8 THEN cc = 8
  581.             IF i$ = Esc$ THEN SYSTEM
  582.         LOOP UNTIL i$ = Enter$
  583.         IF i = 0 THEN
  584.             fr = rr: fc = cc
  585.         ELSE
  586.             tr = rr: tc = cc
  587.         END IF
  588.     NEXT i
  589.     fs$ = MID$("abcdefgh", fc, 1) + LTRIM$(STR$(9 - fr))
  590.     ts$ = MID$("abcdefgh", tc, 1) + LTRIM$(STR$(9 - tr))
  591.     m$ = fs$ + ts$
  592.     '   LOCATE 1, 1: PRINT m$; SPACE$(40);
  593.  
  594. SUB Init
  595.     xr = 1280: yr = 800 '                                            120*50 text?
  596.     SCREEN _NEWIMAGE(xr, yr, 32)
  597.  
  598.     RESTORE rgb
  599.     FOR p = 0 TO 15
  600.         READ PalNum, r, g, b, desc$
  601.         cp&(p) = _RGB32(r * 4, g * 4, b * 4)
  602.     NEXT p
  603.  
  604.     'RANDOMIZE TIMER '                                               seed generator
  605.     Move = 0
  606.     WorB = 1 '                                                       white=1, black=0
  607.     IF debug = 1 THEN
  608.         q = 28: xq = q: yq = q '                                         size of squares
  609.         xc = 1100: yc = 160 '                                            top left corner of board
  610.     ELSE
  611.         q = 80: xq = q: yq = q '                                         size of squares
  612.         xc = 360: yc = 440 '                                            top left corner of board
  613.     END IF
  614.     lf$ = CHR$(10)
  615.     Enter$ = CHR$(13)
  616.     Esc$ = CHR$(27)
  617.     crlf$ = Enter$ + lf$
  618.     Castle$ = SPACE$(4) '                                            flags QKQK (B then W)
  619.     mess$ = ""
  620.  
  621.     RESTORE PiecePatterns '                                          bit images
  622.     FOR p = 1 TO 6 '                                                 RNBQKP
  623.         ScanKey
  624.         n = 0
  625.         FOR y = 0 TO 21 '                                            22 rows
  626.             READ d$
  627.             p1 = INSTR(d$ + "X", "X") '                              find first "on" bit
  628.             FOR t = LEN(d$) TO 1 STEP -1 '                           find last "on" bit
  629.                 IF MID$(d$, t, 1) = "X" THEN
  630.                     p2 = t
  631.                     EXIT FOR
  632.                 END IF
  633.             NEXT t
  634.             FOR x = p1 TO p2
  635.                 pixel = INSTR(".X", MID$(d$, x, 1))
  636.                 n = n + 1
  637.                 IF pixel = 2 THEN tc& = cp&(3) ELSE tc& = cp&(4)
  638.                 x(p, n) = x + 1
  639.                 y(p, n) = y + 2
  640.                 c&(p, n) = tc&
  641.                 IF pixel = 2 THEN tc& = cp&(5) ELSE tc& = cp&(6)
  642.                 c&(p + 6, n) = tc&
  643.             NEXT x
  644.         NEXT y
  645.         c&(p, 0) = n
  646.     NEXT p
  647.  
  648.     RESTORE Legal '                                                  define how piece moves
  649.     FOR p = 1 TO 6 '                                                 RNBQKP
  650.         READ p$ '                                                    piece, not saved
  651.         FOR t = 0 TO 7 '                                             8 each
  652.             READ mp$(p, t) '                                         mp (move piece)
  653.         NEXT t
  654.     NEXT p
  655.  
  656.     RESTORE SetUp '                                                  initial board position
  657.     FOR r = 8 TO 1 STEP -1 '                                         row
  658.         FOR c = 1 TO 8 '                                             column
  659.             READ b(r, c)
  660.             o(r, c) = b(r, c)
  661.         NEXT c
  662.     NEXT r
  663.  
  664.     elim$ = " ,"
  665.     gm = 0: n = 0
  666.     IF LEN(GameFile$) > 0 THEN ReadGame
  667.     gm = 0
  668.  
  669.     MaxRow = 49
  670.  
  671.     f = f + 1
  672.     f$ = "chess" + LTRIM$(STR$(f))
  673.     OPEN f$ + ".alg" FOR OUTPUT AS #1 '                              algrebraic moves
  674.  
  675.     tf = FREEFILE
  676.     OPEN "chtemp.txt" FOR OUTPUT AS #tf
  677.     PRINT #tf, DATE$; " "; TIME$; crlf; crlf$;
  678.     CLOSE #tf
  679.     PlotAll
  680.  
  681. SUB KeyGet
  682.     sr = CSRLIN: sc = POS(0)
  683.     DO: _LIMIT 10
  684.         ScanKey
  685.         star = star XOR 1
  686.         IF i$ > "" THEN star = 0
  687.         LOCATE sr, sc
  688.         IF LEN(GameFile$) = 0 THEN PRINT CHR$(32 + star * 10);
  689.     LOOP UNTIL i$ > ""
  690.     IF i$ = "s" THEN WaitForKey = false
  691.  
  692. FUNCTION Make4$ (t$)
  693.     Make4$ = LEFT$(t$ + SPACE$(4), 4)
  694.  
  695. SUB MoveIt (m$, real)
  696.     IF m$ = "res" THEN EXIT SUB '                                    resign?
  697.     fs$ = LEFT$(m$, 2) '                                             from square
  698.     ts$ = RIGHT$(m$, 2) '                                            to square
  699.     nnn = 1 - (LEFT$(m$, 1) = "O") '                                 two moves for a castle
  700.     FOR pass = 1 TO nnn '                                            two moves for a castle
  701.         IF m$ = "O-O" THEN '                                         castle Kingside
  702.             IF WorB = 1 THEN '                                       white
  703.                 IF pass = 1 THEN '                                   first move of KS castle
  704.                     fs$ = "e1": ts$ = "g1"
  705.                 ELSE '                                               else 2nd
  706.                     fs$ = "h1": ts$ = "f1"
  707.                 END IF
  708.             ELSE '                                                   black castle
  709.                 IF pass = 1 THEN
  710.                     fs$ = "e8": ts$ = "g8"
  711.                 ELSE
  712.                     fs$ = "h8": ts$ = "f8"
  713.                 END IF
  714.             END IF
  715.         END IF
  716.         IF m$ = "O-O-O" THEN '                                       castle Queenside
  717.             IF WorB = 1 THEN '                                       white
  718.                 IF pass = 1 THEN
  719.                     fs$ = "e1": ts$ = "c1"
  720.                 ELSE
  721.                     fs$ = "a1": ts$ = "d1"
  722.                 END IF
  723.             ELSE
  724.                 IF pass = 1 THEN
  725.                     fs$ = "e8": ts$ = "c8"
  726.                 ELSE
  727.                     fs$ = "a8": ts$ = "d8"
  728.                 END IF
  729.             END IF
  730.         END IF
  731.         fr = VAL(RIGHT$(fs$, 1)) '                                   from row
  732.         fc = INSTR("abcdefgh", LEFT$(fs$, 1)) '                      from column
  733.  
  734.         pm = b(fr, fc) '                                             piece to move
  735.         p = pm + (pm > 6) * 6
  736.         tr = VAL(RIGHT$(ts$, 1)) '                                   to row
  737.         tc = INSTR("abcdefgh", LEFT$(ts$, 1)) '                      to column
  738.         b(tr, tc) = pm '                                             move piece in array
  739.         b(fr, fc) = 0 '                                              blank old array spot
  740.         IF real THEN
  741.             IF b(r, c) = o(r, c) THEN o(r, c) = -1
  742.             FadePiece fr, fc, tr, tc
  743.             IF p = King THEN MID$(Castle$, WorB * 2 + 1, 2) = "XX"
  744.             IF p = Rook THEN
  745.                 IF WorB = 0 THEN
  746.                     IF (fr = 8) AND (fc = 1) THEN MID$(Castle$, 1, 1) = "X"
  747.                     IF (fr = 8) AND (fc = 8) THEN MID$(Castle$, 2, 1) = "X"
  748.                 ELSE
  749.                     IF (fr = 1) AND (fc = 1) THEN MID$(Castle$, 3, 1) = "X"
  750.                     IF (fr = 1) AND (fc = 8) THEN MID$(Castle$, 4, 1) = "X"
  751.                 END IF
  752.             END IF
  753.         END IF
  754.         IF (p = Pawn) AND ((tr = 1) OR (tr = 8)) THEN
  755.             b(tr, tc) = Queen - (pm > 6) * 6 '                       promote to queen
  756.             IF real THEN FadePiece tr, tc, tr, tc '                  show queen
  757.         END IF
  758.     NEXT pass
  759.  
  760. SUB PlotAll
  761.     IF LEN(GameFile$) > 0 THEN
  762.         LOCATE 3, 40 - LEN(GameFile$) \ 2
  763.         PRINT GameFile$;
  764.     END IF
  765.     FOR r = 1 TO 8
  766.         FOR c = 1 TO 8
  767.             FadePiece r, c, r, c
  768.         NEXT c
  769.     NEXT r
  770.     FOR i = 1 TO 8 '                                                 legend
  771.         n$ = LTRIM$(STR$(i))
  772.         a$ = MID$("abcdefgh", i, 1)
  773.         IF debug = 1 THEN
  774.             nx = xc - 4 * xq - 12
  775.             ny = y2 + i * yq
  776.             ax = xc + (i - 5) * xq + 10
  777.             ay = yc + 3 * yq + 3
  778.         ELSE
  779.             nx = xc - 4 * xq - 14
  780.             ny = y2 + i * yq + 13
  781.             ax = xc + (i - 5) * xq + 35
  782.             ay = yc + 3 * yq + 3
  783.         END IF
  784.         _PRINTSTRING (nx, ny), n$
  785.         _PRINTSTRING (ax, ay), a$
  786.     NEXT i
  787.  
  788. SUB ReadGame
  789.     DIM g$(500)
  790.     OPEN GameFile$ FOR INPUT AS #1
  791.     WHILE NOT (EOF(1))
  792.         LINE INPUT #1, t$
  793.         n = n + 1
  794.         g$(n) = t$
  795.     WEND
  796.     CLOSE #1
  797.     i = 1
  798.     DO
  799.         g$ = g$(i)
  800.         DO
  801.             p1 = INSTR(g$, " ")
  802.             IF p1 = 0 THEN EXIT DO
  803.             p2 = INSTR(g$, ",")
  804.             IF p2 = 0 THEN p2 = LEN(g$)
  805.             t$ = LTRIM$(MID$(g$, p1, p2 - 2))
  806.             p = INSTR(t$, " ")
  807.             IF p = 0 THEN p = LEN(t$)
  808.             t2$ = RTRIM$(LEFT$(t$, p))
  809.             IF INSTR(elim$, RIGHT$(t2$, 1)) THEN t2$ = LEFT$(t2$, LEN(t2$) - 1)
  810.             gm$(gm) = t2$
  811.             gm = gm + 1
  812.             IF LEN(t$) > p THEN
  813.                 t$ = LTRIM$(RIGHT$(t$, LEN(t$) - p + 1))
  814.                 WHILE INSTR(elim$, RIGHT$(t$, 1))
  815.                     t$ = LEFT$(t$, LEN(t$) - 1)
  816.                 WEND
  817.                 gm$(gm) = t$
  818.                 'PRINT 2; gm$(gm)
  819.                 gm = gm + 1
  820.             END IF
  821.             ' KeyGet
  822.             g$ = RIGHT$(g$, LEN(g$) - p2)
  823.         LOOP UNTIL LEN(g$) = 0
  824.         i = i + 1
  825.     LOOP UNTIL i > n
  826.  
  827. SUB Recurse (Level)
  828.     DispTime
  829.     'LOCATE 1, 45 + Level * 2: PRINT "* ";
  830.     IF Level = MasterLevel THEN EXIT SUB
  831.     IF redo THEN
  832.         EndAt = Moves(Level - 1)
  833.     ELSE
  834.         EndAt = 5
  835.         IF EndAt > Moves(Level - 1) THEN EndAt = Moves(Level - 1)
  836.     END IF
  837.  
  838.     FOR t = 1 TO EndAt
  839.         WorB = SaveWorB
  840.         IF (Level MOD 2) = 1 THEN WorB = WorB XOR 1
  841.         TieTo(Level) = t
  842.         IF (Score(0, t) > -777) THEN
  843.             BoSave Level
  844.             m$ = Move$(Level - 1, t)
  845.             MoveIt m$, 0
  846.             lm1 = Level - 1
  847.             t$ = rjust$(Moves(lm1), 3)
  848.             t$ = t$ + rjust$(t, 4) + " "
  849.             t$ = t$ + Make4$(m$)
  850.             t$ = t$ + rjust$(Score(lm1, t), 5)
  851.  
  852.             'IF debug = 2 THEN ShowMe 3 + Level, 1, t$
  853.             'LOCATE 34, Level * 20: PRINT t; EndAt; " ";
  854.             CheckBoard Level
  855.             Recurse Level + 1
  856.             TakeBest Level
  857.             IF debug = 1 THEN MoveInfo Level
  858.             i = Index
  859.             Score = Score(Level, 1)
  860.             ' IF Level = 2 THEN Score = Score \ 2
  861.             levm1 = Level - 1
  862.             Score(levm1, i) = Score(levm1, i) - Score
  863.             'ShowMe 35, 130, Make4$(Move$(Level, 1)) + rjust$(Score(Level, 1), 4) + " "
  864.             'ShowMe 36, 130, Make4$(Move$(levm1, i)) + rjust$(Score(levm1, i), 4) + " "
  865.             BoRestore Level
  866.         END IF
  867.     NEXT t
  868.  
  869. FUNCTION rjust$ (t, n)
  870.     rjust$ = RIGHT$("   " + STR$(t), n)
  871.  
  872. SUB ScanKey
  873.     i$ = INKEY$
  874.     IF i$ = "" THEN EXIT SUB
  875.  
  876.     IF LEN(i$) = 1 THEN
  877.         IF i$ = "a" THEN
  878.             OnAuto = NOT (OnAuto)
  879.             IF auto THEN human = 0
  880.         END IF
  881.  
  882.         c = INSTR("123456789)!@#$%", i$)
  883.         IF c > 0 THEN
  884.             SOUND 777, 1
  885.             r = RND * 255: g = RND * 255: b = RND * 255
  886.             c& = _RGB32(r, g, b)
  887.             FOR y = 0 TO ym: FOR x = 0 TO xm
  888.                     p& = POINT(x, y)
  889.                     IF p& = cp&(c) THEN PSET (x, y), c&
  890.             NEXT x: NEXT y
  891.             cp&(c) = c&
  892.             i$ = ""
  893.         END IF
  894.  
  895.         IF i$ = "d" THEN
  896.             i$ = CHR$(255): debug = debug XOR 1
  897.             IF debug = 1 THEN
  898.                 q = 28: xq = q: yq = q '                             size of squares
  899.                 xc = 1100: yc = 160 '                                top left corner of board
  900.             ELSE
  901.                 q = 80: xq = q: yq = q '                             size of squares
  902.                 xc = 600: yc = 460 '                                 top left corner of board
  903.             END IF
  904.             CLS: PlotAll
  905.         END IF
  906.  
  907.         IF i$ = "s" THEN i$ = "": SHELL _DONTWAIT "notepad chtemp.txt"
  908.  
  909.         IF i$ = Esc$ THEN CLOSE: END
  910.     END IF
  911.  
  912. SUB ShowAlgebraic (m$)
  913.     IF WorB = 1 THEN ' white=1, black=0
  914.         Move = Move + 1 ' number the moves
  915.         PRINT #1, RIGHT$("  " + STR$(Move), 3);
  916.         PRINT #1, RIGHT$(SPACE$(10) + m$, 7);
  917.         MoveLog$(Move) = SPACE$(15)
  918.         MID$(MoveLog$(Move), 1, 3) = rjust$(Move, 3)
  919.         MID$(MoveLog$(Move), 5, LEN(m$)) = m$
  920.     ELSE
  921.         MID$(MoveLog$(Move), 11, LEN(m$)) = m$
  922.         PRINT #1, " "; m$
  923.         IF (Move MOD 5) = 0 THEN PRINT #1, ""
  924.     END IF
  925.  
  926.     BeginAt = Move - 39
  927.     IF BeginAt < 1 THEN BeginAt = 1
  928.     dr = 17: dc = 123
  929.     FOR t = BeginAt TO Move
  930.         ShowMe dr + 1, dc, MoveLog$(t)
  931.         dr = dr + 1
  932.         IF dr > 36 THEN
  933.             dr = 17: dc = dc + 15
  934.             IF dc > 138 THEN dr = 36: dc = 138
  935.         END IF
  936.     NEXT t
  937.  
  938. SUB ShowMe (dr, dc, t$)
  939.     sr = CSRLIN '                                                    save row
  940.     sc = POS(0) '                                                    save column
  941.     IF (dr > 0) AND (dr < 50) AND (dc > 0) AND (dc < 150) THEN
  942.         LOCATE dr, dc '                                              display row & column
  943.         PRINT t$;
  944.     END IF
  945.     IF NOT (OnAuto) THEN KeyGet
  946.     LOCATE sr, sc '                                                  restore to old location
  947.  
  948. SUB ShowTime (trow, t!, Desc$)
  949.     s! = t!
  950.     SELECT CASE s!
  951.         CASE IS > 3600
  952.             unit$ = "h"
  953.             s! = s! / 3600
  954.         CASE IS > 60
  955.             unit$ = "m"
  956.             s! = s! / 60
  957.         CASE ELSE
  958.             unit$ = "s"
  959.     END SELECT
  960.  
  961.     trow = trow + 3
  962.     LOCATE trow, 34 - LEN(Desc$): PRINT Desc$;
  963.     LOCATE trow, 34
  964.     PRINT USING "###.#"; s!;
  965.     PRINT unit$
  966.  
  967. SUB TakeBest (Level)
  968.     FOR scram = 0 TO 99
  969.         s1 = RND * (Moves(Level) - 1) + 1
  970.         s2 = RND * (Moves(Level) - 1) + 1
  971.         SWAP Score(Level, s1), Score(Level, s2)
  972.         SWAP Move$(Level, s1), Move$(Level, s2)
  973.         SWAP Index(Level, s1), Index(Level, s2)
  974.     NEXT scram
  975.  
  976.     passes = 0
  977.     ReSort:
  978.     Score = -999 '                                                   assume no moves
  979.     DO
  980.         Sorted = true
  981.         FOR s = 2 TO Moves(Level)
  982.             IF Score(Level, s - 1) < Score(Level, s) THEN
  983.                 Sorted = false
  984.                 SWAP Score(Level, s - 1), Score(Level, s)
  985.                 SWAP Move$(Level, s - 1), Move$(Level, s)
  986.                 SWAP Index(Level, s - 1), Index(Level, s)
  987.             END IF
  988.         NEXT s
  989.     LOOP UNTIL Sorted
  990.  
  991.     m$ = Move$(Level, 1)
  992.     Score = Score(Level, 1)
  993.     Index = Index(Level, 1)
  994.  
  995.     IF Level = 0 THEN
  996.         FOR lb = 0 TO 2 '                                            stop repeats
  997.             IF INSTR(MoveLog$(Move - lb), m$) THEN
  998.                 Score(Level, 1) = Score(Level, 2) - 1 '              best = 2nd best-1
  999.                 passes = passes + 1
  1000.                 IF passes < 5 THEN GOTO ReSort '                     repeat may be only move
  1001.             END IF
  1002.         NEXT lb
  1003.     END IF
  1004.  
  1005.     IF Level = 0 THEN
  1006.         IF Score = -777 THEN '                                       in check, no escape
  1007.             mess$ = "Mate"
  1008.         ELSEIF Score = -999 THEN '                                   no moves
  1009.             mess$ = "Stalemate"
  1010.         END IF
  1011.     END IF
  1012.  
  1013.     IF (Level = 1) AND (Score = 777) THEN Score(0, TieTo(1)) = -777
  1014.  
  1015. 'FUNCTION TextCol (xc)
  1016. '    TextCol = (xc - 1) * 2 + 25
  1017. 'END FUNCTION
  1018.  
  1019. 'FUNCTION TextRow (xr)
  1020. '    TextRow = (8 - xr) * 1 + 8
  1021. 'END FUNCTION
  1022.  
  1023. 'FUNCTION TextVal (xr, xc)
  1024. '    i = b(xr, xc)
  1025. '    i = i + (i > 6) * 6
  1026. '    TextVal = i
  1027. 'END FUNCTION
  1028.  
  1029. SUB fprint (t$)
  1030.     tf = FREEFILE
  1031.     OPEN "chtemp.txt" FOR APPEND AS #tf
  1032.     PRINT #tf, t$;
  1033.     CLOSE #tf
  1034.     IF INSTR(t$, Enter$) THEN
  1035.         linesprinted&& = linesprinted&& + 1
  1036.         IF (linesprinted&& MOD 1000) = 0 THEN LOCATE 1, 130: PRINT linesprinted&&;
  1037.     END IF
  1038.  
  1039. SUB MiscInfo
  1040.     LOCATE 1, 124: PRINT "Plies: "; COMMAND$; "  LP:"; linesprinted&&; redo$;
  1041.  
  1042. SUB TryMove (Level, fr, fc) '                                        from row, from column
  1043.     mp = b(fr, fc)
  1044.     IF mp = 0 THEN END
  1045.     mc = -(mp > 6) - (mp = 0) * 2 '                                  moving color
  1046.     IF mc = 2 THEN END
  1047.     mp = mp + (mp > 6) * 6
  1048.     IF mc = 1 THEN s = -1 ELSE s = 1 '                               direction a pawn moves
  1049.  
  1050.     FOR n = 0 TO 7 '                                                 possible 8 dirs
  1051.         udlr$ = mp$(mp, n) '                                         up/down/left/right
  1052.         IF udlr$ = "0000" THEN EXIT FOR '                            added 2Jan95
  1053.         du = VAL(MID$(udlr$, 1, 1)) '                                direction up
  1054.         dd = VAL(MID$(udlr$, 2, 1)) '                                direction down
  1055.         dl = VAL(MID$(udlr$, 3, 1)) '                                direction left
  1056.         dr = VAL(MID$(udlr$, 4, 1)) '                                direction right
  1057.         IF mp <> Knight THEN '                                       not knight
  1058.             du = SGN(du) * s '                                       one square at a time
  1059.             dd = SGN(dd) * s
  1060.             dl = SGN(dl) * s
  1061.             dr = SGN(dr) * s
  1062.         END IF
  1063.         IF INSTR(udlr$, "8") THEN TrySq = 8 ELSE TrySq = 1
  1064.         IF (mp = Pawn) AND (n = 0) THEN '                            pawn first move?
  1065.             IF (fr = 2) AND (WorB = 1) THEN TrySq = 2 '              gambit for white
  1066.             IF (fr = 7) AND (WorB = 0) THEN TrySq = 2 '              gambit for black
  1067.         END IF
  1068.         tr = fr: tc = fc '                                           row, column
  1069.         'IF TrySq = 0 THEN END
  1070.         FOR sq = 1 TO TrySq '                                        up to 8 loops
  1071.             capture = false
  1072.             Score = 0 '                                              must init
  1073.             tr = tr - du + dd '                                      row=row-up+down
  1074.             tc = tc - dl + dr '                                      column=column-left+right
  1075.             IF (tr < 1) OR (tr > 8) OR (tc < 1) OR (tc > 8) THEN EXIT FOR
  1076.             cp = b(tr, tc) '                                         capture piece
  1077.             cc = -(cp > 6) - (cp = 0) * 2 '                          capture color
  1078.             cp = cp + (cp > 6) * 6
  1079.             IF mc = cc THEN '                                        own piece!
  1080.                 EXIT FOR
  1081.             ELSEIF (mc XOR 1) = cc THEN '                            capture
  1082.                 IF (mp = Pawn) AND (n = 0) THEN EXIT FOR '           no diag, no cap!
  1083.                 capture = true
  1084.                 '                 RNBQKP
  1085.                 Score = VAL(MID$("533901", cp, 1)) * 10
  1086.                 IF (Score > 0) AND (Level = 0) THEN Score = Score + 2
  1087.                 IF Score = 0 THEN Score = 777 '                      king capture
  1088.                 ' IF redo AND (Score = 777) THEN Score = 25
  1089.             ELSE
  1090.                 IF (mp = Pawn) AND (n > 0) THEN EXIT FOR
  1091.             END IF
  1092.             IF mp = Pawn THEN
  1093.                 IF (tr = 1) OR (tr = 8) THEN '                       promote pawn
  1094.                     IF Score <> 777 THEN Score = Score + 99
  1095.                 END IF
  1096.             END IF
  1097.  
  1098.             InCheck = (mc = SaveWorB) AND check
  1099.             ' small plus for king moving out of check
  1100.             IF (mp = King) AND InCheck THEN Score = Score + 2
  1101.  
  1102.             ' leave king cap scores, also normal bonuses if in check
  1103.             IF (Score <> 777) AND (NOT (InCheck)) AND (mp <> King) THEN
  1104.                 dis1 = ABS(fr - kr) + ABS(fc - kc) '                 get closer to king
  1105.                 dis2 = ABS(tr - kr) + ABS(tc - kc)
  1106.                 ' IF dis2 < dis1 THEN Score = Score + (dis1 - dis2)
  1107.                 Score = Score + dis1 - dis2
  1108.  
  1109.                 IF Move < 30 THEN
  1110.                     dir = SGN((fr - tr) * s)
  1111.                     IF dir = 1 THEN Score = Score + 2 '              move ahead at begin & mid
  1112.                 END IF
  1113.  
  1114.                 IF mp <> Rook THEN '                                 priority to getting a piece first moved
  1115.                     IF b(fr, fc) = o(fr, fc) THEN Score = Score + 1
  1116.                 END IF
  1117.  
  1118.                 ' priority to getting a piece off the bottom rank
  1119.                 IF (fr = 1) AND (tr > 1) AND (WorB = 1) THEN Score = Score + 1
  1120.                 IF (fr = 8) AND (tf < 8) AND (WorB = 0) THEN Score = Score + 1
  1121.             END IF
  1122.  
  1123.             fs$ = MID$("abcdefgh", fc, 1) + CHR$(48 + fr) '          from square
  1124.             ts$ = MID$("abcdefgh", tc, 1) + CHR$(48 + tr) '          to square
  1125.             AddIt Level, fs$ + ts$, Score
  1126.             'IF capture AND (mp <> Pawn) THEN EXIT FOR '             stop looking
  1127.         NEXT sq
  1128.     NEXT n
  1129.  
It works better if you plug it in.

Offline romichess

  • Forum Regular
  • Posts: 145
    • View Profile
Re: A 90% complete chess engine
« Reply #2 on: January 25, 2020, 12:07:31 pm »
I wish that I had the time to study your code. I'm not fast. Never have been. What you report to have done in a couple hours would take me weeks. But, I have a different take on one issue.

Quote
I think some folks might need to be reminded of the so-called chess algorithm. Computers are stupid, they have no intuition, and certainly can't play chess like a person.

Here is one of many post about my engine RomiChess.

Quote
While Romi made Alfil look like an amateur with his mature positional play!

Look at that good knight vs bad bishop scenario - very human-like, the way Romi seems to be angling for this outcome.

One can look at the game here: http://talkchess.com/forum3/viewtopic.php?f=2&t=66154&p=745438&hilit=romichess+human#p745438

I'm sure that I can find a couple dozen more if I look.
My name is Michael, but you can call me Mike :)

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: A 90% complete chess engine
« Reply #3 on: January 26, 2020, 10:40:51 am »
I wish that I had the time to study your code. I'm not fast. Never have been. What you report to have done in a couple hours would take me weeks. But, I have a different take on one issue.

Here is one of many post about my engine RomiChess.

One can look at the game here: http://talkchess.com/forum3/viewtopic.php?f=2&t=66154&p=745438&hilit=romichess+human#p745438

I'm sure that I can find a couple dozen more if I look.

Ha! A least one week would be more believable but maybe he Trumped up his memory. ;-))


@ Richard Frost, do you check the code before you post? (I ask because this is 2nd time in row I try your code and run smack into error but I know the forum code editor sometimes changes code too though rare). Does the computer only play with itself? Here is screen shot of my Run, is the board supposed to be all the way to right with extra row of squares and run into the play listing? The chess pieces and board look great though tiny for this old man's eyes. I know you said bugs but man!

Quote
The code is entirely mine,...
I am big fan of this approach, I will show you mine.
Chess by R Frost.PNG
* Chess by R Frost.PNG (Filesize: 24.25 KB, Dimensions: 815x630, Views: 179)

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: A 90% complete chess engine
« Reply #4 on: January 26, 2020, 10:53:10 am »
Here is mine with kibitzing from TempodiBasic and Adrian's chess pieces, an extended study of the chess program that came with QB64 samples. Actually TempodiBasic did much more than kibitz (no, I am not Jewish but I seem to gravitate towards... maybe it's the Jewish comedians?), TempodiBasic's help prolonged my interest enough to get this 800+ more lines than it was and some of the bugs of chess engine fixed (still plenty more!), see development notes. Speaking of comedians, this should give our resident chess expert, Romichess, a good laugh! ;-))

Code: QB64: [Select]
  1. _TITLE "Chess 2017-11-22 T .bas     Ctrl+K for Keyboard input"
  2. '2017-10-10 raw patch of Interface to Chess.bas post update with mouse troubles
  3.  
  4. ' 22 10 2017 New fix to Incheck function, I hope the last!
  5. ' 22 10 2017  empowered promotion by mouse
  6. ' 22 10 2017  fix promotion visible only after move of black
  7. ' 22 10 2017 castle by mouse
  8. ' 22 10 2017  empowered castling control, now you cannot castle if they are in check
  9. '             or across a square that is under Black control
  10. ' 22 10 2017 translated in sub Info_Help screen
  11. ' 22 10 2017  translate in sub Fellippe's Wait click and key
  12. ' 22 10 2017 added logical end to the main of program
  13. ' 22 10 2017 put away all code REMMED not yet used
  14.  
  15. '2017 10 24 changed board graphics, arranged alpha order subs, updated highlite square
  16. ' Thanks Adrian Huang
  17. ' http://www.thejoyfulprogrammer.com/qb64/forum/showthread.php?tid=401&rndtime=1508625987687357559
  18.  
  19. '2017 10 24 Incorporate TempodiBasic's legalShow and legalHide routines
  20. ' fix pawn promotions see Ppromote$
  21. ' count pieces captured and show with board
  22. ' install game recorder
  23.  
  24. ' 27 10 2017 color of chessboard are CONST
  25. ' resizing square and character size to  42
  26. ' moving list of piece captured at top right
  27. ' moving output at bottom right
  28. ' new SUB ShowSetup that shows whole setup to choose pieces for white and black,
  29. ' or only pieces capturable (No king because when a King falls game stops!)
  30. ' or only pieces for promotion (Knight Bishop Rook Queen) for both colors
  31. ' now if Black resigns the flow of program ends after main do loop to let replay the game
  32. ' play again label structure and initialization instruction (it is possible to use a DO LOOP)
  33. ' Added ButtonMenuBar at bottom using MakeButton SUB
  34. ' Button QUIT working, button PLAY works for now let us play only as WHITE
  35. ' Build an area for list of moves
  36. ' build an area for output/feedback of program
  37. ' Changed Helpscreen instruction including mouse selection
  38. ' >>>> wow lots of new stuff
  39.  
  40. '2017-10-29/30 fixed dots in empty squares, highlight piece clicked, thing crawling under board while computer thinks
  41. ' now if we can only get the colors ;-)) Outer loop to restart game, elimate some boxes, less cluttered looking.
  42. ' change title to version = date easier to track
  43.  
  44. '2017 10 31 T  Yes I follow you in using date also if in my country I use DD-MM-YYYY   :-)
  45. '  YES fixed BIG BUG about restart and Play Again lasting the last moves in memory... and in File Recorder
  46.  
  47. '2017-11-01 B review TempodiBasic's BIG BUG fix, clean up lines, comments and variables
  48. ' I (bplus) see some work also done in IO for checking checks, I assume.
  49.  
  50. '2017-11-03 B Move Intro to before main program loop, fix some things with promotion
  51. ' prompt for pieces, pWflag$, pBflag$ to add to move list
  52.  
  53. '2017-11-04 B hack AI this is just an experiment for my cat who is always curious specially
  54. ' because it exists in another universe.
  55.  
  56. '2017-11-06 A 2nd post (really posted 11-05) Added/revised code for rotating board to play Black.
  57. ' Adrain has change 5000 number to 9000 im several places and I don't know if this fixes castle
  58. ' It did fix notation in the moves list correctly
  59.  
  60. '2017-11-05 B  from Adrian's 2nd post 2017-11-06( posted 11-05) A #2   continuing with hackBlack hacks!
  61. ' I noticed that code changes were very alike and one fuction would save quite a bit of code FIXED
  62. ' I also noticed the captured pieces were backwards when Black plays FIXED
  63. ' I noticed Black cant castle yet BIGGEST FIX of them all!!!
  64. ' I noticed Ctrl+K for human playing Black did not work, well had to translate move back so
  65. ' IO can reverse again!!  FIXED!
  66. ' Check pawn promotion and track down source of mystery q added to computer's moves.
  67. ' Still allot of goofy things...
  68.  
  69. '2017-11-07 A - removed fake 1st move while playing black
  70.  
  71. '2017-11-07 B hack 2 using above mod but with EXIT SUB instead of GOTO
  72. ' fix capture counts so that only positive counts show
  73. ' Ah found source of allot of goofyness!  hackBlack > playBlack per Adrian
  74. ' I think I have this working correctly through Play Again Y/N?
  75.  
  76. '2017-11-07 T put away GOTO for label 100 to play again
  77. ' moved in main loop AI resign (strange as white it capture by King and then when you takes King it resign!!!
  78. ' GOOD first AI goes on playing without king :-)
  79. '
  80. '2017-11-07 2B removed 100 next to loop since no goto, fixed comments on separate line
  81. ' and added some comments, I think I have finally tracked down source of extra q's!!! FIXED
  82.  
  83. ' 2017-11-10 T  fixed promotion  failure with strange choose made clicking on the other side of window of program
  84. ' at the Y of piece to get by promotion
  85. '   Restored  MAXLEVEL at beginning of program to set power of AI
  86. '
  87. ' 2017-11-10 2T cutting some old comments no more useful for use about issues yet resolved
  88. ' packing the 2 initboard to one (they do the same work with 2 different labels)
  89. '
  90. '2017-11-11 B Put T comments on separate line from code.
  91. 'Recommend making MAXLEVEL a CONST if we will not change it ever.
  92. 'Tell why two different boards are needed to initialize the board positions.
  93. 'Fix pWfalg$ again! that AI has no business changing BUT OK save ElSE block because AI
  94. 'may need to plan for eventual pawn promotion and assuming a Queen is smart assumption.
  95. '
  96. ' 2017-11-13 T  fixed incheck failure and strange moves of king under check using a new shared flag Turn
  97. ' to let analize only the important pieces by INCHECK Function, they are different for White and for Black
  98. ' re-written in MAKEMOVE SUB (sub that makes the move on the board and check for promotion and makes the promotion if is the case
  99. ' the ELSE.. END IF part for white (Human) player is needed together INTFLAG  =1 humang chooses by himself piece in promotion, =0 autochoosed Queen
  100. ' also fixed extra q by inizilization of pWflag$ at start of SUB
  101. '
  102. '2017-11-15 B start work on Undo, Save and Load
  103. ' 2 functions cp2n(piece$), cn2p$(number), for converting a board to a bString$ letter and vice versa
  104. ' bString$ will get all board positions loaded in 64 character string
  105. ' bSetyp will setup a board from a bString$ used for UNDO, Save, Load and future SETUP
  106. ' Center text in a button
  107. ' Now reworked initBoard so initBlack sub can be eliminated and initBoard shrunk, now eliminated also!
  108. ' Now add stuff to make UNDO possible. new Boards$() array works along with Move$(), Boards$() has bString$ of board positions
  109. ' Incorp TempodiBasic changes to AI checking for Check (Chess 2_17-11-13 T) :
  110. '    Use new glabal varaible Turn = 1 for White's and -1 for Black, might come in handy! Yes on loading Game
  111. '        Eliminate the infinite crap I'd rather have AI King commiting suicide as a form of Resign for testing all other stuff
  112. '           Except Then AI plays old trick of putting oppenent into Check for which human is not allowed to take AI KING because in check!!! phooey!
  113. ' Moved ShowButton Bar and showMoveList into ShowBd and gave showMoveList a diet
  114. ' No more File recorder, eliminate Datetime, fix UNDO for trying to go less than 1
  115. ' Remove InitBoard sub, all done in getInput button section
  116.  
  117. ' Fix a ton of bugs to get all this integrated and working together but more keep popping up, blah!
  118. ' Make Result global to fix Y/N question to start over when Y
  119. ' Modify restart to clean slate the entire program, then use buttons to set particular settings needed
  120. ' Bug Loading a game right after Loading a game may cause an error
  121. ' Bug sometimes QB64 _FILEEXISTS says a real file that you typed correctly can't be found, just type it in again.
  122. ' I put a double _FILEEXISTS call in with delay between, helps but still the bug remains!!!
  123. ' Bug missing line when human loads a file playing black and starts game from there.
  124. ' Ugly fix that I doubt will work in other cases
  125.  
  126. '2017-11-16 A Tried to fix bug when AI is checkmated by modifying INCHECK function
  127. '             Minor changes - removed 1 set of board labels. display pieces centrally on squares
  128.  
  129. '2017-11-16 B Adrian some nice changes to board but please no PlayAgain: label, no GOTO unless best way
  130. ' I do not like ending the whole application in the InCheck sub,  nor do I think one time result <-2500 is cause to quit??
  131. ' Remember AI checks many moves with InCheck, I am afraid it might quit first time it gets result < -2500 with better result left.
  132. ' Also I fix my omission with loadFlag code in IO, and it turns out with UNDO we have to clear the capture amounts, fixed.
  133.  
  134. '2017-11-18 A1: Changed White King Value to 4500, Black King value to -9000. Added test for AI's resignation in IO SUB. This should fix the AI check bug, and probably means that the
  135. '           IN CHECK function need not check for checks to AI's king.
  136.  
  137. '2017-11-19 T: fixing the covering of the left border of buttonbar (Movelist too large passed from 700 to 680)
  138. ' 2017-11-22 T: fixing dummy _fileexists, it seems we don't need it yet
  139. ' 2017 11 22 T : coded manageDummySystem on save file, 1. now you can save only a game in progress  (no game = nothing to save)
  140. '                                                      2. now you can overwrite an existing file only if you confirm to overwrite it
  141. '                coded  feedback LoadFile in areaoutput
  142.  
  143.  
  144. CONST XMAX = 900
  145. CONST YMAX = 600
  146. CONST WHITE& = &HFFDDDDDD
  147. CONST BLACK& = &HFF000000
  148. CONST LITE& = &HFFFFFF00
  149. CONST LITE2& = _RGB32(78, 161, 72)
  150. CONST WHITES& = _RGB32(140, 160, 190)
  151. CONST BLACKS& = _RGB32(0, 130, 70)
  152. CONST SQ = 42
  153. 'T here (B out side of restart sub) we need a Maxlevel
  154. CONST MAXLEVEL = 5
  155. 'B might as well make constant!
  156.  
  157. 'B For fonts
  158. COMMON SHARED FW, FH, normal&, maxCol, bArial&, bFW, bFH
  159.  
  160. 'B For human playing Black
  161. COMMON SHARED playBlack, bmoves$, bFirst
  162.  
  163. 'B from original QB64 samples: chess.bas
  164. DIM SHARED BOARD(0 TO 7, 0 TO 7)
  165. DIM SHARED BESTA(0 TO 7), BESTB(0 TO 7), BESTX(0 TO 7), BESTY(0 TO 7)
  166. DIM SHARED LEVEL, SCORE, result
  167. DIM SHARED wcKsflag, wcQsflag, INTFLAG
  168. DIM SHARED wcKsold, wcQsold
  169.  
  170. 'B For saving moves to file
  171. DIM SHARED whiteMove$, blackMove$, pWflag$, pBflag$, GameFile$, Turn
  172.  
  173. 'B For displaying T's on screen list of moves, last 8 shown from Moves$() array
  174. DIM SHARED InGame, countMove, loadFlag
  175. REDIM SHARED Move$(1 TO 300)
  176.  
  177. 'B for Undo
  178. REDIM SHARED Boards$(1 TO 300)
  179.  
  180. 'B Using updated Graphics Screen instead of Screen 0 text program
  181. SCREEN _NEWIMAGE(XMAX, YMAX, 32)
  182. _SCREENMOVE 360, 60
  183.  
  184. 'B Checking fonts normal, big, and chess
  185. 'B load and check our normal font
  186. normal& = _LOADFONT("C:\windows\fonts\arial.ttf", 20)
  187. IF normal& <= 0 THEN PRINT "Trouble with arial.ttf size 16 file, goodbye.": SLEEP: END
  188. _FONT normal&
  189. FW = 11: FH = _FONTHEIGHT(normal&)
  190. maxCol = XMAX / FW
  191.  
  192. 'B load and check SQ size font
  193. bArial& = _LOADFONT("C:\windows\fonts\arial.ttf", SQ, "MONOSPACE")
  194. IF bArial& <= 0 THEN PRINT "Trouble with arial.ttf size "; SQ; " file, goodbye.": SLEEP: END
  195. bFW = _FONTWIDTH(bArial&): bFH = _FONTHEIGHT(bArial&)
  196.  
  197. Intro
  198. Wait_Click_Key
  199.     SCORE = 0
  200.     CALL IO(A, b, x, Y, result)
  201.     'B   HERE IS WHERE CHECKMATE NEEDS TO BE DETERMINED!!!
  202.     IF result < -2500 THEN
  203.         'T & B Human has won
  204.         AreaOutput "I RESIGN!! YOU WIN!!!", " Play Again? Y/N "
  205.         DO
  206.             Revenge$ = UCASE$(INKEY$)
  207.         LOOP UNTIL Revenge$ = "Y" OR Revenge$ = "N"
  208.         IF Revenge$ = "N" THEN
  209.             AreaOutput "Thanks for playing,", "Good Bye!"
  210.             SLEEP 2
  211.             SYSTEM
  212.         END IF
  213.         restart
  214.         InGame = 0
  215.     ELSE
  216.         result = EVALUATE(-1, 10000)
  217.         A = BESTA(1)
  218.         b = BESTB(1)
  219.         x = BESTX(1)
  220.         Y = BESTY(1)
  221.     END IF
  222.     CALL SHOWBD
  223.  
  224. '==========================================================
  225.  
  226. 'B sub for user communications area, T has made it for two strings
  227. SUB AreaOutput (outText$, out2$)
  228.     LINE (480, 510)-(XMAX, YMAX), BLACK&, BF
  229.     lp 26, 46, outText$
  230.     lp 27, 46, out2$
  231.  
  232. SUB BISHOP (A, B, XX(), YY(), NDX)
  233.     ID = SGN(BOARD(B, A))
  234.     FOR DXY = 1 TO 7
  235.         X = A - DXY
  236.         Y = B + DXY
  237.         IF X < 0 OR X > 7 OR Y < 0 OR Y > 7 THEN EXIT FOR
  238.         GOSUB 3
  239.         IF BOARD(Y, X) <> 0 THEN EXIT FOR
  240.     NEXT
  241.     FOR DXY = 1 TO 7
  242.         X = A + DXY
  243.         Y = B + DXY
  244.         IF X < 0 OR X > 7 OR Y < 0 OR Y > 7 THEN EXIT FOR
  245.         GOSUB 3
  246.         IF BOARD(Y, X) <> 0 THEN EXIT FOR
  247.     NEXT
  248.     FOR DXY = 1 TO 7
  249.         X = A - DXY
  250.         Y = B - DXY
  251.         IF X < 0 OR X > 7 OR Y < 0 OR Y > 7 THEN EXIT FOR
  252.         GOSUB 3
  253.         IF BOARD(Y, X) <> 0 THEN EXIT FOR
  254.     NEXT
  255.     FOR DXY = 1 TO 7
  256.         X = A + DXY
  257.         Y = B - DXY
  258.         IF X < 0 OR X > 7 OR Y < 0 OR Y > 7 THEN EXIT FOR
  259.         GOSUB 3
  260.         IF BOARD(Y, X) <> 0 THEN EXIT FOR
  261.     NEXT
  262.     EXIT SUB
  263.  
  264.     'sub gosub subroutine
  265.    3 REM
  266.     IF ID <> SGN(BOARD(Y, X)) THEN
  267.         NDX = NDX + 1
  268.         XX(NDX) = X
  269.         YY(NDX) = Y
  270.     END IF
  271.     RETURN
  272.  
  273. SUB bSetup (bStr$)
  274.     FOR X = 0 TO 7
  275.         FOR Y = 0 TO 7
  276.             p$ = MID$(bStr$, 8 * X + Y + 1, 1)
  277.             BOARD(X, Y) = cp2n(p$)
  278.         NEXT
  279.     NEXT
  280.  
  281. FUNCTION bString$
  282.     r$ = ""
  283.     FOR X = 0 TO 7
  284.         FOR Y = 0 TO 7
  285.             num = BOARD(X, Y)
  286.             r$ = r$ + cn2p$(num)
  287.         NEXT
  288.     NEXT
  289.     bString$ = r$
  290.  
  291. FUNCTION Castleincheck (x)
  292.     'T added to improve short castle control
  293.     IF playBlack THEN
  294.         BOARD(7, 1) = 4500
  295.         'T first square acrossed
  296.         null = INCHECK(x)
  297.         BOARD(7, 1) = 0
  298.         'T original square void
  299.         IF null = 0 THEN
  300.             'T if already in first test King is in check we skip second test
  301.             BOARD(7, 2) = 4500
  302.             'T second square acrossed
  303.             null = INCHECK(x)
  304.             BOARD(7, 2) = 0
  305.         END IF
  306.         Castleincheck = null
  307.     ELSE
  308.         BOARD(7, 6) = 4500
  309.         'T first square acrossed
  310.         null = INCHECK(x)
  311.         BOARD(7, 6) = 0
  312.         'T original square void
  313.         IF null = 0 THEN
  314.             'T if already in first test King is in check we skip second test
  315.             BOARD(7, 5) = 4500
  316.             'T second square acrossed
  317.             null = INCHECK(x)
  318.             BOARD(7, 5) = 0
  319.         END IF
  320.         Castleincheck = null
  321.     END IF
  322.  
  323. FUNCTION CastleincheckL (x)
  324.     'T added to improve long castle control
  325.     IF playBlack THEN
  326.         BOARD(7, 4) = 4500
  327.         null = INCHECK(x)
  328.         BOARD(7, 4) = 0
  329.         'T original square void
  330.         IF null = 0 THEN
  331.             'T if already in first test King is in check we skip second test
  332.             BOARD(7, 5) = 4500
  333.             'T C1 square
  334.             null = INCHECK(x)
  335.             BOARD(7, 5) = 0
  336.         END IF
  337.         CastleincheckL = null
  338.     ELSE
  339.         BOARD(7, 3) = 4500
  340.         'T or B or A D1 square
  341.         null = INCHECK(x)
  342.         BOARD(7, 3) = 0
  343.         'T original square void
  344.         IF null = 0 THEN
  345.             'T if already in first test King is in check we skip second test
  346.             BOARD(7, 2) = 4500
  347.             'T C1 square
  348.             null = INCHECK(x)
  349.             BOARD(7, 2) = 0
  350.         END IF
  351.         CastleincheckL = null
  352.     END IF
  353.  
  354. FUNCTION cn2p$ (n)
  355.     SELECT CASE n
  356.         CASE 0: r$ = "z"
  357.         CASE 100: r$ = "P"
  358.         CASE 270: r$ = "N"
  359.         CASE 300: r$ = "B"
  360.         CASE 500: r$ = "R"
  361.         CASE 900: r$ = "Q"
  362.         CASE 4500: r$ = "K"
  363.         CASE -100: r$ = "p"
  364.         CASE -270: r$ = "n"
  365.         CASE -300: r$ = "b"
  366.         CASE -500: r$ = "r"
  367.         CASE -900: r$ = "q"
  368.         CASE -9000: r$ = "k"
  369.     END SELECT
  370.     cn2p$ = r$
  371.  
  372. FUNCTION cp2n (piece$)
  373.     SELECT CASE piece$
  374.         CASE "z": r = 0
  375.         CASE "P": r = 100
  376.         CASE "N": r = 270
  377.         CASE "B": r = 300
  378.         CASE "R": r = 500
  379.         CASE "Q": r = 900
  380.         CASE "K": r = 4500
  381.         CASE "p": r = -100
  382.         CASE "n": r = -270
  383.         CASE "b": r = -300
  384.         CASE "r": r = -500
  385.         CASE "q": r = -900
  386.         CASE "k": r = -9000
  387.     END SELECT
  388.     cp2n = r
  389.  
  390. SUB cP (row, txt$)
  391.     'B on row center Print txt$
  392.     col = (maxCol - LEN(txt$)) / 2
  393.     _PRINTSTRING ((XMAX - _PRINTWIDTH(txt$)) / 2, row * FH), txt$
  394.  
  395. FUNCTION EVALUATE (ID, PRUNE)
  396.     DIM XX(0 TO 26), YY(0 TO 26)
  397.     LEVEL = LEVEL + 1
  398.     BESTSCORE = 10000 * ID
  399.     FOR b = 7 TO 0 STEP -1
  400.         FOR A = 7 TO 0 STEP -1
  401.             IF SGN(BOARD(b, A)) <> ID THEN GOTO 1
  402.             'Orig IF (LEVEL = 1) THEN CALL SHOWMAN(A, B)
  403.             'B this might be human versus human level?
  404.  
  405.             CALL MOVELIST(A, b, XX(), YY(), NDX)
  406.             FOR I = 0 TO NDX
  407.                 X = XX(I)
  408.                 Y = YY(I)
  409.                 IF LEVEL = 1 THEN
  410.                     AreaOutput "TRYING: " + CHR$(65 + A) + RIGHT$(STR$(8 - b), 1) + "-" + CHR$(65 + X) + RIGHT$(STR$(8 - Y), 1), ""
  411.                     'B Might as well make this look nice too, without the space
  412.                 END IF
  413.                 OLDSCORE = SCORE
  414.                 MOVER = BOARD(b, A)
  415.                 TARGET = BOARD(Y, X)
  416.                 CALL MAKEMOVE(A, b, X, Y)
  417.                 IF (LEVEL < MAXLEVEL) THEN SCORE = SCORE + EVALUATE(-ID, BESTSCORE - TARGET + ID * (8 - ABS(4 - X) - ABS(4 - Y)))
  418.                 SCORE = SCORE + TARGET - ID * (8 - ABS(4 - X) - ABS(4 - Y))
  419.                 IF (ID < 0 AND SCORE > BESTSCORE) OR (ID > 0 AND SCORE < BESTSCORE) THEN
  420.                     BESTA(LEVEL) = A
  421.                     BESTB(LEVEL) = b
  422.                     BESTX(LEVEL) = X
  423.                     BESTY(LEVEL) = Y
  424.                     BESTSCORE = SCORE
  425.                     IF (ID < 0 AND BESTSCORE >= PRUNE) OR (ID > 0 AND BESTSCORE <= PRUNE) THEN
  426.                         BOARD(b, A) = MOVER
  427.                         BOARD(Y, X) = TARGET
  428.                         SCORE = OLDSCORE
  429.                         LEVEL = LEVEL - 1
  430.                         EVALUATE = BESTSCORE
  431.                         EXIT FUNCTION
  432.                     END IF
  433.                 END IF
  434.                 BOARD(b, A) = MOVER
  435.                 BOARD(Y, X) = TARGET
  436.                 SCORE = OLDSCORE
  437.             NEXT
  438.        1 NEXT
  439.     NEXT
  440.     LEVEL = LEVEL - 1
  441.     EVALUATE = BESTSCORE
  442.  
  443. FUNCTION getInput$
  444.     DIM pieceChosen AS _BYTE
  445.     DO
  446.         'B Update board
  447.         SHOWBD
  448.  
  449.         'B gather mouse input
  450.         DO WHILE _MOUSEINPUT
  451.             mouseButton = _MOUSEBUTTON(1)
  452.             tx = _MOUSEX \ SQ - 1: ty = _MOUSEY \ SQ - 1
  453.             ux = tx: uy = ty
  454.         LOOP
  455.  
  456.         'T area of managing Button Bar
  457.         IF _MOUSEBUTTON(1) THEN
  458.             IF _MOUSEX > 700 THEN
  459.                 IF _MOUSEY < 120 THEN
  460.                     'B PLAY WHITE
  461.                     restart
  462.                     InGame = -1
  463.                     Turn = 1
  464.                     playBlack = 0
  465.                     bSetup "rnbqkbnrppppppppzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzPPPPPPPPRNBQKBNR"
  466.                     AreaOutput "Your move.", ""
  467.                     getInput$ = ""
  468.                     EXIT FUNCTION
  469.                 ELSEIF _MOUSEY < 180 THEN
  470.                     'B PLAY BLACK there was a FEN around here also
  471.  
  472.                     'T this is the FEN of initial game setup
  473.                     '  [rnbqkbnr/pppppppp/8/8/8/8/PPPPPPPP/RNBQKBNR w KQkq - 0 1]
  474.                     restart
  475.                     InGame = -1
  476.                     Turn = -1
  477.                     playBlack = -1
  478.                     bSetup "rnbkqbnrppppppppzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzPPPPPPPPRNBKQBNR"
  479.                     getInput$ = ""
  480.                     EXIT FUNCTION
  481.                 ELSEIF _MOUSEY < 240 THEN
  482.                     'B UNDO
  483.                     IF countMove - 1 > 1 THEN
  484.                         Move$(countMove) = ""
  485.                         Boards$(countMove) = ""
  486.                         countMove = countMove - 1
  487.                         whiteMove$ = "": blackMove$ = "": bmoves$ = "": bFirst = -1
  488.                         bSetup Boards$(countMove)
  489.                         IF playBlack = 0 THEN AreaOutput "Your move.", ""
  490.                         '_DISPLAY
  491.                         EXIT FUNCTION
  492.                     END IF
  493.                 ELSEIF _MOUSEY < 300 THEN
  494.                     'B SAVE BOARD
  495.                     'T if you are not in game what are you saving in a file?
  496.                     IF InGame = 0 THEN EXIT FUNCTION
  497.                     ' T file exists, overwirte? Y/N
  498.                     DO
  499.                         in$ = ""
  500.                         in$ = screenInput(50 * FW, 4 * FH, "Enter Save Filename > ")
  501.                         IF _FILEEXISTS(in$) = -1 AND in$ <> "" THEN
  502.                             COLOR LITE&
  503.                             AreaOutput "File exists...", " Overwrite Y/N?"
  504.                             _DISPLAY
  505.                             COLOR WHITE&
  506.                             choice$ = UCASE$(INPUT$(1))
  507.                             IF choice$ = "Y" THEN EXIT DO
  508.                         ELSE
  509.                             ' case _fileexists(in$) = 0
  510.                             EXIT DO
  511.                         END IF
  512.  
  513.                     LOOP
  514.  
  515.                     OPEN in$ FOR OUTPUT AS #1
  516.                     IF playBlack THEN PRINT #1, "Black" ELSE PRINT #1, "White"
  517.                     PRINT #1, blackMove$
  518.                     'we need AI's move made if any since last Move$() entry
  519.                     FOR i = 1 TO countMove
  520.                         PRINT #1, Move$(i)
  521.                     NEXT
  522.                     FOR i = 1 TO countMove
  523.                         PRINT #1, Boards$(i)
  524.                     NEXT
  525.                     CLOSE #1
  526.                     AreaOutput "File " + ins$, "loaded"
  527.                     _DELAY 1
  528.                     IF playBlack = 0 THEN
  529.                         AreaOutput "Your move.", ""
  530.                     ELSE
  531.                         bmove$ = blackMove$
  532.                         bFirst = 0
  533.                     END IF
  534.                     getInput$ = ""
  535.                     EXIT FUNCTION
  536.                 ELSEIF _MOUSEY < 360 THEN
  537.                     'B  LOAD Board
  538.                     in$ = screenInput(50 * FW, 4 * FH, "Enter Load Filename > ")
  539.                     'B  for some damn reason the first time you try _FILEEXISTS with real file it says 0 nope!
  540.                     'B                 but try again and is OK ?????????????????????????????????????????
  541.                     'B                 So f... IT!
  542.                     ' dummy = _FILEEXISTS(in$)
  543.                     '_DELAY 1
  544.                     'B  once is not enough, damn this sucks!!!!!!
  545.                     'dummy = _FILEEXISTS(in$)
  546.                     '_DELAY 1
  547.                     'B  nope didn't help with 2nd call and delay, just try LOAD GAME again!
  548.                     IF _FILEEXISTS(in$) = -1 THEN
  549.  
  550.                         count = 0
  551.                         OPEN in$ FOR INPUT AS #1
  552.                         WHILE EOF(1) = 0
  553.                             INPUT #1, l$
  554.                             count = count + 1
  555.                         WEND
  556.                         CLOSE #1
  557.  
  558.                         ' T feedback to user
  559.                         COLOR LITE&
  560.                         AreaOutput "File loaded", in$
  561.                         COLOR WHITE&
  562.                         _DISPLAY
  563.                         _DELAY 1
  564.  
  565.                         restart
  566.                         countMove = (count - 2) / 2
  567.                         'B This gets needed data items before loading 2 arrays of size countMove
  568.                         OPEN in$ FOR INPUT AS #1
  569.                         INPUT #1, BW$
  570.                         IF LEFT$(BW$, 1) = "B" THEN playBlack = -1 ELSE playBlack = 0
  571.                         INPUT #1, blackMove$
  572.                         'B  this gets AI's last move (if any) not recorded in Move$()
  573.                         '   OK maybe we have to pretend the blackMove$ is whiteMove$ so IO can reverse it when recording in Move$()
  574.                         FOR i = 1 TO countMove
  575.                             INPUT #1, Move$(i)
  576.                         NEXT
  577.                         FOR i = 1 TO countMove
  578.                             INPUT #1, Boards$(i)
  579.                         NEXT
  580.                         CLOSE #1
  581.                         CLS
  582.                         bSetup Boards$(countMove)
  583.                         'B loadFlag is ugly way to fix a missing line in move list that occurs loading a game with human playing Black
  584.                         IF playBlack = 0 THEN AreaOutput "Your move.", "" ELSE loadFlag = -1
  585.                         InGame = -1
  586.                     ELSE
  587.                         AreaOutput in$, "File not found."
  588.                     END IF
  589.                 ELSEIF _MOUSEY < 420 THEN
  590.                     'B MANUAL SET
  591.                 ELSEIF _MOUSEY < 480 THEN
  592.                     'T quit
  593.                     getInput$ = "QUIT"
  594.                     EXIT FUNCTION
  595.                 END IF
  596.             END IF
  597.         END IF
  598.  
  599.         IF InGame = -1 THEN
  600.             IF pieceChosen = 0 THEN
  601.                 IF 1 <= ty AND ty <= 8 THEN
  602.                     'Fellippe or B translate hovered coordinate to chess notation letter + digit
  603.                     d$ = RIGHT$(STR$(9 - ty), 1)
  604.                     IF 1 <= tx AND tx <= 8 THEN
  605.                         l$ = CHR$(64 + tx)
  606.                         ld$ = l$ + d$
  607.                         'B letter + digit
  608.                         ld2xy ld$, bx, by
  609.                         'B translate notation to board$(x, y)
  610.                         IF BOARD(by, bx) > 0 THEN
  611.                             LegalShow bx, by
  612.                             highLightSq bx, by, LITE2&
  613.                             'Fellippe hover highlight
  614.                             IF mouseButton THEN
  615.                                 DO WHILE mouseButton
  616.                                     'Fellippe wait for release
  617.                                     i = _MOUSEINPUT
  618.                                     mouseButton = _MOUSEBUTTON(1)
  619.                                     newtx = _MOUSEX \ SQ - 1: newty = _MOUSEY \ SQ - 1
  620.                                 LOOP
  621.                                 IF newtx = tx AND newty = ty THEN
  622.                                     'Fellippe the mouse was released in the same square
  623.                                     pieceChosen = -1: chosenBX = bx: chosenBY = by
  624.                                 END IF
  625.                             END IF
  626.                         END IF
  627.                     END IF
  628.                 END IF
  629.             ELSE
  630.                 LegalShow chosenBX, chosenBY
  631.                 highLightSq chosenBX, chosenBY, LITE&
  632.                 IF 1 <= uy AND uy <= 8 THEN
  633.                     'B translate click to chess notation letter + digit
  634.                     d2$ = RIGHT$(STR$(9 - uy), 1)
  635.                     IF 1 <= ux AND ux <= 8 THEN
  636.                         l2$ = CHR$(64 + ux)
  637.                         ld2$ = l2$ + d2$
  638.                         'B letter + digit
  639.                         ld2xy ld2$, bx2, by2
  640.                         highLightSq bx2, by2, LITE2&
  641.                         'Fellippe hover highlight
  642.                         IF mouseButton THEN
  643.                             DO WHILE mouseButton
  644.                                 'Fellippe wait for release
  645.                                 i = _MOUSEINPUT
  646.                                 mouseButton = _MOUSEBUTTON(1)
  647.                                 newtx = _MOUSEX \ SQ - 1: newty = _MOUSEY \ SQ - 1
  648.                             LOOP
  649.                             IF newtx = tx AND newty = ty THEN
  650.                                 'Fellippe the mouse was released in the same square
  651.                                 IF ld$ <> ld2$ THEN
  652.                                     getInput$ = ld$ + "-" + ld2$
  653.                                     'T this let AI to castle for white
  654.                                     IF BOARD(by, bx) = 4500 THEN
  655.                                         IF ld$ = "E1" AND ld2$ = "G1" THEN getInput$ = "O-O"
  656.                                         IF ld$ = "E1" AND ld2$ = "C1" THEN getInput$ = "O-O-O"
  657.                                         IF playBlack = -1 THEN
  658.                                             IF ld$ = "D1" AND ld2$ = "B1" THEN getInput$ = "O-O"
  659.                                             IF ld$ = "D1" AND ld2$ = "F1" THEN getInput$ = "O-O-O"
  660.                                         END IF
  661.                                     END IF
  662.                                     _AUTODISPLAY
  663.                                     EXIT FUNCTION
  664.                                 ELSE
  665.                                     LegalHide bx, by
  666.                                     SHOWMAN bx, by
  667.                                     EXIT DO
  668.                                 END IF
  669.                                 'B ld compare
  670.                             END IF
  671.                         END IF
  672.                     END IF
  673.                     'B ux compare
  674.                 END IF
  675.                 'B uy compare
  676.             END IF
  677.             'B piece chosen yet
  678.  
  679.             'B handle keyboard input
  680.             k$ = INKEY$
  681.             IF k$ <> "" THEN
  682.                 IF LEN(k$) = 1 THEN
  683.                     IF ASC(k$) = 11 THEN
  684.                         in$ = screenInput(50 * FW, 4 * FH, "(Esc to quit) Enter Move > ")
  685.                         in$ = UCASE$(in$)
  686.                         spac = INSTR(in$, " ")
  687.                         IF spac THEN in$ = MID$(in$, 1, spac - 1) + "-" + MID$(in$, spac + 1)
  688.                         IF playBlack THEN in$ = w2b$(in$)
  689.                         getInput$ = in$
  690.                         EXIT FUNCTION
  691.                     ELSEIF ASC(k$) = 27 THEN
  692.                         END
  693.                     END IF
  694.                 END IF
  695.             END IF
  696.         END IF
  697.         'B if InGame
  698.         _DISPLAY
  699.     LOOP
  700.     lastLD$ = ""
  701.     getInput$ = in$
  702.  
  703. SUB highLightSq (bx, by, c&)
  704.     LINE ((bx + 2) * SQ, (by + 2) * SQ)-((bx + 3) * SQ, (by + 3) * SQ), , B
  705.     LINE ((bx + 2) * SQ + 1, (by + 2) * SQ + 1)-((bx + 3) * SQ - 1, (by + 3) * SQ - 1), c&, B
  706.     LINE ((bx + 2) * SQ + 2, (by + 2) * SQ + 2)-((bx + 3) * SQ - 2, (by + 3) * SQ - 2), c&, B
  707.  
  708. FUNCTION INCHECK (X)
  709.     DIM XX(27), YY(27), NDX
  710.     FOR b = 0 TO 7
  711.         FOR A = 0 TO 7
  712.  
  713.             IF BOARD(b, A) = 0 THEN GOTO 6
  714.             'T original code BOARD(b,A) >= 0  if white piece or void square skip test
  715.             'A: omit square skip test
  716.             'B Adrian next line is OK, it just skips empty spaces in board
  717.  
  718.             CALL MOVELIST(A, b, XX(), YY(), NDX)
  719.             FOR I = 0 TO NDX STEP 1
  720.                 X = XX(I)
  721.                 Y = YY(I)
  722.                 IF BOARD(Y, X) = 4500 AND Turn = 1 THEN
  723.                     'B ^^^ 2017-11-13 T has added and turn = 1 but turn = 1 is same as playBlack = 0
  724.                     AreaOutput "YOU ARE IN CHECK!", ""
  725.                     INCHECK = 1
  726.                     EXIT FUNCTION
  727.                 END IF
  728.                 IF BOARD(Y, X) = -9000 AND Turn = -1 THEN
  729.                     'B ^^^ 2017-11-13 T has added and turn = -1 but turn = -1 is same as playBlack = -1
  730.                     ' T in my last read of code posted playBack is used to note that Human plays as black
  731.                     ' T Turn is used for knowing if the move  has been made by black Turn = -1 or by White Turn = 1
  732.                     AreaOutput "I AM IN CHECK!", ""
  733.  
  734.                     'T this show Black status incheck
  735.                     INCHECK = -1 'A: this is probably no longer needed
  736.                     'T this should stop failed moves under check attack
  737.                     'EXIT FUNCTION
  738.                     'B exit now and get infinite loop?
  739.                     ' T AI force must exit from loop
  740.                 END IF
  741.             NEXT
  742.        6 NEXT
  743.     NEXT
  744.     INCHECK = 0
  745.  
  746. SUB initBoard
  747.     IF playBlack THEN
  748.         b$ = "rnbkqbnrppppppppzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzPPPPPPPPRNBKQBNR"
  749.     ELSE
  750.         b$ = "rnbqkbnrppppppppzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzPPPPPPPPRNBQKBNR"
  751.     END IF
  752.     bSetup b$
  753.  
  754. SUB Intro
  755.     'T better have a subroutine that we can use as many as we want
  756.     COLOR WHITE&, BLACK&
  757.     cP 3, "QB64 CHESS"
  758.     lp 5, 8, "CHESS is a game played between two players on a board of 64 squares."
  759.     lp 6, 4, "Chess was first invented in its current form in Europe during the late"
  760.     lp 7, 4, "fifteenth century. It evolved from much earlier forms invented in India"
  761.     lp 8, 4, "and Persia."
  762.     lp 9, 8, "The pieces are divided into Black and White.  Each player has 16 pieces:"
  763.     lp 10, 4, "1 king, 1 queen, 2 rooks, 2 bishops, 2 knights, and 8 pawns.  White makes"
  764.     lp 11, 4, "the first move.  The players alternate moving one piece at a time.  Pieces"
  765.     lp 12, 4, "are moved to an unoccupied square, or moved onto a square occupied by an"
  766.     lp 13, 4, "opponent's piece, capturing it.  When the king is under attack, he is in"
  767.     lp 14, 4, "CHECK.  The player cannot put his king in check.  The object is to CHECKMATE"
  768.     lp 15, 4, "the opponent.  This occurs when the king is in check and there is no way to"
  769.     lp 16, 4, "remove the king from attack."
  770.     lp 17, 8, "To move the pieces on the chessboard, click by mouse or type after Ctrl+K"
  771.     lp 18, 4, "notation, e.g. E2-E4 (not in English notation like P-K4).  To castle, type O-O"
  772.     lp 19, 4, "to castle kingside or O-O-O to castle queenside like in English notation."
  773.     lp 20, 4, "To exit the game, type QUIT or press ESCAPE key."
  774.     cP 25, "Click or press any key to continue."
  775.  
  776. SUB IO (A, B, X, Y, RESULT)
  777.     DIM XX(0 TO 26), YY(0 TO 26)
  778.     IF InGame THEN
  779.         'B ugly fix to get a missing line recorded in move list when load file and human playing black
  780.         IF loadFlag AND blackMove$ <> "" THEN
  781.             loadFlag = 0
  782.             countMove = countMove + 1
  783.             Move$(countMove) = blackMove$ + pBflag$ + "  " + whiteMove$ + pWflag$
  784.             'B this above is so ugly I even have to reverse black and white to get it right!
  785.             Boards$(countMove) = bString$
  786.             'B this above was omitted in versions before 11-16, still not right???
  787.         END IF
  788.  
  789.         IF A >= 0 THEN
  790.             Turn = -1
  791.             IF RESULT < -2500 THEN EXIT SUB 'AI should resign
  792.             PIECE = BOARD(Y, X)
  793.             CALL MAKEMOVE(A, B, X, Y)
  794.             'T (chess2_17-11-13 T) this will fix illegal moves of AI under check
  795.             NULL = INCHECK(0)
  796.             'T (chess2_17-11-13 T) we must search for check after choosing a move
  797.  
  798.             'B Adrian, can't have game end here, many moves are checked can't quit if one is bad
  799.             'IF NULL = -1 AND RESULT < -2500 THEN
  800.             '    AreaOutput "AI resigns!", ""
  801.             '    EXIT SUB
  802.             'END IF
  803.  
  804.             IF NULL THEN
  805.                 'T (chess2_17-11-13 T) if there is a check for AI we must restore situation before move
  806.                 BOARD(B, A) = BOARD(Y, X)
  807.                 BOARD(Y, X) = PIECE
  808.                 EXIT SUB
  809.                 'T (chess2_17-11-13 T) if it is check move is illegal
  810.             END IF
  811.             'T this show Black status incheck
  812.  
  813.             mymove$ = CHR$(65 + A) + RIGHT$(STR$(8 - B), 1) + "-" + CHR$(65 + X) + RIGHT$(STR$(8 - Y), 1)
  814.  
  815.             'B ??? next line not used
  816.             'AICHECK = 0 'reset AI check flag
  817.  
  818.             IF playBlack THEN mymove$ = w2b$(mymove$)
  819.             AreaOutput "MY MOVE: " + mymove$, ""
  820.             blackMove$ = mymove$
  821.             IF whiteMove$ <> "" THEN
  822.                 IF playBlack THEN whiteMove$ = w2b$(whiteMove$)
  823.             END IF
  824.             WriteEntry
  825.         END IF
  826.         'B & T >>> it saves the last moves to file and to list I move this IF HERE TO GET THE COUPLE WHITE+BLACK
  827.  
  828.         IF PIECE <> 0 THEN
  829.             s$ = "I TOOK YOUR "
  830.             IF PIECE = 100 THEN s$ = s$ + "PAWN           "
  831.             IF PIECE = 270 THEN s$ = s$ + "KNIGHT         "
  832.             IF PIECE = 300 THEN s$ = s$ + "BISHOP         "
  833.             IF PIECE = 500 THEN s$ = s$ + "ROOK           "
  834.             IF PIECE = 900 THEN s$ = s$ + "QUEEN          "
  835.             IF PIECE = 4500 THEN s$ = s$ + "KING          "
  836.             AreaOutput "", s$
  837.         END IF
  838.  
  839.     END IF
  840.  
  841.     DO
  842.         'B I think this was help from Adrian, so we didn't have to fake a move
  843.         IF playBlack = -1 AND countMove = 0 THEN countMove = 1: EXIT SUB
  844.  
  845.         'B Here we get Human's move but might be illegal so AI has to check before shown
  846.         in$ = getInput$
  847.         'T getinput$ takes user's input also for BUTTONBAR
  848.         'B which is why we have to have to check InGame
  849.  
  850.         IF UCASE$(in$) = "QUIT" THEN END
  851.  
  852.         IF InGame = -1 THEN
  853.             whiteMove$ = in$
  854.             'B ^^^ Human's move who now plays Black or White, don't be fooled by variable name>
  855.             'B Originally human always played white>
  856.             Turn = 1
  857.             IF UCASE$(in$) = "O-O" OR in$ = "0-0" THEN
  858.                 'T short castle rules... here we improve control of check and moves
  859.                 IF wcKsflag <> 0 THEN GOTO 16
  860.                 ' T it skips white castle king
  861.                 IF playBlack THEN
  862.                     IF BOARD(7, 0) <> 500 THEN GOTO 16
  863.                     IF BOARD(7, 1) <> 0 OR BOARD(7, 2) <> 0 THEN GOTO 16
  864.                 ELSE
  865.                     IF BOARD(7, 7) <> 500 THEN GOTO 16
  866.                     IF BOARD(7, 6) <> 0 OR BOARD(7, 5) <> 0 THEN GOTO 16
  867.                 END IF
  868.                 'T now we test if there is a check along the path of king
  869.                 NULL = Castleincheck(0)
  870.                 IF NULL = 0 THEN
  871.                     'B you can castle king side
  872.                     IF playBlack THEN
  873.                         BOARD(7, 1) = 4500
  874.                         BOARD(7, 3) = 0
  875.                         BOARD(7, 2) = 500
  876.                         BOARD(7, 0) = 0
  877.                         wcKsflag = -1
  878.                         'T black castle king side
  879.                         whiteMove$ = "O-O"
  880.                         EXIT SUB
  881.                     ELSE
  882.                         BOARD(7, 6) = 4500
  883.                         BOARD(7, 4) = 0
  884.                         BOARD(7, 5) = 500
  885.                         BOARD(7, 7) = 0
  886.                         wcKsflag = -1
  887.                         'T white castle king side
  888.                         whiteMove$ = "O-O"
  889.                         EXIT SUB
  890.                     END IF
  891.                 END IF
  892.             END IF
  893.             IF UCASE$(in$) = "O-O-O" OR in$ = "0-0-0" THEN
  894.                 'T long castle rules... here we improve control of check and moves
  895.                 IF wcQsflag <> 0 THEN GOTO 16
  896.                 IF playBlack THEN
  897.                     IF BOARD(7, 7) <> 500 THEN GOTO 16
  898.                     IF BOARD(7, 6) <> 0 OR BOARD(7, 5) <> 0 OR BOARD(7, 4) <> 0 THEN GOTO 16
  899.                 ELSE
  900.                     IF BOARD(7, 0) <> 500 THEN GOTO 16
  901.                     IF BOARD(7, 1) <> 0 OR BOARD(7, 2) <> 0 OR BOARD(7, 3) <> 0 THEN GOTO 16
  902.                 END IF
  903.                 'T now we test if there is a check along the path of king
  904.                 NULL = CastleincheckL(0)
  905.                 IF NULL = 0 THEN
  906.                     'B you can castle queen side
  907.                     IF playBlack THEN
  908.                         BOARD(7, 5) = 4500
  909.                         BOARD(7, 3) = 0
  910.                         BOARD(7, 4) = 500
  911.                         BOARD(7, 7) = 0
  912.                         wcQsflag = -1
  913.                         'T black castle queen side
  914.                         whiteMove$ = "O-O-O"
  915.                         EXIT SUB
  916.                     ELSE
  917.                         'T you can castle if there are no check to the king to the start or during the movement of castle
  918.                         BOARD(7, 2) = 4500
  919.                         BOARD(7, 4) = 0
  920.                         BOARD(7, 3) = 500
  921.                         BOARD(7, 0) = 0
  922.                         wcQsflag = -1
  923.                         'T white castle queen side
  924.                         whiteMove$ = "O-O-O"
  925.                         EXIT SUB
  926.                     END IF
  927.                 END IF
  928.             END IF
  929.             IF LEN(in$) < 5 THEN GOTO 16
  930.             B = 8 - (ASC(MID$(in$, 2, 1)) - 48)
  931.             A = ASC(UCASE$(MID$(in$, 1, 1))) - 65
  932.             X = ASC(UCASE$(MID$(in$, 4, 1))) - 65
  933.             Y = 8 - (ASC(MID$(in$, 5, 1)) - 48)
  934.             IF B > 7 OR B < 0 OR A > 7 OR A < 0 OR X > 7 OR X < 0 OR Y > 7 OR Y < 0 THEN GOTO 16
  935.             IF BOARD(B, A) <= 0 THEN GOTO 16
  936.             IF Y = 2 AND B = 3 AND (X = A - 1 OR X = A + 1) THEN
  937.                 IF BOARD(B, A) = 100 AND BOARD(Y, X) = 0 AND BOARD(Y + 1, X) = -100 THEN
  938.                     IF BESTB(1) = 1 AND BESTA(1) = X THEN
  939.                         MOVER = BOARD(B, A)
  940.                         TARGET = BOARD(Y, X)
  941.                         CALL MAKEMOVE(A, B, X, Y)
  942.                         BOARD(Y + 1, X) = 0
  943.                         ENPASSANT = -1
  944.                         GOTO 15
  945.                     END IF
  946.                 END IF
  947.             END IF
  948.             CALL MOVELIST(A, B, XX(), YY(), NDX)
  949.             FOR K = 0 TO NDX STEP 1
  950.                 IF X = XX(K) AND Y = YY(K) THEN
  951.                     MOVER = BOARD(B, A)
  952.                     TARGET = BOARD(Y, X)
  953.  
  954.                     INTFLAG = -1
  955.                     'B so this is where INTFLAG is set
  956.  
  957.                     CALL MAKEMOVE(A, B, X, Y)
  958.                     IF MOVER = 4500 THEN
  959.                         wcQsold = wcQsflag
  960.                         wcKsold = wcKsflag
  961.                         wcKsflag = -1
  962.                         wcQsflag = -1
  963.                     END IF
  964.                     IF (A = 0) AND (B = 7) AND (MOVER = 500) THEN
  965.                         wcQsold = wcQsflag
  966.                         wcQsflag = -1
  967.                     END IF
  968.                     IF (A = 7) AND (B = 7) AND (MOVER = 500) THEN
  969.                         wcKsold = wcKsflag
  970.                         wcKsflag = -1
  971.                     END IF
  972.  
  973.                     INTFLAG = 0
  974.                     'B and this is where INTFLAG is unset!
  975.  
  976.                     15 IF INCHECK(0) = 0 THEN EXIT SUB
  977.  
  978.                     BOARD(B, A) = MOVER
  979.                     BOARD(Y, X) = TARGET
  980.                     IF ENPASSANT THEN BOARD(Y + 1, X) = -100: ENPASSANT = 0
  981.                     IF (A = 0) AND (B = 7) AND (MOVER = 500) THEN wcQsflag = wcQsold
  982.                     IF (A = 7) AND (B = 7) AND (MOVER = 500) THEN wcKsflag = wcKsold
  983.                     IF MOVER = 4500 THEN wcQsflag = wcQsold
  984.                     GOTO 16
  985.                 END IF
  986.             NEXT
  987.         END IF
  988.        16
  989.  
  990.     LOOP
  991.     'B OK so this keeps looping until white makes legal move?
  992.  
  993.  
  994. FUNCTION isWhite (x, y)
  995.     'B for squares and old for chess font
  996.     yes = 0
  997.     IF y MOD 2 = 0 THEN
  998.         IF x MOD 2 = 0 THEN
  999.             yes = -1
  1000.         END IF
  1001.     ELSE
  1002.         IF x MOD 2 = 1 THEN
  1003.             yes = -1
  1004.         END IF
  1005.     END IF
  1006.     isWhite = yes
  1007.  
  1008. SUB KING (A, B, XX(), YY(), NDX)
  1009.     ID = SGN(BOARD(B, A))
  1010.     FOR DY = -1 TO 1
  1011.         IF B + DY < 0 OR B + DY > 7 THEN GOTO 12
  1012.         FOR DX = -1 TO 1
  1013.             IF A + DX < 0 OR A + DX > 7 THEN GOTO 11
  1014.             IF ID <> SGN(BOARD(B + DY, A + DX)) THEN
  1015.                 NDX = NDX + 1
  1016.                 XX(NDX) = A + DX
  1017.                 YY(NDX) = B + DY
  1018.             END IF
  1019.        11 NEXT
  1020.    12 NEXT
  1021.  
  1022. SUB KNIGHT (A, B, XX(), YY(), NDX)
  1023.     ID = SGN(BOARD(B, A))
  1024.     X = A - 1
  1025.     Y = B - 2
  1026.     GOSUB 5
  1027.     X = A - 2
  1028.     Y = B - 1
  1029.     GOSUB 5
  1030.     X = A + 1
  1031.     Y = B - 2
  1032.     GOSUB 5
  1033.     X = A + 2
  1034.     Y = B - 1
  1035.     GOSUB 5
  1036.     X = A - 1
  1037.     Y = B + 2
  1038.     GOSUB 5
  1039.     X = A - 2
  1040.     Y = B + 1
  1041.     GOSUB 5
  1042.     X = A + 1
  1043.     Y = B + 2
  1044.     GOSUB 5
  1045.     X = A + 2
  1046.     Y = B + 1
  1047.     GOSUB 5
  1048.     EXIT SUB
  1049.    5 REM
  1050.     IF X < 0 OR X > 7 OR Y < 0 OR Y > 7 THEN RETURN
  1051.     IF ID <> SGN(BOARD(Y, X)) THEN NDX = NDX + 1: XX(NDX) = X: YY(NDX) = Y
  1052.     RETURN
  1053.  
  1054. SUB ld2xy (ld$, dx, dy)
  1055.     'B dx and dy are going to be changed to find
  1056.     'B position (and thus type) of piece on the board from ld$
  1057.     letter$ = UCASE$(LEFT$(ld$, 1))
  1058.     dx = ASC(letter$) - 65
  1059.     digit = VAL(RIGHT$(ld$, 1))
  1060.     dy = 8 - digit
  1061.  
  1062. SUB LegalHide (x, y)
  1063.     DIM XX(0 TO 26), YY(0 TO 26)
  1064.     CALL MOVELIST(x, y, XX(), YY(), NDX)
  1065.     FOR a = 0 TO NDX STEP 1
  1066.         IF XX(a) >= 0 AND YY(a) >= 0 THEN SHOWMAN YY(a), XX(a)
  1067.     NEXT
  1068.  
  1069. 'T THIS SUB calculates legal position of piece in the board cell x,y
  1070. SUB LegalShow (x, y)
  1071.     DIM XX(0 TO 26), YY(0 TO 26)
  1072.     CALL MOVELIST(x, y, XX(), YY(), NDX)
  1073.     FOR a = 0 TO NDX STEP 1
  1074.         IF XX(a) >= 0 AND YY(a) >= 0 THEN highLightSq XX(a), YY(a), LITE2&
  1075.     NEXT
  1076.  
  1077. 'B graphics version of Locate col, row : Print txt$
  1078. SUB lp (row, col, txt$)
  1079.     _PRINTSTRING (col * FW, row * FH), txt$
  1080.  
  1081. SUB MakeButton (x1, y1, x2, y2, txt$, Col&)
  1082.     LINE (x1, y1)-(x2, y2), Col&, BF
  1083.     LINE (x1, y1)-(x2, y2), WHITE&, B
  1084.     LINE (x1 + 4, y2 - 4)-(x2 - 4, y2 - 4), _RGB32(222, 238, 227), B
  1085.     LINE (x2 - 4, y2 - 4)-(x2 - 4, y1 + 4), _RGB32(222, 238, 227), B
  1086.     'B VVV let's print button labels in middle of button
  1087.     _PRINTSTRING (x1 + 15, y2 - 1.35 * FH), txt$
  1088.  
  1089. SUB MAKEMOVE (A, B, X, Y)
  1090.     'B makemove is called many times, the last decides whether pBflag$ gets set or NOT
  1091.     'B the pWflag$ should only be set by user, no automatic setting allowed by AI.
  1092.     pBflag$ = ""
  1093.     BOARD(Y, X) = BOARD(B, A)
  1094.     BOARD(B, A) = 0
  1095.     IF Y = 0 AND BOARD(Y, X) = 100 THEN
  1096.         ' T it is the row 8
  1097.         IF INTFLAG THEN
  1098.             DO
  1099.                 AreaOutput "Promote to:", ""
  1100.                 I$ = Ppromote$
  1101.                 SELECT CASE UCASE$(I$)
  1102.                     CASE "KNIGHT", "N", "KT", "KT.", "N."
  1103.                         PROMOTE = 270: pWflag$ = "N"
  1104.                     CASE "BISHOP", "B", "B."
  1105.                         PROMOTE = 300: pWflag$ = "B"
  1106.                     CASE "ROOK", "R", "R."
  1107.                         PROMOTE = 500: pWflag$ = "R"
  1108.                     CASE "QUEEN", "Q", "Q."
  1109.                         PROMOTE = 900: pWflag$ = "Q"
  1110.                 END SELECT
  1111.             LOOP UNTIL PROMOTE <> 0
  1112.             IF playBlack THEN pWflag$ = LCASE$(pWflag$)
  1113.             'B       only the human can set the pWflag$
  1114.  
  1115.             BOARD(Y, X) = PROMOTE
  1116.             CLS
  1117.             SHOWBD
  1118.             _DISPLAY
  1119.         ELSE
  1120.             BOARD(Y, X) = 900
  1121.             'B ^^^^ OK AI need the line for checking FUTURE!!! moves
  1122.         END IF
  1123.     END IF
  1124.  
  1125.     IF Y = 7 AND BOARD(Y, X) = -100 THEN
  1126.         rap = -1
  1127.         BOARD(Y, X) = -900
  1128.         IF playBlack THEN pBflag$ = "Q" ELSE pBflag$ = "q"
  1129.     END IF
  1130.  
  1131.  
  1132. SUB MOVELIST (A, B, XX(), YY(), NDX)
  1133.     PIECE = INT(ABS(BOARD(B, A)))
  1134.     NDX = -1
  1135.     SELECT CASE PIECE
  1136.         CASE IS = 100
  1137.             CALL PAWN(A, B, XX(), YY(), NDX)
  1138.         CASE IS = 270
  1139.             CALL KNIGHT(A, B, XX(), YY(), NDX)
  1140.         CASE IS = 300
  1141.             CALL BISHOP(A, B, XX(), YY(), NDX)
  1142.         CASE IS = 500
  1143.             CALL ROOK(A, B, XX(), YY(), NDX)
  1144.         CASE IS = 900
  1145.             CALL QUEEN(A, B, XX(), YY(), NDX)
  1146.         CASE IS = 4500
  1147.             CALL KING(A, B, XX(), YY(), NDX)
  1148.         CASE IS = 9000
  1149.             CALL KING(A, B, XX(), YY(), NDX)
  1150.     END SELECT
  1151.  
  1152. SUB PAWN (A, B, XX(), YY(), NDX)
  1153.     ID = SGN(BOARD(B, A))
  1154.     ' T ID 1 for white piece and -1 for black piece
  1155.     IF (A - 1) >= 0 AND (A - 1) <= 7 AND (B - ID) >= 0 AND (B - ID) <= 7 THEN
  1156.         IF SGN(BOARD((B - ID), (A - 1))) = -ID THEN
  1157.             NDX = NDX + 1
  1158.             XX(NDX) = A - 1
  1159.             YY(NDX) = B - ID
  1160.         END IF
  1161.     END IF
  1162.     IF (A + 1) >= 0 AND (A + 1) <= 7 AND (B - ID) >= 0 AND (B - ID) <= 7 THEN
  1163.         IF SGN(BOARD((B - ID), (A + 1))) = -ID THEN
  1164.             NDX = NDX + 1
  1165.             XX(NDX) = A + 1
  1166.             YY(NDX) = B - ID
  1167.         END IF
  1168.     END IF
  1169.     IF A >= 0 AND A <= 7 AND (B - ID) >= 0 AND (B - ID) <= 7 THEN
  1170.         IF BOARD((B - ID), A) = 0 THEN
  1171.             NDX = NDX + 1
  1172.             XX(NDX) = A
  1173.             YY(NDX) = B - ID
  1174.             IF (ID < 0 AND B = 1) OR (ID > 0 AND B = 6) THEN
  1175.                 IF BOARD((B - ID - ID), A) = 0 THEN
  1176.                     NDX = NDX + 1
  1177.                     XX(NDX) = A
  1178.                     YY(NDX) = B - ID - ID
  1179.                 END IF
  1180.             END IF
  1181.         END IF
  1182.     END IF
  1183.  
  1184.  
  1185. 'B a pawn needs promotion to a piece, which? use mouse or keyboard
  1186. FUNCTION Ppromote$
  1187.     inp$ = "": ky = 0: oldtext$ = prompt$ + " {" + inp$ + "}"
  1188.     newText$ = oldtext$
  1189.     DO WHILE ky <> 13
  1190.         i = _MOUSEINPUT
  1191.         ty = (_MOUSEY + 24) / SQ
  1192.         ' T we must control also X dimension not only Y dimension for mouse in Area Promotion
  1193.         IF _MOUSEBUTTON(1) = -1 AND (_MOUSEX >= 500 AND _MOUSEX <= 700) THEN
  1194.             IF ty > 1 THEN
  1195.                 IF ty = 2 THEN inp$ = "Q": EXIT DO
  1196.                 IF ty = 3 THEN inp$ = "R": EXIT DO
  1197.                 IF ty = 4 THEN inp$ = "B": EXIT DO
  1198.                 IF ty = 5 THEN inp$ = "N": EXIT DO
  1199.             ELSE
  1200.                 inp$ = ""
  1201.                 'T no good click
  1202.             END IF
  1203.         END IF
  1204.         AreaOutput "Promote Enter Q R B N", newText$
  1205.         _DISPLAY
  1206.         oldtext$ = newText$
  1207.         k$ = INKEY$
  1208.         IF LEN(k$) THEN
  1209.             ky = ASC(RIGHT$(k$, 1))
  1210.             IF 31 < ky AND ky < 127 THEN
  1211.                 inp$ = inp$ + CHR$(ky)
  1212.             ELSEIF ky = 8 THEN
  1213.                 IF LEN(inp$) THEN inp$ = LEFT$(inp$, LEN(inp$) - 1)
  1214.             END IF
  1215.             newText$ = prompt$ + " {" + inp$ + "}"
  1216.         END IF
  1217.     LOOP
  1218.     Ppromote$ = inp$
  1219.     'B don't worry about case, it gets checked later
  1220.  
  1221. SUB QUEEN (A, B, XX(), YY(), NDX)
  1222.     CALL BISHOP(A, B, XX(), YY(), NDX)
  1223.     CALL ROOK(A, B, XX(), YY(), NDX)
  1224.  
  1225. SUB restart
  1226.     'B restart variables
  1227.     CLS
  1228.     ERASE BOARD
  1229.     REDIM Move$(1 TO 300)
  1230.     REDIM Boards$(1 TO 300)
  1231.     'B need to start array at 1 not 0
  1232.     result = -2500
  1233.     wcKsflag = 0: wcQsflag = 0: wcKsold = 0: wcQsold = 0
  1234.     LEVEL = 0: INTFLAG = 0: countMove = 0
  1235.     whiteMove$ = "": blackMove$ = "": bmoves$ = "": bFirst = -1
  1236.  
  1237. SUB ROOK (A, B, XX(), YY(), NDX)
  1238.     ID = SGN(BOARD(B, A))
  1239.     FOR X = A - 1 TO 0 STEP -1
  1240.         IF ID <> SGN(BOARD(B, X)) THEN
  1241.             NDX = NDX + 1
  1242.             XX(NDX) = X
  1243.             YY(NDX) = B
  1244.         END IF
  1245.         IF (BOARD(B, X)) <> 0 THEN EXIT FOR
  1246.     NEXT
  1247.     FOR X = A + 1 TO 7 STEP 1
  1248.         IF ID <> SGN(BOARD(B, X)) THEN
  1249.             NDX = NDX + 1
  1250.             XX(NDX) = X
  1251.             YY(NDX) = B
  1252.         END IF
  1253.         IF (BOARD(B, X)) <> 0 THEN EXIT FOR
  1254.     NEXT
  1255.     FOR Y = B - 1 TO 0 STEP -1
  1256.         IF ID <> SGN(BOARD(Y, A)) THEN
  1257.             NDX = NDX + 1
  1258.             XX(NDX) = A
  1259.             YY(NDX) = Y
  1260.         END IF
  1261.         IF (BOARD(Y, A)) <> 0 THEN EXIT FOR
  1262.     NEXT
  1263.     FOR Y = B + 1 TO 7 STEP 1
  1264.         IF ID <> SGN(BOARD(Y, A)) THEN
  1265.             NDX = NDX + 1
  1266.             XX(NDX) = A
  1267.             YY(NDX) = Y
  1268.         END IF
  1269.         IF (BOARD(Y, A)) <> 0 THEN EXIT FOR
  1270.     NEXT
  1271.  
  1272. 'B This is INPUT for graphic screens
  1273. FUNCTION screenInput$ (pixelX, pixelY, prompt$)
  1274.     inp$ = ""
  1275.     ky = 0: oldtext$ = prompt$ + " {" + inp$ + "}"
  1276.     newText$ = oldtext$
  1277.     COLOR LITE&
  1278.     WHILE ky <> 13
  1279.         AreaOutput newText$, ""
  1280.         _DISPLAY
  1281.         oldtext$ = newText$
  1282.         k$ = INKEY$
  1283.         IF LEN(k$) THEN
  1284.             ky = ASC(RIGHT$(k$, 1))
  1285.             IF 31 < ky AND ky < 127 THEN
  1286.                 inp$ = inp$ + CHR$(ky)
  1287.             ELSEIF ky = 8 THEN
  1288.                 IF LEN(inp$) THEN inp$ = LEFT$(inp$, LEN(inp$) - 1)
  1289.             END IF
  1290.             newText$ = prompt$ + " {" + inp$ + "}    "
  1291.         END IF
  1292.     WEND
  1293.     COLOR WHITE&
  1294.     screenInput$ = inp$
  1295.  
  1296. 'B show entire board captured pieces also used for pawn promotion, Move List, Buttons, Debug Info
  1297. SUB SHOWBD
  1298.     COLOR WHITE&, 0
  1299.     _FONT bArial&
  1300.     'B print board labels for files
  1301.     LOCATE 2, 3:
  1302.     IF playBlack = -1 THEN PRINT "HGFEDCBA" ELSE PRINT "ABCDEFGH";
  1303.     'LOCATE 11, 3:                                                          ' A: display 1 set of labels only
  1304.     'IF playBlack = -1 THEN PRINT "HGFEDCBA" ELSE PRINT "ABCDEFGH";
  1305.     'B print board labels for ranks
  1306.     FOR i = 8 TO 1 STEP -1
  1307.         BLR$ = RIGHT$(STR$(i), 1)
  1308.         IF playBlack THEN BLR$ = w2b$(BLR$)
  1309.         LOCATE 8 - i + 3, 2: PRINT BLR$;
  1310.         '    LOCATE 8 - i + 3, 11: PRINT BLR$;
  1311.     NEXT
  1312.     'B Count captures by start of standard set on board and deduct each piece on board
  1313.     DIM c(-6 TO 6)
  1314.     c(-6) = 1: c(-5) = 2: c(-4) = 2: c(-3) = 2: c(-2) = 8: c(-1) = 1
  1315.     c(6) = 1: c(5) = 2: c(4) = 2: c(3) = 2: c(2) = 8: c(1) = 1
  1316.     FOR x = 0 TO 7
  1317.         FOR y = 0 TO 7
  1318.             SHOWMAN x, y
  1319.             _FONT bArial&
  1320.             SELECT CASE BOARD(x, y)
  1321.                 CASE -900: IF c(-6) THEN c(-6) = c(-6) - 1
  1322.                 CASE -500: IF c(-5) THEN c(-5) = c(-5) - 1
  1323.                 CASE -300: IF c(-4) THEN c(-4) = c(-4) - 1
  1324.                 CASE -270: IF c(-3) THEN c(-3) = c(-3) - 1
  1325.                 CASE -100: IF c(-2) THEN c(-2) = c(-2) - 1
  1326.                 CASE -9000: IF c(-1) THEN c(-1) = c(-1) - 1
  1327.                 CASE 4500: IF c(1) THEN c(1) = c(1) - 1
  1328.                 CASE 100: IF c(2) THEN c(2) = c(2) - 1
  1329.                 CASE 270: IF c(3) THEN c(3) = c(3) - 1
  1330.                 CASE 300: IF c(4) THEN c(4) = c(4) - 1
  1331.                 CASE 500: IF c(5) THEN c(5) = c(5) - 1
  1332.                 CASE 900: IF c(6) THEN c(6) = c(6) - 1
  1333.             END SELECT
  1334.         NEXT
  1335.     NEXT
  1336.     'B below need to blackout captures in case UNDO undoes one
  1337.     LINE (12 * SQ, 0)-(700, 9 * SQ), BLACK&, BF
  1338.     'Draw Capture pieces section
  1339.     FOR b = 0 TO 4
  1340.         FOR a = 1 TO 2
  1341.             IF isWhite(a, b) THEN COLOR WHITES& ELSE COLOR BLACKS&
  1342.             LINE (((a * 2) + 10) * SQ, (b + 1) * SQ)-STEP(SQ, SQ), , BF
  1343.             PRESET (((a * 2) + 10) * SQ + 8, (b + 1) * SQ + 36) 'A: centralise pieces
  1344.             IF a = 2 THEN DRAW "C" + STR$(BLACK&) ELSE DRAW "C" + STR$(WHITE&)
  1345.             SELECT CASE b
  1346.                 'A  draw outlines for captured area
  1347.                 CASE 0: DRAW "R26U5H2L6E9U11G4H6G4H4G6H4D11F9L6G2D5"
  1348.                 CASE 1: DRAW "R26U5H2L5U7E3R4U10L6D3L4U3L6D3L4U3L6D10R4F3D7L5G2D5"
  1349.                 CASE 2: DRAW "R26U5H2L8E6U9H2G8H2E8H2L6G6D9F6L8G2D5"
  1350.                 CASE 3: DRAW "R26U5H2U4E2U9H6L9G10D4F2R4E3R4G8L4G2D5"
  1351.                 CASE 4: DRAW "R26U5H2L6U7E3U6H3L10G3D6F3D7L6G2D5"
  1352.                 CASE 5: DRAW "R26U5H2L5E7U6H4L5G3U5R2U2L2U2L2D2L2D2R2D5H3L5G4D6F7L5G2D5"
  1353.             END SELECT
  1354.             DRAW "BE2"
  1355.             'A  MOVE PEN INSIDE
  1356.             IF a = 2 THEN DRAW "P" + STR$(BLACK&) + "," + STR$(BLACK&)
  1357.             IF a = 1 THEN DRAW "P" + STR$(WHITE&) + "," + STR$(WHITE&)
  1358.             COLOR WHITE&, BLACK&
  1359.             IF a = 1 THEN cindex = 6 - b ELSE cindex = -1 * (6 - b)
  1360.             IF playBlack THEN cindex = cindex * -1
  1361.             digit$ = RIGHT$(STR$(c(cindex)), 1)
  1362.             IF digit$ <> "0" THEN LOCATE b + 2, (a * 2) + 12: PRINT digit$;
  1363.         NEXT
  1364.     NEXT
  1365.     COLOR WHITE&, BLACK&
  1366.     _FONT normal&
  1367.     showButtonBar
  1368.     showMoveList
  1369.     'B Some debug stuff also needed for UNDO  Save file
  1370.     LINE (0, 25 * FH)-(46 * FW, YMAX), BLACK&, BF
  1371.     lp 25, 2, "Last move by AI: " + blackMove$
  1372.     lp 26, 2, "Move Count:" + STR$(countMove) + "   Turn:" + STR$(Turn) + "   Result:" + STR$(result)
  1373.     lp 27, 2, "Castle: K flag:" + STR$(wcKsflag) + "   Q flag:" + STR$(wcQsflag) + "   K old:" + STR$(wcKsold) + "   Q old:" + STR$(wcQsold)
  1374.     lp 28, 2, "Last move by Human: " + whiteMove$
  1375.  
  1376. SUB showButtonBar
  1377.     MakeButton 700, 60, 880, 100, "PLAY WHITE", LITE2&
  1378.     MakeButton 700, 120, 880, 160, "PLAY BLACK", LITE2&
  1379.     MakeButton 700, 180, 880, 220, "UNDO", LITE2&
  1380.     MakeButton 700, 240, 880, 280, "SAVE GAME", LITE2&
  1381.     MakeButton 700, 300, 880, 340, "LOAD GAME", LITE2&
  1382.     MakeButton 700, 360, 880, 400, "MANUAL SETUP", LITE2&
  1383.     MakeButton 700, 420, 880, 460, "QUIT", LITE2&
  1384.  
  1385. 'B set this up with Adrian's Draw Strings
  1386. SUB SHOWMAN (A, B)
  1387.     IF isWhite(B, A) THEN COLOR WHITES& ELSE COLOR BLACKS&
  1388.     LINE ((A + 2) * SQ, (B + 2) * SQ)-STEP(SQ, SQ), , BF
  1389.     ZZ = ABS(BOARD(B, A))
  1390.     IF ZZ THEN
  1391.         PRESET ((A + 2) * SQ + 8, (B + 2) * SQ + 36) 'A: centralise pieces
  1392.         IF BOARD(B, A) < 0 THEN
  1393.             IF playBlack THEN DRAW "C" + STR$(WHITE&) ELSE DRAW "C" + STR$(BLACK&)
  1394.         ELSE
  1395.             IF playBlack THEN DRAW "C" + STR$(BLACK&) ELSE DRAW "C" + STR$(WHITE&)
  1396.         END IF
  1397.         SELECT CASE ZZ
  1398.             'A  draw outlines for pieces on board
  1399.             CASE 100: DRAW "R26U5H2L6U7E3U6H3L10G3D6F3D7L6G2D5"
  1400.             CASE 500: DRAW "R26U5H2L5U7E3R4U10L6D3L4U3L6D3L4U3L6D10R4F3D7L5G2D5"
  1401.             CASE 270: DRAW "R26U5H2U4E2U9H6L9G10D4F2R4E3R4G8L4G2D5"
  1402.             CASE 300: DRAW "R26U5H2L8E6U9H2G8H2E8H2L6G6D9F6L8G2D5"
  1403.             CASE 900: DRAW "R26U5H2L6E9U11G4H6G4H4G6H4D11F9L6G2D5"
  1404.             CASE 4500: DRAW "R26U5H2L5E7U6H4L5G3U5R2U2L2U2L2D2L2D2R2D5H3L5G4D6F7L5G2D5"
  1405.             CASE 9000: DRAW "R26U5H2L5E7U6H4L5G3U5R2U2L2U2L2D2L2D2R2D5H3L5G4D6F7L5G2D5"
  1406.         END SELECT
  1407.         DRAW "BE2"
  1408.         'A  MOVE PEN INSIDE and color fill
  1409.         IF BOARD(B, A) < 0 THEN
  1410.             IF playBlack THEN DRAW "P" + STR$(WHITE&) + "," + STR$(WHITE&) ELSE DRAW "P" + STR$(BLACK&) + "," + STR$(BLACK&)
  1411.         END IF
  1412.         IF BOARD(B, A) > 0 THEN
  1413.             IF playBlack THEN DRAW "P" + STR$(BLACK&) + "," + STR$(BLACK&) ELSE DRAW "P" + STR$(WHITE&) + "," + STR$(WHITE&)
  1414.         END IF
  1415.     END IF
  1416.     COLOR WHITE&, BLACK&
  1417.     _FONT normal&
  1418.  
  1419. 'B  T set this up to show last 8 moves of White and Black
  1420. SUB showMoveList
  1421.     IF countMove < 9 THEN z = 8 ELSE z = countMove
  1422.     LINE (500, 300)-(680, 500), BLACK&, BF ' T if we use 700 it covers left border of buttonbar
  1423.     COLOR _RGB(0, 180, 220)
  1424.     FOR a = 0 TO 7
  1425.         lp 22 - a, 46, Move$(z - a)
  1426.     NEXT
  1427.     COLOR WHITE&
  1428.  
  1429. 'B convert BINGO for human playing Black
  1430. FUNCTION w2b$ (s$)
  1431.     b$ = ""
  1432.     FOR i = 1 TO LEN(s$)
  1433.         here = INSTR("ABCDEFGH12345678", MID$(s$, i, 1))
  1434.         IF here THEN b$ = b$ + MID$("HGFEDCBA87654321", here, 1) ELSE b$ = b$ + MID$(s$, i, 1)
  1435.     NEXT
  1436.     w2b$ = b$
  1437.  
  1438. SUB Wait_Click_Key
  1439.     'B handy sub to reuse in other programs
  1440.     DO
  1441.         k = _KEYHIT
  1442.         WHILE _MOUSEINPUT: WEND
  1443.         _LIMIT 30
  1444.     LOOP UNTIL k <> 0 OR _MOUSEBUTTON(1)
  1445.  
  1446. SUB WriteEntry
  1447.     'B  Record game in both Move$() and Boards$() at countMove
  1448.     IF playBlack THEN
  1449.         IF bFirst THEN
  1450.             bFirst = 0
  1451.             bmoves$ = blackMove$ + pBflag$
  1452.         ELSE
  1453.             r$ = bmoves$ + "   " + whiteMove$ + pWflag$
  1454.             countMove = countMove + 1
  1455.             Move$(countMove) = r$
  1456.             bmoves$ = blackMove$ + pBflag$
  1457.         END IF
  1458.     ELSE
  1459.         countMove = countMove + 1
  1460.         Move$(countMove) = whiteMove$ + pWflag$ + " " + blackMove$ + pBflag$
  1461.     END IF
  1462.     Boards$(countMove) = bString$
  1463.     'B clear flags for promoted pawns
  1464.     pWflag$ = "": pBflag$ = ""
  1465.  

Here is screen shot of what it is supposed to look like when you start the program and choose to play Black:
Update: Ha! oops it says last move was by human, nope the computer is playing White, hmm...
Chess 2017 B+ TempodiBasic mods of Sample.PNG
* Chess 2017 B+ TempodiBasic mods of Sample.PNG (Filesize: 52.57 KB, Dimensions: 904x623, Views: 193)
« Last Edit: January 26, 2020, 11:01:31 am by bplus »

Offline TempodiBasic

  • Forum Resident
  • Posts: 1792
    • View Profile
Re: A 90% complete chess engine
« Reply #5 on: January 26, 2020, 11:22:58 am »
@Bplus
thanks to remember me that our adventure!
Thanks to let me understand how to code in cooperation!

I really stop working on it because I don't understand  well the logic behind the IO so I cannot modify or improve what I don't understand.
Surely the original program (CHESS.BAS into folder of examples of QB64) is uncomplete!
I think because the original coder have no too time to write it, because I find some prebuild options that gives me the opportunity to let fight AI vs AI, but the evaluation routine is not so strong!
Moreover when also in buggy way, the original coder has written an Incheck control for White, there is nothing for the black! In fact both black is Ai both black is Human, Black is not able to castle or to take en passant!
I have no knowledge of reverse ingeneering, so I cannot understand the IO routine!  In it must be added the castle and enpassant option for black (it is simple using new flags!) and the evaluation of positional themes... and it is quiet difficult to me.
I'm able to play chess ranging 1200-1500 Elo on the tournament online, so not so much theory to translate into code for AI.

Reading on www.chessprogrammin.org there are so many informations and methods to write a chess program! There is no one way! And for now I have no found a way like that of CHESS.BAS.
Programming isn't difficult, only it's  consuming time and coffee

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: A 90% complete chess engine
« Reply #6 on: January 26, 2020, 11:33:37 am »
Hi TempodiBasic,

Yeah, working on code together was great experience! My memory does not recall problems with castling with Black AND en passant (someone tell the spell checker not to underline, I got that one right) too?

My memory tells me the biggest failure was the King was recognizing being in check but thinking that counter checking was OK! :D :D :D that was when I started to look for another chess engine and got distracted (saved) by other things.


Offline SierraKen

  • Forum Resident
  • Posts: 1454
    • View Profile
Re: A 90% complete chess engine
« Reply #7 on: January 26, 2020, 12:26:36 pm »
Awesome games everyone! All you guys are geniuses. I started on Checkers 2 days ago but don't want any help on it unless I ask later. I got the board and the ability to move pieces so far. Might take a few weeks because I'm working slow on it. But I hope to finish sometime soon.

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: A 90% complete chess engine
« Reply #8 on: January 26, 2020, 12:39:17 pm »
Go for it Ken!

I've been thinking about checkers ever since I created a perfect looking checkerboard, but OK, I won't show ;-)

Offline SierraKen

  • Forum Resident
  • Posts: 1454
    • View Profile
Re: A 90% complete chess engine
« Reply #9 on: January 26, 2020, 12:41:02 pm »
Robert Frost, I got one error on yours though, I can't remember off hand though.
Bplus,  when I was in Check by the computer, I couldn't get out of it so I had to end the game as a stand-still.

Offline SierraKen

  • Forum Resident
  • Posts: 1454
    • View Profile
Re: A 90% complete chess engine
« Reply #10 on: January 26, 2020, 12:44:25 pm »
Thanks B+! It will be a learning experience. I already have where you can't move onto the same space as the opponent or to one of your other pieces. I have to add a few more of those (like not to move on a red square). I'm using a coordinate system (without using the mouse) and it uses 1 variable for both horizontal and vertical, like on the space 1 x 2 it just uses the number 12 for the variable. I'll use that variable for the computer turn, etc. 

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: A 90% complete chess engine
« Reply #11 on: January 26, 2020, 02:11:16 pm »
Robert Frost, I got one error on yours though, I can't remember off hand though.
Bplus,  when I was in Check by the computer, I couldn't get out of it so I had to end the game as a stand-still.

Ken, I don't think there is a single line in program that says Checkmate! If you are in check and can't get out of it then you are done, why rub it in? :-)) yeah, sure, call it a "stand-still".

Offline STxAxTIC

  • Library Staff
  • Forum Resident
  • Posts: 1091
  • he lives
    • View Profile
Re: A 90% complete chess engine
« Reply #12 on: January 26, 2020, 03:38:25 pm »
Quote
Ha! A least one week would be more believable but maybe he Trumped up his memory. ;-))

Think Ima let that slide bplus?

... 15 minutes later...

Welp, no help from the wayback machine. You just have to imagine me without a full time job in the middle of July. A lot of stuff happens in a 24 hour period.

While this is proof by no means, I tried to fit my weird development cycle in one screenshot. I suppose technically the work took place over two calendar days, but for completeness:
chess dev.png
* chess dev.png (Filesize: 123.08 KB, Dimensions: 1366x768, Views: 184)
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 #13 on: January 26, 2020, 03:59:19 pm »
OK I believe! 700+ lines of code is probably possible, specially no check, castle, pawn promo and stopping to play? :) still nice chunk of code to get done.

Is that about 6 hours? One long sitting...
« Last Edit: January 26, 2020, 04:02:35 pm by bplus »

Offline SierraKen

  • Forum Resident
  • Posts: 1454
    • View Profile
Re: A 90% complete chess engine
« Reply #14 on: January 26, 2020, 05:08:02 pm »
Ken, I don't think there is a single line in program that says Checkmate! If you are in check and can't get out of it then you are done, why rub it in? :-)) yeah, sure, call it a "stand-still".

ROFL... well then it wasn't a stand-still. :)