Print Page - A 90% complete chess engine

Title: A 90% complete chess engine
Post by: STxAxTIC 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]

'#lang "qb"
 
DIM SHARED BoardState(8, 8, 10) AS STRING
DIM SHARED MoveListArray(99999, 10) AS STRING
DIM SHARED MoveListArraySize(10)
 
DECLARE FUNCTION CalculateScore (TheColorIn$, GameLayerParIn)
DECLARE SUB DoAMove (TheMoveIn$, GameLayerPar1In, GameLayerPar2In)
DECLARE FUNCTION FindCoordinates$ (ThePieceIn$, GameLayerParIn)
DECLARE SUB GenerateMoveList (TheColorIn$, GameLayerParIn, MoveListLayerIn)
DECLARE SUB ListPieceMoves (ThePieceIn$, GameLayerParIn)
DECLARE SUB PrintGame (GameLayerParIn)
DECLARE SUB GetRowColMovesFull (PieceNameIn$, GameLayerParIn)
DECLARE SUB GetDiagMovesFull (PieceNameIn$, GameLayerParIn)
DECLARE SUB GetRowColMovesSingle (PieceNameIn$, GameLayerParIn)
DECLARE SUB GetDiagMovesSingle (PieceNameIn$, GameLayerParIn)
DECLARE SUB GetKnightMoves (PieceNameIn$, GameLayerParIn)
 
 
' Initialize chess board.
FOR x = 1 TO 8
    FOR y = 1 TO 8 STEP 1
        BoardState(x, y, 0) = "0"
    NEXT
NEXT
 
' Place pieces in their starting positions
BoardState(1, 2, 0) = "WP1" ' White Pawn
BoardState(2, 2, 0) = "WP2" ' White Pawn
BoardState(3, 2, 0) = "WP3" ' White Pawn
BoardState(4, 2, 0) = "WP4" ' White Pawn
BoardState(5, 2, 0) = "WP5" ' White Pawn
BoardState(6, 2, 0) = "WP6" ' White Pawn
BoardState(7, 2, 0) = "WP7" ' White Pawn
BoardState(8, 2, 0) = "WP8" ' White Pawn
BoardState(1, 1, 0) = "WQR" ' White Queen Rook
BoardState(2, 1, 0) = "WQN" ' White Queen Knight
BoardState(3, 1, 0) = "WQB" ' White Queen Bishop
BoardState(4, 1, 0) = "WQQ" ' White Queen
BoardState(5, 1, 0) = "WKK" ' White King
BoardState(6, 1, 0) = "WKB" ' White King Bishop
BoardState(7, 1, 0) = "WKN" ' White King Knight
BoardState(8, 1, 0) = "WKR" ' White King Rook
 
BoardState(1, 7, 0) = "BP1" ' Black Pawn
BoardState(2, 7, 0) = "BP2" ' Black Pawn
BoardState(3, 7, 0) = "BP3" ' Black Pawn
BoardState(4, 7, 0) = "BP4" ' Black Pawn
BoardState(5, 7, 0) = "BP5" ' Black Pawn
BoardState(6, 7, 0) = "BP6" ' Black Pawn
BoardState(7, 7, 0) = "BP7" ' Black Pawn
BoardState(8, 7, 0) = "BP8" ' Black Pawn
BoardState(1, 8, 0) = "BQR" ' Black Queen Rook
BoardState(2, 8, 0) = "BQN" ' Black Queen Knight
BoardState(3, 8, 0) = "BQB" ' Black Queen Bishop
BoardState(4, 8, 0) = "BQQ" ' Black Queen
BoardState(5, 8, 0) = "BKK" ' Black King
BoardState(6, 8, 0) = "BKB" ' Black King Bishop
BoardState(7, 8, 0) = "BKN" ' Black King Knight
BoardState(8, 8, 0) = "BKR" ' Black King Rook
 
' Show the board and wait for key.
CALL PrintGame(0)
LOCATE 20, 20: PRINT "Press any key to begin..."
DO: LOOP UNTIL INKEY$ <> ""
LOCATE 20, 20: PRINT "                         "
 
CurrentPlayer$ = "B": CurrentOpponent$ = "W"
 
TotalGameCalculations = 0
DO
 
    IF CurrentPlayer$ = "W" THEN
        CurrentPlayer$ = "B"
        CurrentOpponent$ = "W"
    ELSE
        CurrentPlayer$ = "W"
        CurrentOpponent$ = "B"
    END IF
 
    BestCandidateMoveIndex = -1
    BestScoreDifference = -999
    OriginalScoreDifference = CalculateScore(CurrentPlayer$, 0) - CalculateScore(CurrentOpponent$, 3)
 
    CALL GenerateMoveList(CurrentPlayer$, 0, 0) '                    Using game 0 generate a move list called 0.
    FOR i = 1 TO MoveListArraySize(0)
        CALL DoAMove(MoveListArray(i, 0), 0, 1) '                    Do the ith move using list 0 taking game 0 to game 1.
        CALL GenerateMoveList(CurrentOpponent$, 1, 1) '              Use game 1 to generate list 1.
        FOR j = 1 TO MoveListArraySize(1)
            CALL DoAMove(MoveListArray(j, 1), 1, 2) '                Do the jth move using list 1 taking game 1 to game 2.
            CALL GenerateMoveList(CurrentPlayer$, 2, 2) '            Use game 2 to generate list 2.
            FOR k = 1 TO MoveListArraySize(2)
                CALL DoAMove(MoveListArray(k, 2), 2, 3) '            Do the kth move using list 2 taking game 2 to game 3.
              
                'CALL GenerateMoveList(CurrentOpponent$, 3, 3) '     Use game 3 to generate list 3.
                'FOR m = 1 TO MoveListArraySize(3)
                'CALL DoAMove(MoveListArray(m, 3), 3, 4) '           Do the kth move using list 3 taking game 3 to game 4.
 
                ' This is a very simplistic "toy model" for computing the score for a given board state.
                ' This is meant to be improved upon and is really the heart of the engine.
                WScore = CalculateScore(CurrentPlayer$, 3)
                BScore = CalculateScore(CurrentOpponent$, 3)
                ScoreDiff = WScore - BScore
                IF ScoreDiff > BestScoreDifference THEN
                    BestScoreDifference = ScoreDiff
                    BestCandidateMoveIndex = i
                END IF
                TotalGameCalculations = TotalGameCalculations + 1
                LOCATE 20, 20: PRINT "Mini-games tried: "; TotalGameCalculations
 
                'NEXT
 
            NEXT
        NEXT
    NEXT
 
    IF BestScoreDifference = -999 THEN EXIT DO
 
    CALL DoAMove(MoveListArray(BestCandidateMoveIndex, 0), 0, 9)
 
    FOR x = 1 TO 8
        FOR y = 1 TO 8
            BoardState(x, y, 0) = BoardState(x, y, 9)
        NEXT
    NEXT
 
    CALL PrintGame(0)
 
LOOP UNTIL INKEY$ = " "
 
END
' '''''''''' '''''''''' '''''''''' '''''''''' ''''''''''
 
FUNCTION CalculateScore (TheColorIn AS STRING, GameLayerParIn)
    DIM TCI AS STRING
    TCI = TheColorIn
    GameLayerParameter = GameLayerParIn
    TheScore = 0
    FOR x = 1 TO 8
        FOR y = 1 TO 8
            c$ = BoardState(x, y, GameLayerParameter)
            IF c$ <> "0" AND LEFT$(c$, 1) = TCI THEN
                SELECT CASE MID$(c$, 3, 1)
                    CASE "K"
                        TheScore = TheScore + 1000
                    CASE "Q"
                        TheScore = TheScore + 80
                    CASE "B"
                        TheScore = TheScore + 30
                    CASE "N"
                        TheScore = TheScore + 30
                    CASE "R"
                        TheScore = TheScore + 50
                    CASE ELSE
                        TheScore = TheScore + 10
                END SELECT
            END IF
        NEXT
    NEXT
    CalculateScore = TheScore
END FUNCTION
 
' '''''''''' '''''''''' '''''''''' '''''''''' ''''''''''
 
SUB DoAMove (TheMoveIn AS STRING, GameLayerPar1In, GameLayerPar2In)
    DIM TheMove AS STRING
    TheMove = TheMoveIn
    GameLayerParameter1 = GameLayerPar1In
    GameLayerParameter2 = GameLayerPar2In
    ThePiece$ = LEFT$(TheMove, 3)
    OldLocation$ = FindCoordinates$(ThePiece$, GameLayerParameter1)
    OldXLoc = VAL(LEFT$(OldLocation$, 1))
    OldYLoc = VAL(RIGHT$(OldLocation$, 1))
    NewLocation$ = RIGHT$(TheMove, 2)
    NewXLoc = VAL(LEFT$(NewLocation$, 1))
    NewYLoc = VAL(RIGHT$(NewLocation$, 1))
    FOR x = 1 TO 8
        FOR y = 1 TO 8
            BoardState(x, y, GameLayerParameter2) = BoardState(x, y, GameLayerParameter1)
        NEXT
    NEXT
    BoardState(OldXLoc, OldYLoc, GameLayerParameter2) = "0"
    BoardState(NewXLoc, NewYLoc, GameLayerParameter2) = ThePiece$
END SUB
 
' '''''''''' '''''''''' '''''''''' '''''''''' ''''''''''
 
FUNCTION FindCoordinates$ (ThePieceIn AS STRING, GameLayerParIn)
    DIM ThePiece AS STRING
    ThePiece = ThePieceIn
    GameLayerParameter = GameLayerParIn
    Temp$ = "-1"
    FOR x = 1 TO 8
        FOR y = 8 TO 1 STEP -1
            IF BoardState(x, y, GameLayerParameter) = ThePiece THEN
                Temp$ = LTRIM$(STR$(x)) + LTRIM$(STR$(y))
                EXIT FOR
            END IF
        NEXT
    NEXT
    FindCoordinates$ = Temp$
END FUNCTION
 
' '''''''''' '''''''''' '''''''''' '''''''''' ''''''''''
 
SUB GenerateMoveList (TheColorIn AS STRING, GameLayerParIn, MoveListLayerIn)
    ' Creates a string and then an array from the string.
    DIM TCI AS STRING
    TCI = TheColorIn
    GameLayerParameter = GameLayerParIn
    MoveListLayer = MoveListLayerIn
    'Temp$ = ""
    'MoveCountIndex = 0
    MoveListArraySize(MoveListLayer) = 0
    FOR x = 1 TO 8
        FOR y = 1 TO 8
            c$ = BoardState(x, y, GameLayerParameter)
            IF LEFT$(c$, 1) = TCI THEN
                CALL ListPieceMoves(c$, GameLayerParameter, MoveListLayer)
            END IF
        NEXT
    NEXT
END SUB
 
' '''''''''' '''''''''' '''''''''' '''''''''' ''''''''''
 
SUB ListPieceMoves (ThePieceIn AS STRING, GameLayerParIn, MoveListLayerIn)
    DIM ThePiece AS STRING
    ThePiece = ThePieceIn
    GameLayerParameter = GameLayerParIn
    MoveListLayer = MoveListLayerIn
 
    ' Isolate last character.
    TheLastChar$ = RIGHT$(ThePiece, 1)
 
    Temp$ = ""
    SELECT CASE TheLastChar$
        CASE "K" ' King
            CALL GetDiagMovesSingle(ThePiece, GameLayerParameter, MoveListLayer)
            CALL GetRowColMovesSingle(ThePiece, GameLayerParameter, MoveListLayer)
        CASE "Q" ' Queen
            CALL GetDiagMovesFull(ThePiece, GameLayerParameter, MoveListLayer)
            CALL GetRowColMovesFull(ThePiece, GameLayerParameter, MoveListLayer)
        CASE "R" ' Rook
            CALL GetRowColMovesFull(ThePiece, GameLayerParameter, MoveListLayer)
        CASE "N" ' Knight
            CALL GetKnightMoves(ThePiece, GameLayerParameter, MoveListLayer)
        CASE "B" ' Bishop
            CALL GetDiagMovesFull(ThePiece, GameLayerParameter, MoveListLayer)
        CASE ELSE ' It's a pawn. They are not ambi-directional so be careful.
 
            PlayerColor$ = LEFT$(ThePiece, 1)
            SELECT CASE PlayerColor$
                CASE "W"
                    OpponentColor$ = "B"
                    PawnMoveDirection = 1
                CASE "B"
                    OpponentColor$ = "W"
                    PawnMoveDirection = -1
            END SELECT
 
            CoordTemp$ = FindCoordinates$(ThePiece, GameLayerParameter)
            XOrig = VAL(LEFT$(CoordTemp$, 1))
            YOrig = VAL(RIGHT$(CoordTemp$, 1))
 
            Temp$ = ""
 
            ' Three standard pawn moves.
            X = XOrig: Y = YOrig: X = X: Y = Y + PawnMoveDirection
            IF X >= 1 AND X <= 8 AND Y >= 1 AND Y <= 8 THEN
                IF BoardState(X, Y, GameLayerParameter) = "0" THEN
                    MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
                    MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = ThePiece + LTRIM$(STR$(X)) + LTRIM$(STR$(Y))
                END IF
            END IF
 
            X = XOrig: Y = YOrig: X = X + 1: Y = Y + PawnMoveDirection
            IF X >= 1 AND X <= 8 AND Y >= 1 AND Y <= 8 THEN
                IF LEFT$(BoardState(X, Y, GameLayerParameter), 1) = OpponentColor$ THEN
                    MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
                    MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = ThePiece + LTRIM$(STR$(X)) + LTRIM$(STR$(Y))
                END IF
            END IF
 
            X = XOrig: Y = YOrig: X = X - 1: Y = Y + PawnMoveDirection
            IF X >= 1 AND X <= 8 AND Y >= 1 AND Y <= 8 THEN
                IF LEFT$(BoardState(X, Y, GameLayerParameter), 1) = OpponentColor$ THEN
                    MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
                    MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = ThePiece + LTRIM$(STR$(X)) + LTRIM$(STR$(Y))
                END IF
            END IF
 
            ' Special case of first pawn move.
            X = XOrig: Y = YOrig:
            SELECT CASE PlayerColor$
                CASE "W"
                    IF Y = 2 THEN
                        X = XOrig: Y = YOrig: X = X: Y = Y + 2 * PawnMoveDirection
                        IF BoardState(X, Y, GameLayerParameter) = "0" THEN
                            MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
                            MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = ThePiece + LTRIM$(STR$(X)) + LTRIM$(STR$(Y))
                        END IF
                    END IF
                CASE "B"
                    IF Y = 7 THEN
                        X = XOrig: Y = YOrig: X = X: Y = Y + 2 * PawnMoveDirection
                        IF BoardState(X, Y, GameLayerParameter) = "0" THEN
                            MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
                            MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = ThePiece + LTRIM$(STR$(X)) + LTRIM$(STR$(Y))
                        END IF
                    END IF
            END SELECT
 
    END SELECT
END SUB
 
' '''''''''' '''''''''' '''''''''' '''''''''' ''''''''''
 
SUB PrintGame (GameLayerParIn)
    GameLayerParameter = GameLayerParIn
    FOR x = 1 TO 8
        FOR y = 1 TO 8
            c$ = BoardState(x, 8 - y + 1, GameLayerParameter)
            SELECT CASE c$
                CASE "0"
                    LOCATE y * 2, x * 5: PRINT "0  "
                CASE ELSE
                    LOCATE y * 2, x * 5: PRINT c$
            END SELECT
 
            LOCATE y * 2, x * 3 + 50: PRINT LTRIM$(STR$(x)) + LTRIM$(STR$(8 - y + 1))
 
        NEXT
    NEXT
END SUB
 
' '''''''''' '''''''''' '''''''''' '''''''''' ''''''''''
 
SUB GetRowColMovesFull (PieceNameIn AS STRING, GameLayerParIn, MoveListLayerIn)
    PieceName$ = PieceNameIn
    GameLayerParameter = GameLayerParIn
    MoveListLayer = MoveListLayerIn
    FirstLetter$ = LEFT$(PieceName$, 1)
    Temp$ = FindCoordinates$(PieceName$, GameLayerParameter)
    XOrig = VAL(LEFT$(Temp$, 1))
    YOrig = VAL(RIGHT$(Temp$, 1))
    X = XOrig
    Y = YOrig
    DO
        X = X + 1
        IF X <= 8 THEN
            IF BoardState(X, Y, GameLayerParameter) = "0" THEN
 
                MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
                MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(X)) + LTRIM$(STR$(Y))
            ELSE
                IF FirstLetter$ <> LEFT$(BoardState(X, Y, GameLayerParameter), 1) THEN
                    MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
                    MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(X)) + LTRIM$(STR$(Y))
                END IF
                EXIT DO
            END IF
        END IF
    LOOP UNTIL X > 8
    X = XOrig
    Y = YOrig
    DO
        X = X - 1
        IF X >= 1 THEN
            IF BoardState(X, Y, GameLayerParameter) = "0" THEN
                MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
                MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(X)) + LTRIM$(STR$(Y))
            ELSE
                IF FirstLetter$ <> LEFT$(BoardState(X, Y, GameLayerParameter), 1) THEN
                    MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
                    MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(X)) + LTRIM$(STR$(Y))
                END IF
                EXIT DO
            END IF
        END IF
    LOOP UNTIL X < 1
    X = XOrig
    Y = YOrig
    DO
        Y = Y + 1
        IF Y <= 8 THEN
            IF BoardState(X, Y, GameLayerParameter) = "0" THEN
                MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
                MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(X)) + LTRIM$(STR$(Y))
            ELSE
                IF FirstLetter$ <> LEFT$(BoardState(X, Y, GameLayerParameter), 1) THEN
                    MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
                    MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(X)) + LTRIM$(STR$(Y))
                END IF
                EXIT DO
            END IF
        END IF
    LOOP UNTIL Y > 8
    X = XOrig
    Y = YOrig
    DO
        Y = Y - 1
        IF Y >= 1 THEN
            IF BoardState(X, Y, GameLayerParameter) = "0" THEN
                MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
                MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(X)) + LTRIM$(STR$(Y))
            ELSE
                IF FirstLetter$ <> LEFT$(BoardState(X, Y, GameLayerParameter), 1) THEN
                    MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
                    MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(X)) + LTRIM$(STR$(Y))
                END IF
                EXIT DO
            END IF
        END IF
    LOOP UNTIL Y < 1
 
END SUB
 
' '''''''''' '''''''''' '''''''''' '''''''''' ''''''''''
 
SUB GetDiagMovesFull (PieceNameIn AS STRING, GameLayerParIn, MoveListLayerIn)
    PieceName$ = PieceNameIn
    GameLayerParameter = GameLayerParIn
    MoveListLayer = MoveListLayerIn
    FirstLetter$ = LEFT$(PieceName$, 1)
    Temp$ = FindCoordinates$(PieceName$, GameLayerParameter)
    XOrig = VAL(LEFT$(Temp$, 1))
    YOrig = VAL(RIGHT$(Temp$, 1))
    X = XOrig
    Y = YOrig
    DO
        X = X + 1
        Y = Y + 1
        IF X <= 8 AND Y <= 8 THEN
            IF BoardState(X, Y, GameLayerParameter) = "0" THEN
                MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
                MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(X)) + LTRIM$(STR$(Y))
            ELSE
                IF FirstLetter$ <> LEFT$(BoardState(X, Y, GameLayerParameter), 1) THEN
                    MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
                    MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(X)) + LTRIM$(STR$(Y))
                END IF
                EXIT DO
            END IF
        END IF
    LOOP UNTIL X > 8 OR Y > 8
    X = XOrig
    Y = YOrig
    DO
        X = X - 1
        Y = Y + 1
        IF X >= 1 AND X <= 8 AND Y >= 1 AND Y <= 8 THEN
            IF BoardState(X, Y, GameLayerParameter) = "0" THEN
                MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
                MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(X)) + LTRIM$(STR$(Y))
            ELSE
                IF FirstLetter$ <> LEFT$(BoardState(X, Y, GameLayerParameter), 1) THEN
                    MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
                    MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(X)) + LTRIM$(STR$(Y))
                END IF
                EXIT DO
            END IF
        END IF
    LOOP UNTIL X < 1 OR Y > 8
    X = XOrig
    Y = YOrig
    DO
        X = X - 1
        Y = Y - 1
        IF X >= 1 AND Y >= 1 THEN
            IF BoardState(X, Y, GameLayerParameter) = "0" THEN
                MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
                MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(X)) + LTRIM$(STR$(Y))
            ELSE
                IF FirstLetter$ <> LEFT$(BoardState(X, Y, GameLayerParameter), 1) THEN
                    MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
                    MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(X)) + LTRIM$(STR$(Y))
                END IF
                EXIT DO
            END IF
        END IF
    LOOP UNTIL X < 1 OR Y < 1
    X = XOrig
    Y = YOrig
    DO
        X = X + 1
        Y = Y - 1
        IF X <= 8 AND Y >= 1 THEN
            IF BoardState(X, Y, GameLayerParameter) = "0" THEN
                MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
                MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(X)) + LTRIM$(STR$(Y))
            ELSE
                IF FirstLetter$ <> LEFT$(BoardState(X, Y, GameLayerParameter), 1) THEN
                    MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
                    MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(X)) + LTRIM$(STR$(Y))
                END IF
                EXIT DO
            END IF
        END IF
    LOOP UNTIL X > 8 OR Y < 1
 
END SUB
 
' '''''''''' '''''''''' '''''''''' '''''''''' ''''''''''
 
SUB GetRowColMovesSingle (PieceNameIn AS STRING, GameLayerParIn, MoveListLayerIn)
    PieceName$ = PieceNameIn
    GameLayerParameter = GameLayerParIn
    MoveListLayer = MoveListLayerIn
    FirstLetter$ = LEFT$(PieceName$, 1)
    Temp$ = FindCoordinates$(PieceName$, GameLayerParameter)
    XOrig = VAL(LEFT$(Temp$, 1))
    YOrig = VAL(RIGHT$(Temp$, 1))
    x = XOrig
    Y = YOrig
    x = x + 1
    IF x <= 8 THEN
        IF BoardState(x, Y, GameLayerParameter) = "0" THEN
            MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
            MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(x)) + LTRIM$(STR$(Y))
        ELSE
            IF FirstLetter$ <> LEFT$(BoardState(x, Y, GameLayerParameter), 1) THEN
                MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
                MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(x)) + LTRIM$(STR$(Y))
            END IF
        END IF
    END IF
    x = XOrig
    Y = YOrig
    x = x - 1
    IF x >= 1 THEN
        IF BoardState(x, Y, GameLayerParameter) = "0" THEN
            MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
            MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(x)) + LTRIM$(STR$(Y))
        ELSE
            IF FirstLetter$ <> LEFT$(BoardState(x, Y, GameLayerParameter), 1) THEN
                MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
                MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(x)) + LTRIM$(STR$(Y))
            END IF
        END IF
    END IF
    x = XOrig
    Y = YOrig
    Y = Y + 1
    IF Y <= 8 THEN
        IF BoardState(x, Y, GameLayerParameter) = "0" THEN
            MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
            MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(x)) + LTRIM$(STR$(Y))
        ELSE
            IF FirstLetter$ <> LEFT$(BoardState(x, Y, GameLayerParameter), 1) THEN
                MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
                MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(x)) + LTRIM$(STR$(Y))
            END IF
        END IF
    END IF
    x = XOrig
    Y = YOrig
    Y = Y - 1
    IF Y >= 1 THEN
        IF BoardState(x, Y, GameLayerParameter) = "0" THEN
            MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
            MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(x)) + LTRIM$(STR$(Y))
        ELSE
            IF FirstLetter$ <> LEFT$(BoardState(x, Y, GameLayerParameter), 1) THEN
                MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
                MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(x)) + LTRIM$(STR$(Y))
            END IF
        END IF
    END IF
 
END SUB
 
' '''''''''' '''''''''' '''''''''' '''''''''' ''''''''''
 
SUB GetDiagMovesSingle (PieceNameIn AS STRING, GameLayerParIn, MoveListLayerIn)
    PieceName$ = PieceNameIn
    GameLayerParameter = GameLayerParIn
    MoveListLayer = MoveListLayerIn
    FirstLetter$ = LEFT$(PieceName$, 1)
    Temp$ = FindCoordinates$(PieceName$, GameLayerParameter)
    XOrig = VAL(LEFT$(Temp$, 1))
    YOrig = VAL(RIGHT$(Temp$, 1))
    X = XOrig
    Y = YOrig
    X = X + 1
    Y = Y + 1
    IF X <= 8 AND Y <= 8 THEN
        IF BoardState(X, Y, GameLayerParameter) = "0" THEN
            MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
            MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(X)) + LTRIM$(STR$(Y))
        ELSE
            IF FirstLetter$ <> LEFT$(BoardState(X, Y, GameLayerParameter), 1) THEN
                MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
                MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(X)) + LTRIM$(STR$(Y))
            END IF
        END IF
    END IF
    X = XOrig
    Y = YOrig
    X = X - 1
    Y = Y + 1
    IF X >= 1 AND X <= 8 AND Y >= 1 AND Y <= 8 THEN
        IF BoardState(X, Y, GameLayerParameter) = "0" THEN
            MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
            MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(X)) + LTRIM$(STR$(Y))
        ELSE
            IF FirstLetter$ <> LEFT$(BoardState(X, Y, GameLayerParameter), 1) THEN
                MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
                MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(X)) + LTRIM$(STR$(Y))
            END IF
        END IF
    END IF
    X = XOrig
    Y = YOrig
    X = X - 1
    Y = Y - 1
    IF X >= 1 AND Y >= 1 THEN
        IF BoardState(X, Y, GameLayerParameter) = "0" THEN
            MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
            MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(X)) + LTRIM$(STR$(Y))
        ELSE
            IF FirstLetter$ <> LEFT$(BoardState(X, Y, GameLayerParameter), 1) THEN
                MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
                MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(X)) + LTRIM$(STR$(Y))
            END IF
        END IF
    END IF
    X = XOrig
    Y = YOrig
    X = X + 1
    Y = Y - 1
    IF X <= 8 AND Y >= 1 THEN
        IF BoardState(X, Y, GameLayerParameter) = "0" THEN
            MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
            MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(X)) + LTRIM$(STR$(Y))
        ELSE
            IF FirstLetter$ <> LEFT$(BoardState(X, Y, GameLayerParameter), 1) THEN
                MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
                MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(X)) + LTRIM$(STR$(Y))
            END IF
        END IF
    END IF
 
END SUB
 
' '''''''''' '''''''''' '''''''''' '''''''''' ''''''''''
 
SUB GetKnightMoves (PieceNameIn AS STRING, GameLayerParIn, MoveListLayerIn)
    PieceName$ = PieceNameIn
    GameLayerParameter = GameLayerParIn
    MoveListLayer = MoveListLayerIn
    FirstLetter$ = LEFT$(PieceName$, 1)
    Temp$ = FindCoordinates$(PieceName$, GameLayerParameter)
    XOrig = VAL(LEFT$(Temp$, 1))
    YOrig = VAL(RIGHT$(Temp$, 1))
 
    X = XOrig: Y = YOrig: X = X + 2: Y = Y + 1
    IF X >= 1 AND X <= 8 AND Y >= 1 AND Y <= 8 THEN
        IF FirstLetter$ <> LEFT$(BoardState(X, Y, GameLayerParameter), 1) THEN
            MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
            MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(X)) + LTRIM$(STR$(Y))
        END IF
    END IF
 
    X = XOrig: Y = YOrig: X = X + 1: Y = Y + 2
    IF X >= 1 AND X <= 8 AND Y >= 1 AND Y <= 8 THEN
        IF FirstLetter$ <> LEFT$(BoardState(X, Y, GameLayerParameter), 1) THEN
            MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
            MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(X)) + LTRIM$(STR$(Y))
        END IF
    END IF
 
    X = XOrig: Y = YOrig: X = X - 1: Y = Y + 2
    IF X >= 1 AND X <= 8 AND Y >= 1 AND Y <= 8 THEN
        IF FirstLetter$ <> LEFT$(BoardState(X, Y, GameLayerParameter), 1) THEN
            MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
            MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(X)) + LTRIM$(STR$(Y))
        END IF
    END IF
 
    X = XOrig: Y = YOrig: X = X - 2: Y = Y + 1
    IF X >= 1 AND X <= 8 AND Y >= 1 AND Y <= 8 THEN
        IF FirstLetter$ <> LEFT$(BoardState(X, Y, GameLayerParameter), 1) THEN
            MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
            MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(X)) + LTRIM$(STR$(Y))
        END IF
    END IF
 
    X = XOrig: Y = YOrig: X = X - 2: Y = Y - 1
    IF X >= 1 AND X <= 8 AND Y >= 1 AND Y <= 8 THEN
        IF FirstLetter$ <> LEFT$(BoardState(X, Y, GameLayerParameter), 1) THEN
            MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
            MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(X)) + LTRIM$(STR$(Y))
        END IF
    END IF
 
    X = XOrig: Y = YOrig: X = X - 1: Y = Y - 2
    IF X >= 1 AND X <= 8 AND Y >= 1 AND Y <= 8 THEN
        IF FirstLetter$ <> LEFT$(BoardState(X, Y, GameLayerParameter), 1) THEN
            MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
            MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(X)) + LTRIM$(STR$(Y))
        END IF
    END IF
 
    X = XOrig: Y = YOrig: X = X + 1: Y = Y - 2
    IF X >= 1 AND X <= 8 AND Y >= 1 AND Y <= 8 THEN
        IF FirstLetter$ <> LEFT$(BoardState(X, Y, GameLayerParameter), 1) THEN
            MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
            MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(X)) + LTRIM$(STR$(Y))
        END IF
    END IF
 
    X = XOrig: Y = YOrig: X = X + 2: Y = Y - 1
    IF X >= 1 AND X <= 8 AND Y >= 1 AND Y <= 8 THEN
        IF FirstLetter$ <> LEFT$(BoardState(X, Y, GameLayerParameter), 1) THEN
            MoveListArraySize(MoveListLayer) = MoveListArraySize(MoveListLayer) + 1
            MoveListArray(MoveListArraySize(MoveListLayer), MoveListLayer) = PieceName$ + LTRIM$(STR$(X)) + LTRIM$(STR$(Y))
        END IF
    END IF
 
END SUB
 
' '''''''''' '''''''''' '''''''''' '''''''''' ''''''''''
 

Title: Re: A 90% complete chess engine
Post by: Richard Frost 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]

_TITLE "Chess"
DEFINT A-Z
CONST true = -1, false = 0
CONST BoardWhite = 1, BoardBlack = 2
CONST Rook = 1, Knight = 2, Bishop = 3, Queen = 4, King = 5, Pawn = 6
 
COMMON SHARED debug$
COMMON SHARED WorB, Move, Score, Index, opening
COMMON SHARED m$, i$, Enter$, Esc$, lf$, mess$
COMMON SHARED fln '                                                  file line number, diagnostics
COMMON SHARED fr, fc, tr, tc
COMMON SHARED MaxRow
COMMON SHARED xq, yq '                                               size of squares in pixels
COMMON SHARED xc, yc '                                               top left of board
COMMON SHARED WaitForKey
COMMON SHARED Castle$, OtherK$, kr, kc, mkr, mkc
COMMON SHARED MasterLevel, SaveWorB
COMMON SHARED GameFile$, check, redo, redo$, b1, b2, b1$, b2$
COMMON SHARED debug, DebugR, DebugC
COMMON SHARED Start1&, Start2&, MaxElapse!
COMMON SHARED human, humanc, OnAuto
COMMON SHARED linesprinted&&
 
l = VAL(COMMAND$) '                                                  going beyond 6 plies takes a long time
IF l = 0 THEN l = 4 '
MasterLevel = l
human = 1: humanc = 0 '                                              comment line out for autoplay
debug = 1 '                                                          change to 0 or press "d" during play for bigger board
 
p = 6: b = 8: q1 = 200: q2 = 500
DIM SHARED b(b, b), t(b, b, l), o(b, b), mp$(p, 7)
DIM SHARED Moves(l), Move$(l, q1), Score(l, q1), TieTo(l), Index(l, q1)
DIM SHARED x(p, q2), y(p, q2), c&(12, q2), MoveLog$(q2)
DIM SHARED gm$(999), garr(31000), cp&(32)
 
OnAuto = NOT (OnAuto)
Begin:
Init
opening = 1
RESTORE o1
 
DO
    redo$ = ""
    MiscInfo
    'LINE (0, 0)-(945, _HEIGHT), _RGB(0, 0, 0), BF
    SaveWorB = WorB
    IF opening > 0 THEN
        READ m$
        IF m$ = "end" THEN opening = 0
    END IF
    IF opening = 0 THEN
        IF Start1& = 0 THEN Start1& = TIMER
        Start2& = TIMER
        CheckBoard 0
        IF Moves(0) = 0 THEN mess$ = "No legal moves."
        IF LEN(mess$) > 0 THEN EXIT DO
        IF human AND (humanc = WorB) THEN
            woof:
            HumanMove
            ok = 0
            FOR i = 1 TO Moves(0)
                IF m$ = Move$(0, i) THEN ok = 1: EXIT FOR
            NEXT i
            IF ok = 0 THEN SOUND 200, 1: GOTO woof
        ELSE
            fln = 0
            DebugR = 999: DebugC = 1
 
            Recurse 1
            TakeBest 0
            IF debug THEN MovesRanked
 
            b1$ = m$
            IF (Score(0, 1) = 777) AND (Score(1, 1) <> -777) THEN
                Score(0, 1) = 22
                TakeBest 0
                b1$ = m$
            END IF
            BoSave 0
 
            WorB = SaveWorB
            CheckBoard 0
            b1 = Score(0, 1)
            MoveIt b1$, 0 '                                          make the move
 
            WorB = SaveWorB XOR 1 '                                  toggle player
            CheckBoard 0 '                                           see what damage can be done
            b2$ = m$
            b2 = Score
 
            redo$ = STR$(b1) + STR$(b2 - 12)
            IF (b1 < (b2 - 112)) OR (Score = 777) THEN '            I forgot WHAT this bit was!
                'IF Score = 777 THEN
                redo = true
                redo$ = "*" + STR$(b1) + STR$(b2 - 12)
            END IF
 
            BoRestore 0
            WorB = SaveWorB
            m$ = b1$
 
            wonka:
            IF redo THEN '                                           try again checking ALL
                sl = MasterLevel
                MasterLevel = 2
                WorB = SaveWorB
                CheckBoard 0
                Recurse 1 '                                          start over
                TakeBest 0
                IF debug THEN MovesRanked
                m$ = Move$(0, 1)
                MasterLevel = sl
                redo = false
            END IF
            WorB = SaveWorB
            PlotAll
 
            fr = VAL(MID$(m$, 2, 1)) '                               from row
            fc = INSTR("abcdefgh", LEFT$(m$, 1)) '                   from column
            IF LEFT$(m$, 1) = "O" THEN fr = kr: fc = kc
            x1 = xc + (fc - 5) * xq
            y1 = yc + ((9 - fr) - 6) * yq
            LINE (x1, y1)-STEP(xq, yq), _RGB(0, 255, 0), B
            LINE (x1 + 1, y1 + 1)-STEP(xq - 2, yq - 2), _RGB(0, 255, 0), B
 
            IF LEFT$(m$, 1) <> "O" THEN
                tr = VAL(MID$(m$, 4, 1))
                tc = INSTR("abcdefgh", MID$(m$, 3, 1))
                x1 = xc + (tc - 5) * xq
                y1 = yc + ((9 - tr) - 6) * yq
                LINE (x1, y1)-STEP(xq, yq), _RGB(255, 255, 255), B
            END IF
 
            'SOUND 333, 1
            IF debug = 1 THEN
                MiscInfo
                RESTORE vlines
                DO
                    READ x
                    IF x = 0 THEN EXIT DO
                    FOR i = -2 TO 2 STEP 4
                        LINE (x + i, 0)-(x + i, _HEIGHT - 16), _RGB32(155, 0, 0)
                    NEXT i
                LOOP
            END IF
 
            DO: _LIMIT 10
                ScanKey
                IF i$ = "s" THEN i$ = "": SHELL _DONTWAIT "notepad chtemp.txt"
            LOOP UNTIL LEN(i$)
        END IF
    END IF
    WorB = SaveWorB
    DispTime
    MoveIt m$, -1
    ShowAlgebraic m$
 
    IF opening = 0 THEN
        check = false
        CheckBoard 0
        LOCATE 1, 8
        IF Score = 777 THEN
            check = true
            PRINT "Check!";
        ELSE
            PRINT "      ";
        END IF
    END IF
 
    WorB = SaveWorB XOR 1 '                                          toggle white/black
    IF LEN(GameFile$) > 0 THEN KeyGet
    WaitForKey = true
LOOP UNTIL Move = 500
 
IF Move = 500 THEN mess$ = "Over 500 moves...."
LOCATE 1, 1: PRINT mess$;
SLEEP
END
 
vlines:
DATA 226,467,707,950,0
 
o1:
DATA e2e4,e7e5,g1f3,b8c6,f1b5,a7a6,b5a4,b7b5,a4b3,g8f6,b1c3,f8e7,f3g5,h7h6
'DATA g5f7,O-O
'DATA f7d8,g8h7
DATA end
 
SetUp:
DATA 1,2,3,4,5,3,2,1
DATA 6,6,6,6,6,6,6,6
DATA 0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0
DATA 12,12,12,12,12,12,12,12
DATA 7,8,9,10,11,9,8,7
 
Legal:
'      udlr,udlr,udlr,udlr,udlr,udlr,udlr,udlr
DATA R,8000,0800,0080,0008,0000,0000,0000,0000
DATA N,2010,2001,0210,0201,1020,1002,0120,0102
DATA B,8080,8008,0880,0808,0000,0000,0000,0000
DATA Q,8000,0800,0080,0008,8080,8008,0880,0808
DATA K,1000,0100,0010,0001,1010,1001,0110,0101
DATA P,1000,1001,1010,0000,0000,0000,0000,0000
 
PiecePatterns:
DATA ........................
DATA ........................
DATA ........................
DATA ........................
DATA ....X..XX..XX..XX..X....
DATA ....X..XX..XX..XX..X....
DATA ....X..XX..XX..XX..X....
DATA ....X..XX..XX..XX..X....
DATA ....X..XX..XX..XX..X....
DATA .....X.XX..XX..XX.X.....
DATA ......XXXXXXXXXXXX......
DATA .....XX..........XX.....
DATA ......X.XXXXXXXX.X......
DATA ......X.XXXXXXXX.X......
DATA ......X.XXXXXXXX.X......
DATA ......X.XXXXXXXX.X......
DATA .....X............X.....
DATA .....X..XXXXXXXX..X.....
DATA ....X..............X....
DATA ...X..XXXXXXXXXXXX..X...
DATA ...X................X...
DATA ...XXXXXXXXXXXXXXXXXX...
 
DATA ........................
DATA ........................
DATA ........................
DATA ........................
DATA ............XXX.........
DATA ..........XX.X.X........
DATA .........X..X.X.XX......
DATA ........X.X.XX.X..X.....
DATA .......X.XXXX.X.X..X....
DATA .......X.X...XXX.X..X...
DATA .....X..XX..X.XXX.X.X...
DATA ....X.XXXXXXX.XXX.X..X..
DATA ...X.XXXXXX.X..XX.X..X..
DATA ...X.XX..XXX.X.XX.X..X..
DATA ....X..XXXX..X.XX.X..X..
DATA .....XX..X..X.XXX.X..X..
DATA ........X..XX.XX.XX.X...
DATA .......X..XX.XX.XX.X....
DATA ......XXXXXXXXXXXXXX....
DATA .....X..............X...
DATA ....X................X..
DATA .....XXXXXXXXXXXXXXXX...
 
DATA ........................
DATA ........................
DATA ........................
DATA ............X...........
DATA ...........X.X..........
DATA ..........X.X.X.........
DATA ........X...XX..X.......
DATA .......X..X..XX..X......
DATA .......X.XXX..XX.X......
DATA .......X.XXXX..X.X......
DATA ........X.......X.......
DATA .......XX.X.X.X.XX......
DATA ......X...........X.....
DATA .......X.XXX.XX.XX......
DATA ........X.XX.XX.X.......
DATA .......X.XXX.XXX.X......
DATA .......X.XXX.XXX.X......
DATA ......X.X.......X.X.....
DATA .....X.XXXXX.XXXXX.X....
DATA .....X.XXXXX.XXXXX.X....
DATA .....X.............X....
DATA ......XXXXXXXXXXXXX.....
 
DATA ............X...........
DATA ...........X.X..........
DATA .....X....X.X.X....X....
DATA ....X.X.XX.XXX..X.X.X...
DATA ...X.X.X..XX.XXX.X.X.X..
DATA ...X.XX.XXX.X.XXX.XX.X..
DATA ...X.XXX.X.XXX.X.XXX.X..
DATA ...X.XXXX.XXXXX.XXXX.X..
DATA ....X.XXXXXX..XXXXX.X...
DATA .....X.XXXXX..XXXX.X....
DATA .....X.............X....
DATA ......XXXXXXXXXXXXX.....
DATA ....X...............X...
DATA ......XX.XXXXXXX.XX.....
DATA .......X.X.XXX.X.X......
DATA ......X.XX.XXX.XX.X.....
DATA ......X.XX.XXX.XX.X.....
DATA .....XXXXXXXXXXXXXXX....
DATA ....X...............X...
DATA ...X..XX.XX.XX.XX.X..X..
DATA ...X.................X..
DATA ....XXXXXXXXXXXXXXXXX...
 
DATA ...........XX...........
DATA .........XX..XX.........
DATA .......XX.X..X.XX.......
DATA .....XX.X......X.XX.....
DATA ....X..XX.X..X.XX..X....
DATA ...X...XXXX..XXXX...X...
DATA ..X...XX........XX...X..
DATA .X..XXX.XXX..XXX.XXX..X.
DATA X..XXX..XXX..XXX..XXX..X
DATA X.XXXX..XXX..XXXX.XXXX.X
DATA X.XXXX.XXXX..XXXX.XXXX.X
DATA X.XXXX..XXXXXXXX..XXXX.X
DATA .X.XXXX..XXXXXX..XXXX.X.
DATA .X..XXXX..XXXX..XXXX..X.
DATA ..X..XXXX......XXXX..X..
DATA ...X....X......X....X...
DATA ...XXXXXXXXXXXXXXXXXX...
DATA ..X..................X..
DATA .X..XXXXXXXXXXXXXXXX..X.
DATA .X..XXXXXXXXXXXXXXXX..X.
DATA ..X..................X..
DATA ...XXXXXXXXXXXXXXXXXX...
 
DATA ........................
DATA ........................
DATA ........................
DATA ..........XXXX..........
DATA .........X....X.........
DATA ........X.XXXX.X........
DATA ........X.XXXX.X........
DATA .........X....X.........
DATA ........XXXXXXXX........
DATA .......X........X.......
DATA ........XXXXXXXX........
DATA .........X.XX.X.........
DATA .........X.XX.X.........
DATA .........X.XX.X.........
DATA ........X..XX..X........
DATA .......X..XXXX..X.......
DATA ......X.XXXXXXXX.X......
DATA ......X.XXXXXXXX.X......
DATA .....X............X.....
DATA ......XXXXXXXXXXXX......
DATA ........................
DATA ........................
 
rgb:
DATA 0,0,0,0,""
DATA 1,40,10,20,"board white"
DATA 2,0,0,0,"board black"
DATA 3,42,42,42,"white bright"
DATA 4,2,2,2,"white highlight"
DATA 5,0,0,0,"black bright"
DATA 6,32,32,32,"black highlight"
DATA 7,20,20,20,""
DATA 8,20,20,20,""
DATA 9,20,20,20,""
DATA 10,20,20,20,""
DATA 11,20,20,20,""
DATA 12,20,20,20,""
DATA 13,20,20,20,""
DATA 14,20,20,20,""
DATA 15,30,30,30,"printing"
 
SUB AddIt (Level, tm$, Score)
    Moves(Level) = Moves(Level) + 1 '                                count ok
    Move$(Level, Moves(Level)) = tm$ '                               save move
    Score(Level, Moves(Level)) = Score
    Index(Level, Moves(Level)) = TieTo(Level)
END SUB
 
SUB BoRestore (Level)
    FOR r = 1 TO 8
        FOR c = 1 TO 8
            b(r, c) = t(r, c, Level)
        NEXT c
    NEXT r
END SUB
 
SUB BoSave (Level)
    FOR r = 1 TO 8
        FOR c = 1 TO 8
            t(r, c, Level) = b(r, c)
        NEXT c
    NEXT r
END SUB
 
SUB CheckBoard (Level)
    Moves(Level) = 0
 
    OtherK = King - (WorB = 1) * 6 '                                 find location of kings
    debug$ = STR$(King) + STR$(OtherK)
    FOR fkr = 1 TO 8 '                                               row
        FOR fkc = 1 TO 8 '                                           column
            IF b(fkr, fkc) = 5 THEN mkr = fkr: mkc = fkc '           my king
            IF b(fkr, fkc) = 11 THEN kr = fkr: kc = fkc '            opponent king
        NEXT fkc
    NEXT fkr
 
    FOR r = 1 TO 8 '                                                 row
        ScanKey
        FOR c = 1 TO 8 '                                             column
            mp = b(r, c)
            mc = -(mp > 6) - (mp = 0) * 2
            IF mc = WorB THEN TryMove Level, r, c
        NEXT c
    NEXT r
 
    IF MID$(Castle$, WorB * 2 + 1, 1) = " " THEN cq = true ELSE cq = false
    IF MID$(Castle$, WorB * 2 + 2, 1) = " " THEN ck = true ELSE ck = false
 
    FOR Castle = 0 TO 1 '                                            queenside, then kingside
        IF Castle = 0 THEN cn$ = "2345" ELSE cn$ = "765"
        IF WorB = 0 THEN rn$ = "8" ELSE rn$ = "1"
        FOR cs = 1 TO LEN(cn$)
            rn = VAL(rn$)
            cn = VAL(MID$(cn$, cs, 1))
            tp = b(rn, cn)
            tp = tp + (tp > 6) * 6
            IF (tp <> 0) AND (tp <> King) THEN
                IF Castle = 0 THEN cq = false ELSE ck = false
            ELSE
                csq$ = MID$("abcdefgh", cn, 1) + rn$
                FOR lm = 1 TO Moves(1)
                    IF csq$ = RIGHT$(Move$(1, lm), 2) THEN
                        IF Castle = 0 THEN cq = false ELSE ck = false
                    END IF
                NEXT lm
            END IF
        NEXT cs
    NEXT Castle
 
    IF ck THEN AddIt Level, "O-O", 12
    IF cq THEN AddIt Level, "O-O-O", 13
 
    ' LOCATE 26 + WorB, 30: PRINT "*"; Castle$; "*";
    ' PRINT MID$("K ", ck + 2, 1);
    ' PRINT MID$("Q ", cq + 2, 1);
 
    TakeBest Level
END SUB
 
SUB MovesRanked '                                shows ranked eval at lower left
    sr = 40
    r = sr
    c = 124
    FOR t = 1 TO 120
        IF c < 150 THEN
            IF t <= Moves(0) THEN
                LOCATE r, c: PRINT SPACE$(8);
                LOCATE r, c
                PRINT Make4$(Move$(0, t)); rjust$(Score(0, t), 4);
            END IF
        END IF
        r = r + 1
        IF r > MaxRow THEN r = sr: c = c + 12
    NEXT t
END SUB
 
SUB MoveInfo (Level) STATIC
    IF debug <> 1 THEN EXIT SUB
    IF Level < 2 THEN
        'DebugR = DebugR + 1
        'EXIT SUB
    END IF
 
    IF DebugR > MaxRow THEN
        DebugR = 1
        DebugC = 1
        FOR r = 1 TO MaxRow
            LOCATE DebugR, DebugC
            'PRINT SPACE$(120 - DebugC);
        NEXT r
    END IF
 
    LOCATE DebugR, DebugC
    ts = 0: s = 1
    fln = fln + 1
    tt$ = RIGHT$(SPACE$(5) + STR$(fln), 5)
 
    fprint tt$ + " "
    FOR t = 1 TO Level
        ti = TieTo(t)
        IF t < 3 THEN PRINT Make4$(Move$(t - 1, ti)); rjust$(Score(t - 1, ti), 3); " ";
        fprint Make4$(Move$(t - 1, ti)) + rjust$(Score(t - 1, ti), 3) + " "
        ts = ts + Score(t - 1, ti) * s
        s = -s
    NEXT t
    ts = ts + Score
    PRINT Make4$(m$); rjust$(Score, 3); rjust$(ts, 4);
    fprint Make4$(m$) + rjust$(Score, 3) + rjust$(ts, 4) + crlf$
    DebugR = DebugR + 1
    IF DebugR > MaxRow THEN
        DebugR = 1
        DebugC = DebugC + 30
        IF DebugC > 120 THEN DebugC = 1
    END IF
END SUB
 
SUB DispTime
    IF Start2& > 0 THEN
        Elapse1! = TIMER - Start1&
        Elapse2! = TIMER - Start2&
        IF Elapse2! > MaxElapse! THEN MaxElapse! = Elapse2!
        'ShowTime 1, Elapse1!, "Game:"
        'ShowTime 2, Elapse2!, "This move:"
        'ShowTime 3, MaxElapse!, "Max move:"
    END IF
END SUB
 
SUB FadePiece (fr, fc, tr, tc)
    x1 = xc + (fc - 5) * xq
    y1 = yc + ((9 - fr) - 6) * yq
    x2 = xc + (tc - 5) * xq
    y2 = yc + ((9 - tr) - 6) * yq
    p = b(tr, tc)
    IF p > 6 THEN wb = 1: p = p - 6
    i = p - (wb = 0) * 6
 
    FOR ps = 0 TO 1
        IF ps = 0 THEN
            c = fr + fc: tx = x1: ty = y1
        ELSE
            c = tr + tc: tx = x2: ty = y2
        END IF
        IF (c MOD 2) = 1 THEN
            LINE (tx, ty)-(tx + xq, ty + yq), cp&(BoardWhite), BF
        ELSE
            LINE (tx, ty)-(tx + xq, ty + yq), cp&(BoardBlack), BF '       black square
            LINE (tx, ty)-(tx + xq, ty + yq), cp&(BoardWhite), B '        border
        END IF
    NEXT ps
 
    FOR t = 1 TO c&(p, 0)
        IF debug = 1 THEN
            tx = x2 + x(p, t)
            ty = y2 + y(p, t)
            PSET (tx, ty), c&(i, t)
        ELSE
            tx = x2 + x(p, t) * 3 - 2
            ty = y2 + y(p, t) * 3
            LINE (tx, ty)-STEP(3, 3), c&(i, t), BF
        END IF
        'PSET (tx, ty), tc&
    NEXT t
END SUB
 
SUB HumanMove
    FOR i = 0 TO 1
        IF i = 0 THEN
            rr = 1: cc = 1
        ELSE
            rr = fr: cc = fc
        END IF
        mx = _MOUSEX
        my = _MOUSEY
        DO
            'LOCATE 1, 1: PRINT "Move ";
            x1 = xc + (cc - 5) * xq
            x2 = xc + (cc - 4) * xq
            y1 = yc + (rr - 6) * yq
            y2 = yc + (rr - 5) * yq
            IF debug < -2 THEN
                GET (x1, y1)-(x2, y2), garr()
                PUT (x1, y1), garr(), PRESET
                _DELAY .1
                PUT (x1, y1), garr(), PSET
                _DELAY .1
            ELSE
                zz = zz XOR 1
                IF zz THEN tc& = _RGB32(0, 0, 0) ELSE tc& = _RGB32(0, 255, 0)
                LINE (x1, y1)-(x2, y2), tc&, B
                _DELAY .1
                LINE (x1, y1)-(x2, y2), _RGB32(0, 0, 0), B
            END IF
            'tmx = _MOUSEX: tmy = _MOUSEY
            IF (ABS(mx - tmx) > 8) OR (ABS(my - tmy) > 8) THEN
                IF tmx > mx THEN cc = cc + 1
                IF tmx < mx THEN cc = cc - 1
                IF tmy > my THEN rr = rr + 1
                IF tmx < my THEN rr = rr - 1
            END IF
            'i$ = INKEY$
            ScanKey
            IF LEN(i$) = 2 THEN
                kk = ASC(RIGHT$(i$, 1))
                cc = cc + (kk = 75) - (kk = 77) '                    left right
                rr = rr + (kk = 72) - (kk = 80) '                    up down
            END IF
            IF rr < 1 THEN rr = 1
            IF rr > 8 THEN rr = 8
            IF cc < 1 THEN cc = 1
            IF cc > 8 THEN cc = 8
            IF i$ = Esc$ THEN SYSTEM
        LOOP UNTIL i$ = Enter$
        IF i = 0 THEN
            fr = rr: fc = cc
        ELSE
            tr = rr: tc = cc
        END IF
    NEXT i
    fs$ = MID$("abcdefgh", fc, 1) + LTRIM$(STR$(9 - fr))
    ts$ = MID$("abcdefgh", tc, 1) + LTRIM$(STR$(9 - tr))
    m$ = fs$ + ts$
    '   LOCATE 1, 1: PRINT m$; SPACE$(40);
END SUB
 
SUB Init
    xr = 1280: yr = 800 '                                            120*50 text?
    SCREEN _NEWIMAGE(xr, yr, 32)
    _FULLSCREEN
 
    RESTORE rgb
    FOR p = 0 TO 15
        READ PalNum, r, g, b, desc$
        cp&(p) = _RGB32(r * 4, g * 4, b * 4)
    NEXT p
 
    'RANDOMIZE TIMER '                                               seed generator
    Move = 0
    WorB = 1 '                                                       white=1, black=0
    IF debug = 1 THEN
        q = 28: xq = q: yq = q '                                         size of squares
        xc = 1100: yc = 160 '                                            top left corner of board
    ELSE
        q = 80: xq = q: yq = q '                                         size of squares
        xc = 360: yc = 440 '                                            top left corner of board
    END IF
    lf$ = CHR$(10)
    Enter$ = CHR$(13)
    Esc$ = CHR$(27)
    crlf$ = Enter$ + lf$
    Castle$ = SPACE$(4) '                                            flags QKQK (B then W)
    mess$ = ""
 
    RESTORE PiecePatterns '                                          bit images
    FOR p = 1 TO 6 '                                                 RNBQKP
        ScanKey
        n = 0
        FOR y = 0 TO 21 '                                            22 rows
            READ d$
            p1 = INSTR(d$ + "X", "X") '                              find first "on" bit
            FOR t = LEN(d$) TO 1 STEP -1 '                           find last "on" bit
                IF MID$(d$, t, 1) = "X" THEN
                    p2 = t
                    EXIT FOR
                END IF
            NEXT t
            FOR x = p1 TO p2
                pixel = INSTR(".X", MID$(d$, x, 1))
                n = n + 1
                IF pixel = 2 THEN tc& = cp&(3) ELSE tc& = cp&(4)
                x(p, n) = x + 1
                y(p, n) = y + 2
                c&(p, n) = tc&
                IF pixel = 2 THEN tc& = cp&(5) ELSE tc& = cp&(6)
                c&(p + 6, n) = tc&
            NEXT x
        NEXT y
        c&(p, 0) = n
    NEXT p
 
    RESTORE Legal '                                                  define how piece moves
    FOR p = 1 TO 6 '                                                 RNBQKP
        READ p$ '                                                    piece, not saved
        FOR t = 0 TO 7 '                                             8 each
            READ mp$(p, t) '                                         mp (move piece)
        NEXT t
    NEXT p
 
    RESTORE SetUp '                                                  initial board position
    FOR r = 8 TO 1 STEP -1 '                                         row
        FOR c = 1 TO 8 '                                             column
            READ b(r, c)
            o(r, c) = b(r, c)
        NEXT c
    NEXT r
 
    elim$ = " ,"
    gm = 0: n = 0
    IF LEN(GameFile$) > 0 THEN ReadGame
    gm = 0
 
    MaxRow = 49
 
    f = f + 1
    f$ = "chess" + LTRIM$(STR$(f))
    OPEN f$ + ".alg" FOR OUTPUT AS #1 '                              algrebraic moves
 
    tf = FREEFILE
    OPEN "chtemp.txt" FOR OUTPUT AS #tf
    PRINT #tf, DATE$; " "; TIME$; crlf; crlf$;
    CLOSE #tf
    PlotAll
END SUB
 
SUB KeyGet
    sr = CSRLIN: sc = POS(0)
    DO: _LIMIT 10
        ScanKey
        star = star XOR 1
        IF i$ > "" THEN star = 0
        LOCATE sr, sc
        IF LEN(GameFile$) = 0 THEN PRINT CHR$(32 + star * 10);
    LOOP UNTIL i$ > ""
    IF i$ = "s" THEN WaitForKey = false
END SUB
 
FUNCTION Make4$ (t$)
    Make4$ = LEFT$(t$ + SPACE$(4), 4)
END FUNCTION
 
SUB MoveIt (m$, real)
    IF m$ = "res" THEN EXIT SUB '                                    resign?
    fs$ = LEFT$(m$, 2) '                                             from square
    ts$ = RIGHT$(m$, 2) '                                            to square
    nnn = 1 - (LEFT$(m$, 1) = "O") '                                 two moves for a castle
    FOR pass = 1 TO nnn '                                            two moves for a castle
        IF m$ = "O-O" THEN '                                         castle Kingside
            IF WorB = 1 THEN '                                       white
                IF pass = 1 THEN '                                   first move of KS castle
                    fs$ = "e1": ts$ = "g1"
                ELSE '                                               else 2nd
                    fs$ = "h1": ts$ = "f1"
                END IF
            ELSE '                                                   black castle
                IF pass = 1 THEN
                    fs$ = "e8": ts$ = "g8"
                ELSE
                    fs$ = "h8": ts$ = "f8"
                END IF
            END IF
        END IF
        IF m$ = "O-O-O" THEN '                                       castle Queenside
            IF WorB = 1 THEN '                                       white
                IF pass = 1 THEN
                    fs$ = "e1": ts$ = "c1"
                ELSE
                    fs$ = "a1": ts$ = "d1"
                END IF
            ELSE
                IF pass = 1 THEN
                    fs$ = "e8": ts$ = "c8"
                ELSE
                    fs$ = "a8": ts$ = "d8"
                END IF
            END IF
        END IF
        fr = VAL(RIGHT$(fs$, 1)) '                                   from row
        fc = INSTR("abcdefgh", LEFT$(fs$, 1)) '                      from column
 
        pm = b(fr, fc) '                                             piece to move
        p = pm + (pm > 6) * 6
        tr = VAL(RIGHT$(ts$, 1)) '                                   to row
        tc = INSTR("abcdefgh", LEFT$(ts$, 1)) '                      to column
        b(tr, tc) = pm '                                             move piece in array
        b(fr, fc) = 0 '                                              blank old array spot
        IF real THEN
            IF b(r, c) = o(r, c) THEN o(r, c) = -1
            FadePiece fr, fc, tr, tc
            IF p = King THEN MID$(Castle$, WorB * 2 + 1, 2) = "XX"
            IF p = Rook THEN
                IF WorB = 0 THEN
                    IF (fr = 8) AND (fc = 1) THEN MID$(Castle$, 1, 1) = "X"
                    IF (fr = 8) AND (fc = 8) THEN MID$(Castle$, 2, 1) = "X"
                ELSE
                    IF (fr = 1) AND (fc = 1) THEN MID$(Castle$, 3, 1) = "X"
                    IF (fr = 1) AND (fc = 8) THEN MID$(Castle$, 4, 1) = "X"
                END IF
            END IF
        END IF
        IF (p = Pawn) AND ((tr = 1) OR (tr = 8)) THEN
            b(tr, tc) = Queen - (pm > 6) * 6 '                       promote to queen
            IF real THEN FadePiece tr, tc, tr, tc '                  show queen
        END IF
    NEXT pass
END SUB
 
SUB PlotAll
    IF LEN(GameFile$) > 0 THEN
        LOCATE 3, 40 - LEN(GameFile$) \ 2
        PRINT GameFile$;
    END IF
    FOR r = 1 TO 8
        FOR c = 1 TO 8
            FadePiece r, c, r, c
        NEXT c
    NEXT r
    FOR i = 1 TO 8 '                                                 legend
        n$ = LTRIM$(STR$(i))
        a$ = MID$("abcdefgh", i, 1)
        IF debug = 1 THEN
            nx = xc - 4 * xq - 12
            ny = y2 + i * yq
            ax = xc + (i - 5) * xq + 10
            ay = yc + 3 * yq + 3
        ELSE
            nx = xc - 4 * xq - 14
            ny = y2 + i * yq + 13
            ax = xc + (i - 5) * xq + 35
            ay = yc + 3 * yq + 3
        END IF
        _PRINTSTRING (nx, ny), n$
        _PRINTSTRING (ax, ay), a$
    NEXT i
END SUB
 
SUB ReadGame
    DIM g$(500)
    OPEN GameFile$ FOR INPUT AS #1
    WHILE NOT (EOF(1))
        LINE INPUT #1, t$
        n = n + 1
        g$(n) = t$
    WEND
    CLOSE #1
    i = 1
    DO
        g$ = g$(i)
        DO
            p1 = INSTR(g$, " ")
            IF p1 = 0 THEN EXIT DO
            p2 = INSTR(g$, ",")
            IF p2 = 0 THEN p2 = LEN(g$)
            t$ = LTRIM$(MID$(g$, p1, p2 - 2))
            p = INSTR(t$, " ")
            IF p = 0 THEN p = LEN(t$)
            t2$ = RTRIM$(LEFT$(t$, p))
            IF INSTR(elim$, RIGHT$(t2$, 1)) THEN t2$ = LEFT$(t2$, LEN(t2$) - 1)
            gm$(gm) = t2$
            gm = gm + 1
            IF LEN(t$) > p THEN
                t$ = LTRIM$(RIGHT$(t$, LEN(t$) - p + 1))
                WHILE INSTR(elim$, RIGHT$(t$, 1))
                    t$ = LEFT$(t$, LEN(t$) - 1)
                WEND
                gm$(gm) = t$
                'PRINT 2; gm$(gm)
                gm = gm + 1
            END IF
            ' KeyGet
            g$ = RIGHT$(g$, LEN(g$) - p2)
        LOOP UNTIL LEN(g$) = 0
        i = i + 1
    LOOP UNTIL i > n
END SUB
 
SUB Recurse (Level)
    DispTime
    'LOCATE 1, 45 + Level * 2: PRINT "* ";
    IF Level = MasterLevel THEN EXIT SUB
    IF redo THEN
        EndAt = Moves(Level - 1)
    ELSE
        EndAt = 5
        IF EndAt > Moves(Level - 1) THEN EndAt = Moves(Level - 1)
    END IF
 
    FOR t = 1 TO EndAt
        WorB = SaveWorB
        IF (Level MOD 2) = 1 THEN WorB = WorB XOR 1
        TieTo(Level) = t
        IF (Score(0, t) > -777) THEN
            BoSave Level
            m$ = Move$(Level - 1, t)
            MoveIt m$, 0
            lm1 = Level - 1
            t$ = rjust$(Moves(lm1), 3)
            t$ = t$ + rjust$(t, 4) + " "
            t$ = t$ + Make4$(m$)
            t$ = t$ + rjust$(Score(lm1, t), 5)
 
            'IF debug = 2 THEN ShowMe 3 + Level, 1, t$
            'LOCATE 34, Level * 20: PRINT t; EndAt; " ";
            CheckBoard Level
            Recurse Level + 1
            TakeBest Level
            IF debug = 1 THEN MoveInfo Level
            i = Index
            Score = Score(Level, 1)
            ' IF Level = 2 THEN Score = Score \ 2
            levm1 = Level - 1
            Score(levm1, i) = Score(levm1, i) - Score
            'ShowMe 35, 130, Make4$(Move$(Level, 1)) + rjust$(Score(Level, 1), 4) + " "
            'ShowMe 36, 130, Make4$(Move$(levm1, i)) + rjust$(Score(levm1, i), 4) + " "
            BoRestore Level
        END IF
    NEXT t
END SUB
 
FUNCTION rjust$ (t, n)
    rjust$ = RIGHT$("   " + STR$(t), n)
END FUNCTION
 
SUB ScanKey
    i$ = INKEY$
    IF i$ = "" THEN EXIT SUB
 
    IF LEN(i$) = 1 THEN
        IF i$ = "a" THEN
            OnAuto = NOT (OnAuto)
            IF auto THEN human = 0
        END IF
 
        c = INSTR("123456789)!@#$%", i$)
        IF c > 0 THEN
            SOUND 777, 1
            r = RND * 255: g = RND * 255: b = RND * 255
            c& = _RGB32(r, g, b)
            FOR y = 0 TO ym: FOR x = 0 TO xm
                    p& = POINT(x, y)
                    IF p& = cp&(c) THEN PSET (x, y), c&
            NEXT x: NEXT y
            cp&(c) = c&
            i$ = ""
        END IF
 
        IF i$ = "d" THEN
            i$ = CHR$(255): debug = debug XOR 1
            IF debug = 1 THEN
                q = 28: xq = q: yq = q '                             size of squares
                xc = 1100: yc = 160 '                                top left corner of board
            ELSE
                q = 80: xq = q: yq = q '                             size of squares
                xc = 600: yc = 460 '                                 top left corner of board
            END IF
            CLS: PlotAll
        END IF
 
        IF i$ = "s" THEN i$ = "": SHELL _DONTWAIT "notepad chtemp.txt"
 
        IF i$ = Esc$ THEN CLOSE: END
    END IF
END SUB
 
SUB ShowAlgebraic (m$)
    IF WorB = 1 THEN ' white=1, black=0
        Move = Move + 1 ' number the moves
        PRINT #1, RIGHT$("  " + STR$(Move), 3);
        PRINT #1, RIGHT$(SPACE$(10) + m$, 7);
        MoveLog$(Move) = SPACE$(15)
        MID$(MoveLog$(Move), 1, 3) = rjust$(Move, 3)
        MID$(MoveLog$(Move), 5, LEN(m$)) = m$
    ELSE
        MID$(MoveLog$(Move), 11, LEN(m$)) = m$
        PRINT #1, " "; m$
        IF (Move MOD 5) = 0 THEN PRINT #1, ""
    END IF
 
    BeginAt = Move - 39
    IF BeginAt < 1 THEN BeginAt = 1
    dr = 17: dc = 123
    FOR t = BeginAt TO Move
        ShowMe dr + 1, dc, MoveLog$(t)
        dr = dr + 1
        IF dr > 36 THEN
            dr = 17: dc = dc + 15
            IF dc > 138 THEN dr = 36: dc = 138
        END IF
    NEXT t
END SUB
 
SUB ShowMe (dr, dc, t$)
    sr = CSRLIN '                                                    save row
    sc = POS(0) '                                                    save column
    IF (dr > 0) AND (dr < 50) AND (dc > 0) AND (dc < 150) THEN
        LOCATE dr, dc '                                              display row & column
        PRINT t$;
    END IF
    IF NOT (OnAuto) THEN KeyGet
    LOCATE sr, sc '                                                  restore to old location
END SUB
 
SUB ShowTime (trow, t!, Desc$)
    s! = t!
    SELECT CASE s!
        CASE IS > 3600
            unit$ = "h"
            s! = s! / 3600
        CASE IS > 60
            unit$ = "m"
            s! = s! / 60
        CASE ELSE
            unit$ = "s"
    END SELECT
 
    trow = trow + 3
    LOCATE trow, 34 - LEN(Desc$): PRINT Desc$;
    LOCATE trow, 34
    PRINT USING "###.#"; s!;
    PRINT unit$
END SUB
 
SUB TakeBest (Level)
    FOR scram = 0 TO 99
        s1 = RND * (Moves(Level) - 1) + 1
        s2 = RND * (Moves(Level) - 1) + 1
        SWAP Score(Level, s1), Score(Level, s2)
        SWAP Move$(Level, s1), Move$(Level, s2)
        SWAP Index(Level, s1), Index(Level, s2)
    NEXT scram
 
    passes = 0
    ReSort:
    Score = -999 '                                                   assume no moves
    DO
        Sorted = true
        FOR s = 2 TO Moves(Level)
            IF Score(Level, s - 1) < Score(Level, s) THEN
                Sorted = false
                SWAP Score(Level, s - 1), Score(Level, s)
                SWAP Move$(Level, s - 1), Move$(Level, s)
                SWAP Index(Level, s - 1), Index(Level, s)
            END IF
        NEXT s
    LOOP UNTIL Sorted
 
    m$ = Move$(Level, 1)
    Score = Score(Level, 1)
    Index = Index(Level, 1)
 
    IF Level = 0 THEN
        FOR lb = 0 TO 2 '                                            stop repeats
            IF INSTR(MoveLog$(Move - lb), m$) THEN
                Score(Level, 1) = Score(Level, 2) - 1 '              best = 2nd best-1
                passes = passes + 1
                IF passes < 5 THEN GOTO ReSort '                     repeat may be only move
            END IF
        NEXT lb
    END IF
 
    IF Level = 0 THEN
        IF Score = -777 THEN '                                       in check, no escape
            mess$ = "Mate"
        ELSEIF Score = -999 THEN '                                   no moves
            mess$ = "Stalemate"
        END IF
    END IF
 
    IF (Level = 1) AND (Score = 777) THEN Score(0, TieTo(1)) = -777
END SUB
 
'FUNCTION TextCol (xc)
'    TextCol = (xc - 1) * 2 + 25
'END FUNCTION
 
'FUNCTION TextRow (xr)
'    TextRow = (8 - xr) * 1 + 8
'END FUNCTION
 
'FUNCTION TextVal (xr, xc)
'    i = b(xr, xc)
'    i = i + (i > 6) * 6
'    TextVal = i
'END FUNCTION
 
SUB fprint (t$)
    tf = FREEFILE
    OPEN "chtemp.txt" FOR APPEND AS #tf
    PRINT #tf, t$;
    CLOSE #tf
    IF INSTR(t$, Enter$) THEN
        linesprinted&& = linesprinted&& + 1
        IF (linesprinted&& MOD 1000) = 0 THEN LOCATE 1, 130: PRINT linesprinted&&;
    END IF
END SUB
 
SUB MiscInfo
    LOCATE 1, 124: PRINT "Plies: "; COMMAND$; "  LP:"; linesprinted&&; redo$;
END SUB
 
SUB TryMove (Level, fr, fc) '                                        from row, from column
    mp = b(fr, fc)
    IF mp = 0 THEN END
    mc = -(mp > 6) - (mp = 0) * 2 '                                  moving color
    IF mc = 2 THEN END
    mp = mp + (mp > 6) * 6
    IF mc = 1 THEN s = -1 ELSE s = 1 '                               direction a pawn moves
 
    FOR n = 0 TO 7 '                                                 possible 8 dirs
        udlr$ = mp$(mp, n) '                                         up/down/left/right
        IF udlr$ = "0000" THEN EXIT FOR '                            added 2Jan95
        du = VAL(MID$(udlr$, 1, 1)) '                                direction up
        dd = VAL(MID$(udlr$, 2, 1)) '                                direction down
        dl = VAL(MID$(udlr$, 3, 1)) '                                direction left
        dr = VAL(MID$(udlr$, 4, 1)) '                                direction right
        IF mp <> Knight THEN '                                       not knight
            du = SGN(du) * s '                                       one square at a time
            dd = SGN(dd) * s
            dl = SGN(dl) * s
            dr = SGN(dr) * s
        END IF
        IF INSTR(udlr$, "8") THEN TrySq = 8 ELSE TrySq = 1
        IF (mp = Pawn) AND (n = 0) THEN '                            pawn first move?
            IF (fr = 2) AND (WorB = 1) THEN TrySq = 2 '              gambit for white
            IF (fr = 7) AND (WorB = 0) THEN TrySq = 2 '              gambit for black
        END IF
        tr = fr: tc = fc '                                           row, column
        'IF TrySq = 0 THEN END
        FOR sq = 1 TO TrySq '                                        up to 8 loops
            capture = false
            Score = 0 '                                              must init
            tr = tr - du + dd '                                      row=row-up+down
            tc = tc - dl + dr '                                      column=column-left+right
            IF (tr < 1) OR (tr > 8) OR (tc < 1) OR (tc > 8) THEN EXIT FOR
            cp = b(tr, tc) '                                         capture piece
            cc = -(cp > 6) - (cp = 0) * 2 '                          capture color
            cp = cp + (cp > 6) * 6
            IF mc = cc THEN '                                        own piece!
                EXIT FOR
            ELSEIF (mc XOR 1) = cc THEN '                            capture
                IF (mp = Pawn) AND (n = 0) THEN EXIT FOR '           no diag, no cap!
                capture = true
                '                 RNBQKP
                Score = VAL(MID$("533901", cp, 1)) * 10
                IF (Score > 0) AND (Level = 0) THEN Score = Score + 2
                IF Score = 0 THEN Score = 777 '                      king capture
                ' IF redo AND (Score = 777) THEN Score = 25
            ELSE
                IF (mp = Pawn) AND (n > 0) THEN EXIT FOR
            END IF
            IF mp = Pawn THEN
                IF (tr = 1) OR (tr = 8) THEN '                       promote pawn
                    IF Score <> 777 THEN Score = Score + 99
                END IF
            END IF
 
            InCheck = (mc = SaveWorB) AND check
            ' small plus for king moving out of check
            IF (mp = King) AND InCheck THEN Score = Score + 2
 
            ' leave king cap scores, also normal bonuses if in check
            IF (Score <> 777) AND (NOT (InCheck)) AND (mp <> King) THEN
                dis1 = ABS(fr - kr) + ABS(fc - kc) '                 get closer to king
                dis2 = ABS(tr - kr) + ABS(tc - kc)
                ' IF dis2 < dis1 THEN Score = Score + (dis1 - dis2)
                Score = Score + dis1 - dis2
 
                IF Move < 30 THEN
                    dir = SGN((fr - tr) * s)
                    IF dir = 1 THEN Score = Score + 2 '              move ahead at begin & mid
                END IF
 
                IF mp <> Rook THEN '                                 priority to getting a piece first moved
                    IF b(fr, fc) = o(fr, fc) THEN Score = Score + 1
                END IF
 
                ' priority to getting a piece off the bottom rank
                IF (fr = 1) AND (tr > 1) AND (WorB = 1) THEN Score = Score + 1
                IF (fr = 8) AND (tf < 8) AND (WorB = 0) THEN Score = Score + 1
            END IF
 
            fs$ = MID$("abcdefgh", fc, 1) + CHR$(48 + fr) '          from square
            ts$ = MID$("abcdefgh", tc, 1) + CHR$(48 + tr) '          to square
            AddIt Level, fs$ + ts$, Score
            'IF capture AND (mp <> Pawn) THEN EXIT FOR '             stop looking
        NEXT sq
    NEXT n
END SUB
 

Title: Re: A 90% complete chess engine
Post by: romichess 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 (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.

Title: Re: A 90% complete chess engine
Post by: bplus on January 26, 2020, 10:40:51 am

Quote from: romichess 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.

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 (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.

Title: Re: A 90% complete chess engine
Post by: bplus 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]

_TITLE "Chess 2017-11-22 T .bas     Ctrl+K for Keyboard input"
'2017-10-10 raw patch of Interface to Chess.bas post update with mouse troubles
 
' 22 10 2017 New fix to Incheck function, I hope the last!
' 22 10 2017  empowered promotion by mouse
' 22 10 2017  fix promotion visible only after move of black
' 22 10 2017 castle by mouse
' 22 10 2017  empowered castling control, now you cannot castle if they are in check
'             or across a square that is under Black control
' 22 10 2017 translated in sub Info_Help screen
' 22 10 2017  translate in sub Fellippe's Wait click and key
' 22 10 2017 added logical end to the main of program
' 22 10 2017 put away all code REMMED not yet used
 
'2017 10 24 changed board graphics, arranged alpha order subs, updated highlite square
' Thanks Adrian Huang
' http://www.thejoyfulprogrammer.com/qb64/forum/showthread.php?tid=401&rndtime=1508625987687357559
 
'2017 10 24 Incorporate TempodiBasic's legalShow and legalHide routines
' fix pawn promotions see Ppromote$
' count pieces captured and show with board
' install game recorder
 
' 27 10 2017 color of chessboard are CONST
' resizing square and character size to  42
' moving list of piece captured at top right
' moving output at bottom right
' new SUB ShowSetup that shows whole setup to choose pieces for white and black,
' or only pieces capturable (No king because when a King falls game stops!)
' or only pieces for promotion (Knight Bishop Rook Queen) for both colors
' now if Black resigns the flow of program ends after main do loop to let replay the game
' play again label structure and initialization instruction (it is possible to use a DO LOOP)
' Added ButtonMenuBar at bottom using MakeButton SUB
' Button QUIT working, button PLAY works for now let us play only as WHITE
' Build an area for list of moves
' build an area for output/feedback of program
' Changed Helpscreen instruction including mouse selection
' >>>> wow lots of new stuff
 
'2017-10-29/30 fixed dots in empty squares, highlight piece clicked, thing crawling under board while computer thinks
' now if we can only get the colors ;-)) Outer loop to restart game, elimate some boxes, less cluttered looking.
' change title to version = date easier to track
 
'2017 10 31 T  Yes I follow you in using date also if in my country I use DD-MM-YYYY   :-)
'  YES fixed BIG BUG about restart and Play Again lasting the last moves in memory... and in File Recorder
 
'2017-11-01 B review TempodiBasic's BIG BUG fix, clean up lines, comments and variables
' I (bplus) see some work also done in IO for checking checks, I assume.
 
'2017-11-03 B Move Intro to before main program loop, fix some things with promotion
' prompt for pieces, pWflag$, pBflag$ to add to move list
 
'2017-11-04 B hack AI this is just an experiment for my cat who is always curious specially
' because it exists in another universe.
 
'2017-11-06 A 2nd post (really posted 11-05) Added/revised code for rotating board to play Black.
' Adrain has change 5000 number to 9000 im several places and I don't know if this fixes castle
' It did fix notation in the moves list correctly
 
'2017-11-05 B  from Adrian's 2nd post 2017-11-06( posted 11-05) A #2   continuing with hackBlack hacks!
' I noticed that code changes were very alike and one fuction would save quite a bit of code FIXED
' I also noticed the captured pieces were backwards when Black plays FIXED
' I noticed Black cant castle yet BIGGEST FIX of them all!!!
' I noticed Ctrl+K for human playing Black did not work, well had to translate move back so
' IO can reverse again!!  FIXED!
' Check pawn promotion and track down source of mystery q added to computer's moves.
' Still allot of goofy things...
 
'2017-11-07 A - removed fake 1st move while playing black
 
'2017-11-07 B hack 2 using above mod but with EXIT SUB instead of GOTO
' fix capture counts so that only positive counts show
' Ah found source of allot of goofyness!  hackBlack > playBlack per Adrian
' I think I have this working correctly through Play Again Y/N?
 
'2017-11-07 T put away GOTO for label 100 to play again
' moved in main loop AI resign (strange as white it capture by King and then when you takes King it resign!!!
' GOOD first AI goes on playing without king :-)
'
'2017-11-07 2B removed 100 next to loop since no goto, fixed comments on separate line
' and added some comments, I think I have finally tracked down source of extra q's!!! FIXED
 
' 2017-11-10 T  fixed promotion  failure with strange choose made clicking on the other side of window of program
' at the Y of piece to get by promotion
'   Restored  MAXLEVEL at beginning of program to set power of AI
'
' 2017-11-10 2T cutting some old comments no more useful for use about issues yet resolved
' packing the 2 initboard to one (they do the same work with 2 different labels)
'
'2017-11-11 B Put T comments on separate line from code.
'Recommend making MAXLEVEL a CONST if we will not change it ever.
'Tell why two different boards are needed to initialize the board positions.
'Fix pWfalg$ again! that AI has no business changing BUT OK save ElSE block because AI
'may need to plan for eventual pawn promotion and assuming a Queen is smart assumption.
'
' 2017-11-13 T  fixed incheck failure and strange moves of king under check using a new shared flag Turn
' to let analize only the important pieces by INCHECK Function, they are different for White and for Black
' 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
' the ELSE.. END IF part for white (Human) player is needed together INTFLAG  =1 humang chooses by himself piece in promotion, =0 autochoosed Queen
' also fixed extra q by inizilization of pWflag$ at start of SUB
'
'2017-11-15 B start work on Undo, Save and Load
' 2 functions cp2n(piece$), cn2p$(number), for converting a board to a bString$ letter and vice versa
' bString$ will get all board positions loaded in 64 character string
' bSetyp will setup a board from a bString$ used for UNDO, Save, Load and future SETUP
' Center text in a button
' Now reworked initBoard so initBlack sub can be eliminated and initBoard shrunk, now eliminated also!
' Now add stuff to make UNDO possible. new Boards$() array works along with Move$(), Boards$() has bString$ of board positions
' Incorp TempodiBasic changes to AI checking for Check (Chess 2_17-11-13 T) :
'    Use new glabal varaible Turn = 1 for White's and -1 for Black, might come in handy! Yes on loading Game
'        Eliminate the infinite crap I'd rather have AI King commiting suicide as a form of Resign for testing all other stuff
'           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!
' Moved ShowButton Bar and showMoveList into ShowBd and gave showMoveList a diet
' No more File recorder, eliminate Datetime, fix UNDO for trying to go less than 1
' Remove InitBoard sub, all done in getInput button section
 
' Fix a ton of bugs to get all this integrated and working together but more keep popping up, blah!
' Make Result global to fix Y/N question to start over when Y
' Modify restart to clean slate the entire program, then use buttons to set particular settings needed
' Bug Loading a game right after Loading a game may cause an error
' Bug sometimes QB64 _FILEEXISTS says a real file that you typed correctly can't be found, just type it in again.
' I put a double _FILEEXISTS call in with delay between, helps but still the bug remains!!!
' Bug missing line when human loads a file playing black and starts game from there.
' Ugly fix that I doubt will work in other cases
 
'2017-11-16 A Tried to fix bug when AI is checkmated by modifying INCHECK function
'             Minor changes - removed 1 set of board labels. display pieces centrally on squares
 
'2017-11-16 B Adrian some nice changes to board but please no PlayAgain: label, no GOTO unless best way
' I do not like ending the whole application in the InCheck sub,  nor do I think one time result <-2500 is cause to quit??
' Remember AI checks many moves with InCheck, I am afraid it might quit first time it gets result < -2500 with better result left.
' Also I fix my omission with loadFlag code in IO, and it turns out with UNDO we have to clear the capture amounts, fixed.
 
'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
'           IN CHECK function need not check for checks to AI's king.
 
'2017-11-19 T: fixing the covering of the left border of buttonbar (Movelist too large passed from 700 to 680)
' 2017-11-22 T: fixing dummy _fileexists, it seems we don't need it yet
' 2017 11 22 T : coded manageDummySystem on save file, 1. now you can save only a game in progress  (no game = nothing to save)
'                                                      2. now you can overwrite an existing file only if you confirm to overwrite it
'                coded  feedback LoadFile in areaoutput
 
 
_DEFINE A-Z AS INTEGER
RANDOMIZE TIMER
CONST XMAX = 900
CONST YMAX = 600
CONST WHITE& = &HFFDDDDDD
CONST BLACK& = &HFF000000
CONST LITE& = &HFFFFFF00
CONST LITE2& = _RGB32(78, 161, 72)
CONST WHITES& = _RGB32(140, 160, 190)
CONST BLACKS& = _RGB32(0, 130, 70)
CONST SQ = 42
'T here (B out side of restart sub) we need a Maxlevel
CONST MAXLEVEL = 5
'B might as well make constant!
 
'B For fonts
COMMON SHARED FW, FH, normal&, maxCol, bArial&, bFW, bFH
 
'B For human playing Black
COMMON SHARED playBlack, bmoves$, bFirst
 
'B from original QB64 samples: chess.bas
DIM SHARED BOARD(0 TO 7, 0 TO 7)
DIM SHARED BESTA(0 TO 7), BESTB(0 TO 7), BESTX(0 TO 7), BESTY(0 TO 7)
DIM SHARED LEVEL, SCORE, result
DIM SHARED wcKsflag, wcQsflag, INTFLAG
DIM SHARED wcKsold, wcQsold
 
'B For saving moves to file
DIM SHARED whiteMove$, blackMove$, pWflag$, pBflag$, GameFile$, Turn
 
'B For displaying T's on screen list of moves, last 8 shown from Moves$() array
DIM SHARED InGame, countMove, loadFlag
REDIM SHARED Move$(1 TO 300)
 
'B for Undo
REDIM SHARED Boards$(1 TO 300)
 
'B Using updated Graphics Screen instead of Screen 0 text program
SCREEN _NEWIMAGE(XMAX, YMAX, 32)
_SCREENMOVE 360, 60
 
'B Checking fonts normal, big, and chess
'B load and check our normal font
normal& = _LOADFONT("C:\windows\fonts\arial.ttf", 20)
IF normal& <= 0 THEN PRINT "Trouble with arial.ttf size 16 file, goodbye.": SLEEP: END
_FONT normal&
FW = 11: FH = _FONTHEIGHT(normal&)
maxCol = XMAX / FW
 
'B load and check SQ size font
bArial& = _LOADFONT("C:\windows\fonts\arial.ttf", SQ, "MONOSPACE")
IF bArial& <= 0 THEN PRINT "Trouble with arial.ttf size "; SQ; " file, goodbye.": SLEEP: END
bFW = _FONTWIDTH(bArial&): bFH = _FONTHEIGHT(bArial&)
 
Intro
Wait_Click_Key
CLS
DO
    SCORE = 0
    CALL IO(A, b, x, Y, result)
    'B   HERE IS WHERE CHECKMATE NEEDS TO BE DETERMINED!!!
    IF result < -2500 THEN
        'T & B Human has won
        AreaOutput "I RESIGN!! YOU WIN!!!", " Play Again? Y/N "
        DO
            Revenge$ = UCASE$(INKEY$)
        LOOP UNTIL Revenge$ = "Y" OR Revenge$ = "N"
        IF Revenge$ = "N" THEN
            AreaOutput "Thanks for playing,", "Good Bye!"
            SLEEP 2
            SYSTEM
        END IF
        restart
        InGame = 0
    ELSE
        result = EVALUATE(-1, 10000)
        A = BESTA(1)
        b = BESTB(1)
        x = BESTX(1)
        Y = BESTY(1)
    END IF
    CALL SHOWBD
LOOP
END
 
'==========================================================
 
'B sub for user communications area, T has made it for two strings
SUB AreaOutput (outText$, out2$)
    LINE (480, 510)-(XMAX, YMAX), BLACK&, BF
    lp 26, 46, outText$
    lp 27, 46, out2$
END SUB
 
SUB BISHOP (A, B, XX(), YY(), NDX)
    ID = SGN(BOARD(B, A))
    FOR DXY = 1 TO 7
        X = A - DXY
        Y = B + DXY
        IF X < 0 OR X > 7 OR Y < 0 OR Y > 7 THEN EXIT FOR
        GOSUB 3
        IF BOARD(Y, X) <> 0 THEN EXIT FOR
    NEXT
    FOR DXY = 1 TO 7
        X = A + DXY
        Y = B + DXY
        IF X < 0 OR X > 7 OR Y < 0 OR Y > 7 THEN EXIT FOR
        GOSUB 3
        IF BOARD(Y, X) <> 0 THEN EXIT FOR
    NEXT
    FOR DXY = 1 TO 7
        X = A - DXY
        Y = B - DXY
        IF X < 0 OR X > 7 OR Y < 0 OR Y > 7 THEN EXIT FOR
        GOSUB 3
        IF BOARD(Y, X) <> 0 THEN EXIT FOR
    NEXT
    FOR DXY = 1 TO 7
        X = A + DXY
        Y = B - DXY
        IF X < 0 OR X > 7 OR Y < 0 OR Y > 7 THEN EXIT FOR
        GOSUB 3
        IF BOARD(Y, X) <> 0 THEN EXIT FOR
    NEXT
    EXIT SUB
 
    'sub gosub subroutine
    3 REM
    IF ID <> SGN(BOARD(Y, X)) THEN
        NDX = NDX + 1
        XX(NDX) = X
        YY(NDX) = Y
    END IF
    RETURN
END SUB
 
SUB bSetup (bStr$)
    FOR X = 0 TO 7
        FOR Y = 0 TO 7
            p$ = MID$(bStr$, 8 * X + Y + 1, 1)
            BOARD(X, Y) = cp2n(p$)
        NEXT
    NEXT
END SUB
 
FUNCTION bString$
    r$ = ""
    FOR X = 0 TO 7
        FOR Y = 0 TO 7
            num = BOARD(X, Y)
            r$ = r$ + cn2p$(num)
        NEXT
    NEXT
    bString$ = r$
END FUNCTION
 
FUNCTION Castleincheck (x)
    'T added to improve short castle control
    IF playBlack THEN
        BOARD(7, 1) = 4500
        'T first square acrossed
        null = INCHECK(x)
        BOARD(7, 1) = 0
        'T original square void
        IF null = 0 THEN
            'T if already in first test King is in check we skip second test
            BOARD(7, 2) = 4500
            'T second square acrossed
            null = INCHECK(x)
            BOARD(7, 2) = 0
        END IF
        Castleincheck = null
    ELSE
        BOARD(7, 6) = 4500
        'T first square acrossed
        null = INCHECK(x)
        BOARD(7, 6) = 0
        'T original square void
        IF null = 0 THEN
            'T if already in first test King is in check we skip second test
            BOARD(7, 5) = 4500
            'T second square acrossed
            null = INCHECK(x)
            BOARD(7, 5) = 0
        END IF
        Castleincheck = null
    END IF
END FUNCTION
 
FUNCTION CastleincheckL (x)
    'T added to improve long castle control
    IF playBlack THEN
        BOARD(7, 4) = 4500
        null = INCHECK(x)
        BOARD(7, 4) = 0
        'T original square void
        IF null = 0 THEN
            'T if already in first test King is in check we skip second test
            BOARD(7, 5) = 4500
            'T C1 square
            null = INCHECK(x)
            BOARD(7, 5) = 0
        END IF
        CastleincheckL = null
    ELSE
        BOARD(7, 3) = 4500
        'T or B or A D1 square
        null = INCHECK(x)
        BOARD(7, 3) = 0
        'T original square void
        IF null = 0 THEN
            'T if already in first test King is in check we skip second test
            BOARD(7, 2) = 4500
            'T C1 square
            null = INCHECK(x)
            BOARD(7, 2) = 0
        END IF
        CastleincheckL = null
    END IF
END FUNCTION
 
FUNCTION cn2p$ (n)
    SELECT CASE n
        CASE 0: r$ = "z"
        CASE 100: r$ = "P"
        CASE 270: r$ = "N"
        CASE 300: r$ = "B"
        CASE 500: r$ = "R"
        CASE 900: r$ = "Q"
        CASE 4500: r$ = "K"
        CASE -100: r$ = "p"
        CASE -270: r$ = "n"
        CASE -300: r$ = "b"
        CASE -500: r$ = "r"
        CASE -900: r$ = "q"
        CASE -9000: r$ = "k"
    END SELECT
    cn2p$ = r$
END FUNCTION
 
FUNCTION cp2n (piece$)
    SELECT CASE piece$
        CASE "z": r = 0
        CASE "P": r = 100
        CASE "N": r = 270
        CASE "B": r = 300
        CASE "R": r = 500
        CASE "Q": r = 900
        CASE "K": r = 4500
        CASE "p": r = -100
        CASE "n": r = -270
        CASE "b": r = -300
        CASE "r": r = -500
        CASE "q": r = -900
        CASE "k": r = -9000
    END SELECT
    cp2n = r
END FUNCTION
 
SUB cP (row, txt$)
    'B on row center Print txt$
    col = (maxCol - LEN(txt$)) / 2
    _PRINTSTRING ((XMAX - _PRINTWIDTH(txt$)) / 2, row * FH), txt$
END SUB
 
FUNCTION EVALUATE (ID, PRUNE)
    DIM XX(0 TO 26), YY(0 TO 26)
    LEVEL = LEVEL + 1
    BESTSCORE = 10000 * ID
    FOR b = 7 TO 0 STEP -1
        FOR A = 7 TO 0 STEP -1
            IF SGN(BOARD(b, A)) <> ID THEN GOTO 1
            'Orig IF (LEVEL = 1) THEN CALL SHOWMAN(A, B)
            'B this might be human versus human level?
 
            CALL MOVELIST(A, b, XX(), YY(), NDX)
            FOR I = 0 TO NDX
                X = XX(I)
                Y = YY(I)
                IF LEVEL = 1 THEN
                    AreaOutput "TRYING: " + CHR$(65 + A) + RIGHT$(STR$(8 - b), 1) + "-" + CHR$(65 + X) + RIGHT$(STR$(8 - Y), 1), ""
                    'B Might as well make this look nice too, without the space
                END IF
                OLDSCORE = SCORE
                MOVER = BOARD(b, A)
                TARGET = BOARD(Y, X)
                CALL MAKEMOVE(A, b, X, Y)
                IF (LEVEL < MAXLEVEL) THEN SCORE = SCORE + EVALUATE(-ID, BESTSCORE - TARGET + ID * (8 - ABS(4 - X) - ABS(4 - Y)))
                SCORE = SCORE + TARGET - ID * (8 - ABS(4 - X) - ABS(4 - Y))
                IF (ID < 0 AND SCORE > BESTSCORE) OR (ID > 0 AND SCORE < BESTSCORE) THEN
                    BESTA(LEVEL) = A
                    BESTB(LEVEL) = b
                    BESTX(LEVEL) = X
                    BESTY(LEVEL) = Y
                    BESTSCORE = SCORE
                    IF (ID < 0 AND BESTSCORE >= PRUNE) OR (ID > 0 AND BESTSCORE <= PRUNE) THEN
                        BOARD(b, A) = MOVER
                        BOARD(Y, X) = TARGET
                        SCORE = OLDSCORE
                        LEVEL = LEVEL - 1
                        EVALUATE = BESTSCORE
                        EXIT FUNCTION
                    END IF
                END IF
                BOARD(b, A) = MOVER
                BOARD(Y, X) = TARGET
                SCORE = OLDSCORE
            NEXT
        1 NEXT
    NEXT
    LEVEL = LEVEL - 1
    EVALUATE = BESTSCORE
END FUNCTION
 
FUNCTION getInput$
    DIM pieceChosen AS _BYTE
    DO
        'B Update board
        SHOWBD
 
        'B gather mouse input
        DO WHILE _MOUSEINPUT
            mouseButton = _MOUSEBUTTON(1)
            tx = _MOUSEX \ SQ - 1: ty = _MOUSEY \ SQ - 1
            ux = tx: uy = ty
        LOOP
 
        'T area of managing Button Bar
        IF _MOUSEBUTTON(1) THEN
            IF _MOUSEX > 700 THEN
                IF _MOUSEY < 120 THEN
                    'B PLAY WHITE
                    restart
                    InGame = -1
                    Turn = 1
                    playBlack = 0
                    bSetup "rnbqkbnrppppppppzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzPPPPPPPPRNBQKBNR"
                    AreaOutput "Your move.", ""
                    getInput$ = ""
                    EXIT FUNCTION
                ELSEIF _MOUSEY < 180 THEN
                    'B PLAY BLACK there was a FEN around here also
 
                    'T this is the FEN of initial game setup
                    '  [rnbqkbnr/pppppppp/8/8/8/8/PPPPPPPP/RNBQKBNR w KQkq - 0 1]
                    restart
                    InGame = -1
                    Turn = -1
                    playBlack = -1
                    bSetup "rnbkqbnrppppppppzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzPPPPPPPPRNBKQBNR"
                    getInput$ = ""
                    EXIT FUNCTION
                ELSEIF _MOUSEY < 240 THEN
                    'B UNDO
                    IF countMove - 1 > 1 THEN
                        Move$(countMove) = ""
                        Boards$(countMove) = ""
                        countMove = countMove - 1
                        whiteMove$ = "": blackMove$ = "": bmoves$ = "": bFirst = -1
                        bSetup Boards$(countMove)
                        IF playBlack = 0 THEN AreaOutput "Your move.", ""
                        '_DISPLAY
                        EXIT FUNCTION
                    END IF
                ELSEIF _MOUSEY < 300 THEN
                    'B SAVE BOARD
                    'T if you are not in game what are you saving in a file?
                    IF InGame = 0 THEN EXIT FUNCTION
                    ' T file exists, overwirte? Y/N
                    DO
                        in$ = ""
                        in$ = screenInput(50 * FW, 4 * FH, "Enter Save Filename > ")
                        IF _FILEEXISTS(in$) = -1 AND in$ <> "" THEN
                            COLOR LITE&
                            AreaOutput "File exists...", " Overwrite Y/N?"
                            _DISPLAY
                            COLOR WHITE&
                            choice$ = UCASE$(INPUT$(1))
                            IF choice$ = "Y" THEN EXIT DO
                        ELSE
                            ' case _fileexists(in$) = 0
                            EXIT DO
                        END IF
 
                    LOOP
 
                    OPEN in$ FOR OUTPUT AS #1
                    IF playBlack THEN PRINT #1, "Black" ELSE PRINT #1, "White"
                    PRINT #1, blackMove$
                    'we need AI's move made if any since last Move$() entry
                    FOR i = 1 TO countMove
                        PRINT #1, Move$(i)
                    NEXT
                    FOR i = 1 TO countMove
                        PRINT #1, Boards$(i)
                    NEXT
                    CLOSE #1
                    AreaOutput "File " + ins$, "loaded"
                    _DELAY 1
                    IF playBlack = 0 THEN
                        AreaOutput "Your move.", ""
                    ELSE
                        bmove$ = blackMove$
                        bFirst = 0
                    END IF
                    getInput$ = ""
                    EXIT FUNCTION
                ELSEIF _MOUSEY < 360 THEN
                    'B  LOAD Board
                    in$ = screenInput(50 * FW, 4 * FH, "Enter Load Filename > ")
                    'B  for some damn reason the first time you try _FILEEXISTS with real file it says 0 nope!
                    'B                 but try again and is OK ?????????????????????????????????????????
                    'B                 So f... IT!
                    ' dummy = _FILEEXISTS(in$)
                    '_DELAY 1
                    'B  once is not enough, damn this sucks!!!!!!
                    'dummy = _FILEEXISTS(in$)
                    '_DELAY 1
                    'B  nope didn't help with 2nd call and delay, just try LOAD GAME again!
                    IF _FILEEXISTS(in$) = -1 THEN
 
                        count = 0
                        OPEN in$ FOR INPUT AS #1
                        WHILE EOF(1) = 0
                            INPUT #1, l$
                            count = count + 1
                        WEND
                        CLOSE #1
 
                        ' T feedback to user
                        COLOR LITE&
                        AreaOutput "File loaded", in$
                        COLOR WHITE&
                        _DISPLAY
                        _DELAY 1
 
                        restart
                        countMove = (count - 2) / 2
                        'B This gets needed data items before loading 2 arrays of size countMove
                        OPEN in$ FOR INPUT AS #1
                        INPUT #1, BW$
                        IF LEFT$(BW$, 1) = "B" THEN playBlack = -1 ELSE playBlack = 0
                        INPUT #1, blackMove$
                        'B  this gets AI's last move (if any) not recorded in Move$()
                        '   OK maybe we have to pretend the blackMove$ is whiteMove$ so IO can reverse it when recording in Move$()
                        FOR i = 1 TO countMove
                            INPUT #1, Move$(i)
                        NEXT
                        FOR i = 1 TO countMove
                            INPUT #1, Boards$(i)
                        NEXT
                        CLOSE #1
                        CLS
                        bSetup Boards$(countMove)
                        'B loadFlag is ugly way to fix a missing line in move list that occurs loading a game with human playing Black
                        IF playBlack = 0 THEN AreaOutput "Your move.", "" ELSE loadFlag = -1
                        InGame = -1
                    ELSE
                        AreaOutput in$, "File not found."
                    END IF
                ELSEIF _MOUSEY < 420 THEN
                    'B MANUAL SET
                ELSEIF _MOUSEY < 480 THEN
                    'T quit
                    getInput$ = "QUIT"
                    EXIT FUNCTION
                END IF
            END IF
        END IF
 
        IF InGame = -1 THEN
            IF pieceChosen = 0 THEN
                IF 1 <= ty AND ty <= 8 THEN
                    'Fellippe or B translate hovered coordinate to chess notation letter + digit
                    d$ = RIGHT$(STR$(9 - ty), 1)
                    IF 1 <= tx AND tx <= 8 THEN
                        l$ = CHR$(64 + tx)
                        ld$ = l$ + d$
                        'B letter + digit
                        ld2xy ld$, bx, by
                        'B translate notation to board$(x, y)
                        IF BOARD(by, bx) > 0 THEN
                            LegalShow bx, by
                            highLightSq bx, by, LITE2&
                            'Fellippe hover highlight
                            IF mouseButton THEN
                                DO WHILE mouseButton
                                    'Fellippe wait for release
                                    i = _MOUSEINPUT
                                    mouseButton = _MOUSEBUTTON(1)
                                    newtx = _MOUSEX \ SQ - 1: newty = _MOUSEY \ SQ - 1
                                LOOP
                                IF newtx = tx AND newty = ty THEN
                                    'Fellippe the mouse was released in the same square
                                    pieceChosen = -1: chosenBX = bx: chosenBY = by
                                END IF
                            END IF
                        END IF
                    END IF
                END IF
            ELSE
                LegalShow chosenBX, chosenBY
                highLightSq chosenBX, chosenBY, LITE&
                IF 1 <= uy AND uy <= 8 THEN
                    'B translate click to chess notation letter + digit
                    d2$ = RIGHT$(STR$(9 - uy), 1)
                    IF 1 <= ux AND ux <= 8 THEN
                        l2$ = CHR$(64 + ux)
                        ld2$ = l2$ + d2$
                        'B letter + digit
                        ld2xy ld2$, bx2, by2
                        highLightSq bx2, by2, LITE2&
                        'Fellippe hover highlight
                        IF mouseButton THEN
                            DO WHILE mouseButton
                                'Fellippe wait for release
                                i = _MOUSEINPUT
                                mouseButton = _MOUSEBUTTON(1)
                                newtx = _MOUSEX \ SQ - 1: newty = _MOUSEY \ SQ - 1
                            LOOP
                            IF newtx = tx AND newty = ty THEN
                                'Fellippe the mouse was released in the same square
                                IF ld$ <> ld2$ THEN
                                    getInput$ = ld$ + "-" + ld2$
                                    'T this let AI to castle for white
                                    IF BOARD(by, bx) = 4500 THEN
                                        IF ld$ = "E1" AND ld2$ = "G1" THEN getInput$ = "O-O"
                                        IF ld$ = "E1" AND ld2$ = "C1" THEN getInput$ = "O-O-O"
                                        IF playBlack = -1 THEN
                                            IF ld$ = "D1" AND ld2$ = "B1" THEN getInput$ = "O-O"
                                            IF ld$ = "D1" AND ld2$ = "F1" THEN getInput$ = "O-O-O"
                                        END IF
                                    END IF
                                    _AUTODISPLAY
                                    EXIT FUNCTION
                                ELSE
                                    LegalHide bx, by
                                    SHOWMAN bx, by
                                    EXIT DO
                                END IF
                                'B ld compare
                            END IF
                        END IF
                    END IF
                    'B ux compare
                END IF
                'B uy compare
            END IF
            'B piece chosen yet
 
            'B handle keyboard input
            k$ = INKEY$
            IF k$ <> "" THEN
                IF LEN(k$) = 1 THEN
                    IF ASC(k$) = 11 THEN
                        in$ = screenInput(50 * FW, 4 * FH, "(Esc to quit) Enter Move > ")
                        in$ = UCASE$(in$)
                        spac = INSTR(in$, " ")
                        IF spac THEN in$ = MID$(in$, 1, spac - 1) + "-" + MID$(in$, spac + 1)
                        IF playBlack THEN in$ = w2b$(in$)
                        getInput$ = in$
                        EXIT FUNCTION
                    ELSEIF ASC(k$) = 27 THEN
                        END
                    END IF
                END IF
            END IF
        END IF
        'B if InGame
        _DISPLAY
    LOOP
    lastLD$ = ""
    getInput$ = in$
END FUNCTION
 
SUB highLightSq (bx, by, c&)
    LINE ((bx + 2) * SQ, (by + 2) * SQ)-((bx + 3) * SQ, (by + 3) * SQ), , B
    LINE ((bx + 2) * SQ + 1, (by + 2) * SQ + 1)-((bx + 3) * SQ - 1, (by + 3) * SQ - 1), c&, B
    LINE ((bx + 2) * SQ + 2, (by + 2) * SQ + 2)-((bx + 3) * SQ - 2, (by + 3) * SQ - 2), c&, B
END SUB
 
FUNCTION INCHECK (X)
    DIM XX(27), YY(27), NDX
    FOR b = 0 TO 7
        FOR A = 0 TO 7
 
            IF BOARD(b, A) = 0 THEN GOTO 6
            'T original code BOARD(b,A) >= 0  if white piece or void square skip test
            'A: omit square skip test
            'B Adrian next line is OK, it just skips empty spaces in board
 
            CALL MOVELIST(A, b, XX(), YY(), NDX)
            FOR I = 0 TO NDX STEP 1
                X = XX(I)
                Y = YY(I)
                IF BOARD(Y, X) = 4500 AND Turn = 1 THEN
                    'B ^^^ 2017-11-13 T has added and turn = 1 but turn = 1 is same as playBlack = 0
                    AreaOutput "YOU ARE IN CHECK!", ""
                    INCHECK = 1
                    EXIT FUNCTION
                END IF
                IF BOARD(Y, X) = -9000 AND Turn = -1 THEN
                    'B ^^^ 2017-11-13 T has added and turn = -1 but turn = -1 is same as playBlack = -1
                    ' T in my last read of code posted playBack is used to note that Human plays as black
                    ' T Turn is used for knowing if the move  has been made by black Turn = -1 or by White Turn = 1
                    AreaOutput "I AM IN CHECK!", ""
 
                    'T this show Black status incheck
                    INCHECK = -1 'A: this is probably no longer needed
                    'T this should stop failed moves under check attack
                    'EXIT FUNCTION
                    'B exit now and get infinite loop?
                    ' T AI force must exit from loop
                END IF
            NEXT
        6 NEXT
    NEXT
    INCHECK = 0
END FUNCTION
 
SUB initBoard
    IF playBlack THEN
        b$ = "rnbkqbnrppppppppzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzPPPPPPPPRNBKQBNR"
    ELSE
        b$ = "rnbqkbnrppppppppzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzPPPPPPPPRNBQKBNR"
    END IF
    bSetup b$
END SUB
 
SUB Intro
    'T better have a subroutine that we can use as many as we want
    COLOR WHITE&, BLACK&
    cP 3, "QB64 CHESS"
    lp 5, 8, "CHESS is a game played between two players on a board of 64 squares."
    lp 6, 4, "Chess was first invented in its current form in Europe during the late"
    lp 7, 4, "fifteenth century. It evolved from much earlier forms invented in India"
    lp 8, 4, "and Persia."
    lp 9, 8, "The pieces are divided into Black and White.  Each player has 16 pieces:"
    lp 10, 4, "1 king, 1 queen, 2 rooks, 2 bishops, 2 knights, and 8 pawns.  White makes"
    lp 11, 4, "the first move.  The players alternate moving one piece at a time.  Pieces"
    lp 12, 4, "are moved to an unoccupied square, or moved onto a square occupied by an"
    lp 13, 4, "opponent's piece, capturing it.  When the king is under attack, he is in"
    lp 14, 4, "CHECK.  The player cannot put his king in check.  The object is to CHECKMATE"
    lp 15, 4, "the opponent.  This occurs when the king is in check and there is no way to"
    lp 16, 4, "remove the king from attack."
    lp 17, 8, "To move the pieces on the chessboard, click by mouse or type after Ctrl+K"
    lp 18, 4, "notation, e.g. E2-E4 (not in English notation like P-K4).  To castle, type O-O"
    lp 19, 4, "to castle kingside or O-O-O to castle queenside like in English notation."
    lp 20, 4, "To exit the game, type QUIT or press ESCAPE key."
    cP 25, "Click or press any key to continue."
END SUB
 
SUB IO (A, B, X, Y, RESULT)
    DIM XX(0 TO 26), YY(0 TO 26)
    IF InGame THEN
        'B ugly fix to get a missing line recorded in move list when load file and human playing black
        IF loadFlag AND blackMove$ <> "" THEN
            loadFlag = 0
            countMove = countMove + 1
            Move$(countMove) = blackMove$ + pBflag$ + "  " + whiteMove$ + pWflag$
            'B this above is so ugly I even have to reverse black and white to get it right!
            Boards$(countMove) = bString$
            'B this above was omitted in versions before 11-16, still not right???
        END IF
 
        IF A >= 0 THEN
            Turn = -1
            IF RESULT < -2500 THEN EXIT SUB 'AI should resign
            PIECE = BOARD(Y, X)
            CALL MAKEMOVE(A, B, X, Y)
            'T (chess2_17-11-13 T) this will fix illegal moves of AI under check
            NULL = INCHECK(0)
            'T (chess2_17-11-13 T) we must search for check after choosing a move
 
            'B Adrian, can't have game end here, many moves are checked can't quit if one is bad
            'IF NULL = -1 AND RESULT < -2500 THEN
            '    AreaOutput "AI resigns!", ""
            '    EXIT SUB
            'END IF
 
            IF NULL THEN
                'T (chess2_17-11-13 T) if there is a check for AI we must restore situation before move
                BOARD(B, A) = BOARD(Y, X)
                BOARD(Y, X) = PIECE
                EXIT SUB
                'T (chess2_17-11-13 T) if it is check move is illegal
            END IF
            'T this show Black status incheck
 
            mymove$ = CHR$(65 + A) + RIGHT$(STR$(8 - B), 1) + "-" + CHR$(65 + X) + RIGHT$(STR$(8 - Y), 1)
 
            'B ??? next line not used
            'AICHECK = 0 'reset AI check flag
 
            IF playBlack THEN mymove$ = w2b$(mymove$)
            AreaOutput "MY MOVE: " + mymove$, ""
            blackMove$ = mymove$
            IF whiteMove$ <> "" THEN
                IF playBlack THEN whiteMove$ = w2b$(whiteMove$)
            END IF
            WriteEntry
        END IF
        'B & T >>> it saves the last moves to file and to list I move this IF HERE TO GET THE COUPLE WHITE+BLACK
 
        IF PIECE <> 0 THEN
            s$ = "I TOOK YOUR "
            IF PIECE = 100 THEN s$ = s$ + "PAWN           "
            IF PIECE = 270 THEN s$ = s$ + "KNIGHT         "
            IF PIECE = 300 THEN s$ = s$ + "BISHOP         "
            IF PIECE = 500 THEN s$ = s$ + "ROOK           "
            IF PIECE = 900 THEN s$ = s$ + "QUEEN          "
            IF PIECE = 4500 THEN s$ = s$ + "KING          "
            AreaOutput "", s$
        END IF
 
    END IF
 
    DO
        'B I think this was help from Adrian, so we didn't have to fake a move
        IF playBlack = -1 AND countMove = 0 THEN countMove = 1: EXIT SUB
 
        'B Here we get Human's move but might be illegal so AI has to check before shown
        in$ = getInput$
        'T getinput$ takes user's input also for BUTTONBAR
        'B which is why we have to have to check InGame
 
        IF UCASE$(in$) = "QUIT" THEN END
 
        IF InGame = -1 THEN
            whiteMove$ = in$
            'B ^^^ Human's move who now plays Black or White, don't be fooled by variable name>
            'B Originally human always played white>
            Turn = 1
            IF UCASE$(in$) = "O-O" OR in$ = "0-0" THEN
                'T short castle rules... here we improve control of check and moves
                IF wcKsflag <> 0 THEN GOTO 16
                ' T it skips white castle king
                IF playBlack THEN
                    IF BOARD(7, 0) <> 500 THEN GOTO 16
                    IF BOARD(7, 1) <> 0 OR BOARD(7, 2) <> 0 THEN GOTO 16
                ELSE
                    IF BOARD(7, 7) <> 500 THEN GOTO 16
                    IF BOARD(7, 6) <> 0 OR BOARD(7, 5) <> 0 THEN GOTO 16
                END IF
                'T now we test if there is a check along the path of king
                NULL = Castleincheck(0)
                IF NULL = 0 THEN
                    'B you can castle king side
                    IF playBlack THEN
                        BOARD(7, 1) = 4500
                        BOARD(7, 3) = 0
                        BOARD(7, 2) = 500
                        BOARD(7, 0) = 0
                        wcKsflag = -1
                        'T black castle king side
                        whiteMove$ = "O-O"
                        EXIT SUB
                    ELSE
                        BOARD(7, 6) = 4500
                        BOARD(7, 4) = 0
                        BOARD(7, 5) = 500
                        BOARD(7, 7) = 0
                        wcKsflag = -1
                        'T white castle king side
                        whiteMove$ = "O-O"
                        EXIT SUB
                    END IF
                END IF
            END IF
            IF UCASE$(in$) = "O-O-O" OR in$ = "0-0-0" THEN
                'T long castle rules... here we improve control of check and moves
                IF wcQsflag <> 0 THEN GOTO 16
                IF playBlack THEN
                    IF BOARD(7, 7) <> 500 THEN GOTO 16
                    IF BOARD(7, 6) <> 0 OR BOARD(7, 5) <> 0 OR BOARD(7, 4) <> 0 THEN GOTO 16
                ELSE
                    IF BOARD(7, 0) <> 500 THEN GOTO 16
                    IF BOARD(7, 1) <> 0 OR BOARD(7, 2) <> 0 OR BOARD(7, 3) <> 0 THEN GOTO 16
                END IF
                'T now we test if there is a check along the path of king
                NULL = CastleincheckL(0)
                IF NULL = 0 THEN
                    'B you can castle queen side
                    IF playBlack THEN
                        BOARD(7, 5) = 4500
                        BOARD(7, 3) = 0
                        BOARD(7, 4) = 500
                        BOARD(7, 7) = 0
                        wcQsflag = -1
                        'T black castle queen side
                        whiteMove$ = "O-O-O"
                        EXIT SUB
                    ELSE
                        'T you can castle if there are no check to the king to the start or during the movement of castle
                        BOARD(7, 2) = 4500
                        BOARD(7, 4) = 0
                        BOARD(7, 3) = 500
                        BOARD(7, 0) = 0
                        wcQsflag = -1
                        'T white castle queen side
                        whiteMove$ = "O-O-O"
                        EXIT SUB
                    END IF
                END IF
            END IF
            IF LEN(in$) < 5 THEN GOTO 16
            B = 8 - (ASC(MID$(in$, 2, 1)) - 48)
            A = ASC(UCASE$(MID$(in$, 1, 1))) - 65
            X = ASC(UCASE$(MID$(in$, 4, 1))) - 65
            Y = 8 - (ASC(MID$(in$, 5, 1)) - 48)
            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
            IF BOARD(B, A) <= 0 THEN GOTO 16
            IF Y = 2 AND B = 3 AND (X = A - 1 OR X = A + 1) THEN
                IF BOARD(B, A) = 100 AND BOARD(Y, X) = 0 AND BOARD(Y + 1, X) = -100 THEN
                    IF BESTB(1) = 1 AND BESTA(1) = X THEN
                        MOVER = BOARD(B, A)
                        TARGET = BOARD(Y, X)
                        CALL MAKEMOVE(A, B, X, Y)
                        BOARD(Y + 1, X) = 0
                        ENPASSANT = -1
                        GOTO 15
                    END IF
                END IF
            END IF
            CALL MOVELIST(A, B, XX(), YY(), NDX)
            FOR K = 0 TO NDX STEP 1
                IF X = XX(K) AND Y = YY(K) THEN
                    MOVER = BOARD(B, A)
                    TARGET = BOARD(Y, X)
 
                    INTFLAG = -1
                    'B so this is where INTFLAG is set
 
                    CALL MAKEMOVE(A, B, X, Y)
                    IF MOVER = 4500 THEN
                        wcQsold = wcQsflag
                        wcKsold = wcKsflag
                        wcKsflag = -1
                        wcQsflag = -1
                    END IF
                    IF (A = 0) AND (B = 7) AND (MOVER = 500) THEN
                        wcQsold = wcQsflag
                        wcQsflag = -1
                    END IF
                    IF (A = 7) AND (B = 7) AND (MOVER = 500) THEN
                        wcKsold = wcKsflag
                        wcKsflag = -1
                    END IF
 
                    INTFLAG = 0
                    'B and this is where INTFLAG is unset!
 
                    15 IF INCHECK(0) = 0 THEN EXIT SUB
 
                    BOARD(B, A) = MOVER
                    BOARD(Y, X) = TARGET
                    IF ENPASSANT THEN BOARD(Y + 1, X) = -100: ENPASSANT = 0
                    IF (A = 0) AND (B = 7) AND (MOVER = 500) THEN wcQsflag = wcQsold
                    IF (A = 7) AND (B = 7) AND (MOVER = 500) THEN wcKsflag = wcKsold
                    IF MOVER = 4500 THEN wcQsflag = wcQsold
                    GOTO 16
                END IF
            NEXT
        END IF
        16
 
    LOOP
    'B OK so this keeps looping until white makes legal move?
 
END SUB
 
FUNCTION isWhite (x, y)
    'B for squares and old for chess font
    yes = 0
    IF y MOD 2 = 0 THEN
        IF x MOD 2 = 0 THEN
            yes = -1
        END IF
    ELSE
        IF x MOD 2 = 1 THEN
            yes = -1
        END IF
    END IF
    isWhite = yes
END FUNCTION
 
SUB KING (A, B, XX(), YY(), NDX)
    ID = SGN(BOARD(B, A))
    FOR DY = -1 TO 1
        IF B + DY < 0 OR B + DY > 7 THEN GOTO 12
        FOR DX = -1 TO 1
            IF A + DX < 0 OR A + DX > 7 THEN GOTO 11
            IF ID <> SGN(BOARD(B + DY, A + DX)) THEN
                NDX = NDX + 1
                XX(NDX) = A + DX
                YY(NDX) = B + DY
            END IF
        11 NEXT
    12 NEXT
END SUB
 
SUB KNIGHT (A, B, XX(), YY(), NDX)
    ID = SGN(BOARD(B, A))
    X = A - 1
    Y = B - 2
    GOSUB 5
    X = A - 2
    Y = B - 1
    GOSUB 5
    X = A + 1
    Y = B - 2
    GOSUB 5
    X = A + 2
    Y = B - 1
    GOSUB 5
    X = A - 1
    Y = B + 2
    GOSUB 5
    X = A - 2
    Y = B + 1
    GOSUB 5
    X = A + 1
    Y = B + 2
    GOSUB 5
    X = A + 2
    Y = B + 1
    GOSUB 5
    EXIT SUB
    5 REM
    IF X < 0 OR X > 7 OR Y < 0 OR Y > 7 THEN RETURN
    IF ID <> SGN(BOARD(Y, X)) THEN NDX = NDX + 1: XX(NDX) = X: YY(NDX) = Y
    RETURN
END SUB
 
SUB ld2xy (ld$, dx, dy)
    'B dx and dy are going to be changed to find
    'B position (and thus type) of piece on the board from ld$
    letter$ = UCASE$(LEFT$(ld$, 1))
    dx = ASC(letter$) - 65
    digit = VAL(RIGHT$(ld$, 1))
    dy = 8 - digit
END SUB
 
SUB LegalHide (x, y)
    DIM XX(0 TO 26), YY(0 TO 26)
    CALL MOVELIST(x, y, XX(), YY(), NDX)
    FOR a = 0 TO NDX STEP 1
        IF XX(a) >= 0 AND YY(a) >= 0 THEN SHOWMAN YY(a), XX(a)
    NEXT
END SUB
 
'T THIS SUB calculates legal position of piece in the board cell x,y
SUB LegalShow (x, y)
    DIM XX(0 TO 26), YY(0 TO 26)
    CALL MOVELIST(x, y, XX(), YY(), NDX)
    FOR a = 0 TO NDX STEP 1
        IF XX(a) >= 0 AND YY(a) >= 0 THEN highLightSq XX(a), YY(a), LITE2&
    NEXT
END SUB
 
'B graphics version of Locate col, row : Print txt$
SUB lp (row, col, txt$)
    _PRINTSTRING (col * FW, row * FH), txt$
END SUB
 
SUB MakeButton (x1, y1, x2, y2, txt$, Col&)
    LINE (x1, y1)-(x2, y2), Col&, BF
    LINE (x1, y1)-(x2, y2), WHITE&, B
    LINE (x1 + 4, y2 - 4)-(x2 - 4, y2 - 4), _RGB32(222, 238, 227), B
    LINE (x2 - 4, y2 - 4)-(x2 - 4, y1 + 4), _RGB32(222, 238, 227), B
    _PRINTMODE _KEEPBACKGROUND
    'B VVV let's print button labels in middle of button
    _PRINTSTRING (x1 + 15, y2 - 1.35 * FH), txt$
    _PRINTMODE _FILLBACKGROUND
END SUB
 
SUB MAKEMOVE (A, B, X, Y)
    'B makemove is called many times, the last decides whether pBflag$ gets set or NOT
    'B the pWflag$ should only be set by user, no automatic setting allowed by AI.
    pBflag$ = ""
    BOARD(Y, X) = BOARD(B, A)
    BOARD(B, A) = 0
    IF Y = 0 AND BOARD(Y, X) = 100 THEN
        ' T it is the row 8
        IF INTFLAG THEN
            DO
                AreaOutput "Promote to:", ""
                I$ = Ppromote$
                SELECT CASE UCASE$(I$)
                    CASE "KNIGHT", "N", "KT", "KT.", "N."
                        PROMOTE = 270: pWflag$ = "N"
                    CASE "BISHOP", "B", "B."
                        PROMOTE = 300: pWflag$ = "B"
                    CASE "ROOK", "R", "R."
                        PROMOTE = 500: pWflag$ = "R"
                    CASE "QUEEN", "Q", "Q."
                        PROMOTE = 900: pWflag$ = "Q"
                END SELECT
            LOOP UNTIL PROMOTE <> 0
            IF playBlack THEN pWflag$ = LCASE$(pWflag$)
            'B       only the human can set the pWflag$
 
            BOARD(Y, X) = PROMOTE
            CLS
            SHOWBD
            _DISPLAY
        ELSE
            BOARD(Y, X) = 900
            'B ^^^^ OK AI need the line for checking FUTURE!!! moves
        END IF
    END IF
 
    IF Y = 7 AND BOARD(Y, X) = -100 THEN
        rap = -1
        BOARD(Y, X) = -900
        IF playBlack THEN pBflag$ = "Q" ELSE pBflag$ = "q"
    END IF
 
END SUB
 
SUB MOVELIST (A, B, XX(), YY(), NDX)
    PIECE = INT(ABS(BOARD(B, A)))
    NDX = -1
    SELECT CASE PIECE
        CASE IS = 100
            CALL PAWN(A, B, XX(), YY(), NDX)
        CASE IS = 270
            CALL KNIGHT(A, B, XX(), YY(), NDX)
        CASE IS = 300
            CALL BISHOP(A, B, XX(), YY(), NDX)
        CASE IS = 500
            CALL ROOK(A, B, XX(), YY(), NDX)
        CASE IS = 900
            CALL QUEEN(A, B, XX(), YY(), NDX)
        CASE IS = 4500
            CALL KING(A, B, XX(), YY(), NDX)
        CASE IS = 9000
            CALL KING(A, B, XX(), YY(), NDX)
    END SELECT
END SUB
 
SUB PAWN (A, B, XX(), YY(), NDX)
    ID = SGN(BOARD(B, A))
    ' T ID 1 for white piece and -1 for black piece
    IF (A - 1) >= 0 AND (A - 1) <= 7 AND (B - ID) >= 0 AND (B - ID) <= 7 THEN
        IF SGN(BOARD((B - ID), (A - 1))) = -ID THEN
            NDX = NDX + 1
            XX(NDX) = A - 1
            YY(NDX) = B - ID
        END IF
    END IF
    IF (A + 1) >= 0 AND (A + 1) <= 7 AND (B - ID) >= 0 AND (B - ID) <= 7 THEN
        IF SGN(BOARD((B - ID), (A + 1))) = -ID THEN
            NDX = NDX + 1
            XX(NDX) = A + 1
            YY(NDX) = B - ID
        END IF
    END IF
    IF A >= 0 AND A <= 7 AND (B - ID) >= 0 AND (B - ID) <= 7 THEN
        IF BOARD((B - ID), A) = 0 THEN
            NDX = NDX + 1
            XX(NDX) = A
            YY(NDX) = B - ID
            IF (ID < 0 AND B = 1) OR (ID > 0 AND B = 6) THEN
                IF BOARD((B - ID - ID), A) = 0 THEN
                    NDX = NDX + 1
                    XX(NDX) = A
                    YY(NDX) = B - ID - ID
                END IF
            END IF
        END IF
    END IF
 
END SUB
 
'B a pawn needs promotion to a piece, which? use mouse or keyboard
FUNCTION Ppromote$
    inp$ = "": ky = 0: oldtext$ = prompt$ + " {" + inp$ + "}"
    newText$ = oldtext$
    DO WHILE ky <> 13
        i = _MOUSEINPUT
        ty = (_MOUSEY + 24) / SQ
        ' T we must control also X dimension not only Y dimension for mouse in Area Promotion
        IF _MOUSEBUTTON(1) = -1 AND (_MOUSEX >= 500 AND _MOUSEX <= 700) THEN
            IF ty > 1 THEN
                IF ty = 2 THEN inp$ = "Q": EXIT DO
                IF ty = 3 THEN inp$ = "R": EXIT DO
                IF ty = 4 THEN inp$ = "B": EXIT DO
                IF ty = 5 THEN inp$ = "N": EXIT DO
            ELSE
                inp$ = ""
                'T no good click
            END IF
        END IF
        AreaOutput "Promote Enter Q R B N", newText$
        _DISPLAY
        oldtext$ = newText$
        k$ = INKEY$
        IF LEN(k$) THEN
            ky = ASC(RIGHT$(k$, 1))
            IF 31 < ky AND ky < 127 THEN
                inp$ = inp$ + CHR$(ky)
            ELSEIF ky = 8 THEN
                IF LEN(inp$) THEN inp$ = LEFT$(inp$, LEN(inp$) - 1)
            END IF
            newText$ = prompt$ + " {" + inp$ + "}"
        END IF
    LOOP
    Ppromote$ = inp$
    'B don't worry about case, it gets checked later
END FUNCTION
 
SUB QUEEN (A, B, XX(), YY(), NDX)
    CALL BISHOP(A, B, XX(), YY(), NDX)
    CALL ROOK(A, B, XX(), YY(), NDX)
END SUB
 
SUB restart
    'B restart variables
    CLS
    ERASE BOARD
    REDIM Move$(1 TO 300)
    REDIM Boards$(1 TO 300)
    'B need to start array at 1 not 0
    result = -2500
    wcKsflag = 0: wcQsflag = 0: wcKsold = 0: wcQsold = 0
    LEVEL = 0: INTFLAG = 0: countMove = 0
    whiteMove$ = "": blackMove$ = "": bmoves$ = "": bFirst = -1
END SUB
 
SUB ROOK (A, B, XX(), YY(), NDX)
    ID = SGN(BOARD(B, A))
    FOR X = A - 1 TO 0 STEP -1
        IF ID <> SGN(BOARD(B, X)) THEN
            NDX = NDX + 1
            XX(NDX) = X
            YY(NDX) = B
        END IF
        IF (BOARD(B, X)) <> 0 THEN EXIT FOR
    NEXT
    FOR X = A + 1 TO 7 STEP 1
        IF ID <> SGN(BOARD(B, X)) THEN
            NDX = NDX + 1
            XX(NDX) = X
            YY(NDX) = B
        END IF
        IF (BOARD(B, X)) <> 0 THEN EXIT FOR
    NEXT
    FOR Y = B - 1 TO 0 STEP -1
        IF ID <> SGN(BOARD(Y, A)) THEN
            NDX = NDX + 1
            XX(NDX) = A
            YY(NDX) = Y
        END IF
        IF (BOARD(Y, A)) <> 0 THEN EXIT FOR
    NEXT
    FOR Y = B + 1 TO 7 STEP 1
        IF ID <> SGN(BOARD(Y, A)) THEN
            NDX = NDX + 1
            XX(NDX) = A
            YY(NDX) = Y
        END IF
        IF (BOARD(Y, A)) <> 0 THEN EXIT FOR
    NEXT
END SUB
 
'B This is INPUT for graphic screens
FUNCTION screenInput$ (pixelX, pixelY, prompt$)
    inp$ = ""
    ky = 0: oldtext$ = prompt$ + " {" + inp$ + "}"
    newText$ = oldtext$
    COLOR LITE&
    WHILE ky <> 13
        AreaOutput newText$, ""
        _DISPLAY
        oldtext$ = newText$
        k$ = INKEY$
        IF LEN(k$) THEN
            ky = ASC(RIGHT$(k$, 1))
            IF 31 < ky AND ky < 127 THEN
                inp$ = inp$ + CHR$(ky)
            ELSEIF ky = 8 THEN
                IF LEN(inp$) THEN inp$ = LEFT$(inp$, LEN(inp$) - 1)
            END IF
            newText$ = prompt$ + " {" + inp$ + "}    "
        END IF
    WEND
    COLOR WHITE&
    screenInput$ = inp$
END FUNCTION
 
'B show entire board captured pieces also used for pawn promotion, Move List, Buttons, Debug Info
SUB SHOWBD
    COLOR WHITE&, 0
    _FONT bArial&
    'B print board labels for files
    LOCATE 2, 3:
    IF playBlack = -1 THEN PRINT "HGFEDCBA" ELSE PRINT "ABCDEFGH";
    'LOCATE 11, 3:                                                          ' A: display 1 set of labels only
    'IF playBlack = -1 THEN PRINT "HGFEDCBA" ELSE PRINT "ABCDEFGH";
    'B print board labels for ranks
    FOR i = 8 TO 1 STEP -1
        BLR$ = RIGHT$(STR$(i), 1)
        IF playBlack THEN BLR$ = w2b$(BLR$)
        LOCATE 8 - i + 3, 2: PRINT BLR$;
        '    LOCATE 8 - i + 3, 11: PRINT BLR$;
    NEXT
    'B Count captures by start of standard set on board and deduct each piece on board
    DIM c(-6 TO 6)
    c(-6) = 1: c(-5) = 2: c(-4) = 2: c(-3) = 2: c(-2) = 8: c(-1) = 1
    c(6) = 1: c(5) = 2: c(4) = 2: c(3) = 2: c(2) = 8: c(1) = 1
    FOR x = 0 TO 7
        FOR y = 0 TO 7
            SHOWMAN x, y
            _FONT bArial&
            SELECT CASE BOARD(x, y)
                CASE -900: IF c(-6) THEN c(-6) = c(-6) - 1
                CASE -500: IF c(-5) THEN c(-5) = c(-5) - 1
                CASE -300: IF c(-4) THEN c(-4) = c(-4) - 1
                CASE -270: IF c(-3) THEN c(-3) = c(-3) - 1
                CASE -100: IF c(-2) THEN c(-2) = c(-2) - 1
                CASE -9000: IF c(-1) THEN c(-1) = c(-1) - 1
                CASE 4500: IF c(1) THEN c(1) = c(1) - 1
                CASE 100: IF c(2) THEN c(2) = c(2) - 1
                CASE 270: IF c(3) THEN c(3) = c(3) - 1
                CASE 300: IF c(4) THEN c(4) = c(4) - 1
                CASE 500: IF c(5) THEN c(5) = c(5) - 1
                CASE 900: IF c(6) THEN c(6) = c(6) - 1
            END SELECT
        NEXT
    NEXT
    'B below need to blackout captures in case UNDO undoes one
    LINE (12 * SQ, 0)-(700, 9 * SQ), BLACK&, BF
    'Draw Capture pieces section
    FOR b = 0 TO 4
        FOR a = 1 TO 2
            IF isWhite(a, b) THEN COLOR WHITES& ELSE COLOR BLACKS&
            LINE (((a * 2) + 10) * SQ, (b + 1) * SQ)-STEP(SQ, SQ), , BF
            PRESET (((a * 2) + 10) * SQ + 8, (b + 1) * SQ + 36) 'A: centralise pieces
            IF a = 2 THEN DRAW "C" + STR$(BLACK&) ELSE DRAW "C" + STR$(WHITE&)
            SELECT CASE b
                'A  draw outlines for captured area
                CASE 0: DRAW "R26U5H2L6E9U11G4H6G4H4G6H4D11F9L6G2D5"
                CASE 1: DRAW "R26U5H2L5U7E3R4U10L6D3L4U3L6D3L4U3L6D10R4F3D7L5G2D5"
                CASE 2: DRAW "R26U5H2L8E6U9H2G8H2E8H2L6G6D9F6L8G2D5"
                CASE 3: DRAW "R26U5H2U4E2U9H6L9G10D4F2R4E3R4G8L4G2D5"
                CASE 4: DRAW "R26U5H2L6U7E3U6H3L10G3D6F3D7L6G2D5"
                CASE 5: DRAW "R26U5H2L5E7U6H4L5G3U5R2U2L2U2L2D2L2D2R2D5H3L5G4D6F7L5G2D5"
            END SELECT
            DRAW "BE2"
            'A  MOVE PEN INSIDE
            IF a = 2 THEN DRAW "P" + STR$(BLACK&) + "," + STR$(BLACK&)
            IF a = 1 THEN DRAW "P" + STR$(WHITE&) + "," + STR$(WHITE&)
            COLOR WHITE&, BLACK&
            IF a = 1 THEN cindex = 6 - b ELSE cindex = -1 * (6 - b)
            IF playBlack THEN cindex = cindex * -1
            digit$ = RIGHT$(STR$(c(cindex)), 1)
            IF digit$ <> "0" THEN LOCATE b + 2, (a * 2) + 12: PRINT digit$;
        NEXT
    NEXT
    COLOR WHITE&, BLACK&
    _FONT normal&
    showButtonBar
    showMoveList
    'B Some debug stuff also needed for UNDO  Save file
    LINE (0, 25 * FH)-(46 * FW, YMAX), BLACK&, BF
    lp 25, 2, "Last move by AI: " + blackMove$
    lp 26, 2, "Move Count:" + STR$(countMove) + "   Turn:" + STR$(Turn) + "   Result:" + STR$(result)
    lp 27, 2, "Castle: K flag:" + STR$(wcKsflag) + "   Q flag:" + STR$(wcQsflag) + "   K old:" + STR$(wcKsold) + "   Q old:" + STR$(wcQsold)
    lp 28, 2, "Last move by Human: " + whiteMove$
END SUB
 
SUB showButtonBar
    MakeButton 700, 60, 880, 100, "PLAY WHITE", LITE2&
    MakeButton 700, 120, 880, 160, "PLAY BLACK", LITE2&
    MakeButton 700, 180, 880, 220, "UNDO", LITE2&
    MakeButton 700, 240, 880, 280, "SAVE GAME", LITE2&
    MakeButton 700, 300, 880, 340, "LOAD GAME", LITE2&
    MakeButton 700, 360, 880, 400, "MANUAL SETUP", LITE2&
    MakeButton 700, 420, 880, 460, "QUIT", LITE2&
END SUB
 
'B set this up with Adrian's Draw Strings
SUB SHOWMAN (A, B)
    IF isWhite(B, A) THEN COLOR WHITES& ELSE COLOR BLACKS&
    LINE ((A + 2) * SQ, (B + 2) * SQ)-STEP(SQ, SQ), , BF
    ZZ = ABS(BOARD(B, A))
    IF ZZ THEN
        PRESET ((A + 2) * SQ + 8, (B + 2) * SQ + 36) 'A: centralise pieces
        IF BOARD(B, A) < 0 THEN
            IF playBlack THEN DRAW "C" + STR$(WHITE&) ELSE DRAW "C" + STR$(BLACK&)
        ELSE
            IF playBlack THEN DRAW "C" + STR$(BLACK&) ELSE DRAW "C" + STR$(WHITE&)
        END IF
        SELECT CASE ZZ
            'A  draw outlines for pieces on board
            CASE 100: DRAW "R26U5H2L6U7E3U6H3L10G3D6F3D7L6G2D5"
            CASE 500: DRAW "R26U5H2L5U7E3R4U10L6D3L4U3L6D3L4U3L6D10R4F3D7L5G2D5"
            CASE 270: DRAW "R26U5H2U4E2U9H6L9G10D4F2R4E3R4G8L4G2D5"
            CASE 300: DRAW "R26U5H2L8E6U9H2G8H2E8H2L6G6D9F6L8G2D5"
            CASE 900: DRAW "R26U5H2L6E9U11G4H6G4H4G6H4D11F9L6G2D5"
            CASE 4500: DRAW "R26U5H2L5E7U6H4L5G3U5R2U2L2U2L2D2L2D2R2D5H3L5G4D6F7L5G2D5"
            CASE 9000: DRAW "R26U5H2L5E7U6H4L5G3U5R2U2L2U2L2D2L2D2R2D5H3L5G4D6F7L5G2D5"
        END SELECT
        DRAW "BE2"
        'A  MOVE PEN INSIDE and color fill
        IF BOARD(B, A) < 0 THEN
            IF playBlack THEN DRAW "P" + STR$(WHITE&) + "," + STR$(WHITE&) ELSE DRAW "P" + STR$(BLACK&) + "," + STR$(BLACK&)
        END IF
        IF BOARD(B, A) > 0 THEN
            IF playBlack THEN DRAW "P" + STR$(BLACK&) + "," + STR$(BLACK&) ELSE DRAW "P" + STR$(WHITE&) + "," + STR$(WHITE&)
        END IF
    END IF
    COLOR WHITE&, BLACK&
    _FONT normal&
END SUB
 
'B  T set this up to show last 8 moves of White and Black
SUB showMoveList
    IF countMove < 9 THEN z = 8 ELSE z = countMove
    LINE (500, 300)-(680, 500), BLACK&, BF ' T if we use 700 it covers left border of buttonbar
    COLOR _RGB(0, 180, 220)
    FOR a = 0 TO 7
        lp 22 - a, 46, Move$(z - a)
    NEXT
    COLOR WHITE&
END SUB
 
'B convert BINGO for human playing Black
FUNCTION w2b$ (s$)
    b$ = ""
    FOR i = 1 TO LEN(s$)
        here = INSTR("ABCDEFGH12345678", MID$(s$, i, 1))
        IF here THEN b$ = b$ + MID$("HGFEDCBA87654321", here, 1) ELSE b$ = b$ + MID$(s$, i, 1)
    NEXT
    w2b$ = b$
END FUNCTION
 
SUB Wait_Click_Key
    'B handy sub to reuse in other programs
    DO
        k = _KEYHIT
        WHILE _MOUSEINPUT: WEND
        _LIMIT 30
    LOOP UNTIL k <> 0 OR _MOUSEBUTTON(1)
END SUB
 
SUB WriteEntry
    'B  Record game in both Move$() and Boards$() at countMove
    IF playBlack THEN
        IF bFirst THEN
            bFirst = 0
            bmoves$ = blackMove$ + pBflag$
        ELSE
            r$ = bmoves$ + "   " + whiteMove$ + pWflag$
            countMove = countMove + 1
            Move$(countMove) = r$
            bmoves$ = blackMove$ + pBflag$
        END IF
    ELSE
        countMove = countMove + 1
        Move$(countMove) = whiteMove$ + pWflag$ + " " + blackMove$ + pBflag$
    END IF
    Boards$(countMove) = bString$
    'B clear flags for promoted pawns
    pWflag$ = "": pBflag$ = ""
END SUB
 

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...

Title: Re: A 90% complete chess engine
Post by: TempodiBasic 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.

Title: Re: A 90% complete chess engine
Post by: bplus 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.

Title: Re: A 90% complete chess engine
Post by: SierraKen 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.

Title: Re: A 90% complete chess engine
Post by: bplus 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 ;-)

Title: Re: A 90% complete chess engine
Post by: SierraKen 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.

Title: Re: A 90% complete chess engine
Post by: SierraKen 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.

Title: Re: A 90% complete chess engine
Post by: bplus on January 26, 2020, 02:11:16 pm

Quote from: SierraKen 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.

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".

Title: Re: A 90% complete chess engine
Post by: STxAxTIC 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:

Title: Re: A 90% complete chess engine
Post by: bplus 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...

Title: Re: A 90% complete chess engine
Post by: SierraKen on January 26, 2020, 05:08:02 pm

Quote from: bplus on January 26, 2020, 02:11:16 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. :)

Title: Re: A 90% complete chess engine
Post by: SierraKen on January 26, 2020, 05:11:01 pm

Quote from: bplus 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...

The only way I could ever do 700+ lines of code in 1 day is to use my Picture to .BAS converter. It changes a picture to all PSET lines, 1 PSET per line.... like 10,000 lines or something like that.

Title: Re: A 90% complete chess engine
Post by: Richard Frost on January 29, 2020, 12:44:05 am

Update using Bplus's graphics. Castling works properly. Still no checkmate. Has "t" for take back move.
Still a long way to go, like years of my spare time.

Code: QB64: [Select]

_TITLE "Chess"
 
DEFINT A-Z
 
CONST true = -1, false = 0
CONST Rook = 1, Knight = 2, Bishop = 3, Queen = 4, King = 5, Pawn = 6
 
COMMON SHARED WorB, Move, Score, Index, opening
COMMON SHARED m$, i$, mess$
COMMON SHARED MaxRow, xq, yq, xc, yc, xm, ym
COMMON SHARED speed, WaitForKey, Studying
COMMON SHARED Castle$, OtherK$, mkr, mkc, okr, okc, invert
COMMON SHARED MasterLevel, SaveWorB
COMMON SHARED GameFile$, RunWith, check, redo, b1, b2, b1$, b2$
COMMON SHARED debug, DebugR, DebugC
COMMON SHARED Start1&, Start2&, MaxElapse!
COMMON SHARED human, humanc, OnAuto, sillyf, rflag
COMMON SHARED boardwhite&, boardblack&
COMMON SHARED black&, red&, green&, blue&, white&
COMMON SHARED Enter$, Esc$, lf$, crlf$
COMMON SHARED debug$, tbf, tbc
 
l = 5: p = 6: b = 8: q1 = 200: q2 = 500
DIM SHARED b(b, b), t(b, b, l), o(b, b), mp$(p, 7), tb(b, b, 10)
DIM SHARED Moves(l), Move$(l, q1), Score(l, q1), TieTo(l), Index(l, q1)
DIM SHARED x(p, q2), y(p, q2), c(12, q2), MoveLog$(q2)
DIM SHARED gm$(999)
DIM SHARED cp&(32)
 
'ON ERROR GOTO Oops
 
'GameFile$ = "'chessx.alg"
 
sillyf = 1 '                                            Moire effect, toggle with "z", or just default this to 0
 
Begin:
Init
gm = 1
DO
    SaveWorB = WorB
    IF LEN(GameFile$) THEN
        opening = 1
        ScanKey
        m$ = gm$(gm)
        'LOCATE 1, 1: PRINT gm; "*"; m$; "*";
        _DISPLAY
        SLEEP
        Score = 0
        IF RIGHT$(m$, 1) = "+" THEN
            Score = 777
            check = true
            m$ = LEFT$(m$, LEN(m$) - 1)
        END IF
        gm = gm + 1
        IF LEN(m$) = 0 THEN opening = 0: GameFile$ = ""
    END IF
 
    'IF opening > 0 THEN
    '    READ m$
    'IF m$ = "end" THEN opening = 0
    'END IF
 
    IF opening = 0 THEN
        IF Start1& = 0 THEN Start1& = TIMER
        Start2& = TIMER
        SaveForTakeBack
        redo:
        WorB = WorB XOR 1
        CheckBoard 1
        WorB = WorB XOR 1
        CheckBoard 0
        IF Moves(0) = 0 THEN mess$ = "Stalemate"
        IF LEN(mess$) > 0 THEN EXIT DO
        'LOCATE 1, 1: PRINT debug$;
        IF human AND (humanc = WorB) THEN
            woof:
            IF tbf THEN
                takeback
                PlotAll
                tbf = 0
                GOTO redo
            END IF
            'LOCATE 1, 1: PRINT tbc; " ";
            HumanMove
            IF tbf THEN GOTO woof
            ok = 0
            FOR i = 1 TO Moves(0)
                IF m$ = Move$(0, i) THEN ok = 1: EXIT FOR
            NEXT i
            IF ok = 0 THEN SOUND 200, 1: GOTO woof
        ELSE
            DebugR = 99
            IF sillyf THEN silly
            rflag = 1
            Recurse 1
            rflag = 0
            TakeBest 0
            IF debug THEN Debug1
            PlotAll
        END IF
    END IF
    WorB = SaveWorB
    DispTime
 
    fr = VAL(MID$(m$, 2, 1)) '                                       from row
    IF invert THEN fr = 9 - fr
    fc = INSTR("abcdefgh", LEFT$(m$, 1)) '                           from column
    IF invert THEN fc = 9 - fc
    IF LEFT$(m$, 1) = "O" THEN
        IF (WorB = 0) AND (humanc = 0) THEN
            fr = mkr: fc = mkc
        ELSE
            fr = okr: fc = okc
        END IF
    END IF
 
    DO: _LIMIT 10
        ic = (ic + 1) MOD 10
        IF ic > 5 THEN f$ = "clockx.png" ELSE f$ = "clockx2.png"
        IF f$ <> oldf$ THEN
            i& = _LOADIMAGE(f$): _ICON i&: _FREEIMAGE i&
            oldf$ = f$
        END IF
        zz = zz XOR 1
        IF zz THEN
            c1& = _RGB32(RND * 155 + 100, RND * 155 + 100, RND * 155 + 100)
            c2& = _RGB32(RND * 155 + 100, RND * 155 + 100, RND * 155 + 100)
        ELSE
            c1& = black&: c2& = black&
        END IF
        x1 = xc + (fc - 5) * xq
        y1 = yc + (4 - fr) * yq
        x2 = x1 + xq
        y2 = y1 + yq
        LINE (x1 + 1, y1 + 1)-(x2 - 1, y2 - 1), c1&, B
        LINE (x1 + 2, y1 + 2)-(x2 - 2, y2 - 2), c1&, B
 
        IF LEFT$(m$, 1) <> "O" THEN '                                    castling
            tr = VAL(MID$(m$, 4, 1))
            IF invert THEN tr = 9 - tr
            tc = INSTR("abcdefgh", MID$(m$, 3, 1))
            IF invert THEN tc = 9 - tc
            x1 = xc + (tc - 5) * xq
            y1 = yc + (4 - tr) * yq
            x2 = x1 + xq
            y2 = y1 + yq
            LINE (x1 + 1, y1 + 1)-(x2 - 1, y2 - 1), c2&, B
            LINE (x1 + 2, y1 + 2)-(x2 - 2, y2 - 2), c2&, B
        END IF
        _DISPLAY
        _DELAY .01
        IF NOT ((WorB <> humanc) AND (opening = 0)) THEN EXIT DO
        ScanKey
        'IF tbf THEN GOTO begin2
    LOOP UNTIL i$ = Enter$
    f$ = "chess3.png": i& = _LOADIMAGE(f$): _ICON i&: _FREEIMAGE i&
 
    MoveIt m$, -1
    ShowAlgebraic m$
    IF sillyf THEN silly ELSE PlotAll
    _DISPLAY
 
    IF opening = 0 THEN
        check = false
        CheckBoard 0
        LOCATE 1, 58
        IF Score = 777 THEN
            check = true
            PRINT "Check!";
        ELSE
            PRINT "      ";
        END IF
    END IF
 
    WorB = SaveWorB XOR 1 '                                          toggle white/black
    'IF LEN(GameFile$) > 0 THEN KeyGet
    'IF humanc = WorB THEN KeyGet
    'WaitForKey = true
LOOP UNTIL Move = 500
 
IF Move = 500 THEN mess$ = "Over 500 moves...."
tc = 60 - LEN(mess$) \ 2
LOCATE 22, tc: PRINT mess$;
PRINT #1, ""
PRINT #1, mess$
' IF Studying THEN KeyGet
CLOSE
GOTO Begin
END
 
o1:
DATA e2e4,e7e5,g1f3,b8c6,f1b5,a7a6,b5a4,b7b5,a4b3,g8f6,b1c3,f8e7,f3g5,h7h6
'DATA g5f7,O-O
'DATA f7d8,g8h7
DATA end
 
SetUp:
DATA 1,2,3,4,5,3,2,1
DATA 6,6,6,6,6,6,6,6
DATA 0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0
DATA 12,12,12,12,12,12,12,12
DATA 7,8,9,10,11,9,8,7
 
Legal:
'       udlr,udlr,udlr,udlr,udlr,udlr,udlr,udlr
DATA R,8000,0800,0080,0008,0000,0000,0000,0000
DATA N,2010,2001,0210,0201,1020,1002,0120,0102
DATA B,8080,8008,0880,0808,0000,0000,0000,0000
DATA Q,8000,0800,0080,0008,8080,8008,0880,0808
DATA K,1000,0100,0010,0001,1010,1001,0110,0101
DATA P,1000,1001,1010,0000,0000,0000,0000,0000
 
PiecePatterns:
DATA ........................
DATA ........................
DATA ........................
DATA ........................
DATA ....X..XX..XX..XX..X....
DATA ....X..XX..XX..XX..X....
DATA ....X..XX..XX..XX..X....
DATA ....X..XX..XX..XX..X....
DATA ....X..XX..XX..XX..X....
DATA .....X.XX..XX..XX.X.....
DATA ......XXXXXXXXXXXX......
DATA .....XX..........XX.....
DATA ......X.XXXXXXXX.X......
DATA ......X.XXXXXXXX.X......
DATA ......X.XXXXXXXX.X......
DATA ......X.XXXXXXXX.X......
DATA .....X............X.....
DATA .....X..XXXXXXXX..X.....
DATA ....X..............X....
DATA ...X..XXXXXXXXXXXX..X...
DATA ...X................X...
DATA ...XXXXXXXXXXXXXXXXXX...
 
DATA ........................
DATA ........................
DATA ........................
DATA ........................
DATA ............XXX.........
DATA ..........XX.X.X........
DATA .........X..X.X.XX......
DATA ........X.X.XX.X..X.....
DATA .......X.XXXX.X.X..X....
DATA .......X.X...XXX.X..X...
DATA .....X..XX..X.XXX.X.X...
DATA ....X.XXXXXXX.XXX.X..X..
DATA ...X.XXXXXX.X..XX.X..X..
DATA ...X.XX..XXX.X.XX.X..X..
DATA ....X..XXXX..X.XX.X..X..
DATA .....XX..X..X.XXX.X..X..
DATA ........X..XX.XX.XX.X...
DATA .......X..XX.XX.XX.X....
DATA ......XXXXXXXXXXXXXX....
DATA .....X..............X...
DATA ....X................X..
DATA .....XXXXXXXXXXXXXXXX...
 
DATA ........................
DATA ........................
DATA ........................
DATA ............X...........
DATA ...........X.X..........
DATA ..........X.X.X.........
DATA ........X...XX..X.......
DATA .......X..X..XX..X......
DATA .......X.XXX..XX.X......
DATA .......X.XXXX..X.X......
DATA ........X.......X.......
DATA .......XX.X.X.X.XX......
DATA ......X...........X.....
DATA .......X.XXX.XX.XX......
DATA ........X.XX.XX.X.......
DATA .......X.XXX.XXX.X......
DATA .......X.XXX.XXX.X......
DATA ......X.X.......X.X.....
DATA .....X.XXXXX.XXXXX.X....
DATA .....X.XXXXX.XXXXX.X....
DATA .....X.............X....
DATA ......XXXXXXXXXXXXX.....
 
DATA ............X...........
DATA ...........X.X..........
DATA .....X....X.X.X....X....
DATA ....X.X.XX.XXX..X.X.X...
DATA ...X.X.X..XX.XXX.X.X.X..
DATA ...X.XX.XXX.X.XXX.XX.X..
DATA ...X.XXX.X.XXX.X.XXX.X..
DATA ...X.XXXX.XXXXX.XXXX.X..
DATA ....X.XXXXXX..XXXXX.X...
DATA .....X.XXXXX..XXXX.X....
DATA .....X.............X....
DATA ......XXXXXXXXXXXXX.....
DATA ....X...............X...
DATA ......XX.XXXXXXX.XX.....
DATA .......X.X.XXX.X.X......
DATA ......X.XX.XXX.XX.X.....
DATA ......X.XX.XXX.XX.X.....
DATA .....XXXXXXXXXXXXXXX....
DATA ....X...............X...
DATA ...X..XX.XX.XX.XX.X..X..
DATA ...X.................X..
DATA ....XXXXXXXXXXXXXXXXX...
 
DATA ...........XX...........
DATA .........XX..XX.........
DATA .......XX.X..X.XX.......
DATA .....XX.X......X.XX.....
DATA ....X..XX.X..X.XX..X....
DATA ...X...XXXX..XXXX...X...
DATA ..X...XX........XX...X..
DATA .X..XXX.XXX..XXX.XXX..X.
DATA X..XXX..XXX..XXX..XXX..X
DATA X.XXXX..XXX..XXXX.XXXX.X
DATA X.XXXX.XXXX..XXXX.XXXX.X
DATA X.XXXX..XXXXXXXX..XXXX.X
DATA .X.XXXX..XXXXXX..XXXX.X.
DATA .X..XXXX..XXXX..XXXX..X.
DATA ..X..XXXX......XXXX..X..
DATA ...X....X......X....X...
DATA ...XXXXXXXXXXXXXXXXXX...
DATA ..X..................X..
DATA .X..XXXXXXXXXXXXXXXX..X.
DATA .X..XXXXXXXXXXXXXXXX..X.
DATA ..X..................X..
DATA ...XXXXXXXXXXXXXXXXXX...
 
DATA ........................
DATA ........................
DATA ........................
DATA ..........XXXX..........
DATA .........X....X.........
DATA ........X.XXXX.X........
DATA ........X.XXXX.X........
DATA .........X....X.........
DATA ........XXXXXXXX........
DATA .......X........X.......
DATA ........XXXXXXXX........
DATA .........X.XX.X.........
DATA .........X.XX.X.........
DATA .........X.XX.X.........
DATA ........X..XX..X........
DATA .......X..XXXX..X.......
DATA ......X.XXXXXXXX.X......
DATA ......X.XXXXXXXX.X......
DATA .....X............X.....
DATA ......XXXXXXXXXXXX......
DATA ........................
DATA ........................
 
rgb:
DATA 0,0,0,0,""
DATA 1,30,60,20,"board white"
DATA 2,1,1,1,"board black"
DATA 3,92,92,92,"white bright"
DATA 4,22,22,92,"white hightlight"
DATA 5,0,0,0,"black bright"
DATA 6,62,22,22,"black hightlight"
DATA 7,63,20,20,"red"
DATA 8,0,63,0,"green"
DATA 9,0,0,63,"blue"
DATA 10,63,63,63,"white"
DATA 11,20,20,20,""
DATA 12,20,20,20,""
DATA 13,20,20,20,""
DATA 14,20,20,20,""
DATA 15,30,30,30,"printing"
 
Oops:
gronk = gronk + 1
IF gronk < 900 THEN
    RESUME
ELSE
    PRINT "Error "; DATE$; "  "; TIME$;
    END
END IF
 
SUB AddIt (Level, tm$, Score)
    Moves(Level) = Moves(Level) + 1 '                                count ok
    Move$(Level, Moves(Level)) = tm$ '                               save move
    Score(Level, Moves(Level)) = Score
    Index(Level, Moves(Level)) = TieTo(Level)
END SUB
 
SUB BoRestore (Level)
    FOR r = 1 TO 8
        FOR c = 1 TO 8
            b(r, c) = t(r, c, Level)
        NEXT c
    NEXT r
END SUB
 
SUB BoSave (Level)
    FOR r = 1 TO 8
        FOR c = 1 TO 8
            t(r, c, Level) = b(r, c)
        NEXT c
    NEXT r
END SUB
 
SUB CheckBoard (Level)
    Moves(Level) = 0
    tking = 5: oking = 11
    IF WorB THEN SWAP tking, oking
    FOR r = 1 TO 8
        FOR c = 1 TO 8
            IF b(r, c) = tking THEN
                mkr = r
                mkc = c
            END IF
            IF b(r, c) = tking THEN
                okr = r
                okc = c
            END IF
        NEXT c
    NEXT r
 
    FOR r = 1 TO 8
        FOR c = 1 TO 8
            mp = b(r, c)
            mc = -(mp > 6) - (mp = 0) * 2
            IF mc = WorB THEN TryMove Level, r, c
        NEXT c
    NEXT r
 
    '  BBWW
    '  QKQK
    IF MID$(Castle$, WorB * 2 + 1, 1) = " " THEN cq = true ELSE cq = false ' blank means ok
    IF MID$(Castle$, WorB * 2 + 2, 1) = " " THEN ck = true ELSE ck = false
 
    neks$ = "" '  not empty kingside
    neqs$ = "" '  not empty queenside
    qsc$ = "" '   queenside control
    ksc$ = "" '   kingside control
    kic$ = "" '   king in check
    nok$ = "" '   king not there
    nrq$ = "" '   no rook queenside
    nrk$ = "" '   no rook kingside
 
    FOR Castle = 0 TO 1 '                                            queenside, then kingside
        '                         bcd              fg
        IF Castle = 0 THEN ca$ = "234" ELSE ca$ = "67" '             column number
        IF WorB THEN rn$ = "1" ELSE rn$ = "8" '                      row number
        tp = b(VAL(rn$), 5): tp = tp + (tp > 6) * 6
        IF tp <> 5 THEN nok$ = "nok "
        tp = b(VAL(rn$), 1): tp = tp + (tp > 6) * 6
        IF tp <> 1 THEN nrq$ = "nrq "
        tp = b(VAL(rn$), 8): tp = tp + (tp > 6) * 6
        IF tp <> 1 THEN nrq$ = "nrk "
        FOR cs = 1 TO LEN(ca$)
            rn = VAL(rn$)
            n$ = MID$(ca$, cs, 1)
            cn = VAL(n$)
            c$ = MID$("abcdefgh", cn, 1)
            tp = b(rn, cn)
            tp = tp + (tp > 6) * 6 '                                 convert >6 to 1-5
            IF tp <> 0 THEN '                                        not empty
                IF Castle = 0 THEN cq = false ELSE ck = false
                IF Castle = 0 THEN neqs$ = neqs$ + "neq " + c$ + rn$ + " "
                IF Castle = 1 THEN neks$ = neks$ + "nek " + c$ + rn$ + " "
            END IF
            q$ = MID$("abcdefgh", cn, 1) + rn$
            FOR lm = 1 TO Moves(1)
                IF q$ = RIGHT$(Move$(1, lm), 2) THEN
                    IF Castle = 0 THEN cq = false ELSE ck = false
                    IF Castle = 0 THEN qsc$ = "qsc" + Move$(1, lm) + " "
                    IF Castle = 1 THEN ksc$ = "ksc " + Move$(1, lm) + " "
                END IF
            NEXT lm
            q$ = "e" + rn$
            FOR lm = 1 TO Moves(1)
                IF q$ = RIGHT$(Move$(1, lm), 2) THEN cq = 0: ck = 0: kic$ = "kic " + Move$(1, lm) + " "
            NEXT lm
        NEXT cs
    NEXT Castle
    debug$ = nok$ + nrq$ + nrk$ + kic$ + neqs$ + neks$ + qsc$ + ksc$ + "     *"
 
    IF ck THEN AddIt Level, "O-O", 12
    IF cq THEN AddIt Level, "O-O-O", 13
 
    'LOCATE 34 + WorB, 46: PRINT "*"; Castle$; "*";
    'PRINT MID$("K ", ck + 2, 1);
    'PRINT MID$("Q ", cq + 2, 1); cq; ck;
 
    TakeBest Level
END SUB
 
SUB Debug1
    sr = 32
    r = sr
    c = 4
    FOR t = 1 TO 20
        IF c < 75 THEN
            LOCATE r, c: PRINT SPACE$(8);
            IF t <= Moves(0) THEN
                LOCATE r, c
                PRINT Make4$(Move$(0, t)); rjust$(Score(0, t), 4);
            END IF
        END IF
        r = r + 1
        IF r > MaxRow THEN r = sr: c = c + 9
    NEXT t
END SUB
 
SUB Debug2 ()
    'IF human AND (humanc = WorB) THEN EXIT SUB
    DebugR = DebugR + 1
    IF DebugR > MaxRow THEN
        _DISPLAY
        DebugR = 3: DebugC = 62
        FOR r = 0 TO MaxRow - 2
            LOCATE DebugR + r, DebugC
            PRINT SPACE$(98 - DebugC);
        NEXT r
    END IF
    ts = 0: s = 1
    z$ = ""
    FOR t = 1 TO 3
        ti = TieTo(t)
        z$ = z$ + Make4$(Move$(t - 1, ti)) + rjust$(Score(t - 1, ti), 3) + " "
        ts = ts + Score(t - 1, ti) * s
        's = -s
    NEXT t
    ts = ts - Score
    z$ = z$ + Make4$(m$) + rjust$(Score, 3) + " " + rjust$(ts, 4)
    LOCATE DebugR, DebugC
    PRINT z$; "   ";
    PRINT #7, z$
END SUB
 
SUB DispText (zr, zc)
    t$ = " RNBQKP"
    LOCATE TextRow(zr), TextCol(zc)
    IF b(zr, zc) > 6 THEN COLOR 0, 7
    PRINT MID$(t$, TextVal(zr, zc) + 1, 1);
    COLOR 7, 0
END SUB
 
SUB DispTime
    IF Start2& > 0 THEN
        Elapse1! = TIMER - Start1&
        Elapse2! = TIMER - Start2&
        IF Elapse2! > MaxElapse! THEN MaxElapse! = Elapse2!
        'ShowTime 3, Elapse1!, "Game:"
        'ShowTime 4, Elapse2!, "This move:"
        'ShowTime 5, MaxElapse!, "Max move:"
    END IF
END SUB
 
SUB FadePiece (tfr, tfc, ttr, ttc)
    fr = tfr: fc = tfc: tr = ttr: tc = ttc
    x1 = xc + (fc - 5) * xq
    y1 = yc + (4 - fr) * yq
    x2 = xc + (tc - 5) * xq
    y2 = yc + (4 - tr) * yq
    p = b(tr, tc)
    IF invert THEN p = b(9 - tr, 9 - tc)
    IF p > 6 THEN wb = 1: p = p - 6
    i = p - (wb = 0) * 6
 
    FOR ps = 0 TO 1
        IF ps = 0 THEN
            c = fr + fc: tx = x1: ty = y1
        ELSE
            c = tr + tc: tx = x2: ty = y2
        END IF
        IF c MOD 2 THEN
            LINE (tx, ty)-(tx + xq, ty + yq), boardwhite&, BF
        ELSE
            LINE (tx, ty)-(tx + xq, ty + yq), boardblack&, BF '      black square
            LINE (tx, ty)-(tx + xq, ty + yq), boardwhite&, B '       border
        END IF
    NEXT ps
 
    FOR t = 1 TO c(p, 0)
        tx = x1 + x(p, t) * 2
        ty = y1 + y(p, t) * 2
        LINE (tx, ty)-STEP(1, 1), cp&(c(i, t)), B
    NEXT t
END SUB
 
SUB HumanMove
    getreal:
    FOR i = 0 TO 1
        IF i = 0 THEN
            rr = 8: cc = 1
            IF invert THEN rr = 9 - rr: cc = 9 - cc
        ELSE
            rr = fr: cc = fc
        END IF
        IF invert THEN rr = 9 - rr: cc = 9 - cc
        mx = _MOUSEX
        my = _MOUSEY
        DO
            x1 = xc - 4 * xq
            y1 = yc - 4 * yq
            x2 = xc + 4 * xq
            y2 = yc + 4 * yq
            LINE (x1, y1)-(x2, y2), boardwhite&, B
            'LOCATE 1, 1: PRINT "Move ";
            x1 = xc + (cc - 5) * xq
            x2 = xc + (cc - 4) * xq
            y1 = yc + (rr - 5) * yq
            y2 = yc + (rr - 4) * yq
            wc& = POINT(x1 + 1, y1 + 1)
            FOR zz = 0 TO 1
                FOR zx = 1 TO 4
                    IF zz THEN tc& = wc& ELSE tc& = red&
                    LINE (x1 + zx, y1 + zx)-(x2 - zx, y2 - zx), tc&, B
                NEXT zx
                _DISPLAY
                _DELAY .01
            NEXT zz
            tmx = _MOUSEX
            tmy = _MOUSEY
            IF (ABS(mx - tmx) > 8) OR (ABS(my - tmy) > 8) THEN
                IF tmx > mx THEN cc = cc + 1
                IF tmx < mx THEN cc = cc - 1
                IF tmy > my THEN rr = rr + 1
                IF tmx < my THEN rr = rr - 1
            END IF
            ScanKey
            IF tbf THEN EXIT SUB
            IF LEN(i$) = 2 THEN
                kk = ASC(RIGHT$(i$, 1))
                cc = cc + (kk = 75) - (kk = 77) '                    left right
                rr = rr + (kk = 72) - (kk = 80) '                    up down
            END IF
            IF rr < 1 THEN rr = 1
            IF rr > 8 THEN rr = 8
            IF cc < 1 THEN cc = 1
            IF cc > 8 THEN cc = 8
        LOOP UNTIL (i$ = Enter$) OR (i$ = "d")
        IF invert THEN rr = 9 - rr: cc = 9 - cc
        IF i = 0 THEN
            fr = rr: fc = cc
        ELSE
            tr = rr: tc = cc
        END IF
    NEXT i
    fs$ = MID$("abcdefgh", fc, 1) + LTRIM$(STR$(9 - fr))
    ts$ = MID$("abcdefgh", tc, 1) + LTRIM$(STR$(9 - tr))
    'IF fs$ = ts$ THEN GOTO getreal
    m$ = fs$ + ts$
    IF m$ = "e1g1" THEN m$ = "O-O"
    IF m$ = "e1c1" THEN m$ = "O-O-O"
    IF m$ = "e8g1" THEN m$ = "O-O"
    IF m$ = "e8c1" THEN m$ = "O-O-O"
END SUB
 
SUB colorassign
    black& = cp&(0)
    boardwhite& = cp&(1)
    boardblack& = cp&(2)
    red& = _RGB32(255, 0, 0)
    green& = cp&(8)
    blue& = cp&(9)
    white& = cp&(10)
END SUB
 
SUB Init
    IF highres THEN
        xm = 1280: ym = 800
    ELSE
        xm = 800: ym = 600
    END IF
    SCREEN _NEWIMAGE(xm, ym, 32)
    _DELAY .3
    IF highres THEN _SCREENMOVE 0, 0 ELSE _SCREENMOVE 472, 20
    MaxRow = ym \ 16 - 1
    _DELAY .3
 
    f$ = "chess3.png": i& = _LOADIMAGE(f$): _ICON i&: _FREEIMAGE i&
    _DELAY .3
    _ALLOWFULLSCREEN _SQUAREPIXELS
 
    RESTORE rgb
    FOR p = 0 TO 15
        READ PalNum, r, g, b, Desc$
        cp&(p) = _RGB32(r * 4, g * 4, b * 4)
    NEXT p
    colorassign '                                                    red&, green&, etc, easier to use than palette numbers
 
    RANDOMIZE TIMER '                                                seed generator
    Move = 0
    WorB = 1 '                                                       white=1, black=0
    speed = 3
    q = 28
    q = q * 2
    xq = q: yq = q
    xc = 248: yc = 254 '                                             center of board
 
    Enter$ = CHR$(13)
    Esc$ = CHR$(27) '                                                to quit program
    lf$ = CHR$(10) '                                                 line feed
    crlf$ = Enter$ + lf$
 
    Castle$ = SPACE$(4) '                                            flags QKQK (B then W)
 
    mess$ = ""
    RESTORE PiecePatterns '                                          bit images
    FOR p = 1 TO 6 ' RNBQKP
        PRINT MID$("RNBQKP", p, 1); " ";
        n = 0
        FOR y = 0 TO 21 ' 22 rows
            READ d$
            p1 = INSTR(d$ + "X", "X") '                              find first "on" bit
            FOR t = LEN(d$) TO 1 STEP -1 '                           find last "on" bit
                IF MID$(d$, t, 1) = "X" THEN
                    p2 = t
                    EXIT FOR
                END IF
            NEXT t
            FOR x = p1 TO p2
                pixel = INSTR(".X", MID$(d$, x, 1))
                n = n + 1
                IF pixel = 2 THEN c = 3 ELSE c = 4
                x(p, n) = x + 1
                y(p, n) = y + 2
                c(p, n) = c
                IF pixel = 2 THEN c = 5 ELSE c = 6
                c(p + 6, n) = c
            NEXT x
        NEXT y
        c(p, 0) = n
        FOR scram = 1 TO 256 '                                       scramble (moves nicer)
            c1 = RND * (c(p, 0) - 1) + 1 '                           any bit
            c2 = RND * (c(p, 0) - 1) + 1 '                           any other bit
            SWAP x(p, c1), x(p, c2)
            SWAP y(p, c1), y(p, c2)
            SWAP c(p, c1), c(p, c2) '                                black
            SWAP c(p + 6, c1), c(p + 6, c2) '                        white
        NEXT scram
    NEXT p
 
    RESTORE Legal '                                                  define how piece moves
    FOR p = 1 TO 6 '                                                 RNBQKP
        READ p$ '                                                    piece, not saved
        FOR t = 0 TO 7 '                                             8 each
            READ mp$(p, t) '                                         mp (move piece)
        NEXT t
    NEXT p
 
    RESTORE SetUp '                                                  initial board position
    FOR r = 8 TO 1 STEP -1 '                                         row
        FOR c = 1 TO 8 '                                             column
            READ b(r, c)
            o(r, c) = b(r, c)
        NEXT c
    NEXT r
 
    elim$ = " ,"
    gm = 0: n = 0
    IF LEN(GameFile$) > 0 THEN ReadGame
    gm = 0
 
    f = f + 1
    f$ = "chess" + LTRIM$(STR$(f))
    OPEN f$ + ".alg" FOR OUTPUT AS #1 '                              algrebraic moves
    OPEN "debug.txt" FOR OUTPUT AS #7
    'MasterLevel = VAL(COMMAND$) '                                    only 4 really tested....
    'GameFile$ = COMMAND$
    'IF _FILEEXISTS(GameFile$) THEN ReadGame ELSE GameFile$ = ""
    MasterLevel = VAL(COMMAND$)
    IF MasterLevel = 0 THEN MasterLevel = 4
    debug = true '                                                   someday I may turn this off
 
    m$ = "(w)hite  (b)lack  (n)one"
    r = _HEIGHT \ 32: c = _WIDTH \ 16
    CLS: LOCATE r, c - LEN(m$) \ 2: PRINT m$;
    DO: _LIMIT 10
        i$ = INKEY$
        IF i$ = "" THEN i$ = " "
        IF i$ = Esc$ THEN SYSTEM
        p = INSTR("bwn", i$)
    LOOP UNTIL p
    IF p = 3 THEN
        human = 0 '                                                  press n for none (watch computer play)
    ELSE
        human = 1
        humanc = p - 1 '                                             0 black, 1 white
        IF humanc = 0 THEN invert = 1 '                              if black, flip board to have black at bottom
    END IF
    CLS
    PlotAll
 
    'opening = 1
    'RESTORE o1
END SUB
 
SUB KeyGet
    EXIT SUB
    sr = CSRLIN: sc = POS(0)
    DO
        ScanKey
        star = star XOR 1
        IF i$ > "" THEN star = 0
        LOCATE sr, sc
        IF LEN(GameFile$) = 0 THEN PRINT CHR$(32 + star * 10);
    LOOP UNTIL i$ > ""
    IF i$ = "s" THEN WaitForKey = false
END SUB
 
FUNCTION Make4$ (t$)
    Make4$ = LEFT$(t$ + SPACE$(4), 4)
END FUNCTION
 
SUB MoveIt (m$, real)
    IF m$ = "res" THEN EXIT SUB '                                    resign?
    fs$ = LEFT$(m$, 2) '                                             from square
    ts$ = RIGHT$(m$, 2) '                                            to square
    tzz = 1 - (LEFT$(m$, 1) = "O") '                                 two moves for a castle
    FOR pass = 1 TO tzz
        IF m$ = "O-O" THEN '                                         castle Kingside
            IF WorB = 1 THEN '                                       white
                IF pass = 1 THEN '                                   first move of KS castle
                    fs$ = "e1": ts$ = "g1"
                ELSE ' else 2nd
                    fs$ = "h1": ts$ = "f1"
                END IF
            ELSE ' black castle
                IF pass = 1 THEN
                    fs$ = "e8": ts$ = "g8"
                ELSE
                    fs$ = "h8": ts$ = "f8"
                END IF
            END IF
        END IF
        IF m$ = "O-O-O" THEN '                                       castle Queenside
            IF WorB THEN '                                           white
                IF pass = 1 THEN
                    fs$ = "e1": ts$ = "c1"
                ELSE
                    fs$ = "a1": ts$ = "d1"
                END IF
            ELSE
                IF pass = 1 THEN
                    fs$ = "e8": ts$ = "c8"
                ELSE
                    fs$ = "a8": ts$ = "d8"
                END IF
            END IF
        END IF
        fr = VAL(RIGHT$(fs$, 1)) '                                   from row
        fc = INSTR("abcdefgh", LEFT$(fs$, 1)) '                      from column
        pm = b(fr, fc) '                                             piece to move
        p = pm + (pm > 6) * 6
        tr = VAL(RIGHT$(ts$, 1)) '                                   to row
        tc = INSTR("abcdefgh", LEFT$(ts$, 1)) '                      to column
        b(tr, tc) = pm '                                             move piece in array
        b(fr, fc) = 0 '                                              blank old array spot
        IF real THEN
            IF b(r, c) = o(r, c) THEN o(r, c) = -1
            FadePiece fr, fc, tr, tc
            IF p = King THEN MID$(Castle$, WorB * 2 + 1, 2) = "XX"
            IF p = Rook THEN
                IF WorB = 0 THEN
                    IF (fr = 8) AND (fc = 1) THEN MID$(Castle$, 1, 1) = "X"
                    IF (fr = 8) AND (fc = 8) THEN MID$(Castle$, 2, 1) = "X"
                ELSE
                    IF (fr = 1) AND (fc = 1) THEN MID$(Castle$, 3, 1) = "X"
                    IF (fr = 1) AND (fc = 8) THEN MID$(Castle$, 4, 1) = "X"
                END IF
            END IF
        END IF
        IF (p = Pawn) AND ((tr = 1) OR (tr = 8)) THEN
            b(tr, tc) = Queen - (pm > 6) * 6 '                       promote to queen
            IF real THEN FadePiece tr, tc, tr, tc '                  show queen
        END IF
    NEXT pass
END SUB
 
SUB PlotAll
    IF LEN(GameFile$) > 0 THEN
        LOCATE 3, 40 - LEN(GameFile$) \ 2
        PRINT GameFile$;
    END IF
    FOR zr = 1 TO 8
        FOR zc = 1 TO 8
            FadePiece zr, zc, zr, zc
        NEXT zc
    NEXT zr
    'CIRCLE (xc, yc), 100, red&
 
    r = _RED32(boardwhite&) \ 2
    g = _GREEN32(boardwhite&) \ 2
    b = _BLUE32(boardwhite&) \ 2
    COLOR _RGB32(r, g, b)
    FOR i = 1 TO 8 '                                                 legend
        IF invert THEN z = i ELSE z = 9 - i
        n$ = LTRIM$(STR$(z))
        IF invert THEN z = 9 - i ELSE z = i
        a$ = MID$("abcdefgh", z, 1)
        nx = xc - 4 * xq - 12
        ny = yc + (i - 4) * yq - 34
        ax = xc + (i - 5) * xq + 22
        ay = yc + 4 * yq + 3
        _PRINTSTRING (nx, ny), n$
        _PRINTSTRING (ax, ay), a$
    NEXT i
    COLOR white&
END SUB
 
SUB ReadGame
    DIM g$(500)
    CLS
    OPEN GameFile$ FOR INPUT AS #8
    WHILE NOT (EOF(8))
        INPUT #8, mn, m1$, m2$
        gm = gm + 1: g$(gm) = LTRIM$(m1$)
        gm = gm + 1: g$(gm) = LTRIM$(m2$)
        PRINT m1$; "*"; m2$
    WEND
    CLOSE #8
    _DISPLAY
    SLEEP
    CLS
    _DISPLAY
END SUB
 
SUB Recurse (Level)
    DispTime
    IF Level = MasterLevel THEN EXIT SUB
    'IF human AND (humanc = WorB) AND (Level = 2) THEN EXIT SUB
 
    FOR t = 1 TO Moves(Level - 1)
        WorB = SaveWorB
        IF (Level MOD 2) = 1 THEN WorB = WorB XOR 1
        TieTo(Level) = t
 
        IF (Score(0, t) > -777) THEN
            BoSave Level
            m$ = Move$(Level - 1, t)
            MoveIt m$, 0
            t$ = rjust$(Moves(Level - 1), 3)
            t$ = t$ + rjust$(t, 4) + " "
            t$ = t$ + Make4$(m$)
            t$ = t$ + rjust$(Score(Level - 1, t), 5)
            ShowMe Level + 1, 24, t$
            CheckBoard Level
            Recurse Level + 1
            TakeBest Level
            Score = Score(Level, 1)
            levm1 = Level - 1
            i = Index
            IF Score(levm, i) <> -777 THEN Score(levm1, i) = Score(levm1, i) - Score
            IF Level = (MasterLevel - 1) THEN Debug2
            BoRestore Level
        END IF
    NEXT t
    ScanKey
END SUB
 
FUNCTION rjust$ (t, n)
    rjust$ = RIGHT$("   " + STR$(t), n)
END FUNCTION
 
SUB ScanKey
    i$ = INKEY$
    IF LEN(i$) = 1 THEN
        IF i$ = Enter$ THEN EXIT SUB
        IF i$ = Esc$ THEN CLOSE: SYSTEM
        c = INSTR("123456789ABCDEF", i$)
        IF c > 0 THEN cp&(c) = _RGB32(RND * 255, RND * 255, RND * 255): colorassign: PlotAll
        IF i$ = "a" THEN OnAuto = NOT (OnAuto)
        IF i$ = "i" THEN invert = invert XOR 1: PlotAll
        IF i$ = "p" THEN
            ShowMe 1, 72, "NoPause"
            ShowMe 1, 72, "       "
        END IF
        IF i$ = "s" THEN SHELL _DONTWAIT "notepad debug.txt"
        IF i$ = "t" THEN tbf = 1
        IF i$ = "z" THEN
            sillyf = sillyf XOR 1
            IF sillyf = 0 THEN PlotAll
        END IF
        i$ = ""
    END IF
    IF sillyf AND (rflag = 0) THEN silly
    IF rflag = 0 THEN _DISPLAY
END SUB
 
SUB ShowAlgebraic (m$)
    IF WorB THEN '                                                  white=1, black=0
        Move = Move + 1 '                                            number the moves
        PRINT #1, RIGHT$("  " + STR$(Move), 3);
        PRINT #1, RIGHT$(SPACE$(10) + m$, 7);
        MoveLog$(Move) = SPACE$(15)
        MID$(MoveLog$(Move), 1, 3) = rjust$(Move, 3)
        MID$(MoveLog$(Move), 5, LEN(m$)) = m$
    ELSE
        MID$(MoveLog$(Move), 11, LEN(m$)) = m$
        PRINT #1, " "; m$
        IF (Move MOD 5) = 0 THEN PRINT #1, ""
    END IF
 
    BeginAt = Move - 18
    IF BeginAt < 1 THEN BeginAt = 1
    dr = 1
    FOR t = BeginAt TO Move
        ShowMe dr + 1, 1, MoveLog$(t)
        dr = dr + 1
    NEXT t
END SUB
 
SUB ShowAsText (br)
    FOR zr1 = 1 TO 8
        FOR zc1 = 1 TO 8
            zr2 = (10 - zr1) * 2 + 3
            zc2 = zc1 * 3 + 17 + br * 32
            tp = b(zr1, zc1)
            IF tp = 0 THEN
                z$ = "  "
            ELSEIF tp < 7 THEN
                z$ = "B" + MID$("RNBQKP", tp, 1)
            ELSE
                z$ = "W" + MID$("RNBQKP", tp - 6, 1)
            END IF
            ShowMe zr2, zc2, z$
        NEXT zc1
    NEXT zr1
END SUB
 
SUB ShowMe (dr, dc, t$)
    EXIT SUB
    sr = CSRLIN '                                                    save row
    sc = POS(0) '                                                    save column
    IF (dr > 0) AND (dr < MaxRow) AND (dc > 0) AND (dc < 76) THEN
        LOCATE dr, dc '                                              display row & column
        PRINT t$;
    END IF
    IF NOT (OnAuto) THEN KeyGet
    LOCATE sr, sc '                                                  restore to old location
    '   IF Pause THEN SLEEP
END SUB
 
SUB ShowTime (trow, t!, Desc$)
    s! = t!
    SELECT CASE s!
        CASE IS > 3600
            unit$ = "h"
            s! = s! / 3600
        CASE IS > 60
            unit$ = "m"
            s! = s! / 60
        CASE ELSE
            unit$ = "s"
    END SELECT
    trow = trow + 3
    LOCATE trow, 34 - LEN(Desc$): PRINT Desc$;
    LOCATE trow, 34
    PRINT USING "###.#"; s!;
    PRINT unit$
END SUB
 
SUB TakeBest (Level)
    FOR scram = 0 TO 99
        s1 = RND * (Moves(Level) - 1) + 1
        s2 = RND * (Moves(Level) - 1) + 1
        SWAP Score(Level, s1), Score(Level, s2)
        SWAP Move$(Level, s1), Move$(Level, s2)
        SWAP Index(Level, s1), Index(Level, s2)
    NEXT scram
 
    passes = 0
    ReSort:
    Score = -999 ' assume no moves
    DO
        Sorted = true
        FOR s = 2 TO Moves(Level)
            IF Score(Level, s - 1) < Score(Level, s) THEN
                Sorted = false
                SWAP Score(Level, s - 1), Score(Level, s)
                SWAP Move$(Level, s - 1), Move$(Level, s)
                SWAP Index(Level, s - 1), Index(Level, s)
            END IF
        NEXT s
    LOOP UNTIL Sorted
 
    m$ = Move$(Level, 1)
    Score = Score(Level, 1)
    Index = Index(Level, 1)
 
    'IF Level = -1 THEN
    '    FOR lb = 0 TO 2 '                                            stop repeats
    '        IF INSTR(MoveLog$(Move - lb), m$) THEN
    '            Score(Level, 1) = Score(Level, 2) - 1 '              best = 2nd best-1
    '            passes = passes + 1
    '            IF passes < 5 THEN GOTO ReSort '                     repeat may be only move
    '        END IF
    '    NEXT lb
    'END IF
 
    IF Level = 1 THEN
        IF Score = -777 THEN '                                       in check, no escape
            mess$ = "Mate"
        ELSEIF Score = -999 THEN '                                   no moves
            mess$ = "Stalemate"
        END IF
    END IF
 
    IF (Level = 1) AND (Score = 777) THEN Score(0, TieTo(1)) = -777
END SUB
 
FUNCTION TextCol (xc)
    TextCol = (xc - 1) * 2 + 25
END FUNCTION
 
FUNCTION TextRow (xr)
    TextRow = (8 - xr) * 1 + 8
END FUNCTION
 
FUNCTION TextVal (xr, xc)
    i = b(xr, xc)
    i = i + (i > 6) * 6
    TextVal = i
END FUNCTION
 
SUB TryMove (Level, fr, fc) '                                        from row, from column
    mp = b(fr, fc)
    IF mp = 0 THEN END
    mc = -(mp > 6) - (mp = 0) * 2 '                                  moving color
    IF mc = 2 THEN END
    mp = mp + (mp > 6) * 6
    IF mc = 1 THEN s = -1 ELSE s = 1 '                               direction a pawn moves
 
    FOR n = 0 TO 7 '                                                 possible 8 dirs
        udlr$ = mp$(mp, n) '                                         up/down/left/right
        IF udlr$ = "0000" THEN EXIT FOR '                            added 2Jan95
        du = VAL(MID$(udlr$, 1, 1)) '                                direction up
        dd = VAL(MID$(udlr$, 2, 1)) '                                direction down
        dl = VAL(MID$(udlr$, 3, 1)) '                                direction left
        dr = VAL(MID$(udlr$, 4, 1)) '                                direction right
        IF mp <> Knight THEN '                                       not knight
            du = SGN(du) * s '                                       one square at a time
            dd = SGN(dd) * s
            dl = SGN(dl) * s
            dr = SGN(dr) * s
        END IF
        IF INSTR(udlr$, "8") THEN TrySq = 8 ELSE TrySq = 1
        IF (mp = Pawn) AND (n = 0) THEN '                            pawn first move?
            IF (fr = 2) AND (WorB = 1) THEN TrySq = 2 '              gambit for white
            IF (fr = 7) AND (WorB = 0) THEN TrySq = 2 '              gambit for black
        END IF
        tr = fr: tc = fc '                                           row, column
        IF TrySq = 0 THEN END
        FOR sq = 1 TO TrySq '                                        up to 8 loops
            cap = false
            Score = 0 '                                              must init
            tr = tr - du + dd '                                      row=row-up+down
            tc = tc - dl + dr '                                      column=column-left+right
            IF (tr < 1) OR (tr > 8) OR (tc < 1) OR (tc > 8) THEN EXIT FOR
            cp = b(tr, tc) '                                         capture piece
            cc = -(cp > 6) - (cp = 0) * 2 '                          capture color
            cp = cp + (cp > 6) * 6
            IF mc = cc THEN '                                        own piece!
                EXIT FOR
            ELSEIF (mc XOR 1) = cc THEN '                            capture
                IF (mp = Pawn) AND (n = 0) THEN EXIT FOR ' no diag, no cap!
                cap = true
                '                 RNBQKP
                Score = VAL(MID$("533901", cp, 1)) * 10
                IF (Score > 0) AND (Level = 0) THEN Score = Score + 2
                IF Score = 0 THEN Score = 777 '                      king capture
                ' IF redo AND (Score = 777) THEN Score = 25
            ELSE
                IF (mp = Pawn) AND (n > 0) THEN EXIT FOR
            END IF
            IF mp = Pawn THEN
                IF (tr = 1) OR (tr = 8) THEN '                       promote pawn
                    IF Score <> 777 THEN Score = Score + 99
                END IF
            END IF
 
            ' usually not good to be moving the King
            IF mp = King THEN Score = Score - 4
 
            ' small plus for king moving out of check
            InCheck = (mc = SaveWorB) AND check
            IF (mp = King) AND InCheck THEN Score = Score + 2
 
            ' leave king cap scores, also normal bonuses if in check
            IF (Score <> 777) AND (NOT (InCheck)) AND (mp <> King) THEN
                dis1 = ABS(fr - okr) + ABS(fc - okc) '                 get closer to king
                dis2 = ABS(tr - okr) + ABS(tc - okc)
                ' IF dis2 < dis1 THEN Score = Score + (dis1 - dis2)
                Score = Score + dis1 - dis2
 
                IF Move < 30 THEN
                    dir = SGN((fr - tr) * s)
                    IF dir = 1 THEN Score = Score + 2 '              move ahead at begin&mid
                END IF
 
                ' priority to getting a piece first moved
                IF mp <> Rook THEN
                    IF b(fr, fc) = o(fr, fc) THEN Score = Score + 1
                END IF
 
                ' priority to getting a piece off the bottom rank
                IF (fr = 1) AND (tr > 1) AND (WorB = 1) THEN Score = Score + 1
                IF (fr = 8) AND (tf < 8) AND (WorB = 0) THEN Score = Score + 1
            END IF
 
            fs$ = MID$("abcdefgh", fc, 1) + CHR$(48 + fr) '          from square
            ts$ = MID$("abcdefgh", tc, 1) + CHR$(48 + tr) '          to square
            AddIt Level, fs$ + ts$, Score
            IF cap AND (mp <> Pawn) THEN EXIT FOR '                  stop looking
        NEXT sq
    NEXT n
END SUB
 
SUB silly STATIC
    PlotAll
    br = 255
    zz = (zz + 1) MOD 50: IF zz = 1 THEN r! = RND: g! = RND: b! = RND
    x1 = xc - 4 * xq
    y1 = yc - 4 * yq
    x2 = x1 + 8 * xq
    y2 = y1 + 8 * yq
    'LINE (x1, y1)-(x2, y2), boardwhite&
    FOR sy = y1 TO y2
        FOR sx = x1 TO x2
            p& = POINT(sx, sy)
            IF p& = boardwhite& THEN
                z = ABS((sx - xc - xq \ 2) * (sy - yc - yq \ 2))
                PSET (sx, sy), _RGB32(br * SIN(.1 * r! * z + zz), br * SIN(.155 * g! * z + zz), br * SIN(2 * b! * z + zz))
            END IF
    NEXT sx: NEXT sy
END SUB
 
SUB SaveForTakeBack STATIC
    FOR i = 10 TO 1 STEP -1
        FOR r = 1 TO 8
            FOR c = 1 TO 8
                tb(r, c, i) = tb(r, c, i - 1)
            NEXT c
        NEXT r
    NEXT i
    FOR r = 1 TO 8
        FOR c = 1 TO 8
            tb(r, c, 0) = b(r, c)
        NEXT c
    NEXT r
    tbc = tbc + 1
    IF tbc > 10 THEN tbc = 10
END SUB
 
SUB takeback
    IF tbc < 2 THEN EXIT SUB
    SOUND 777, 2
    FOR r = 1 TO 8
        FOR c = 1 TO 8
            b(r, c) = tb(r, c, 2)
        NEXT c
    NEXT r
    FOR i = 0 TO 9
        FOR r = 1 TO 8
            FOR c = 1 TO 8
                tb(r, c, i) = tb(r, c, i + 1)
            NEXT c
        NEXT r
    NEXT i
    tbc = tbc - 1
END SUB
 

Title: Eh? (Canadian)
Post by: Richard Frost on January 29, 2020, 12:51:47 am

Yes, I think the initial version only played itself, which is the ideal
way to improve the "smarts" of it. The newest version posted lets
the user pick a side, or "none" for automation. The purpose of
the initial post is to show the guts of an operating engine - the
approach I took with moving pieces legally and whatnot. I still
don't even have the mouse working - arrow keys to move.

I don't know how anyone got the notion that I created this in a day!
I got it to run in QB64 in a day. It's old QB4.5 code of mine that
probably took me at least a month to write.

How does one choose which resolution to use? I had this in 1024*768
for awhile, but I like to see other windows, hence this 800*600. The old
640*480 is too limiting - no room for big graphics AND text. It's a problem
I never encounted with old QB4.5 - what to choose! What factors do you
folk consider to choose a mode? Or should everything be resizable?

Title: Re: A 90% complete chess engine
Post by: bplus on January 29, 2020, 10:27:54 am

Hi Richard Frost,

The comments about doing chess program in a day were meant for STxAxTIC whose post started this thread.

Hey! Your new one works (maybe I just needed to download png for icon file like for this one for last one. no, no png was provided) and it has a nicely sized board (800 x 600 is nice size until out grows all the options you start adding) and the vital question of doing something different with white squares has been answered! :D

So the AI calculates moves but you still have to press enter to get the oppositions pieces moved (after you see the blinking squares).

Hmm... how would plasma look for Black squares :)

Title: Re: A 90% complete chess engine
Post by: SMcNeill on January 29, 2020, 10:31:36 am

Who wants a chess board that looks like half the tiles are high on mushrooms? White/Red on Black is fine for me, as it seems less distracting and non-seizure inducing.

Title: Re: A 90% complete chess engine
Post by: bplus on January 29, 2020, 11:53:58 am

Quote from: SMcNeill on January 29, 2020, 10:31:36 am

Who wants a chess board that looks like half the tiles are high on mushrooms? White/Red on Black is fine for me, as it seems less distracting and non-seizure inducing.

One is not stuck with mushrooms :D and it's not like he doesn't know silly ;-)

Code: QB64: [Select]

sillyf = 1 '                                            Moire effect, toggle with "z", or just default this to 0
 

Title: Re: A 90% complete chess engine
Post by: Richard Frost on January 29, 2020, 12:51:54 pm

Yes, the graphics are a bit distracting, until one gets used to it. Normally I *do* have
it turned off. I set the silly flag in the upload to make it easier for everyone to see
the mayhem without having to read or change any code.

I saw a Queen jump across pawns to eat the other Queen recently....hope that bug isn't in
the upload. And I'm wrong about the castling, it's still wonky.

"Bugs spell job security."

Title: Re: A 90% complete chess engine
Post by: bplus on January 29, 2020, 01:23:18 pm

Quote

"Bugs spell job security."

LOL played a decent game with White Castling, the moves see farther ahead than I which isn't saying too much.

Title: Re: A 90% complete chess engine
Post by: romichess on January 29, 2020, 05:02:58 pm

Now that it works it is more interesting! :)

I was wondering how many moves deep my engine RomiChess would have to see in order to win. I started off RomiChess at 2 moves deep. Note that finishing off capture sequences is part of a 2 ply search and is hard coded. RomiChess played the black pieces. At 2 ply deep RomiChess plays each move instantly.

1. d3 e5 2. c3 Bc5 3. Be3 Bxe3 4. fxe3 Qh4+ 5. Kd2 Ne7 6. g3 Qf6 7. Qe1 Qb6
8. b3 Rf8 9. Bg2 Nbc6 10. Nf3 Nf5 11. d4 Qa5 12. Nxe5 Nxe5 13. dxe5 Qxe5
14. e4 Nd6 15. Na3 Nxe4+ 16. Bxe4 Qxe4 17. Rf1 d5 18. Rf4 Qe7 19. Rd4 Qxa3
20. Qf2 Qb2+ 21. Kd1 Qxa1+ 22. Kd2 Qxa2+ 23. Kd1 Qxb3+ 24. Kc1 Qxc3+ 25.
Kb1 Bf5+ 26. Ka2 Be4 27. e3 c5 28. Ra4 Qe5 29. Qb2 Qxb2+ 30. Kxb2 Ke7 31.
Ra5 Rfc8 32. Ra1 Ke6 33. h3 Ke5 34. Ra4 a5 35. Ra1 b5 36. Ra3 a4 37. Ra1 b4
38. Ra2 a3+ 39. Kb3 h5 40. Ra1 Re8 41. Ra2 Re7 42. Ra1 Rae8 43. Ra2 Rd8 44.
h4 Rde8 45. Ra1 Re6 46. Ra2 R8e7 47. Ra1 Rg6 48. Ra2 Rxg3 49. Re2 Rg1 50.
Ra2 Re1 51. Rd2 Rxe3+ 52. Ka4 Re1 53. Ra2 Bd3 54. Rd2 Kd4 55. Ra2 Rh1 56.
Rd2 Rxh4 57. Ra2 Rh1 58. Rd2 Rhe1 59. Ra2 Re8 60. Rd2 g5 61. Ra2 f5 62. Rd2
f4 63. Ra2 f3 64. Rd2 R8e7 65. Ra2 Bf5 66. Rd2+ Ke5 67. Ra2 Bd3 68. Rd2 Be4
69. Ra2 Bf5 70. Rd2 Re8 71. Ra2 Kd4 72. Rd2+ Bd3 73. Ra2 R8e7 74. Rd2 g4
75. Ra2 h4 76. Rd2 Re8 77. Ra2 h3 78. Rd2 g3 79. Ra2 f2 80. Rxf2 gxf2 81.
Ka5 f1=Q 82. Kb6 a2 83. Kc7 a1=Q 84. Kc6 h2 85. Kc7 h1=Q 86. Kb7 b3 87. Kc6
Qa7 88. Kd6 Qf6# 0-1

I will be doing more with my chess tutorial in the coming days. Maybe I'll just steal this interface for my tutorial! :)

P.S. Romi tried to castle on move 8 so I just moved 8 ... Rf8 instead. Please do not think that Romi made that terrible move on its own volition. lol

P.P.S. I decided to play a quick game with the black pieces.

1. d3 e5 2. a3 Bc5 3. Be3 Bxe3 4. fxe3 Nf6 5. Nd2 d5 6. d4 Nc6 7. dxe5 Nxe5
8. h3 Qd6 9. Ngf3 Neg4 10. Nc4 Qg3+ 11. Kd2 Nf2 12. Qc1 N6e4+ 13. Ke1 Nd3+
14. Kd1 Qe1+ 15. Nxe1 Ndf2# 0-1

Title: Re: A 90% complete chess engine
Post by: TempodiBasic on February 02, 2020, 12:25:05 pm

Yes I confirm that there is the bug of EnterKeypressing for get the Black move,
but why does AI prefer always the Nimzowitsch to open game of white ?
https://it.wikipedia.org/wiki/Difesa_Nimzowitsch (https://it.wikipedia.org/wiki/Difesa_Nimzowitsch) It is a minor defence against E4!
I think you must use a book of opening to improve AI force.

Here my first game user's experience:

Fine the gameplay also if there are the distracting lights of white squares and no support of mouse.
A big bug ... AI doesn't recognize the checkmate! See screenshot!
PS your program run away to Print key of Windows to capture the screen. So i must install SnapShot to get it...(I know that there is the SMcNeill Steve's library... but I don't want to write code, now I'm just a player)

[ This attachment cannot be displayed inline in 'Print Page' view ]
Here the first game like White

Quote

1. e4 Nc6
2. d4 e6
3 Bc4 Na5
4 Bd3 Nc6
5 Nf3 h6
6 O-O Nge7
7 c4 Nb4
8 Be2 Nbc6
9 Nc3 b6
10 Re1 Bb7
11 d5 Nb8
12 dxe6 fxe6
13 e5 Nf5
14 g4 Nfe7
15 Nh4 g5
16 Nf3 Bg7
17 Bd3 O-O
18 Nc3 Qe8
19 Qe2 Qf7
20 Nxg5 hxg5
21 Nxg5 Qe8
22 Bh7+ Kh8
23 Qd3 Nc6
24 Qh3 Rd8
25 Bg6+ Bh6
26 Qxh6+ Kg8
27 Qh7#

moreover...
the game went on with this following moves...

Quote

27... Nb4
28 Qxg8 Qxg6

[ This attachment cannot be displayed inline in 'Print Page' view ]
so if you want improve that AI
1. not only it must be build the rule of checkmate (the king is under attack and it will be captured to the next move and there is no defence to this)
2. but also you must build the rule without King there is gameover (No King is equal No game for that color/side)

Thanks to share you chessprogram with a intermediate AI and any lack of some rules

Title: Re: A 90% complete chess engine
Post by: TempodiBasic on February 02, 2020, 12:53:49 pm

another bit feedback
in my first game as Black... I cannot castle
this is the sequence of moves

Quote

1 d3 d5
2 Be3 e5
3 a3 c5
4 c3 Nc6
5 Qb3 Nf6
6 f3 Bd6
7 Nd2

this is the screenshot
[ This attachment cannot be displayed inline in 'Print Page' view ]
here if I take King and I do 2 steps to the left the program takes my move but then it resets the input to me refusing my choice.

IMHO also this rules must be added to the AI (castle is for white and for black) .
I hope this is not so much for a positive feedback!

Title: Re: A 90% complete chess engine
Post by: TempodiBasic on February 02, 2020, 01:52:41 pm

About CHESS.BAS that follows the QB64 package of example of QB and Qbasic code runnable under QB64..

I and Bplus have worked more on adjurnament of the interface and of the input adding mouse support to input the move, a set of buttons to choose how to play, showing avaiabled moves of the piece that the mouse is pointing, but not so much improving the AI because without understanding how it is structured the original AI there are poor opportunity to empower something, it is simpler write again with your way. In fact Bplus wrote the most of the code to let choose and play with the Black the gamer vs AI. And it was not so clear to me how to use the system implemented into original AI to play with Black. AI uses an 8x8 chess table miming the fisical chessboard and no a single array of 64 (0-63) elements. The moves are calculated on fly and not with a offset.
Also with its all limitations the original AI recognize an impossible to continue setting on the chessboard. See screenshots

Title: Re: A 90% complete chess engine
Post by: SierraKen on February 02, 2020, 04:46:59 pm

Bplus, I got pretty close to finishing a 2-person checkers game after a week of programming every day. But I can't figure out how to keep the king symbol on a king checker piece. The symbol shows up fine on it when you get to the other side, but then when you move again it's deleted. I'm sure I didn't do the variables the right way. I actually just tossed in variables not knowing exactly what they do which is totally not good. I also am getting hang-ups every once in awhile where it won't let you plot coordinates (I don't even use the mouse in this game). So, I will probably either take a long break on this game or just give up on it.
Feel free to have the code anyone, if you wish to do anything with it. Just remember the king symbol doesn't stay and once in awhile maybe it won't let you plot (not sure I may have fixed that). The only reason I'm posting the code today is to show everyone how good I actually did make it so far. You can jump, but only do 1 jump per move. So all in all, it's a very rough and bad way to play checkers, but it is the best one I've made so far. Oh also, it does say which player wins when they do win. I've only played 1 full game of it myself. And like 40 other tries of fixing things. lol Been a crazy little program. But for now, I'm finished with it myself.

Code: QB64: [Select]

_TITLE "1 Jump - 2 Player Checkers - by Ken G."
SCREEN _NEWIMAGE(800, 600, 32)
DIM black2(88), red2(88), bking(88), rking(88)
 
'Make checkerboard
LINE (149, 49)-(651, 551), _RGB32(255, 255, 255), B
FOR ly = 50 TO 487.5 STEP 125
    FOR lx = 212.5 TO 650 STEP 125
        LINE (lx - 62.5, ly)-(lx, ly + 62.5), _RGB32(255, 0, 0), BF
    NEXT lx
    FOR lx = 212.5 TO 650 STEP 125
        LINE (lx, ly + 62.5)-(lx + 62.5, ly + 125), _RGB32(255, 0, 0), BF
    NEXT lx
    FOR lx = 275 TO 650 STEP 125
        LINE (lx - 62.5, ly)-(lx, ly + 62.5), _RGB32(0, 0, 0), BF
    NEXT lx
    FOR lx = 150 TO 587.5 STEP 125
        LINE (lx, ly + 62.5)-(lx + 62.5, ly + 125), _RGB32(0, 0, 0), BF
    NEXT lx
NEXT ly
COLOR _RGB32(255, 255, 255)
LOCATE 3, 87: PRINT "Red"
LOCATE 4, 87: PRINT "From:"
LOCATE 9, 87: PRINT "To:"
LOCATE 3, 5: PRINT "Black"
LOCATE 4, 5: PRINT "From:"
LOCATE 9, 5: PRINT "To:"
 
COLOR _RGB32(127, 255, 255)
FOR lx = 170 TO 607.5 STEP 62.5
    h = h + 1
    h$ = STR$(h)
    _PRINTSTRING (lx, 30), h$
NEXT lx
COLOR _RGB32(128, 249, 127)
FOR ly = 70 TO 507.5 STEP 62.5
    v = v + 1
    v$ = STR$(v)
    _PRINTSTRING (120, ly), v$
NEXT ly
h = 0: v = 0
COLOR _RGB32(127, 255, 255)
FOR lx = 170 TO 607.5 STEP 62.5
    h = h + 1
    h$ = STR$(h)
    _PRINTSTRING (lx, 560), h$
NEXT lx
COLOR _RGB32(128, 249, 127)
FOR ly = 70 TO 507.5 STEP 62.5
    v = v + 1
    v$ = STR$(v)
    _PRINTSTRING (660, ly), v$
NEXT ly
 
'setup pieces
'black
ly = 50
FOR lx = 212.5 TO 650 STEP 125
    CIRCLE (lx + 31.25, ly + 31.25), 20, _RGB32(50, 50, 50)
    PAINT (lx + 31.25, ly + 31.25), _RGB32(50, 50, 50)
NEXT lx
FOR lx = 212.5 TO 650 STEP 125
    CIRCLE (lx - 31.25, ly + 93.75), 20, _RGB32(50, 50, 50)
    PAINT (lx - 31.25, ly + 93.75), _RGB32(50, 50, 50)
NEXT lx
FOR lx = 212.5 TO 650 STEP 125
    CIRCLE (lx + 31.25, ly + 156.25), 20, _RGB32(50, 50, 50)
    PAINT (lx + 31.25, ly + 156.25), _RGB32(50, 50, 50)
NEXT lx
'red
ly = 206.25
FOR lx = 212.5 TO 650 STEP 125
    CIRCLE (lx - 31.25, ly + 187.5), 20, _RGB32(200, 50, 50)
    PAINT (lx - 31.25, ly + 187.5), _RGB32(200, 50, 50)
NEXT lx
FOR lx = 212.5 TO 650 STEP 125
    CIRCLE (lx + 31.25, ly + 250), 20, _RGB32(200, 50, 50)
    PAINT (lx + 31.25, ly + 250), _RGB32(200, 50, 50)
NEXT lx
FOR lx = 212.5 TO 650 STEP 125
    CIRCLE (lx - 31.25, ly + 312.5), 20, _RGB32(200, 50, 50)
    PAINT (lx - 31.25, ly + 312.5), _RGB32(200, 50, 50)
NEXT lx
 
'The coordinate variables use a 2 digit number, the first digit is the horizon, the second is the vertical.
black2(1) = 12
black2(2) = 14
black2(3) = 16
black2(4) = 18
 
black2(5) = 21
black2(6) = 23
black2(7) = 25
black2(8) = 27
 
black2(9) = 32
black2(10) = 34
black2(11) = 36
black2(12) = 38
 
red2(9) = 81
red2(10) = 83
red2(11) = 85
red2(12) = 87
 
red2(5) = 72
red2(6) = 74
red2(7) = 76
red2(8) = 78
 
red2(1) = 61
red2(2) = 63
red2(3) = 65
red2(4) = 67
 
'----------------------------------------------------------------------------
'Main Loop
 
_LIMIT 200
 
'Player One
one:
COLOR _RGB32(128, 249, 127)
LOCATE 5, 87: PRINT "Horizon": LOCATE 6, 87: INPUT ph
IF ph > 8 OR ph < 1 THEN GOTO one:
IF ph <> INT(ph) THEN GOTO one:
COLOR _RGB32(127, 255, 255)
LOCATE 7, 87: PRINT "Vertical": LOCATE 8, 87: INPUT pv
IF pv > 8 OR pv < 1 THEN GOTO one:
IF pv <> INT(pv) THEN GOTO one:
ph$ = STR$(ph)
pv$ = STR$(pv)
sp$ = ph$ + pv$
sp = VAL(sp$)
FOR check = 1 TO 88
    IF red2(check) = sp THEN ch = sp: GOTO move:
NEXT check
GOTO one:
 
'Player Two
two:
COLOR _RGB32(128, 249, 127)
LOCATE 5, 5: PRINT "Horizon": LOCATE 6, 5: INPUT ph3
IF ph3 > 8 OR ph3 < 1 THEN GOTO two:
IF ph3 <> INT(ph3) THEN GOTO two:
COLOR _RGB32(127, 255, 255)
LOCATE 7, 5: PRINT "Vertical": LOCATE 8, 5: INPUT pv3
IF pv3 > 8 OR pv3 < 1 THEN GOTO two:
IF pv3 <> INT(pv3) THEN GOTO two:
ph3$ = STR$(ph3)
pv3$ = STR$(pv3)
sp3$ = ph3$ + pv3$
sp3 = VAL(sp3$)
FOR check2 = 1 TO 88
    IF black2(check2) = sp3 THEN ch2 = sp3: GOTO move2:
NEXT check2
GOTO two:
 
'----------------------------------------------------------------------------
 
move:
COLOR _RGB32(128, 249, 127)
LOCATE 10, 87: PRINT "Horizon": LOCATE 11, 87: INPUT ph2
IF ph2 > 8 OR ph2 < 1 THEN GOTO one:
IF ph2 <> INT(ph2) THEN GOTO one:
 
COLOR _RGB32(127, 255, 255)
LOCATE 12, 87: PRINT "Vertical": LOCATE 13, 87: INPUT pv2
IF pv2 > 8 OR pv2 < 1 THEN GOTO one:
IF pv2 <> INT(pv2) THEN GOTO one:
ph2$ = STR$(ph2)
pv2$ = STR$(pv2)
sp2$ = ph2$ + pv2$
sp2 = VAL(sp2$)
IF sp = sp2 THEN GOTO one:
IF pv = pv2 OR ph = ph2 THEN
    COLOR _RGB32(255, 0, 0)
    LOCATE 15, 87
    PRINT "Illegal Move"
    GOTO one:
END IF
 
'Check for red squares.
IF sp2 = 11 OR sp2 = 13 OR sp2 = 15 OR sp2 = 17 OR sp2 = 22 OR sp2 = 24 OR sp2 = 26 OR sp2 = 28 THEN
    COLOR _RGB32(255, 0, 0)
    LOCATE 15, 87
    PRINT "Illegal Move"
    GOTO one:
END IF
IF sp2 = 31 OR sp2 = 33 OR sp2 = 35 OR sp2 = 37 OR sp2 = 42 OR sp2 = 44 OR sp2 = 46 OR sp2 = 48 THEN
    COLOR _RGB32(255, 0, 0)
    LOCATE 15, 87
    PRINT "Illegal Move"
    GOTO one:
END IF
IF sp2 = 51 OR sp2 = 53 OR sp2 = 55 OR sp2 = 57 OR sp2 = 62 OR sp2 = 64 OR sp2 = 66 OR sp2 = 68 THEN
    COLOR _RGB32(255, 0, 0)
    LOCATE 15, 87
    PRINT "Illegal Move"
    GOTO one:
END IF
IF sp2 = 71 OR sp2 = 73 OR sp2 = 75 OR sp2 = 77 OR sp2 = 82 OR sp2 = 84 OR sp2 = 86 OR sp2 = 88 THEN
    COLOR _RGB32(255, 0, 0)
    LOCATE 15, 87
    PRINT "Illegal Move"
    GOTO one:
END IF
 
red2(ch) = sp2
 
'Draw player one checker in the new square.
'First erase the old checker.
IF sp = 12 THEN CIRCLE (243.75, 81.25), 20, _RGB32(0, 0, 0): PAINT (243.75, 81.25), _RGB32(0, 0, 0): x1 = 243.75: y1 = 81.25
IF sp = 14 THEN CIRCLE (368.75, 81.25), 20, _RGB32(0, 0, 0): PAINT (368.75, 81.25), _RGB32(0, 0, 0): x1 = 368.75: y1 = 81.25
IF sp = 16 THEN CIRCLE (493.75, 81.25), 20, _RGB32(0, 0, 0): PAINT (493.75, 81.25), _RGB32(0, 0, 0): x1 = 493.75: y1 = 81.25
IF sp = 18 THEN CIRCLE (618.75, 81.25), 20, _RGB32(0, 0, 0): PAINT (618.75, 81.25), _RGB32(0, 0, 0): x1 = 618.75: y1 = 81.25
IF sp = 21 THEN CIRCLE (181.25, 143.75), 20, _RGB32(0, 0, 0): PAINT (181.25, 143.75), _RGB32(0, 0, 0): x1 = 181.25: y1 = 143.75
IF sp = 23 THEN CIRCLE (306.25, 143.75), 20, _RGB32(0, 0, 0): PAINT (306.25, 143.75), _RGB32(0, 0, 0): x1 = 306.25: y1 = 143.75
IF sp = 25 THEN CIRCLE (431.25, 143.75), 20, _RGB32(0, 0, 0): PAINT (431.25, 143.75), _RGB32(0, 0, 0): x1 = 431.25: y1 = 143.75
IF sp = 27 THEN CIRCLE (556.25, 143.75), 20, _RGB32(0, 0, 0): PAINT (556.25, 143.75), _RGB32(0, 0, 0): x1 = 556.25: y1 = 143.75
IF sp = 32 THEN CIRCLE (243.75, 206.25), 20, _RGB32(0, 0, 0): PAINT (243.75, 206.25), _RGB32(0, 0, 0): x1 = 243.75: y1 = 206.25
IF sp = 34 THEN CIRCLE (368.75, 206.25), 20, _RGB32(0, 0, 0): PAINT (368.75, 206.25), _RGB32(0, 0, 0): x1 = 368.75: y1 = 206.25
IF sp = 36 THEN CIRCLE (493.75, 206.25), 20, _RGB32(0, 0, 0): PAINT (493.75, 206.25), _RGB32(0, 0, 0): x1 = 493.75: y1 = 206.25
IF sp = 38 THEN CIRCLE (618.75, 206.25), 20, _RGB32(0, 0, 0): PAINT (618.75, 206.25), _RGB32(0, 0, 0): x1 = 618.75: y1 = 206.25
IF sp = 41 THEN CIRCLE (181.25, 268.75), 20, _RGB32(0, 0, 0): PAINT (181.25, 268.75), _RGB32(0, 0, 0): x1 = 181.25: y1 = 268.75
IF sp = 43 THEN CIRCLE (306.25, 268.75), 20, _RGB32(0, 0, 0): PAINT (306.25, 268.75), _RGB32(0, 0, 0): x1 = 306.25: y1 = 268.75
IF sp = 45 THEN CIRCLE (431.25, 268.75), 20, _RGB32(0, 0, 0): PAINT (431.25, 268.75), _RGB32(0, 0, 0): x1 = 431.25: y1 = 268.75
IF sp = 47 THEN CIRCLE (556.25, 268.75), 20, _RGB32(0, 0, 0): PAINT (556.25, 268.75), _RGB32(0, 0, 0): x1 = 556.25: y1 = 268.75
IF sp = 52 THEN CIRCLE (243.75, 331.25), 20, _RGB32(0, 0, 0): PAINT (243.75, 331.25), _RGB32(0, 0, 0): x1 = 243.75: y1 = 331.25
IF sp = 54 THEN CIRCLE (368.75, 331.25), 20, _RGB32(0, 0, 0): PAINT (368.75, 331.25), _RGB32(0, 0, 0): x1 = 368.75: y1 = 331.25
IF sp = 56 THEN CIRCLE (493.75, 331.25), 20, _RGB32(0, 0, 0): PAINT (493.75, 331.25), _RGB32(0, 0, 0): x1 = 493.75: y1 = 331.25
IF sp = 58 THEN CIRCLE (618.75, 331.25), 20, _RGB32(0, 0, 0): PAINT (618.75, 331.25), _RGB32(0, 0, 0): x1 = 618.75: y1 = 331.25
IF sp = 61 THEN CIRCLE (181.25, 393.75), 20, _RGB32(0, 0, 0): PAINT (181.25, 393.74), _RGB32(0, 0, 0): x1 = 181.25: y1 = 393.75
IF sp = 63 THEN CIRCLE (306.25, 393.75), 20, _RGB32(0, 0, 0): PAINT (306.25, 393.75), _RGB32(0, 0, 0): x1 = 306.25: y1 = 393.75
IF sp = 65 THEN CIRCLE (431.25, 393.75), 20, _RGB32(0, 0, 0): PAINT (431.25, 393.75), _RGB32(0, 0, 0): x1 = 431.25: y1 = 393.75
IF sp = 67 THEN CIRCLE (556.25, 393.75), 20, _RGB32(0, 0, 0): PAINT (556.25, 393.75), _RGB32(0, 0, 0): x1 = 556.25: y1 = 393.75
IF sp = 72 THEN CIRCLE (243.75, 456.25), 20, _RGB32(0, 0, 0): PAINT (243.75, 456.25), _RGB32(0, 0, 0): x1 = 243.75: y1 = 456.25
IF sp = 74 THEN CIRCLE (368.75, 456.25), 20, _RGB32(0, 0, 0): PAINT (368.75, 456.25), _RGB32(0, 0, 0): x1 = 368.75: y1 = 456.25
IF sp = 76 THEN CIRCLE (493.75, 456.25), 20, _RGB32(0, 0, 0): PAINT (493.75, 456.25), _RGB32(0, 0, 0): x1 = 493.75: y1 = 456.25
IF sp = 78 THEN CIRCLE (618.75, 456.25), 20, _RGB32(0, 0, 0): PAINT (618.75, 456.25), _RGB32(0, 0, 0): x1 = 618.75: y1 = 456.25
IF sp = 81 THEN CIRCLE (181.25, 518.75), 20, _RGB32(0, 0, 0): PAINT (181.25, 518.75), _RGB32(0, 0, 0): x1 = 181.25: y1 = 518.75
IF sp = 83 THEN CIRCLE (306.25, 518.75), 20, _RGB32(0, 0, 0): PAINT (306.25, 518.75), _RGB32(0, 0, 0): x1 = 306.25: y1 = 518.75
IF sp = 85 THEN CIRCLE (431.25, 518.75), 20, _RGB32(0, 0, 0): PAINT (431.25, 518.75), _RGB32(0, 0, 0): x1 = 431.25: y1 = 518.75
IF sp = 87 THEN CIRCLE (556.25, 518.75), 20, _RGB32(0, 0, 0): PAINT (556.25, 518.75), _RGB32(0, 0, 0): x1 = 556.25: y1 = 518.75
 
'Now draw the new checker.
IF sp2 = 12 THEN CIRCLE (243.75, 81.25), 20, _RGB32(200, 50, 50): PAINT (243.75, 81.25), _RGB32(200, 50, 50): x2 = 243.75: y2 = 81.25
IF sp2 = 14 THEN CIRCLE (368.75, 81.25), 20, _RGB32(200, 50, 50): PAINT (368.75, 81.25), _RGB32(200, 50, 50): x2 = 368.75: y2 = 81.25
IF sp2 = 16 THEN CIRCLE (493.75, 81.25), 20, _RGB32(200, 50, 50): PAINT (493.75, 81.25), _RGB32(200, 50, 50): x2 = 493.75: y2 = 81.25
IF sp2 = 18 THEN CIRCLE (618.75, 81.25), 20, _RGB32(200, 50, 50): PAINT (618.75, 81.25), _RGB32(200, 50, 50): x2 = 618.75: y2 = 81.25
IF sp2 = 21 THEN CIRCLE (181.25, 143.75), 20, _RGB32(200, 50, 50): PAINT (181.25, 143.75), _RGB32(200, 50, 50): x2 = 181.25: y2 = 143.75
IF sp2 = 23 THEN CIRCLE (306.25, 143.75), 20, _RGB32(200, 50, 50): PAINT (306.25, 143.75), _RGB32(200, 50, 50): x2 = 306.25: y2 = 143.75
IF sp2 = 25 THEN CIRCLE (431.25, 143.75), 20, _RGB32(200, 50, 50): PAINT (431.25, 143.75), _RGB32(200, 50, 50): x2 = 431.25: y2 = 143.75
IF sp2 = 27 THEN CIRCLE (556.25, 143.75), 20, _RGB32(200, 50, 50): PAINT (556.25, 143.75), _RGB32(200, 50, 50): x2 = 556.25: y2 = 143.75
IF sp2 = 32 THEN CIRCLE (243.75, 206.25), 20, _RGB32(200, 50, 50): PAINT (243.75, 206.25), _RGB32(200, 50, 50): x2 = 243.75: y2 = 206.25
IF sp2 = 34 THEN CIRCLE (368.75, 206.25), 20, _RGB32(200, 50, 50): PAINT (368.75, 206.25), _RGB32(200, 50, 50): x2 = 368.75: y2 = 206.25
IF sp2 = 36 THEN CIRCLE (493.75, 206.25), 20, _RGB32(200, 50, 50): PAINT (493.75, 206.25), _RGB32(200, 50, 50): x2 = 493.75: y2 = 206.25
IF sp2 = 38 THEN CIRCLE (618.75, 206.25), 20, _RGB32(200, 50, 50): PAINT (618.75, 206.25), _RGB32(200, 50, 50): x2 = 618.75: y2 = 206.25
IF sp2 = 41 THEN CIRCLE (181.25, 268.75), 20, _RGB32(200, 50, 50): PAINT (181.25, 268.75), _RGB32(200, 50, 50): x2 = 181.25: y2 = 268.75
IF sp2 = 43 THEN CIRCLE (306.25, 268.75), 20, _RGB32(200, 50, 50): PAINT (306.25, 268.75), _RGB32(200, 50, 50): x2 = 306.25: y2 = 268.75
IF sp2 = 45 THEN CIRCLE (431.25, 268.75), 20, _RGB32(200, 50, 50): PAINT (431.25, 268.75), _RGB32(200, 50, 50): x2 = 431.25: y2 = 268.75
IF sp2 = 47 THEN CIRCLE (556.25, 268.75), 20, _RGB32(200, 50, 50): PAINT (556.25, 268.75), _RGB32(200, 50, 50): x2 = 556.25: y2 = 268.75
IF sp2 = 52 THEN CIRCLE (243.75, 331.25), 20, _RGB32(200, 50, 50): PAINT (243.75, 331.25), _RGB32(200, 50, 50): x2 = 243.75: y2 = 331.25
IF sp2 = 54 THEN CIRCLE (368.75, 331.25), 20, _RGB32(200, 50, 50): PAINT (368.75, 331.25), _RGB32(200, 50, 50): x2 = 368.75: y2 = 331.25
IF sp2 = 56 THEN CIRCLE (493.75, 331.25), 20, _RGB32(200, 50, 50): PAINT (493.75, 331.25), _RGB32(200, 50, 50): x2 = 493.75: y2 = 331.25
IF sp2 = 58 THEN CIRCLE (618.75, 331.25), 20, _RGB32(200, 50, 50): PAINT (618.75, 331.25), _RGB32(200, 50, 50): x2 = 618.75: y2 = 331.25
IF sp2 = 61 THEN CIRCLE (181.25, 393.75), 20, _RGB32(200, 50, 50): PAINT (181.25, 393.74), _RGB32(200, 50, 50): x2 = 181.25: y2 = 393.75
IF sp2 = 63 THEN CIRCLE (306.25, 393.75), 20, _RGB32(200, 50, 50): PAINT (306.25, 393.75), _RGB32(200, 50, 50): x2 = 306.25: y2 = 393.75
IF sp2 = 65 THEN CIRCLE (431.25, 393.75), 20, _RGB32(200, 50, 50): PAINT (431.25, 393.75), _RGB32(200, 50, 50): x2 = 431.25: y2 = 393.75
IF sp2 = 67 THEN CIRCLE (556.25, 393.75), 20, _RGB32(200, 50, 50): PAINT (556.25, 393.75), _RGB32(200, 50, 50): x2 = 556.25: y2 = 393.75
IF sp2 = 72 THEN CIRCLE (243.75, 456.25), 20, _RGB32(200, 50, 50): PAINT (243.75, 456.25), _RGB32(200, 50, 50): x2 = 243.75: y2 = 456.25
IF sp2 = 74 THEN CIRCLE (368.75, 456.25), 20, _RGB32(200, 50, 50): PAINT (368.75, 456.25), _RGB32(200, 50, 50): x2 = 368.75: y2 = 456.25
IF sp2 = 76 THEN CIRCLE (493.75, 456.25), 20, _RGB32(200, 50, 50): PAINT (493.75, 456.25), _RGB32(200, 50, 50): x2 = 493.75: y2 = 456.25
IF sp2 = 78 THEN CIRCLE (618.75, 456.25), 20, _RGB32(200, 50, 50): PAINT (618.75, 456.25), _RGB32(200, 50, 50): x2 = 618.75: y2 = 456.25
IF sp2 = 81 THEN CIRCLE (181.25, 518.75), 20, _RGB32(200, 50, 50): PAINT (181.25, 518.75), _RGB32(200, 50, 50): x2 = 181.25: y2 = 518.75
IF sp2 = 83 THEN CIRCLE (306.25, 518.75), 20, _RGB32(200, 50, 50): PAINT (306.25, 518.75), _RGB32(200, 50, 50): x2 = 306.25: y2 = 518.75
IF sp2 = 85 THEN CIRCLE (431.25, 518.75), 20, _RGB32(200, 50, 50): PAINT (431.25, 518.75), _RGB32(200, 50, 50): x2 = 431.25: y2 = 518.75
IF sp2 = 87 THEN CIRCLE (556.25, 518.75), 20, _RGB32(200, 50, 50): PAINT (556.25, 518.75), _RGB32(200, 50, 50): x2 = 556.25: y2 = 518.75
 
'Check for a jump.
IF pv - pv2 = 2 OR pv2 - pv = 2 THEN
    IF ph - ph2 = 2 OR ph2 - ph = 2 THEN
        IF x1 > x2 THEN stp = -.25
        IF x1 < x2 THEN stp = .25
        IF y1 > y2 THEN stp2 = -.25
        IF y1 < y2 THEN stp2 = .25
        yy = y1
        FOR xx = x1 TO x2 STEP stp
            yy = yy + stp2
            IF POINT(xx, yy) = _RGB32(50, 50, 50) THEN
                PAINT (xx, yy), _RGB32(0, 0, 0)
                GOTO nex:
            END IF
        NEXT xx
    END IF
END IF
nex:
 
 
'Check for a King.
IF ph2 = 1 THEN
    k1 = k1 + 1
    rking(k1) = red2(ch)
    GOSUB drawking:
END IF
FOR cch = 1 TO 88
    IF rking(cch) = red2(cch) AND rking(cch) <> 0 THEN GOSUB drawking:
NEXT cch
 
 
'Check for a win.
FOR wx = 0 TO 800
    FOR wy = 0 TO 600
        IF POINT(wx, wy) = _RGB32(50, 50, 50) THEN GOTO nex3:
    NEXT wy
NEXT wx
COLOR _RGB32(255, 0, 0)
LOCATE 3, 87: PRINT "Red Wins!"
END
 
nex3:
LOCATE 5, 87: PRINT "           ": LOCATE 6, 87: PRINT "            "
LOCATE 7, 87: PRINT "           ": LOCATE 8, 87: PRINT "            "
LOCATE 10, 87: PRINT "           ": LOCATE 11, 87: PRINT "            "
LOCATE 12, 87: PRINT "           ": LOCATE 13, 87: PRINT "            "
LOCATE 15, 87: PRINT "            "
GOTO two:
 
'-----------------------------------------------------------------------------------------------------------
'Player Two
 
move2:
COLOR _RGB32(128, 249, 127)
LOCATE 10, 5: PRINT "Horizon": LOCATE 11, 5: INPUT ph4
IF ph4 > 8 OR ph4 < 1 THEN GOTO two:
IF ph4 <> INT(ph4) THEN GOTO two:
COLOR _RGB32(127, 255, 255)
LOCATE 12, 5: PRINT "Vertical": LOCATE 13, 5: INPUT pv4
 
IF pv4 > 8 OR pv4 < 1 THEN GOTO two:
IF pv4 <> INT(pv4) THEN GOTO two:
ph4$ = STR$(ph4)
pv4$ = STR$(pv4)
sp4$ = ph4$ + pv4$
sp4 = VAL(sp4$)
IF sp3 = sp4 THEN GOTO two:
IF pv3 = pv4 OR ph3 = ph4 THEN
    COLOR _RGB32(255, 0, 0)
    LOCATE 15, 5
    PRINT "Illegal Move"
    GOTO one:
END IF
 
'Check for red squares.
IF sp4 = 11 OR sp4 = 13 OR sp4 = 15 OR sp4 = 17 OR sp4 = 22 OR sp4 = 24 OR sp4 = 26 OR sp4 = 28 THEN
    COLOR _RGB32(255, 0, 0)
    LOCATE 15, 5
    PRINT "Illegal Move"
    GOTO two:
END IF
IF sp4 = 31 OR sp4 = 33 OR sp4 = 35 OR sp4 = 37 OR sp4 = 42 OR sp4 = 44 OR sp4 = 46 OR sp4 = 48 THEN
    COLOR _RGB32(255, 0, 0)
    LOCATE 15, 5
    PRINT "Illegal Move"
    GOTO two:
END IF
IF sp4 = 51 OR sp4 = 53 OR sp4 = 55 OR sp4 = 57 OR sp4 = 62 OR sp4 = 64 OR sp4 = 66 OR sp4 = 68 THEN
    COLOR _RGB32(255, 0, 0)
    LOCATE 15, 5
    PRINT "Illegal Move"
    GOTO two:
END IF
IF sp4 = 71 OR sp4 = 73 OR sp4 = 75 OR sp4 = 77 OR sp4 = 82 OR sp4 = 84 OR sp4 = 86 OR sp4 = 88 THEN
    COLOR _RGB32(255, 0, 0)
    LOCATE 15, 5
    PRINT "Illegal Move"
    GOTO two:
END IF
 
black2(ch2) = sp4
 
'Draw player two checker in the new square.
'First erase the old checker.
IF sp3 = 12 THEN CIRCLE (243.75, 81.25), 20, _RGB32(0, 0, 0): PAINT (243.75, 81.25), _RGB32(0, 0, 0): x1 = 243.75: y1 = 81.25
IF sp3 = 14 THEN CIRCLE (368.75, 81.25), 20, _RGB32(0, 0, 0): PAINT (368.75, 81.25), _RGB32(0, 0, 0): x1 = 368.75: y1 = 81.25
IF sp3 = 16 THEN CIRCLE (493.75, 81.25), 20, _RGB32(0, 0, 0): PAINT (493.75, 81.25), _RGB32(0, 0, 0): x1 = 493.75: y1 = 81.25
IF sp3 = 18 THEN CIRCLE (618.75, 81.25), 20, _RGB32(0, 0, 0): PAINT (618.75, 81.25), _RGB32(0, 0, 0): x1 = 618.75: y1 = 81.25
IF sp3 = 21 THEN CIRCLE (181.25, 143.75), 20, _RGB32(0, 0, 0): PAINT (181.25, 143.75), _RGB32(0, 0, 0): x1 = 181.25: y1 = 143.75
IF sp3 = 23 THEN CIRCLE (306.25, 143.75), 20, _RGB32(0, 0, 0): PAINT (306.25, 143.75), _RGB32(0, 0, 0): x1 = 306.25: y1 = 143.75
IF sp3 = 25 THEN CIRCLE (431.25, 143.75), 20, _RGB32(0, 0, 0): PAINT (431.25, 143.75), _RGB32(0, 0, 0): x1 = 431.25: y1 = 143.75
IF sp3 = 27 THEN CIRCLE (556.25, 143.75), 20, _RGB32(0, 0, 0): PAINT (556.25, 143.75), _RGB32(0, 0, 0): x1 = 556.25: y1 = 143.75
IF sp3 = 32 THEN CIRCLE (243.75, 206.25), 20, _RGB32(0, 0, 0): PAINT (243.75, 206.25), _RGB32(0, 0, 0): x1 = 243.75: y1 = 206.25
IF sp3 = 34 THEN CIRCLE (368.75, 206.25), 20, _RGB32(0, 0, 0): PAINT (368.75, 206.25), _RGB32(0, 0, 0): x1 = 368.75: y1 = 206.25
IF sp3 = 36 THEN CIRCLE (493.75, 206.25), 20, _RGB32(0, 0, 0): PAINT (493.75, 206.25), _RGB32(0, 0, 0): x1 = 493.75: y1 = 206.25
IF sp3 = 38 THEN CIRCLE (618.75, 206.25), 20, _RGB32(0, 0, 0): PAINT (618.75, 206.25), _RGB32(0, 0, 0): x1 = 618.75: y1 = 206.25
IF sp3 = 41 THEN CIRCLE (181.25, 268.75), 20, _RGB32(0, 0, 0): PAINT (181.25, 268.75), _RGB32(0, 0, 0): x1 = 181.25: y1 = 268.75
IF sp3 = 43 THEN CIRCLE (306.25, 268.75), 20, _RGB32(0, 0, 0): PAINT (306.25, 268.75), _RGB32(0, 0, 0): x1 = 306.25: y1 = 268.75
IF sp3 = 45 THEN CIRCLE (431.25, 268.75), 20, _RGB32(0, 0, 0): PAINT (431.25, 268.75), _RGB32(0, 0, 0): x1 = 431.25: y1 = 268.75
IF sp3 = 47 THEN CIRCLE (556.25, 268.75), 20, _RGB32(0, 0, 0): PAINT (556.25, 268.75), _RGB32(0, 0, 0): x1 = 556.25: y1 = 268.75
IF sp3 = 52 THEN CIRCLE (243.75, 331.25), 20, _RGB32(0, 0, 0): PAINT (243.75, 331.25), _RGB32(0, 0, 0): x1 = 243.75: y1 = 331.25
IF sp3 = 54 THEN CIRCLE (368.75, 331.25), 20, _RGB32(0, 0, 0): PAINT (368.75, 331.25), _RGB32(0, 0, 0): x1 = 368.75: y1 = 331.25
IF sp3 = 56 THEN CIRCLE (493.75, 331.25), 20, _RGB32(0, 0, 0): PAINT (493.75, 331.25), _RGB32(0, 0, 0): x1 = 493.75: y1 = 331.25
IF sp3 = 58 THEN CIRCLE (618.75, 331.25), 20, _RGB32(0, 0, 0): PAINT (618.75, 331.25), _RGB32(0, 0, 0): x1 = 618.75: y1 = 331.25
IF sp3 = 61 THEN CIRCLE (181.25, 393.75), 20, _RGB32(0, 0, 0): PAINT (181.25, 393.74), _RGB32(0, 0, 0): x1 = 181.25: y1 = 393.75
IF sp3 = 63 THEN CIRCLE (306.25, 393.75), 20, _RGB32(0, 0, 0): PAINT (306.25, 393.75), _RGB32(0, 0, 0): x1 = 306.25: y1 = 393.75
IF sp3 = 65 THEN CIRCLE (431.25, 393.75), 20, _RGB32(0, 0, 0): PAINT (431.25, 393.75), _RGB32(0, 0, 0): x1 = 431.25: y1 = 393.75
IF sp3 = 67 THEN CIRCLE (556.25, 393.75), 20, _RGB32(0, 0, 0): PAINT (556.25, 393.75), _RGB32(0, 0, 0): x1 = 556.25: y1 = 393.75
IF sp3 = 72 THEN CIRCLE (243.75, 456.25), 20, _RGB32(0, 0, 0): PAINT (243.75, 456.25), _RGB32(0, 0, 0): x1 = 243.75: y1 = 456.25
IF sp3 = 74 THEN CIRCLE (368.75, 456.25), 20, _RGB32(0, 0, 0): PAINT (368.75, 456.25), _RGB32(0, 0, 0): x1 = 368.75: y1 = 456.25
IF sp3 = 76 THEN CIRCLE (493.75, 456.25), 20, _RGB32(0, 0, 0): PAINT (493.75, 456.25), _RGB32(0, 0, 0): x1 = 493.75: y1 = 456.25
IF sp3 = 78 THEN CIRCLE (618.75, 456.25), 20, _RGB32(0, 0, 0): PAINT (618.75, 456.25), _RGB32(0, 0, 0): x1 = 618.75: y1 = 456.25
IF sp3 = 81 THEN CIRCLE (181.25, 518.75), 20, _RGB32(0, 0, 0): PAINT (181.25, 518.75), _RGB32(0, 0, 0): x1 = 181.25: y1 = 518.75
IF sp3 = 83 THEN CIRCLE (306.25, 518.75), 20, _RGB32(0, 0, 0): PAINT (306.25, 518.75), _RGB32(0, 0, 0): x1 = 306.25: y1 = 518.75
IF sp3 = 85 THEN CIRCLE (431.25, 518.75), 20, _RGB32(0, 0, 0): PAINT (431.25, 518.75), _RGB32(0, 0, 0): x1 = 431.25: y1 = 518.75
IF sp3 = 87 THEN CIRCLE (556.25, 518.75), 20, _RGB32(0, 0, 0): PAINT (556.25, 518.75), _RGB32(0, 0, 0): x1 = 556.25: y1 = 518.75
 
'Now draw the new checker.
IF sp4 = 12 THEN CIRCLE (243.75, 81.25), 20, _RGB32(50, 50, 50): PAINT (243.75, 81.25), _RGB32(50, 50, 50): x2 = 243.75: y2 = 81.25
IF sp4 = 14 THEN CIRCLE (368.75, 81.25), 20, _RGB32(50, 50, 50): PAINT (368.75, 81.25), _RGB32(50, 50, 50): x2 = 368.75: y2 = 81.25
IF sp4 = 16 THEN CIRCLE (493.75, 81.25), 20, _RGB32(50, 50, 50): PAINT (493.75, 81.25), _RGB32(50, 50, 50): x2 = 493.75: y2 = 81.25
IF sp4 = 18 THEN CIRCLE (618.75, 81.25), 20, _RGB32(50, 50, 50): PAINT (618.75, 81.25), _RGB32(50, 50, 50): x2 = 618.75: y2 = 81.25
IF sp4 = 21 THEN CIRCLE (181.25, 143.75), 20, _RGB32(50, 50, 50): PAINT (181.25, 143.75), _RGB32(50, 50, 50): x2 = 181.25: y2 = 143.75
IF sp4 = 23 THEN CIRCLE (306.25, 143.75), 20, _RGB32(50, 50, 50): PAINT (306.25, 143.75), _RGB32(50, 50, 50): x2 = 306.25: y2 = 143.75
IF sp4 = 25 THEN CIRCLE (431.25, 143.75), 20, _RGB32(50, 50, 50): PAINT (431.25, 143.75), _RGB32(50, 50, 50): x2 = 431.25: y2 = 143.75
IF sp4 = 27 THEN CIRCLE (556.25, 143.75), 20, _RGB32(50, 50, 50): PAINT (556.25, 143.75), _RGB32(50, 50, 50): x2 = 556.25: y2 = 143.75
IF sp4 = 32 THEN CIRCLE (243.75, 206.25), 20, _RGB32(50, 50, 50): PAINT (243.75, 206.25), _RGB32(50, 50, 50): x2 = 243.75: y2 = 206.25
IF sp4 = 34 THEN CIRCLE (368.75, 206.25), 20, _RGB32(50, 50, 50): PAINT (368.75, 206.25), _RGB32(50, 50, 50): x2 = 368.75: y2 = 206.25
IF sp4 = 36 THEN CIRCLE (493.75, 206.25), 20, _RGB32(50, 50, 50): PAINT (493.75, 206.25), _RGB32(50, 50, 50): x2 = 493.75: y2 = 206.25
IF sp4 = 38 THEN CIRCLE (618.75, 206.25), 20, _RGB32(50, 50, 50): PAINT (618.75, 206.25), _RGB32(50, 50, 50): x2 = 618.75: y2 = 206.25
IF sp4 = 41 THEN CIRCLE (181.25, 268.75), 20, _RGB32(50, 50, 50): PAINT (181.25, 268.75), _RGB32(50, 50, 50): x2 = 181.25: y2 = 268.75
IF sp4 = 43 THEN CIRCLE (306.25, 268.75), 20, _RGB32(50, 50, 50): PAINT (306.25, 268.75), _RGB32(50, 50, 50): x2 = 306.25: y2 = 268.75
IF sp4 = 45 THEN CIRCLE (431.25, 268.75), 20, _RGB32(50, 50, 50): PAINT (431.25, 268.75), _RGB32(50, 50, 50): x2 = 431.25: y2 = 268.75
IF sp4 = 47 THEN CIRCLE (556.25, 268.75), 20, _RGB32(50, 50, 50): PAINT (556.25, 268.75), _RGB32(50, 50, 50): x2 = 556.25: y2 = 268.75
IF sp4 = 52 THEN CIRCLE (243.75, 331.25), 20, _RGB32(50, 50, 50): PAINT (243.75, 331.25), _RGB32(50, 50, 50): x2 = 243.75: y2 = 331.25
IF sp4 = 54 THEN CIRCLE (368.75, 331.25), 20, _RGB32(50, 50, 50): PAINT (368.75, 331.25), _RGB32(50, 50, 50): x2 = 368.75: y2 = 331.25
IF sp4 = 56 THEN CIRCLE (493.75, 331.25), 20, _RGB32(50, 50, 50): PAINT (493.75, 331.25), _RGB32(50, 50, 50): x2 = 493.75: y2 = 331.25
IF sp4 = 58 THEN CIRCLE (618.75, 331.25), 20, _RGB32(50, 50, 50): PAINT (618.75, 331.25), _RGB32(50, 50, 50): x2 = 618.75: y2 = 331.25
IF sp4 = 61 THEN CIRCLE (181.25, 393.75), 20, _RGB32(50, 50, 50): PAINT (181.25, 393.74), _RGB32(50, 50, 50): x2 = 181.25: y2 = 393.75
IF sp4 = 63 THEN CIRCLE (306.25, 393.75), 20, _RGB32(50, 50, 50): PAINT (306.25, 393.75), _RGB32(50, 50, 50): x2 = 306.25: y2 = 393.75
IF sp4 = 65 THEN CIRCLE (431.25, 393.75), 20, _RGB32(50, 50, 50): PAINT (431.25, 393.75), _RGB32(50, 50, 50): x2 = 431.25: y2 = 393.75
IF sp4 = 67 THEN CIRCLE (556.25, 393.75), 20, _RGB32(50, 50, 50): PAINT (556.25, 393.75), _RGB32(50, 50, 50): x2 = 556.25: y2 = 393.75
IF sp4 = 72 THEN CIRCLE (243.75, 456.25), 20, _RGB32(50, 50, 50): PAINT (243.75, 456.25), _RGB32(50, 50, 50): x2 = 243.75: y2 = 456.25
IF sp4 = 74 THEN CIRCLE (368.75, 456.25), 20, _RGB32(50, 50, 50): PAINT (368.75, 456.25), _RGB32(50, 50, 50): x2 = 368.75: y2 = 456.25
IF sp4 = 76 THEN CIRCLE (493.75, 456.25), 20, _RGB32(50, 50, 50): PAINT (493.75, 456.25), _RGB32(50, 50, 50): x2 = 493.75: y2 = 456.25
IF sp4 = 78 THEN CIRCLE (618.75, 456.25), 20, _RGB32(50, 50, 50): PAINT (618.75, 456.25), _RGB32(50, 50, 50): x2 = 618.75: y2 = 456.25
IF sp4 = 81 THEN CIRCLE (181.25, 518.75), 20, _RGB32(50, 50, 50): PAINT (181.25, 518.75), _RGB32(50, 50, 50): x2 = 181.25: y2 = 518.75
IF sp4 = 83 THEN CIRCLE (306.25, 518.75), 20, _RGB32(50, 50, 50): PAINT (306.25, 518.75), _RGB32(50, 50, 50): x2 = 306.25: y2 = 518.75
IF sp4 = 85 THEN CIRCLE (431.25, 518.75), 20, _RGB32(50, 50, 50): PAINT (431.25, 518.75), _RGB32(50, 50, 50): x2 = 431.25: y2 = 518.75
IF sp4 = 87 THEN CIRCLE (556.25, 518.75), 20, _RGB32(50, 50, 50): PAINT (556.25, 518.75), _RGB32(50, 50, 50): x2 = 556.25: y2 = 518.75
 
'Check for a jump.
IF pv3 - pv4 = 2 OR pv4 - pv3 = 2 THEN
    IF ph3 - ph4 = 2 OR ph4 - ph3 = 2 THEN
        IF x1 > x2 THEN stp = -.25
        IF x1 < x2 THEN stp = .25
        IF y1 > y2 THEN stp2 = -.25
        IF y1 < y2 THEN stp2 = .25
        yy = y1
        FOR xx = x1 TO x2 STEP stp
            yy = yy + stp2
            IF POINT(xx, yy) = _RGB32(200, 50, 50) THEN
                PAINT (xx, yy), _RGB32(0, 0, 0)
                GOTO nex2:
            END IF
        NEXT xx
    END IF
END IF
nex2:
 
'Check for a King.
IF ph4 = 8 THEN
    k2 = k2 + 1
    bking(k2) = black2(ch2)
    GOSUB drawking:
END IF
FOR cch = 1 TO 88
    IF bking(cch) = black2(cch) AND bking(cch) <> 0 THEN GOSUB drawking:
NEXT cch
 
'Check for a win.
FOR wx = 0 TO 800
    FOR wy = 0 TO 600
        IF POINT(wx, wy) = _RGB32(200, 50, 50) THEN GOTO nex4:
    NEXT wy
NEXT wx
COLOR _RGB32(255, 0, 0)
LOCATE 3, 87: PRINT "Black Wins!"
END
 
nex4:
LOCATE 5, 5: PRINT "           ": LOCATE 6, 5: PRINT "            "
LOCATE 7, 5: PRINT "           ": LOCATE 8, 5: PRINT "            "
LOCATE 10, 5: PRINT "           ": LOCATE 11, 5: PRINT "            "
LOCATE 12, 5: PRINT "           ": LOCATE 13, 5: PRINT "            "
LOCATE 15, 5: PRINT "            "
 
'Go back to Player One
GOTO one:
 
'Draw the king symbol on the piece.
drawking:
LINE (x2 - 10, y2 + 10)-(x2 + 10, y2 + 10), _RGB32(255, 255, 255)
LINE (x2 - 10, y2 + 7)-(x2 + 10, y2 + 7), _RGB32(255, 255, 255)
LINE (x2 - 10, y2 + 7)-(x2 - 15, y2 - 2), _RGB32(255, 255, 255)
CIRCLE (x2 - 15, y2 - 5), 3, _RGB32(255, 255, 255)
LINE (x2 - 15, y2 - 2)-(x2 - 5, y2), _RGB32(255, 255, 255)
LINE (x2 - 5, y2)-(x2, y2 - 4), _RGB32(255, 255, 255)
CIRCLE (x2, y2 - 7), 3, _RGB32(255, 255, 255)
LINE (x2 + 10, y2 + 7)-(x2 + 15, y2 - 2), _RGB32(255, 255, 255)
CIRCLE (x2 + 15, y2 - 5), 3, _RGB32(255, 255, 255)
LINE (x2 + 15, y2 - 2)-(x2 + 5, y2), _RGB32(255, 255, 255)
LINE (x2 + 5, y2)-(x2, y2 - 4), _RGB32(255, 255, 255)
RETURN
 

Title: Re: A 90% complete chess engine
Post by: bplus on February 02, 2020, 04:50:27 pm

Hi Ken,

Ah so that's what you've been up to! I wish you started a new thread, so I could join in. This one is already all over the place with chess.

I look forward to checking it out, thanks.

Title: Re: A 90% complete chess engine
Post by: SierraKen on February 02, 2020, 05:40:47 pm

I'll make a new thread for it.

Title: Re: A 90% complete chess engine
Post by: Richard Frost on February 26, 2020, 09:47:41 pm

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

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

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

Code: QB64: [Select]

$CONSOLE
 
_TITLE "Chess"
DEFINT A-Z
 
CONST true = -1, false = 0, Rook = 1, Knight = 2, Bishop = 3, Queen = 4, King = 5, Pawn = 6
COMMON SHARED WorB, Move, Score, Index, opening, invert, i$, m$, lm$, msg$, abort, MaxRow, xq, yq, xc, yc, xm, ym, castle$, OtherK$
COMMON SHARED mkr, mkc, okr, okc, k$, MasterLevel, MasterLevel1, SaveWorB, GameFile$, check, incheck, debug, DebugR, DebugC, Start1!, Start2!
COMMON SHARED MaxElapse!, human, humanc, OnAuto, graphics, rflag, tlimit, boardwhite&, boardblack&, black&, red&, green&, blue&, white&, gray&
COMMON SHARED Enter$, Esc$, lf$, crlf$, debug$, pinit, takebackflag, tbc, waitflag, pause, cursoron!, quitflag, smode, vflag, MakeNoise
COMMON SHARED bri, hold!, dtime!, mtime!, altblack, epfc, epfr, eptc, eptr, eprc, eprr, best, best$, ep$, rick, lcount&, alpha$, ocount&
 
DIM SHARED l, p, b, q1, q2
l = 10: p = 6: b = 8: q1 = 300: q2 = 500
DIM SHARED b(b, b), t(b, b, l), o(b, b), tb(b, b, 10), castle$(l), Moves(l), Move$(l, q1), Score(l, q1)
DIM SHARED TieTo(l), Index(l, q1), prot(l), prot$(l, q1), x(p, q2), y(p, q2), c(12, q2), MoveLog$(q2)
DIM SHARED cp&(32), etime!(3), myr(32), myg(32), myb(32), icon&(10), emin, useidiot, main&, alfred!
DIM SHARED mcount&(10), du(p, 7), dd(p, 7), dl(p, 7), dr(p, 7), value(p), alphal$(8)
DIM SHARED showthink, history, showlegalf, showprotf
 
DIM SHARED abuff(30000)
'DIM SHARED debug$(2)
 
DIM SHARED s1(b, b), s2(b, b), s3(b, b), s4(b, b), s5(b, b), s9(b, b) '                  saving board state for recursion
DIM SHARED m(9) AS _MEM
m(0) = _MEM(b(0, 0))
m(1) = _MEM(s1(0, 0))
m(2) = _MEM(s2(0, 0))
m(3) = _MEM(s3(0, 0))
m(4) = _MEM(s4(0, 0))
m(5) = _MEM(s5(0, 0))
m(9) = _MEM(s9(0, 0))
 
rick = _FILEEXISTS("rick.")
IF INSTR(COMMAND$ + " ", "rick") THEN debug = true
_CONSOLE OFF
 
begin:
Init
OPEN "chess.txt" FOR OUTPUT AS #2
DO
    _ICON icon&(1) '                                                 chess.png
    SaveWorB = WorB
 
    mking = 5: oking = 11
    IF humanc = 0 THEN SWAP mking, oking
    FOR r = 1 TO 8
        FOR c = 1 TO 8
            IF b(c, r) = mking THEN mkr = r: mkc = c
            IF b(c, r) = oking THEN okr = r: okc = c
        NEXT c
    NEXT r
    ks$ = alphal$(mkc) + CHR$(48 + mkr)
 
    redo:
    SaveForTakeBack
    Reset_To_Zero
    IF Moves(0) = 0 THEN msg$ = "Stalemate": GOTO yoyo
    Start1! = TIMER: Start2! = Start1!
    DebugR = 99
 
    IF human AND (humanc = WorB) OR (human = 2) THEN '               2 is two humans
        IF human = 2 THEN invert = -(WorB = 0)
        DO
            pinit = 0 '                                              nudge for the graphics, vary it a little
            HumanMove '                                              get a move
            IF LEN(msg$) THEN GOTO yoyo
            IF takebackflag THEN
                TakeBack '                                           restores board & castling status
                PlotBoard
                takebackflag = 0
                GOTO redo
            END IF
            sm$ = m$
            _MEMCOPY m(0), m(0).OFFSET, m(0).SIZE TO m(9), m(9).OFFSET '         save board
            MoveIt m$, false
            WorB = WorB XOR 1
            CheckBoard 1
            WorB = WorB XOR 1
            m$ = sm$
            _MEMCOPY m(9), m(9).OFFSET, m(9).SIZE TO m(0), m(0).OFFSET '     restore board
            IF Score <> 777 THEN
                FOR i = 1 TO Moves(0) '                              check against legal list
                    IF m$ = Move$(0, i) THEN EXIT DO '               move found, skip more checking
                NEXT i
            END IF
            alfred! = TIMER + 5
            IF MakeNoise THEN PlaySound "bad"
        LOOP
    ELSE
        abort = false
        DebugR = 99
        rflag = true '                                               flag in recursion to stop displaying board
        best = -99999
        Center 0, "", true
        MasterLevel = 2 '                                            fast check in case slow aborted
        Recurse 1 '                                                  try all moves & responses
        TakeBest 0, true '
        ShowBest
        IF (Score < -700) OR (Score > 500) THEN
            rflag = 0
            IF Moves(0) THEN msg$ = "Checkmate!" ELSE msg$ = "Stalemate!"
            msg$ = msg$ + STR$(Score)
            GOTO yoyo
        END IF
        MasterLevel = MasterLevel1 '                                 slow check
        FOR i = 1 TO MasterLevel: Moves(i) = 0: NEXT
        Recurse 1 '                                                  try all moves & responses
        IF MakeNoise THEN PlaySound "ding"
        TakeBest 0, true '
        ShowBest
        rflag = false
        Center 0, "", true
        IF abort THEN _MEMCOPY m(1), m(1).OFFSET, m(1).SIZE TO m(0), m(0).OFFSET '         restore board
        IF msg$ = "abort" THEN msg$ = ""
        IF LEN(msg$) THEN WorBs = WorB + 1: GOTO yoyo
    END IF
 
    IF LEN(msg$) THEN GOTO yoyo
 
    WorB = SaveWorB
 
    sm$ = m$: m2$ = m$ '                                             save move for display in case modified for castling
    IF m$ = "O-O" THEN '                                             castle kingside
        IF WorB THEN
            m$ = "e1g1": m2$ = "h1f1"
        ELSE
            m$ = "e8g8": m2$ = "h8f8"
        END IF
    END IF
    IF m$ = "O-O-O" THEN '                                           castle queenside
        IF WorB THEN
            m$ = "e1c1": m2$ = "a1c1"
        ELSE
            m$ = "e8c8": m2$ = "a8d8"
        END IF
    END IF
 
    IF human <> 1 THEN GOTO doit '                                   people playing, or computer playing itself
 
    waitflag = 1
    _ICON icon&(2) '                                                 clockx or clockx2
 
    fr = VAL(MID$(m$, 2, 1)) '                                       from row (or rank)
    IF invert THEN fr = 9 - fr '                                     invert means black at bottom
    fc = INSTR(alpha$, LEFT$(m$, 1)) '                               from column
 
    IF invert THEN fc = 9 - fc
 
    tr = VAL(MID$(m$, 4, 1)) '                                       row or rank
    IF invert THEN tr = 9 - tr '                                     black at bottom
    tc = INSTR(alpha$, MID$(m$, 3, 1)) '                             column
    IF invert THEN tc = 9 - tc
 
    DO: _LIMIT 100
        'IF (itime! = 0) OR (TIMER > itime!) THEN
        '    iname = iname XOR 1
        '    _ICON icon&(iname + 2) '                                clockx or clockx2
        '    itime! = TIMER + .5
        'END IF
        KeyScan 1, 1 '                                               plotscreen, _display
        Cursor fr, fc, 0
        Cursor tr, tc, 0
        IF WorB = humanc THEN EXIT DO
    LOOP UNTIL (i$ = Enter$) OR (human = 0) OR LEN(msg$)
 
    waitflag = 0
 
    doit:
    m$ = sm$
    lm$ = m$
    MoveIt m$, true
    AddMove
    PlotScreen true
    _DISPLAY
 
    check = false
    CheckBoard 0
    IF Score = 777 THEN check = true: TempMess "Check!", 2
 
    'check = 0: incheck = 0
 
    'check = false: z = Level XOR 1
    'k1$ = MID$(alpha$, mkc, 1) + CHR$(48 + mkr) '                   location of King
    'k2$ = MID$(alpha$, okc, 1) + CHR$(48 + okr) '                   location of King
    'ic = 0
    'FOR i = 1 TO Moves(0) '                                         can any opponent piece move there?
    '    s$ = RIGHT$(Move$(z, 0), 2)
    '    IF k1$ = s$ THEN ic = 1 '                                   in check
    '    IF k2$ = s$ THEN ic = 2 '                                   in check
    'NEXT i
    'IF ic THEN
    '    check = true
    '    ic$ = CHR$(48 + ic) + " Check!"
    '    TempMess ic$
    'END IF
 
    WorB = SaveWorB XOR 1 '                                          toggle white/black
LOOP UNTIL Move = 500
 
IF Move = 500 THEN msg$ = "Over 500 moves...."
PRINT #1, ""
PRINT #1, msg$
 
yoyo:
Playagain msg$
msg$ = ""
CLS
IF i$ = "n" THEN GOTO begin '                                        n for new game
IF WorBs THEN
    WorB = WorBs - 1: WorBs = 0
    WorB = WorB XOR 1
END IF
PlotScreen true
GOTO redo
 
o1:
DATA e2e4,e7e5,g1f3,b8c6,f1b5,a7a6,b5a4,b7b5,a4b3,g8f6,b1c3,f8e7,f3g5,h7h6
'DATA g5f7,O-O
'DATA f7d8,g8h7
DATA end
 
Setup:
DATA 1,2,3,4,5,3,2,1
DATA 6,6,6,6,6,6,6,6
DATA 0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0
DATA 12,12,12,12,12,12,12,12
DATA 7,8,9,10,11,9,8,7
 
test:
DATA 0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0
DATA 0,11,0,0,0,0,0,0
DATA 0,7,0,12,0,0,0,0
DATA 0,0,0,0,0,0,0,0
DATA 9,0,0,0,6,0,0,0
DATA 5,9,0,0,0,0,0,0
 
Legal:
'      udlr,udlr,udlr,udlr,udlr,udlr,udlr,udlr
DATA R,7000,0700,0070,0007,0000,0000,0000,0000
DATA N,2010,2001,0210,0201,1020,1002,0120,0102
DATA B,7070,7007,0770,0707,0000,0000,0000,0000
DATA Q,7000,0700,0070,0007,7070,7007,0770,0707
DATA K,1000,0100,0010,0001,1010,1001,0110,0101
DATA P,1000,1001,1010,0000,0000,0000,0000,0000
 
hg:
'                   1         2         3         4         5
'          12345678901234567890123456789012345678901234567890
DATA "01","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "02","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "03","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "04","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "05","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "06","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "07","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "08","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "09","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "10","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "11","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "12","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "13","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "14","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "15","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "16","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "17","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "18","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "19","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "20","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "21","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "22","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "23","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "24","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "25","               XXXXXXXXXXXXXXXXXXXX               "
DATA "26","                XXXXXXXXXXXXXXXXXX                "
DATA "27","                 XXXXXXXXXXXXXXXX                 "
DATA "28","                  XXXXXXXXXXXXXX                  "
DATA "29","                   XXXXXXXXXXXX                   "
DATA "30","                    XXXXXXXXXX                    "
DATA "31","                     XXXXXXXX                     "
DATA "32","                      XXXXXX                      "
 
DATA "33","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "34","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "35","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "36","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "37","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "38","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "39","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "40","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "41","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "42","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "43","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "44","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "45","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "46","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "47","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "48","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "49","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "50","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "51","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "52","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "53","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "54","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "55","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "56","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "57","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "58","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "59","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "51","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "60","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "61","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "62","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "63","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "64","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
 
PiecePatterns:
DATA ........................
DATA ........................
DATA ........................
DATA ........................
DATA ....X..XX..XX..XX..X....
DATA ....X..XX..XX..XX..X....
DATA ....X..XX..XX..XX..X....
DATA ....X..XX..XX..XX..X....
DATA ....X..XX..XX..XX..X....
DATA .....X.XX..XX..XX.X.....
DATA ......XXXXXXXXXXXX......
DATA .....XX..........XX.....
DATA ......X.XXXXXXXX.X......
DATA ......X.XXXXXXXX.X......
DATA ......X.XXXXXXXX.X......
DATA ......X.XXXXXXXX.X......
DATA .....X............X.....
DATA .....X..XXXXXXXX..X.....
DATA ....X..............X....
DATA ...X..XXXXXXXXXXXX..X...
DATA ...X................X...
DATA ...XXXXXXXXXXXXXXXXXX...
 
DATA ........................
DATA ........................
DATA ........................
DATA ........................
DATA ............XXX.........
DATA ..........XX.X.X........
DATA .........X..X.X.XX......
DATA ........X.X.XX.X..X.....
DATA .......X.XXXX.X.X..X....
DATA .......X.X...XXX.X..X...
DATA .....X..XX..X.XXX.X.X...
DATA ....X.XXXXXXX.XXX.X..X..
DATA ...X.XXXXXX.X..XX.X..X..
DATA ...X.XX..XXX.X.XX.X..X..
DATA ....X..XXXX..X.XX.X..X..
DATA .....XX..X..X.XXX.X..X..
DATA ........X..XX.XX.XX.X...
DATA .......X..XX.XX.XX.X....
DATA ......XXXXXXXXXXXXXX....
DATA .....X..............X...
DATA ....X................X..
DATA .....XXXXXXXXXXXXXXXX...
 
DATA ........................
DATA ........................
DATA ........................
DATA ............X...........
DATA ...........X.X..........
DATA ..........X.X.X.........
DATA ........X...XX..X.......
DATA .......X..X..XX..X......
DATA .......X.XXX..XX.X......
DATA .......X.XXXX..X.X......
DATA ........X.......X.......
DATA .......XX.X.X.X.XX......
DATA ......X...........X.....
DATA .......X.XXX.XX.XX......
DATA ........X.XX.XX.X.......
DATA .......X.XXX.XXX.X......
DATA .......X.XXX.XXX.X......
DATA ......X.X.......X.X.....
DATA .....X.XXXXX.XXXXX.X....
DATA .....X.XXXXX.XXXXX.X....
DATA .....X.............X....
DATA ......XXXXXXXXXXXXX.....
 
DATA ............X...........
DATA ...........X.X..........
DATA .....X....X.X.X....X....
DATA ....X.X.XX.XXX..X.X.X...
DATA ...X.X.X..XX.XXX.X.X.X..
DATA ...X.XX.XXX.X.XXX.XX.X..
DATA ...X.XXX.X.XXX.X.XXX.X..
DATA ...X.XXXX.XXXXX.XXXX.X..
DATA ....X.XXXXXX..XXXXX.X...
DATA .....X.XXXXX..XXXX.X....
DATA .....X.............X....
DATA ......XXXXXXXXXXXXX.....
DATA ....X...............X...
DATA ......XX.XXXXXXX.XX.....
DATA .......X.X.XXX.X.X......
DATA ......X.XX.XXX.XX.X.....
DATA ......X.XX.XXX.XX.X.....
DATA .....XXXXXXXXXXXXXXX....
DATA ....X...............X...
DATA ...X..XX.XX.XX.XX.X..X..
DATA ...X.................X..
DATA ....XXXXXXXXXXXXXXXXX...
 
DATA ...........XX...........
DATA .........XX..XX.........
DATA .......XX.X..X.XX.......
DATA .....XX.X......X.XX.....
DATA ....X..XX.X..X.XX..X....
DATA ...X...XXXX..XXXX...X...
DATA ..X...XX........XX...X..
DATA .X..XXX.XXX..XXX.XXX..X.
DATA X..XXX..XXX..XXX..XXX..X
DATA X.XXXX..XXX..XXXX.XXXX.X
DATA X.XXXX.XXXX..XXXX.XXXX.X
DATA X.XXXX..XXXXXXXX..XXXX.X
DATA .X.XXXX..XXXXXX..XXXX.X.
DATA .X..XXXX..XXXX..XXXX..X.
DATA ..X..XXXX......XXXX..X..
DATA ...X....X......X....X...
DATA ...XXXXXXXXXXXXXXXXXX...
DATA ..X..................X..
DATA .X..XXXXXXXXXXXXXXXX..X.
DATA .X..XXXXXXXXXXXXXXXX..X.
DATA ..X..................X..
DATA ...XXXXXXXXXXXXXXXXXX...
 
DATA ........................
DATA ........................
DATA ........................
DATA ..........XXXX..........
DATA .........X....X.........
DATA ........X.XXXX.X........
DATA ........X.XXXX.X........
DATA .........X....X.........
DATA ........XXXXXXXX........
DATA .......X........X.......
DATA ........XXXXXXXX........
DATA .........X.XX.X.........
DATA .........X.XX.X.........
DATA .........X.XX.X.........
DATA ........X..XX..X........
DATA .......X..XXXX..X.......
DATA ......X.XXXXXXXX.X......
DATA ......X.XXXXXXXX.X......
DATA .....X............X.....
DATA ......XXXXXXXXXXXX......
DATA ........................
DATA ........................
 
rgb:
DATA 0,0,0,0,""
'DATA 1,20,50,0,"board white"
DATA 1,30,60,20,"board white"
DATA 2,1,1,1,"board black"
DATA 3,50,50,50,"white bright"
DATA 4,12,12,30,"white hightlight"
DATA 5,0,0,0,"black bright"
'DATA 6,32,32,32,"black highlight"
DATA 6,50,12,12,"black highlight"
DATA 7,63,0,0,"red"
DATA 8,0,63,0,"green"
DATA 9,0,0,63,"blue"
DATA 10,50,50,50,"white"
DATA 11,20,20,20,""
DATA 12,20,20,20,""
DATA 13,40,10,30,""
DATA 14,25,25,25,"gray"
DATA 15,30,30,30,"printing"
 
cmenu:
DATA "1 Board white"
DATA "2 Board black"
DATA "3 W piece main"
DATA "4 W piece trim"
DATA "5 B piece main"
DATA "6 B piece trim"
 
Oops:
gronk = gronk + 1
IF gronk < 100 THEN
    RESUME
ELSE
    PRINT "Error "; DATE$; "  "; TIME$;
    END
END IF
 
SUB AddIt (Level, tm$, Score)
    IF rflag THEN mcount&(Level) = mcount&(Level) + 1
    Moves(Level) = Moves(Level) + 1 '                                count ok
    Move$(Level, Moves(Level)) = tm$ '                               save move
    Score(Level, Moves(Level)) = Score
    Index(Level, Moves(Level)) = TieTo(Level)
END SUB
 
SUB AddMove
 
    IF WorB THEN '                                                   white=1, black=0
        Move = Move + 1 '                                            number the moves
        PRINT #1, RIGHT$("  " + STR$(Move), 3);
        PRINT #1, RIGHT$(SPACE$(10) + m$, 7);
        MoveLog$(Move) = SPACE$(15)
        MID$(MoveLog$(Move), 1, 3) = Rjust$(Move, 3)
        MID$(MoveLog$(Move), 5, LEN(m$)) = m$
    ELSE
        MID$(MoveLog$(Move), 11, LEN(m$)) = m$
        PRINT #1, " "; m$
        IF (Move MOD 5) = 0 THEN PRINT #1, ""
    END IF
 
END SUB
 
SUB Center (tr, t$, highlight)
    IF t$ = "" THEN
        IF rflag THEN
            t$ = "           Quit   spacebar:move now   Noise           "
        ELSE
            t$ = "Quit Resign Back Color Invert Setup Mode Noise Graphic"
        END IF
    END IF
    z = _WIDTH \ 2 - LEN(t$) * 4 + 8
    SELECT CASE tr
        CASE IS = -1
            y = ym - 40
        CASE IS = 0
            y = ym - 18
        CASE ELSE
            y = tr / (ym / 16) * ym
    END SELECT
    LINE (0, ym)-(xm - 1, ym - 18), black&, BF
    COLOR white&
    _PRINTSTRING (z, y), t$
    IF highlight THEN
        COLOR cp&(1)
        FOR i = 1 TO LEN(t$)
            c$ = MID$(t$, i, 1)
            IF (c$ = UCASE$(c$)) AND (c$ <> ":") THEN
                _PRINTSTRING (z + (i - 1) * 8, y), c$
            END IF
        NEXT
    END IF
    COLOR white&
END SUB
 
SUB ChangeColors
    LINE (0, 500)-(xm, ym), black&, BF '                             clear lower area
    k = 1
    DO
        RESTORE cmenu
        FOR i = 1 TO 6
            READ t$
            tx = 40 + INT((i - 1) / 2) * 150
            ty = 540 + ((i - 1) MOD 2) * 16
            IF i = k THEN COLOR white& ELSE COLOR gray& '            highlight palette for change
            _PRINTSTRING (tx, ty), t$
        NEXT i
        COLOR white&
        t$ = "rgb:down   RGB:up  Esc:exit"
        tx = _WIDTH \ 2 - LEN(t$) * 4 + 8
        _PRINTSTRING (tx, _HEIGHT - 20), t$
 
        FOR i = 1 TO 3 '                                             show 3 colors lines
            x1 = xc - xq * 4: x2 = xc + xq * 4
            y1 = yc + yq * 4 + 20 + i * 8: y2 = y1 + 4
            LINE (x1, y1)-(x2, y2), black&, BF
            LINE (x1, y1)-(x2, y2), gray&, B
            IF i = 1 THEN j = myr(k): tc& = red&
            IF i = 2 THEN j = myg(k): tc& = green&
            IF i = 3 THEN j = myb(k): tc& = blue&
            j = j / 255 * xq * 8
            LINE (x1, y1)-(x1 + j, y2), tc&, BF
        NEXT i
 
        _DISPLAY
 
        DO: _LIMIT 10: i$ = INKEY$: LOOP UNTIL LEN(i$) '             wait for key
        IF i$ = Esc$ THEN EXIT DO '                                  done
        IF i$ = "" THEN i$ = " " '                                   so instr doesn't bomb
        p = INSTR("123456", i$): IF p THEN k = p '                   select palette
 
        z = 10
        SELECT CASE i$
            CASE IS = "r" '                                          red down
                myr(k) = myr(k) - z
                IF myr(k) < 0 THEN myr(k) = 0
            CASE IS = "g" '                                          green down
                myg(k) = myg(k) - z
                IF myg(k) < 0 THEN myg(k) = 0
            CASE IS = "b" '                                          blue down
                myb(k) = myb(k) - z
                IF myb(k) < 0 THEN myb(k) = 0
            CASE IS = "R" '                                          red up
                myr(k) = myr(k) + z
                IF myr(k) > 255 THEN myr(k) = 255
            CASE IS = "G" '                                          green up
                myg(k) = myg(k) + z
                IF myg(k) > 255 THEN myg(k) = 255
            CASE IS = "B" '                                          blue up
                myb(k) = myb(k) + z
                IF myb(k) > 255 THEN myb(k) = 255
        END SELECT
 
        ColorWrite
        Colorassign
        PlotScreen false
    LOOP
 
    LINE (0, 500)-(xm, ym), black&, BF
 
END SUB
 
SUB CheckBoard (Level)
    Moves(Level) = 0
    prot(Level) = 0
 
    FOR r = 1 TO 8
        FOR c = 1 TO 8
            mp = b(c, r)
            mc = -(mp > 6) - (mp = 0) * 2 '                          evaluates to 0 black 1 white 2 empty
            mp = mp + (mp > 6) * 6
            IF mc = WorB THEN
                TryMove Level, c, r, mp, mc
            END IF
        NEXT
    NEXT
 
    IF Level > 1 THEN GOTO nocastle '                                only do for current move (speed)
 
    cq = true: ck = true '                                           castling
 
    IF WorB THEN rn$ = "1" ELSE rn$ = "8"
    rn = VAL(rn$)
    tp = b(5, rn): tp = tp + (tp > 6) * 6 '                          e1 (white) or e8 (black)
    IF tp <> King THEN cq = 0: ck = 0: GOTO nocastle '               no King here
 
    t$ = "e" + rn$ '                                                 King home spot algebraic
    FOR lm = 1 TO Moves(1) '                                         can any opponent piece move there?
        IF t$ = RIGHT$(Move$(1, lm), 2) THEN cq = 0: ck = 0: GOTO nocastle ' must be in check
    NEXT lm
 
    ' WHITE                      BLACK
    ' 8 R N B Q K B N R          1 R N B K Q B N R
    ' 7 P P P P P P P P          2 P P P P P P P P
    ' 6                          3
    ' 5                          4
    ' 4                          5
    ' 3                          6
    ' 2 P P P P P P P P          7 P P P P P P P P
    ' 1 R N B Q K B N R          8 R N B K Q B N R
    '   a b c d e f g h            h g f e d c b a
 
    FOR castle = 1 TO 2 '                                            queenside, then kingside
 
        'debug$(castle) = ""
        nr = 0 '   no rook
        pr = 0 '   prior condition
        ne = 0 '   not empty
        co = 0 '   controlled space
 
        '                 bbww
        ' castle$ format "QKQK" blank if ok, X if nulled by King or Rook move
        IF MID$(castle$, WorB * 2 + castle, 1) <> " " THEN pr = castle: GOTO nocando '  prior condition
 
        IF castle = 1 THEN cn = 1 ELSE cn = 8 '                      column number
        p = b(cn, rn): p = p + (p > 6) * 6
        IF p <> Rook THEN nr = 1: GOTO nocando
 
        '                         bcd              fg
        IF castle = 1 THEN ca$ = "234" ELSE ca$ = "67" '             column number
        FOR cs = 1 TO LEN(ca$) '                                     look at spaces between king and rook
            cn = VAL(MID$(ca$, cs, 1))
            IF b(cn, rn) > 0 THEN ne = castle: GOTO nocando '        not empty
 
            IF NOT ((cs = 1) AND (castle = 1)) THEN '                queenside knight
                t$ = MID$(alpha$, cn, 1) + rn$ '                     controlled square?
                IF Level THEN lm = 0 ELSE lm = 1
                FOR i = 1 TO Moves(lm) '                             see what can move here
                    IF t$ = RIGHT$(Move$(lm, i), 2) THEN
                        'debug$(castle) = Move$(lm, i)
                        co = castle: EXIT FOR ' yes
                    END IF
                NEXT i
            END IF
        NEXT cs
        nocando:
        'debug$(castle) = debug$(castle) + STR$(nr) + STR$(pr) + STR$(ne) + STR$(co)
        IF (nr + pr + ne + co) THEN '                                non-zero means some test failed
            IF castle = 1 THEN cq = false ELSE ck = false
        END IF
    NEXT castle
 
    IF ck THEN AddIt Level, "O-O", 12
    IF cq THEN AddIt Level, "O-O-O", 13
 
    'LOCATE 34 + WorB, 45: PRINT "*"; castle$; "* ";
    'PRINT MID$("K ", ck + 2, 1);
    'PRINT MID$("Q ", cq + 2, 1); cq; ck;
 
    nocastle:
    TakeBest Level, false
END SUB
 
SUB Colorassign
    tf$ = "ccolor.dat"
    tf = FREEFILE
    IF _FILEEXISTS(tf$) THEN
        OPEN tf$ FOR INPUT AS #tf
        INPUT #tf, bri
        IF bri = 0 THEN bri = obri
        IF bri < 2 THEN bri = 2
        FOR i = 0 TO 31
            INPUT #tf, myr(i), myg(i), myb(i)
            cp&(i) = _RGB32(myr(i) * bri, myg(i) * bri, myb(i) * bri)
        NEXT
        CLOSE #tf
    ELSE
        bri = 4
        RESTORE rgb
        FOR i = 0 TO 31
            IF i < 16 THEN
                READ PalNum, myr(i), myg(i), myb(i), Desc$
            ELSE
                myr(i) = 32: myg(i) = 32: myb(i) = 32
            END IF
            cp&(i) = _RGB32(myr(i) * bri, myg(i) * bri, myb(i) * bri)
        NEXT
        ColorWrite
    END IF
    CLOSE #tf
    black& = cp&(0)
    boardwhite& = cp&(1)
    boardblack& = cp&(2)
    red& = cp&(7)
    green& = cp&(8)
    blue& = cp&(9)
    white& = _RGB32(155, 155, 155)
    gray& = _RGB32(40, 40, 40)
    COLOR gray&
    IF altblack THEN cp&(6) = _RGB32(32 * bri, 32 * bri, 32 * bri)
END SUB
 
SUB ColorWrite
    tf$ = "ccolor.dat"
    tf = FREEFILE
    OPEN tf$ FOR OUTPUT AS #tf
    PRINT #tf, bri
    FOR i = 0 TO 31
        PRINT #tf, myr(i); ","; myg(i); ","; myb(i)
    NEXT
    CLOSE #tf
END SUB
 
SUB Cursor (br, bc, fl) STATIC
    DIM garr(8000)
    IF (bc < 1) OR (br < 1) OR (bc > 8) OR (br > 8) THEN EXIT SUB
    x1 = xc + (bc - 5) * xq: x2 = x1 + xq
    y1 = yc + (4 - br) * yq: y2 = y1 + yq
    GET (x1, y1)-(x2, y2), garr()
    IF (ctime! = 0) OR (TIMER > ctime!) THEN xx = xx XOR 1: ctime! = TIMER + .25
    IF xx THEN
        IF useidiot OR (TIMER < alfred!) THEN PUT (x1 + 2, y1 + 2), abuff(), PSET ELSE PUT (x1, y1), garr(), PRESET
    END IF
    IF fl THEN _PRINTSTRING (x1 + 16, y1 + 36), "To?"
    _DISPLAY
END SUB
 
SUB DispStats
 
    IF waitflag = 0 THEN
        IF rflag = 0 THEN tc = humanc ELSE tc = 1 - humanc
        etime!(tc) = etime!(tc) + TIMER - Start2!
        etime!(2) = TIMER - Start1! + hold! '                        current move
        hold! = 0
        IF etime!(2) > etime!(tc) THEN etime!(2) = etime!(tc)
        etime!(3) = etime!(0) + etime!(1) '                          game total
        emin = etime!(2) \ 60
    END IF
    Start2! = TIMER
 
    IF (dtime! = 0) OR (TIMER > dtime!) THEN
 
        'IF rick AND (vflag = 0) THEN
        '    LOCATE 1, 4
        '    PRINT Moves(0);
        '    FOR i = 1 TO 3
        '        PRINT mcount&(i);
        '    NEXT i
        '    LOCATE 2, 4
        '    FOR i = 0 TO 3
        '        PRINT Moves(i);
        '    NEXT i
        'END IF
 
        'IF tlimit > 0 THEN t$ = LTRIM$(STR$(tlimit)) + "m" ELSE t$ = "unlimited"
        't$ = "Time: " + t$
        'LOCATE 2, 4: PRINT t$;
 
        tcount& = Moves(0) + mcount&(1) + mcount&(2) + mcount&(3)
        mps& = tcount& - ocount&
        IF mps& <= 100 THEN mps& = omps& ELSE opms& = mps&
        t$ = "   " + STR$(mps&)
        tx = _WIDTH - LEN(t$) * 8 - 10
        IF mps& THEN _PRINTSTRING (tx, 2), t$
 
        t$ = STR$(tcount&)
        tx = _WIDTH - LEN(t$) * 8 - 10
        _PRINTSTRING (tx, 16), t$
 
        ShowTime 32, etime!(0), "Black"
        ShowTime 33, etime!(1), "White"
        ShowTime 34, etime!(3), "Game"
        ShowTime 35, etime!(2), "Move"
 
        ocount& = tcount&
        dtime! = TIMER + 1
    END IF
 
    IF (showthink = 0) OR (smode < 2) THEN _DISPLAY
 
END SUB
 
DEFSNG A-Z
FUNCTION f_pl (n1, n2, n3) '                                         plasma function
    f_pl = _RGB32(n1 * 255, n2 * 255, n3 * 255)
END FUNCTION
 
DEFINT A-Z
SUB Init
    xm = 600: ym = 200
    main& = _NEWIMAGE(xm, ym, 32)
    SCREEN main&
    _DELAY .2
    _SCREENMOVE _MIDDLE
    _DELAY .2
 
    RANDOMIZE TIMER '                                                seed generator
    Colorassign '                                                    red&, green&, etc, easier to use than palette numbers
 
    alpha$ = "abcdefgh"
    castle$ = SPACE$(4) '                                            flags QKQK (B then W)
    crlf$ = Enter$ + lf$
    Enter$ = CHR$(13)
    Esc$ = CHR$(27) '                                                to quit program
    graphics = 3 '                                                   graphics for white squares (0-3)
    lcount& = 0 '                                                    line counter for debug output
    lf$ = CHR$(10) '                                                 line feed
    Move = 0
    MakeNoise = 1
    showthink = 1
    WorB = 1 '                                                       white=1, black=0
    xq = 56: yq = 56
    xc = 248: yc = 256 '                                             center of board
 
    FOR i = 1 TO 8
        alphal$(i) = MID$(alpha$, i, 1)
    NEXT i
 
    FOR i = 0 TO 3: etime!(i) = 0: NEXT '                            sides, total, current
 
    RESTORE PiecePatterns '                                          bit images
    FOR p = 1 TO 6 '                                                 RNBQKP
        n = 0
        FOR y = 0 TO 21 ' 22 rows
            READ d$
            p1 = INSTR(d$ + "X", "X") '                              find first "on" bit
            FOR t = LEN(d$) TO 1 STEP -1 '                           find last "on" bit
                IF MID$(d$, t, 1) = "X" THEN
                    p2 = t
                    EXIT FOR
                END IF
            NEXT t
            FOR x = p1 TO p2
                pixel = INSTR(".X", MID$(d$, x, 1))
                n = n + 1
                IF pixel = 2 THEN c = 3 ELSE c = 4
                x(p, n) = x + 1
                y(p, n) = y + 2
                c(p, n) = c
                IF pixel = 2 THEN c = 5 ELSE c = 6
                c(p + 6, n) = c
            NEXT x
        NEXT y
        c(p, 0) = n
        FOR scram = 1 TO 256 '                                       scramble (moves nicer)
            c1 = RND * (c(p, 0) - 1) + 1 '                           any bit
            c2 = RND * (c(p, 0) - 1) + 1 '                           any other bit
            SWAP x(p, c1), x(p, c2)
            SWAP y(p, c1), y(p, c2)
            SWAP c(p, c1), c(p, c2) '                                black
            SWAP c(p + 6, c1), c(p + 6, c2) '                        white
        NEXT scram
    NEXT p
 
    RESTORE Legal '                                                  define how piece moves
    FOR p = 1 TO 6 '                                                 RNBQKP
        READ p$ '                                                    piece, not saved
        FOR t = 0 TO 7 '                                             8 each
            READ udlr$
            du(p, t) = VAL(MID$(udlr$, 1, 1)) '                      direction up
            dd(p, t) = VAL(MID$(udlr$, 2, 1)) '                      direction down
            dl(p, t) = VAL(MID$(udlr$, 3, 1)) '                      direction left
            dr(p, t) = VAL(MID$(udlr$, 4, 1)) '                      direction right
        NEXT t
    NEXT p
 
    FOR i = 1 TO 6
        '                    RNBQKP
        value(i) = VAL(MID$("533901", i, 1)) '                       point value for capture
    NEXT i
 
    RESTORE Setup '                                                  initial board position
    FOR r = 8 TO 1 STEP -1 '                                         row
        FOR c = 1 TO 8 '                                             column
            READ b(c, r) '                                           board
            o(c, r) = b(c, r) '                                      initial setup
        NEXT c
    NEXT r
 
    gm = 0: n = 0
    IF LEN(GameFile$) > 0 THEN ReadGame
    gm = 0
 
    CLOSE
    newf:
    f = f + 1
    f$ = "ch" + RIGHT$("0000000" + LTRIM$(STR$(f)), 6) + ".alg" '    save game for analysis
    IF _FILEEXISTS(f$) THEN GOTO newf
 
    OPEN f$ FOR OUTPUT AS #1 '                                       algrebraic moves
    MasterLevel1 = VAL(COMMAND$) '                                   only 4 really tested....2 is plenty stupid, odds not tested!
    IF MasterLevel1 = 0 THEN MasterLevel1 = 4
 
    FOR i = 0 TO 3
        SELECT CASE i
            CASE IS = 0
                f$ = "alfred.jpg" '                                  Alfred E. Neuman
            CASE IS = 1
                f$ = "chess.png"
            CASE IS = 2
                f$ = "clockx.png"
            CASE IS = 3
                f$ = "clockx2.png"
        END SELECT
        IF _FILEEXISTS(f$) = 0 THEN '                                accomodate Linux, which cares about case
            f$ = UCASE$(f$) '                                        now try uppercase
            IF _FILEEXISTS(f$) = 0 THEN SYSTEM '                     so it really isn't there
        END IF
        li1:
        icon&(i) = _LOADIMAGE(f$)
        IF icon&(i) >= -1 THEN _DELAY .2: GOTO li1
    NEXT i
    _ICON icon&(1)
    _DELAY .2
 
    _SOURCE icon&(0) '                                               Alfred E. Neuman
    _DISPLAY '                                                       hide idiot
    _PUTIMAGE
    GET (0, 0)-(52, 53), abuff(0)
 
    CLS
    _DELAY .2
    Menubox
    Center 6, "White  Black  Humans  Computer", 1
    Center 0, "Quit or Esc to exit", 1
    _DISPLAY
    DO: _LIMIT 10
        i$ = INKEY$
        IF i$ = "" THEN i$ = " "
        IF (LCASE$(i$) = "q") OR (i$ = Esc$) THEN SYSTEM
        p = INSTR("bwhc", i$)
    LOOP UNTIL p
    SELECT CASE p
        CASE IS = 1 '                                                player is black
            human = 1: humanc = 0: invert = 1
        CASE IS = 2 '                                                player is white
            human = 1: humanc = 1
        CASE IS = 3 '                                                human vs. human
            human = 2
        CASE IS = 4 '                                                computer vs. computer, just watch
            human = 0: OnAuto = 1
    END SELECT
 
    'IF human <> 2 THEN
    '    tlimit = 0
    '    DO
    '        CLS
    '        Menubox
    '        Center 6, "Time limit in minutes?  (0 unlimited)", 0
    '        Center 8, STR$(tlimit), 0
    '        Center 0, "Quit or Esc to exit", 1
    '        _DISPLAY
    '        DO: _LIMIT 10
    '            i$ = INKEY$
    '        LOOP UNTIL LEN(i$)
    '        IF (LCASE$(i$) = "q") OR (i$ = Esc$) THEN SYSTEM
    '        IF i$ = CHR$(8) THEN tlimit = tlimit / 10
    '        p = INSTR("0123456789", i$): IF p THEN tlimit = tlimit * 10 + p - 1
    '    LOOP UNTIL i$ = Enter$
    'END IF
 
    'IF rick THEN smode = 2
    ScreenInit
    PlotBoard
END SUB
 
SUB HumanMove STATIC
    cursoron! = TIMER + 3
    IF cc = 0 THEN
        rr = 7
        cc = 5 + (WorB = 0)
    END IF
    FOR i = 0 TO 1
        DO: _LIMIT 30
            IF vflag THEN ShowValid cc, rr
            KeyScan 1, 0 '                                           plotscreen, no _display
            IF rr < 1 THEN rr = 1
            IF rr > 8 THEN rr = 8
            IF cc < 1 THEN cc = 1
            IF cc > 8 THEN cc = 8
            IF cursoron! > TIMER THEN Cursor 9 - rr, cc, i
            IF takebackflag OR LEN(msg$) THEN EXIT SUB
            WHILE _MOUSEINPUT
                mx = _MOUSEX
                my = _MOUSEY
                xx = (mx - xc - (4 * xq) + xq \ 2) / xq + 8
                yy = (my - yc - (4 * yq) + yq \ 2) / yq + 8
                IF (xx > 0) AND (xx < 9) AND (yy > 0) AND (yy < 9) THEN rr = yy: cc = xx
                IF _MOUSEBUTTON(1) OR _MOUSEBUTTON(2) THEN i$ = Enter$
            WEND
            IF LEN(i$) = 2 THEN
                kk = ASC(RIGHT$(i$, 1))
                cc = cc + (kk = 75) - (kk = 77) '                    left right
                rr = rr + (kk = 72) - (kk = 80) '                    up down
            END IF
        LOOP UNTIL i$ = Enter$
        IF i = 0 THEN
            fr = rr: fc = cc
            IF invert THEN fr = 9 - fr: fc = 9 - fc
        ELSE
            tr = rr: tc = cc
            IF invert THEN tr = 9 - tr: tc = 9 - tc
        END IF
    NEXT i
 
    fs$ = alphal$(fc) + LTRIM$(STR$(9 - fr))
    ts$ = alphal$(tc) + LTRIM$(STR$(9 - tr))
    m$ = fs$ + ts$
    IF m$ = "e1g1" THEN m$ = "O-O"
    IF m$ = "e1c1" THEN m$ = "O-O-O"
    IF m$ = "e8g8" THEN m$ = "O-O"
    IF m$ = "e8c8" THEN m$ = "O-O-O"
END SUB
 
SUB KeyScan (kf1, kf2) STATIC '                                      plotscreen, _display
    TempMess "", 0
    DispStats
    dot = 0
    i$ = INKEY$
    IF LEN(i$) THEN
        cursoron! = TIMER + 2
    END IF
    IF LEN(i$) = 1 THEN
        IF (LCASE$(i$) = "q") OR (i$ = Esc$) THEN abort = 9: msg$ = "Quit!"
        IF i$ = Enter$ THEN EXIT SUB
        IF i$ = " " THEN msg$ = "abort": abort = 1: EXIT SUB '       move now
        c = INSTR("123456789ABCDEF0", i$) '                          experiment with colors
        IF c > 0 THEN
            IF c = 16 THEN
                c = 2
                myr(c) = 0: myg(c) = 0: myb(c) = 0
            ELSE
                myr(c) = RND * 64: myg(c) = RND * 64: myb(c) = RND * 64
            END IF
            cp&(c) = _RGB32(myr(c) * bri, myg(c) * bri, myb(c) * bri)
            ColorWrite
            Colorassign
            PlotBoard
        END IF
        IF i$ = "a" THEN OnAuto = NOT (OnAuto) '                     not currently in use
        IF i$ = "b" THEN takebackflag = 1
        IF i$ = "c" THEN ChangeColors
        IF i$ = "g" THEN '                                           change white square graphics scheme
            graphics = (graphics + 1) MOD 4
            IF graphics = 0 THEN PlotBoard
            t$ = "Mode" + STR$(graphics + 1) + " of 4"
            TempMess t$, 2
        END IF
        IF i$ = "G" THEN pinit = pinit XOR 1 '                       adjust current white square graphics
        IF i$ = "h" THEN dot = 1: history = history XOR 1
        IF i$ = "i" THEN invert = invert XOR 1: PlotBoard '          flip board around
        IF i$ = "I" THEN
            useidiot = useidiot XOR 1
            t$ = "Idiot " + OnOff$(useidiot)
            TempMess t$, 2
        END IF
        IF i$ = "l" THEN dot = 1: showlegalf = showlegalf XOR 1
        IF i$ = "L" THEN '                                           look at log file
            CLOSE #2
            SHELL _DONTWAIT "notepad chess.txt"
            OPEN "chess.txt" FOR APPEND AS #2
        END IF
        IF i$ = "m" THEN '                                           screen mode
            smode = (smode + 1) MOD 3
            ScreenInit
        END IF
        IF i$ = "n" THEN '                                           sound effects
            MakeNoise = MakeNoise XOR 1
            t$ = "Sound " + OnOff$(MakeNoise)
            TempMess t$, 2
        END IF
        IF i$ = "p" THEN dot = 1: showprotf = showprotf XOR 1
        IF i$ = "P" THEN
            pause = pause XOR 1
            IF pause THEN
                LOCATE 2, 29: PRINT "PAUSED";
                _DISPLAY
                hold! = TIMER - etime!(2)
                SLEEP
                Start1! = TIMER
                LOCATE 2, 29: PRINT SPACE$(10);
                _DISPLAY '
            END IF
        END IF
        IF (rflag = 0) AND (i$ = "r") THEN abort = 2: msg$ = "Resign!"
        IF i$ = "s" THEN Setup '                                     setup
        IF i$ = "t" THEN dot = 1: showthink = showthink XOR 1
        IF i$ = "v" THEN '                                           show valid moves at top left
            vflag = vflag XOR 1
            LOCATE 2, 4: PRINT SPACE$(40);
            _DISPLAY
        END IF
        IF i$ = "x" AND MakeNoise THEN PlaySound "ding" '            sound test
        IF i$ = "X" THEN
            SHELL _HIDE "del ccolor.dat" '                           kill color file
            ColorWrite
            Colorassign
            PlotBoard
        END IF
        'IF i$ = "y" THEN itest '                                    see how bad icon problem is
        IF i$ = "z" THEN
            altblack = altblack XOR 1
            Colorassign
            CLS
            PlotBoard
            TempMess "Alternate black " + OnOff(altblack), 2
        END IF
        i$ = ""
    END IF
    IF LEN(i$) = 2 THEN
        k = ASC(RIGHT$(i$, 1))
        wbri = bri
        bri = bri - (k = 73) + (k = 81) '                            brightness PgUp/PgDn
        IF bri < 2 THEN bri = 2
        IF bri > 4 THEN bri = 4
        IF bri <> wbri THEN '                                        was changed
            ColorWrite
            Colorassign
            TempMess "Brightness" + STR$(bri), 1
        END IF
    END IF
 
    IF kf1 THEN PlotScreen true
    IF dot THEN DebugR = 99: TextInfo ""
    IF kf2 THEN _DISPLAY
END SUB
 
FUNCTION Make4$ (t$)
    Make4$ = LEFT$(t$ + SPACE$(4), 4)
END FUNCTION
 
SUB LogThinking () STATIC
    ts = 0: z1$ = "": z2$ = ""
    FOR t = 1 TO 3
        ti = TieTo(t)
        z1$ = z1$ + Make4$(Move$(t - 1, ti)) + " "
        z2$ = z2$ + Rjust$(Score(t - 1, ti), 3) + " "
        ts = ts + Score(t - 1, ti)
    NEXT t
    ts = ts - Score
    zz$ = z1$ + Make4$(m$) + z2$ + Rjust$(Score, 3) + " " + Rjust$(ts, 4)
    PRINT #2, zz$
    TextInfo zz$
END SUB
 
SUB Menubox
    tx = _WIDTH \ 2: ty = _HEIGHT \ 2
    xs = 200: ys = 70
    x1 = tx - xs: y1 = ty - ys
    x2 = tx + xs: y2 = ty + ys
 
    LINE (x1, y1 + 20)-(x2, y2 - 20), _RGBA(1, 1, 1, 220), BF
    FOR q = 2 TO 20 STEP 4
        LINE (x1 - q + 0, y1 + q + 0)-(x2 + q + 0, y2 - q + 0), cp&(1), B
        LINE (x1 - q + 1, y1 + q + 1)-(x2 + q + 1, y2 - q + 1), cp&(1), B
    NEXT q
END SUB
 
SUB MoveIt (m$, real)
    IF m$ = ep$ THEN '                                               epfc, epfr, eptc, eptr, eprc, eprr
        Plotpiece fc, fr, tc, tr
        b(epfc, epfr) = 0
        b(eprc, eprr) = 0
        b(eptc, eptr) = 6 + WorB * 6
        EXIT SUB
    END IF
 
    IF m$ = "res" THEN EXIT SUB '                                    resign?
    fs$ = LEFT$(m$, 2) '                                             from square
    ts$ = RIGHT$(m$, 2) '                                            to square
    tzz = 1 - (LEFT$(m$, 1) = "O") - (L1$ = "e") '                   two moves for a castle
 
    FOR pass = 1 TO tzz
 
        IF m$ = "O-O" THEN '                                         castle Kingside
            IF WorB = 1 THEN '                                       white
                IF pass = 1 THEN '                                   first move of KS castle
                    fs$ = "e1": ts$ = "g1"
                ELSE '                                               else 2nd
                    fs$ = "h1": ts$ = "f1"
                END IF
            ELSE '                                                   black castle
                IF pass = 1 THEN
                    fs$ = "e8": ts$ = "g8"
                ELSE
                    fs$ = "h8": ts$ = "f8"
                END IF
            END IF
        END IF
        IF m$ = "O-O-O" THEN '                                       castle Queenside
            IF WorB THEN '                                           white
                IF pass = 1 THEN
                    fs$ = "e1": ts$ = "c1"
                ELSE
                    fs$ = "a1": ts$ = "d1"
                END IF
            ELSE
                IF pass = 1 THEN
                    fs$ = "e8": ts$ = "c8"
                ELSE
                    fs$ = "a8": ts$ = "d8"
                END IF
            END IF
        END IF
        fc = INSTR(alpha$, LEFT$(fs$, 1)) '                          from column
        fr = VAL(RIGHT$(fs$, 1)) '                                   from row
        pm = b(fc, fr) '                                             piece to move
        p = pm + (pm > 6) * 6
        tc = INSTR(alpha$, LEFT$(ts$, 1)) '                          to column
        tr = VAL(RIGHT$(ts$, 1)) '                                   to row
        b(tc, tr) = pm '                                             move piece in array
        b(fc, fr) = 0 '                                              blank old array spot
        IF real THEN
            IF b(c, r) = o(c, r) THEN o(c, r) = -1
            Plotpiece fc, fr, tc, tr
            IF p = King THEN MID$(castle$, WorB * 2 + 1, 2) = "XX"
            IF p = Rook THEN
                IF WorB THEN
                    IF (fc = 1) AND (fr = 1) THEN MID$(castle$, 3, 1) = "X"
                    IF (fc = 1) AND (fr = 8) THEN MID$(castle$, 4, 1) = "X"
                ELSE
                    IF (fc = 8) AND (fr = 1) THEN MID$(castle$, 1, 1) = "X"
                    IF (fc = 8) AND (fr = 8) THEN MID$(castle$, 2, 1) = "X"
                END IF
            END IF
        END IF
        IF (p = Pawn) AND ((tr = 1) OR (tr = 8)) THEN
            b(tc, tr) = Queen - (pm > 6) * 6 '                       promote to queen
            IF real THEN Plotpiece tc, tr, tc, tr '                  show queen
        END IF
    NEXT pass
END SUB
 
DEFINT A-Z
FUNCTION OnOff$ (v)
    OnOff$ = MID$("OFFON ", v * 3 + 1, 3)
END FUNCTION
 
DEFSNG A-Z
SUB Plasma STATIC
    TYPE xy
        x AS SINGLE
        y AS SINGLE
        dx AS SINGLE
        dy AS SINGLE
    END TYPE
 
    IF pinit% = 0 THEN
        DIM c(360) AS _UNSIGNED LONG, p(10) AS xy, f(10)
        r = RND: g = RND: b = RND: i% = 0: q = .5
        FOR n% = 1 TO 5
            r1 = r: g1 = g: b1 = b
            DO: r = RND: LOOP UNTIL ABS(r - r1) > q
            DO: g = RND: LOOP UNTIL ABS(g - g1) > q
            DO: b = RND: LOOP UNTIL ABS(g - g1) > q
            FOR m% = 0 TO 17: m1% = 17 - m%
                f1 = (m% * r) / 18: f2 = (m% * g) / 18: f3 = (m% * b) / 18: c(i%) = f_pl(f1, f2, f3): i% = i% + 1
            NEXT
            FOR m% = 0 TO 17: m1% = 17 - m%
                f1 = (m% + m1% * r) / 18: f2 = (m% + m1% * g) / 18: f3 = (m% + m1% * b) / 18: c(i%) = f_pl(f1, f2, f3): i% = i% + 1
            NEXT
            FOR m% = 0 TO 17: m1% = 17 - m%
                f1 = (m1% + m% * r) / 18: f2 = (m1% + m% * g) / 18: f3 = (m1% + m% * b) / 18: c(i%) = f_pl(f1, f2, f3): i% = i% + 1
            NEXT
            FOR m% = 0 TO 17: m1% = 17 - m%
                f1 = (m1% * r) / 18: f2 = (m1% * g) / 18: f3 = (m1% * b) / 18: c(i%) = f_pl(f1, f2, f3): i% = i% + 1
            NEXT
        NEXT
 
        FOR n% = 0 TO 5
            p(n%).x = RND * xm%: p(n%).y = RND * ym%: p(n%).dx = RND * 2 - 1: p(n%).dy = RND * 2 - 1
            f(n%) = RND * .1
        NEXT
 
        xm2% = 8 * xq%: ym2% = xm2%: x1% = xc% - 4 * xq%: y1% = yc% - 4 * yq%: x2% = xc% + 4 * xq%: y2% = yc% + 4 * yq%:
        pinit% = 1
    END IF
 
    FOR n% = 0 TO 5
        p(n%).x = p(n%).x + p(n%).dx
        IF p(n%).x > xm2% OR p(n%).x < 0 THEN p(n%).dx = -p(n%).dx
        p(n%).y = p(n%).y + p(n%).dy
        IF p(n%).y > ym2% OR p(n%).y < 0 THEN p(n%).dy = -p(n%).dy
    NEXT
 
    IF graphics% = 2 THEN z% = 1 ELSE z% = 2
 
    FOR y% = y1% TO y2% STEP z%
        FOR x% = x1% TO x2% STEP z%
            p& = POINT(x%, y%)
            'IF (p& = boardwhite&) OR (p& = boardblack&) THEN
            IF (p& = boardwhite&) THEN
                d = 0
                FOR n% = 0 TO 5
                    dx = x% - p(n%).x: dy = y% - p(n%).y
                    k = SQR(dx * dx + dy * dy)
                    d = d + (SIN(k * f(n%)) + 1) / 2
                NEXT
                PSET (x%, y%), c(d * 60)
            END IF
        NEXT
        '_DELAY .001
    NEXT
END SUB
 
DEFINT A-Z
SUB Playagain (t$)
    Menubox
    COLOR _RGBA32(222, 222, 222, 255), _RGBA32(1, 1, 1, 0)
    Center 18, t$, 0
    IF INSTR("QR", LEFT$(t$, 1)) THEN '                              Quit or Resign
        Center 20, "Resume    New game     Quit", 1
        ks$ = "rn"
    ELSE
        Center 20, "New game     Quit", 1
        ks$ = "rn" '                                                 take out r when working properly (false checkmates)
    END IF
    _DISPLAY
    COLOR _RGBA(155, 155, 155, 255), _RGBA32(0, 0, 0, 255)
 
    DO: _LIMIT 10
        i$ = INKEY$
        IF i$ = "" THEN i$ = " "
        IF (i$ = Esc$) OR (LCASE$(i$) = "q") THEN SYSTEM
        IF human = 0 THEN i$ = "n"
    LOOP UNTIL INSTR(ks$, i$)
END SUB
 
DEFSNG A-Z
SUB PlaySound (f$) STATIC '         ding,tada,notify,windows xp hardware fail, etc\
    CONST CACHE = 441 '             minimal detected frequency for analyzer is 100 Hz, so this is enought value (with 44100 biterate)
    TYPE head
        chunk AS STRING * 4 '       4 bytes  (RIFF)
        size AS LONG '              4 bytes  (?E??)
        fomat AS STRING * 4 '       4 bytes  (WAVE)
        sub1 AS STRING * 4 '        4 bytes  (fmt )
        subchunksize AS LONG '      4 bytes  (lo / hi), $00000010 for PCM audio
        format AS STRING * 2 '      2 bytes  (0001 = standard PCM, 0101 = IBM mu-law, 0102 = IBM a-law, 0103 = IBM AVC ADPCM)
        channels AS INTEGER '       2 bytes  (1 = mono, 2 = stereo)
        rate AS LONG '              4 bytes  (sample rate, standard is 44100)
        ByteRate AS LONG '          4 bytes  (= sample rate * number of channels * (bits per channel /8))
        Block AS INTEGER '          2 bytes  (block align = number of channels * bits per sample /8)
        Bits AS INTEGER '           2 bytes  (bits per sample. 8 = 8, 16 = 16)
        subchunk2 AS STRING * 4 '   4 bytes  ("data")  contains begin audio samples
    END TYPE '                     40 bytes  total
    TYPE Wav16S
        Left AS INTEGER
        Right AS INTEGER
    END TYPE
    REDIM scache(CACHE) AS Wav16S
    DIM H AS head
    ch = FREEFILE
    f$ = f$ + ".wav"
    IF _FILEEXISTS(f$) = 0 THEN EXIT SUB
    OPEN f$ FOR BINARY AS #ch
    GET #ch, , H
    block = H.Block
    RATE = H.rate
    chan = H.channels
    bits = H.Bits
    L = _SNDOPENRAW
    R = _SNDOPENRAW
    REDIM scache(CACHE) AS Wav16S
    DO WHILE NOT EOF(ch)
        GET #ch, , scache()
        FOR P = 0 TO CACHE
            lef = scache(P).Left
            IF chan = 1 THEN righ = lef ELSE righ = scache(P).Right
            lef = lef / RATE
            righ = righ / RATE
            IF RATE > 44100 THEN frekvence = RATE ELSE frekvence = 44100
            FOR plll = 1 TO frekvence / RATE
                _SNDRAW lef, L
                _SNDRAW righ, R
            NEXT plll
        NEXT
    LOOP
    CLOSE ch
END SUB
 
DEFINT A-Z
SUB PlotBoard
    FOR zr = 1 TO 8
        FOR zc = 1 TO 8
            IF rflag = 0 THEN Plotpiece zc, zr, zc, zr
        NEXT zc
    NEXT zr
END SUB
 
SUB Plotpiece (fc, fr, tc, tr)
    x1 = xc + (fc - 5) * xq
    x2 = xc + (tc - 5) * xq
    y1 = yc + (4 - fr) * yq
    y2 = yc + (4 - tr) * yq
    p = b(tc, tr)
    IF invert THEN p = b(9 - tc, 9 - tr)
    IF p > 6 THEN wb = 1: p = p - 6
    i = p - (wb = 0) * 6
 
    FOR ps = 0 TO 1
        IF ps = 0 THEN
            c = fr + fc: tx = x1: ty = y1
        ELSE
            c = tr + tc: tx = x2: ty = y2
        END IF
        IF c MOD 2 THEN
            LINE (tx, ty)-(tx + xq, ty + yq), boardwhite&, BF
        ELSE
            LINE (tx, ty)-(tx + xq, ty + yq), boardblack&, BF '      black square
            LINE (tx, ty)-(tx + xq, ty + yq), boardwhite&, B '       border
        END IF
    NEXT ps
 
    FOR t = 1 TO c(p, 0)
        tx = x1 + x(p, t) * 2
        ty = y1 + y(p, t) * 2
        LINE (tx, ty)-STEP(1, 1), cp&(c(i, t)), B
    NEXT t
END SUB
 
SUB PlotScreen (lflag) STATIC
    PlotBoard
    TextInfo ""
    r = _RED32(boardwhite&) \ 2 '                                    legend, dim a-h, 1-8 along sides
    g = _GREEN32(boardwhite&) \ 2
    b = _BLUE32(boardwhite&) \ 2
    COLOR _RGB32(r, g, b)
    FOR i = 1 TO 8
        IF invert THEN z = i ELSE z = 9 - i
        n$ = LTRIM$(STR$(z))
        IF invert THEN z = 9 - i ELSE z = i
        a$ = alphal$(z)
        nx = xc - 4 * xq - 12
        ny = yc + (i - 4) * yq - 34
        ax = xc + (i - 5) * xq + 22
        ay = yc + 4 * yq + 3
        _PRINTSTRING (nx, ny), n$
        _PRINTSTRING (ax, ay), a$
    NEXT i
    COLOR white&
 
    IF lflag THEN Center 0, "", 1
 
    IF graphics = 0 THEN EXIT SUB
    IF graphics > 1 THEN
        Plasma
        EXIT SUB
    END IF
 
    br = 255
    zz = (zz + 1) MOD 50: IF zz = 1 THEN r! = RND: g! = RND: b! = RND
    x1 = xc - 4 * xq
    y1 = yc - 4 * yq
    x2 = x1 + 8 * xq
    y2 = y1 + 8 * yq
    FOR sy = y1 TO y2
        FOR sx = x1 TO x2
            p& = POINT(sx, sy)
            IF p& = boardwhite& THEN
                z = ABS((sx - xc - xq \ 2) * (sy - yc - yq \ 2))
                PSET (sx, sy), _RGB32(br * SIN(.1 * r! * z + zz), br * SIN(.155 * g! * z + zz), br * SIN(2 * b! * z + zz))
            END IF
    NEXT sx: NEXT sy
END SUB
 
SUB ReadGame
    DIM g$(500)
    CLS
    OPEN GameFile$ FOR INPUT AS #8
    WHILE NOT (EOF(8))
        INPUT #8, mn, m1$, m2$
        gm = gm + 1: g$(gm) = LTRIM$(m1$)
        gm = gm + 1: g$(gm) = LTRIM$(m2$)
        PRINT m1$; "*"; m2$
    WEND
    CLOSE #8
    _DISPLAY
    SLEEP
    CLS
    _DISPLAY
END SUB
 
SUB Recurse (Level)
    IF abort OR (Level = MasterLevel) THEN EXIT SUB
    FOR t = 1 TO Moves(Level - 1)
 
        IF Level = 1 THEN '                                                              progress bar
            x1 = xc - 4 * xq: x2 = xc + 4 * xq
            y1 = yc + 4 * yq + 20
            z1 = Moves(Level - 1): z2 = z1 - (z1 = 0)
            xx = (z1 - t + 1) / z2 * (x2 - x1)
            IF xx < x1 THEN xx = x1
            IF xx > x2 THEN xx = x2
            LINE (x1, y1)-(x2, y1), black&
            IF (xx - x1) > 2 THEN LINE (x1, y1)-(xx, y1), cp&(1)
 
            'x1 = 290: x2 = x1 + 50
            'y1 = 508: y2 = y1 + 64
            'LINE (x1, y1)-(x2, y2), _RGB32(222, 0, 0), B
 
        END IF
 
        WorB = SaveWorB
        IF (Level MOD 2) = 1 THEN WorB = WorB XOR 1
        TieTo(Level) = t
        IF ABS(Score(0, t)) <> 777 THEN
            _MEMCOPY m(0), m(0).OFFSET, m(0).SIZE TO m(Level), m(Level).OFFSET '         save board
            m$ = Move$(Level - 1, t)
            MoveIt m$, false
            lm1 = Level - 1
            CheckBoard Level
            Recurse Level + 1
            TakeBest Level, false
            i = Index
            Score = Score(Level, 1)
            levm1 = Level - 1
            IF Score(levm1, 1) <> 777 THEN Score(levm1, i) = Score(levm1, i) - Score
            IF Level = (MasterLevel - 1) THEN
                KeyScan 0, 0 '                                                           no plotscreen or _display
                'IF (tlimit > 0) AND (emin >= tlimit) THEN abort = true
                IF abort THEN EXIT SUB
                IF smode = 2 THEN LogThinking
            END IF
            _MEMCOPY m(Level), m(Level).OFFSET, m(Level).SIZE TO m(0), m(0).OFFSET '     restore board
        END IF
    NEXT t
END SUB
 
SUB Reset_To_Zero
    WorB = WorB XOR 1 '      reverse who's moving
    CheckBoard 1 '           need to know what opponent can do to ensre legal castling
    WorB = WorB XOR 1 '      restore playing color
    CheckBoard 0 '           determine legal moves
END SUB
 
FUNCTION Rjust$ (t, n)
    Rjust$ = RIGHT$("   " + STR$(t), n)
END FUNCTION
 
SUB SaveForTakeBack STATIC '                                         use MEM later to move arrays
    FOR i = 10 TO 1 STEP -1
        castle$(i) = castle$(i - 1)
        FOR r = 1 TO 8
            FOR c = 1 TO 8
                tb(c, r, i) = tb(c, r, i - 1)
            NEXT c
        NEXT r
    NEXT i
    castle$(0) = castle$
    FOR r = 1 TO 8
        FOR c = 1 TO 8
            tb(c, r, 0) = b(c, r)
        NEXT c
    NEXT r
    tbc = tbc + 1
    IF tbc > 10 THEN tbc = 10
 
END SUB
 
SUB ScreenInit
    xm = 480: ym = 600
    MaxRow = ym \ 16 - 2
    k = 99
    SELECT CASE smode
        CASE IS = 0
            SCREEN _NEWIMAGE(xm, ym), 32
            _SCREENMOVE _DESKTOPWIDTH \ 2 - xm \ 2, _DESKTOPHEIGHT \ 2 - ym \ 2
        CASE IS = 1
            _SCREENMOVE 780, 20
        CASE IS = 2
            SCREEN _NEWIMAGE(800, 600), 32
            _SCREENMOVE 472, 20
    END SELECT
    _ALLOWFULLSCREEN _SQUAREPIXELS , _SMOOTH
END SUB
 
SUB Setup
    t1$ = "rnbkqp:black      clear:one     spacebar:flip"
    t2$ = "RNBKQP:white      Clear:all          Esc:exit"
 
    LINE (0, 500)-(xm, ym), black&, BF
    cc = 1: rr = 8
    DO
        Center -1, t1$, 0
        Center 0, t2$, 0
        _DISPLAY
        DO: _LIMIT 20
            PlotBoard
            z = z XOR 1
            IF z THEN Cursor 9 - rr, cc, 0
            i$ = INKEY$: z = LEN(i$)
        LOOP UNTIL z
        SELECT CASE z
            CASE IS = 1
                r2 = 9 - rr
                IF i$ = Esc$ THEN EXIT DO
                IF (i$ = CHR$(9)) OR (i$ = "c") THEN b(cc, r2) = 0 ' Del or "c" to delete piece
                IF i$ = "C" THEN '                                   delete all pieces
                    FOR c = 1 TO 8: FOR r = 1 TO 8
                            b(c, r) = 0
                    NEXT: NEXT
                END IF
                p = INSTR("rnbqkpRNBQKP", i$)
                IF p THEN b(cc, r2) = p '                            set piece by letter
                IF INSTR(" t", i$) THEN '                            t or space toggle color
                    mp = b(cc, r2)
                    IF mp < 7 THEN mp = mp + 6 ELSE mp = mp - 6
                    b(cc, r2) = mp
                END IF
                IF i$ = "x" THEN
                    FOR c = 1 TO 8
                        FOR r = 1 TO 8
                            t = b(c, r)
                            IF t THEN
                                IF t < 7 THEN t = t + 6 ELSE t = t - 6
                                s9(c, r) = t
                            END IF
                        NEXT r
                    NEXT c
                    FOR c = 1 TO 8
                        FOR r = 1 TO 8
                            b(c, 9 - r) = s9(c, r)
                        NEXT r
                    NEXT c
                END IF
                IF i$ = "z" THEN
                    RESTORE test
                    FOR r = 1 TO 8
                        FOR c = 1 TO 8
                            READ b(c, r)
                    NEXT: NEXT
                END IF
            CASE IS = 2
                kk = ASC(RIGHT$(i$, 1))
                cc = cc + (kk = 75) - (kk = 77) '                    left right
                rr = rr + (kk = 72) - (kk = 80) '                    up down
                IF rr < 1 THEN rr = 1
                IF rr > 8 THEN rr = 8
                IF cc < 1 THEN cc = 1
                IF cc > 8 THEN cc = 8
        END SELECT
    LOOP
    LINE (0, 500)-(xm, ym), black&, BF
    '                        board probably changed - reinitialize legal moves
    Reset_To_Zero
END SUB
 
SUB ShowBest
    yy = 505
    ty = yy
    tx = 24
    FOR t = 1 TO 15
        IF t <= Moves(0) THEN
            t$ = Make4$(Move$(0, t)) + Rjust$(Score(0, t), 5)
            FOR i = 1 TO LEN(t$) '                                   shift "g" up 2 pixels
                c$ = MID$(t$, i, 1)
                y2 = ty + (c$ = "g") * 2
                _PRINTSTRING (tx + (i - 1) * 8, y2), c$
            NEXT
        END IF
        ty = ty + 14
        IF ty > 570 THEN ty = yy: tx = tx + 80
    NEXT t
END SUB
 
SUB ShowMe (dr, dc, t$)
    EXIT SUB
    sr = CSRLIN '                                                    save row
    sc = POS(0) '                                                    save column
    IF (dr > 0) AND (dr < MaxRow) AND (dc > 0) AND (dc < 76) THEN
        LOCATE dr, dc '                                              display row & column
        PRINT t$;
    END IF
    LOCATE sr, sc '                                                  restore to old location
END SUB
 
SUB ShowTime (trow, z!, Desc$)
    t! = z!
    SELECT CASE t!
        CASE IS > 3600
            unit$ = "h"
            t! = t! / 3600
        CASE IS > 60
            unit$ = "m"
            t! = t! / 60
        CASE ELSE
            unit$ = "s"
    END SELECT
    x1 = 414
    x2 = x1 - (LEN(Desc$) + 1) * 8
    yy = trow / (600 / 16) * 600 - 4
    t! = INT(t! * 1000) / 1000
    t$ = LTRIM$(STR$(t!))
    IF INSTR(t$, ".") = 0 THEN
        IF t! < 1 THEN t$ = "." + t$ ELSE t$ = t$ + "."
    END IF
    zz = 0
    WHILE INSTR(t$, ".") <> (LEN(t$) - 3)
        t$ = t$ + "0"
        zz = zz + 1
        IF zz > 5 THEN GOTO dammit
    WEND
    dammit:
 
    IF LEFT$(t$, 1) = "." THEN t$ = "0" + t$
    t$ = RIGHT$(SPACE$(10) + t$, 6)
    _PRINTSTRING (x1, yy), t$ + unit$
    _PRINTSTRING (x2, yy), Desc$
END SUB
 
SUB ShowValid (cc, rr) '                                             show valid moves for piece at cursor
 
    IF (cc < 0) OR (rr < 0) OR (cc > 8) OR (rr > 8) THEN EXIT SUB
    tc = cc: tr = rr
    IF invert THEN tc = 9 - tc: tr = 9 - tr
    mp = b(tc, tr): mp = mp + (mp > 6) * 6
    z$ = alphal$(tc) + LTRIM$(STR$(9 - tr))
    t$ = z$ + ":"
    FOR i = 1 TO Moves(0)
        IF z$ = LEFT$(Move$(0, i), 2) THEN t$ = t$ + " " + RIGHT$(Move$(0, i), 2)
        IF (mp = King) AND (LEFT$(Move$(0, i), 1) = "O") THEN t$ = t$ + " " + Move$(0, i)
    NEXT i
    'IF (tc = epfc) AND (tr = epfc) THEN t$ = t$ + " ep"
 
    sw = _WIDTH \ 8 - 3
    LOCATE 2, 4: PRINT SPACE$(sw);
    LOCATE 2, 4: PRINT LEFT$(t$, sw);
    IF LEN(t$) > sw THEN PRINT "..";
 
END SUB
 
SUB TakeBack '                                                       use MEM to move arrays? speed not an issue here
    IF tbc < 2 THEN EXIT SUB
    IF MakeNoise THEN PlaySound "tb" '                               so your mom knows you're cheating  :)
    castle$ = castle$(2)
    FOR r = 1 TO 8
        FOR c = 1 TO 8
            b(c, r) = tb(c, r, 2)
        NEXT c
    NEXT r
    FOR i = 0 TO 9
        castle$(i) = castle$(i + 1)
        FOR r = 1 TO 8
            FOR c = 1 TO 8
                tb(c, r, i) = tb(c, r, i + 1)
            NEXT c
        NEXT r
    NEXT i
    tbc = tbc - 1
    Reset_To_Zero
END SUB
 
SUB TakeBest (Level, final)
 
    IF final THEN '                                                  feeble attempt to vary response when scores equal
        upto = 10
        IF upto > Moves(Level) THEN upto = Moves(Level)
        FOR scram = 0 TO 199
            s1 = RND * updo + 1
            s2 = RND * upto + 1
            SWAP Score(Level, s1), Score(Level, s2)
            SWAP Move$(Level, s1), Move$(Level, s2)
            SWAP Index(Level, s1), Index(Level, s2)
        NEXT scram
    END IF
 
    passes = 0
    ReSort:
    Score = -999 '                                                   assume no moves
    DO
        Sorted = true
        FOR s = 2 TO Moves(Level)
            IF Score(Level, s - 1) < Score(Level, s) THEN
                Sorted = false
                SWAP Score(Level, s - 1), Score(Level, s)
                SWAP Move$(Level, s - 1), Move$(Level, s)
                SWAP Index(Level, s - 1), Index(Level, s)
            END IF
        NEXT s
    LOOP UNTIL Sorted
 
    m$ = Move$(Level, 1)
    Score = Score(Level, 1)
    Index = Index(Level, 1)
 
    IF final AND (Level < 2) THEN
        IF Score = -777 THEN '                                       in check, no escape
            abort = 3: msg$ = "Checkmate!"
        ELSEIF Score = -999 THEN '                                   no moves
            abort = 3: msg$ = "Stalemate!"
        END IF
 
        tm = Moves(1)
        FOR lb = 1 TO 9 '                                            stop repeats
            IF tm > 8 THEN
                IF INSTR(MoveLog$(tm - lb), m$) THEN
                    'SOUND 888, 1
                    Score(1, 1) = Score(1, 1) - 10
                    passes = passes + 1
                    IF passes < 5 THEN GOTO ReSort '                 repeat may be only move
                END IF
            END IF
        NEXT lb
    END IF
 
    IF (Level = 1) AND (Score = 777) THEN Score(0, TieTo(1)) = -777
END SUB
 
SUB TextInfo (zz$)
    IF smode <> 2 THEN EXIT SUB
 
    t$ = "History Thinking Legal Protection"
    LOCATE 3, 61
    FOR i = 1 TO LEN(t$)
        c$ = MID$(t$, i, 1)
        IF c$ = UCASE$(c$) THEN COLOR cp&(1) ELSE COLOR white&
        PRINT c$;
    NEXT
    COLOR white&
 
    'LOCATE 1, 4: PRINT showthink; history; showlegalf; showprotf;
 
    z = 0
    IF showthink THEN z = 1
    IF history THEN z = 2
    IF showlegalf THEN z = 3
    IF showprotf THEN z = 4
    IF z = 0 THEN EXIT SUB
 
    IF DebugR > MaxRow THEN
        _DISPLAY
        DebugR = 3: DebugC = 61
        FOR r = DebugR TO MaxRow
            LOCATE r, DebugC
            PRINT SPACE$(100 - DebugC);
        NEXT r
    END IF
 
    SELECT CASE z
        CASE IS = 1
            DebugR = DebugR + 1
            LOCATE DebugR, DebugC
            PRINT zz$;
            IF DebugR = MaxRow THEN DebugR = 99
        CASE IS = 2
            BeginAt = Move - 28
            IF BeginAt < 1 THEN BeginAt = 1
            tr = 4
            FOR i = BeginAt TO Move
                LOCATE tr, DebugC
                PRINT MoveLog$(i);
                tr = tr + 1
                IF tr > MaxRow THEN EXIT FOR
            NEXT i
        CASE IS = 3
            FOR i = 1 TO Moves(0)
                tr = i + 3
                IF tr > MaxRow THEN EXIT FOR
                LOCATE tr, 63
                PRINT USING "## "; i;
                PRINT Move$(0, i);
            NEXT i
            FOR i = 1 TO Moves(1)
                tr = i + 3
                IF tr > MaxRow THEN EXIT FOR
                LOCATE tr, 73
                PRINT USING "## "; i;
                PRINT Move$(1, i);
            NEXT i
        CASE IS = 4
            FOR i = 1 TO prot(0)
                tr = i + 3
                IF tr > MaxRow THEN EXIT FOR
                LOCATE tr, 63
                PRINT USING "## "; i;
                PRINT prot$(0, i);
            NEXT i
            FOR i = 1 TO prot(1)
                tr = i + 3
                IF tr > MaxRow THEN EXIT FOR
                LOCATE tr, 73
                PRINT USING "## "; i;
                PRINT prot$(1, i);
            NEXT i
    END SELECT
END SUB
 
SUB TryMove (Level, fc, fr, mp, mc) '                                from row, from column
    IF mc = 1 THEN s = -1 ELSE s = 1 '                               direction a pawn moves
    incheck = (mc = SaveWorB) AND check
 
    '                  rnbqkp
    nmoves = VAL(MID$("373772", mp, 1))
 
    FOR n = 0 TO nmoves '                                            possible 8 dirs
        du = du(mp, n): dd = dd(mp, n): dl = dl(mp, n): dr = dr(mp, n)
        IF mp <> Knight THEN du = SGN(du) * s: dd = SGN(dd) * s: dl = SGN(dl) * s: dr = SGN(dr) * s
        IF du(mp, 0) = 7 THEN TrySq = 7 ELSE TrySq = 1
        IF (mp = Pawn) AND (n = 0) THEN '                            pawn first move?
            IF (fr = 2) AND (WorB = 1) THEN TrySq = 2 '              gambit for white
            IF (fr = 7) AND (WorB = 0) THEN TrySq = 2 '              gambit for black
        END IF
        tc = fc: tr = fr '                                           row, column
        fs$ = alphal$(fc) + CHR$(48 + fr) '                          from square
        cap = false
        FOR sq = 1 TO TrySq '                                        up to 7 steps in current direction
            Score = 0 '                                              must init
            tc = tc - dl + dr '                                      column=column-left+right
            tr = tr - du + dd '                                      row=row-up+down
            IF (tr < 1) OR (tr > 8) OR (tc < 1) OR (tc > 8) THEN EXIT FOR
            ts$ = alphal$(tc) + CHR$(48 + tr) '                      to square
            IF fs$ = ts$ THEN SYSTEM
            cp = b(tc, tr) '                                         capture piece
            cc = -(cp > 6) - (cp = 0) * 2 '                          capture color
            cp = cp + (cp > 6) * 6
            IF mc = cc THEN '                                        own piece
                prot(Level) = prot(Level) + 1
                IF prot(Level) < q1 THEN prot$(Level, prot(Level)) = fs$ + ts$
                IF (mp = Pawn) AND (n = 0) THEN EXIT FOR
                IF mp = Knight THEN GOTO nsquare ELSE EXIT FOR
            ELSEIF (mc XOR 1) = cc THEN '                            capture
                IF (mp = Pawn) AND (n = 0) THEN EXIT FOR '           no diag, no cap!
                cap = true
                Score = Score + value(cp) * 10
                IF value(cp) = 0 THEN Score = 777 '                  king capture
            ELSE
                IF (mp = Pawn) AND (n > 0) THEN EXIT FOR
            END IF
 
            IF mp = King THEN
                IF Level = 0 THEN lm = 1 ELSE lm = 0 '               wonka
                'FOR i = 1 TO Moves(lm) '                            can any opponent piece move there?
                '    s$ = RIGHT$(Move$(lm, i), 2)
                'IF ts$ = s$ THEN GOTO nsquare '                     would be moving into check
                'NEXT
                FOR i = 1 TO prot(lm) '                              opponent piece protecting?
                    s$ = RIGHT$(prot$(lm, i), 2)
                    IF ts$ = s$ THEN GOTO nsquare '                  would be moving into check
                NEXT
                IF incheck THEN
                    Score = Score + 20
                ELSE
                    IF Move < 30 THEN Score = Score - 4 '            usually not good to be moving the King
                END IF
            ELSE
                dis1 = ABS(fr - okr) + ABS(fc - okc) '               get closer to king
                dis2 = ABS(tr - okr) + ABS(tc - okc)
                Score = Score + dis1 - dis2
                IF Move < 20 THEN
                    dir = SGN((fr - tr) * s)
                    IF dir = 1 THEN Score = Score + 2 '              move ahead at begin & mid game
                END IF
 
                ' priority to getting a piece off the bottom rank
                IF (fr = 1) AND (tr > 1) AND (WorB = 1) THEN Score = Score + 1
                IF (fr = 8) AND (tf < 8) AND (WorB = 0) THEN Score = Score + 1
                IF mp <> Rook THEN '                                 priority to getting a piece first moved
                    IF b(fc, fr) = o(fc, fr) THEN Score = Score + 1
                END IF
            END IF
            's1 = Score
 
            'IF (Score <> 777) AND (NOT (incheck)) THEN
 
            IF mp = Pawn THEN
                Score = Score + TrySq
                IF (tr = 1) OR (tr = 8) THEN '                       promote pawn
                    Score = Score + 99
                END IF
            END IF
            'END IF
            'IF s1 = 777 THEN Score = s1
 
            AddIt Level, fs$ + ts$, Score
 
            IF cap AND (mp = Pawn) AND (n = 0) THEN EXIT FOR
            IF cap AND (mp <> Knight) THEN EXIT FOR
            nsquare:
        NEXT sq
    NEXT n
 
    IF mp = Pawn THEN '                                              en passant
        IF WorB THEN othp = 6 ELSE othp = 12 '                       opponent pawn
        l1 = 7 + (WorB = 0) * 5 '                                    rank 7 for white, 2 for black
        l2 = 5 - (WorB = 0) '                                        rank 5 for white, 6 for black
    END IF
    IF (mp = Pawn) AND (fr = l2) AND (Level < 2) THEN
        FOR z = -1 TO 1 STEP 2 '                                     look each side
            lc = fc + z '                                            look column
            IF (lc > 0) AND (lc < 9) THEN '                          in bounds of board
                IF b(lc, fr) = othp THEN '                           it is a pawn
                    tc$ = alphal$(lc)
                    tm$ = tc$ + CHR$(48 + l1) + tc$ + CHR$(48 + l2) '  form coordinate
                    IF tm$ = lm$ THEN '                              yes, add e.p. to list of legal moves
                        epfc = fc: epfr = fr '                       en passant from row, column
                        eptc = lc: eptr = fr - s '                   en passant to row, column
                        eprc = lc: eprr = fr '                       en passant remove piece
                        ep$ = alphal$(epfc) + CHR$(48 + epfr) + alphal$(eptc) + CHR$(48 + eptr)
                        AddIt Level, ep$, 1 '                        add with score of 1
                    END IF
                END IF
            END IF
        NEXT z
    END IF
 
END SUB
 
SUB TempMess (t$, secs) STATIC
    'EXIT SUB
    zz = 100: x1 = xc - zz: x2 = xc + zz
    IF (LEN(t$) > 0) AND (t$ <> current$) THEN
        x = xc - LEN(t$) * 4
        y = 12
        LINE (x1, 0)-(x2, 28), black&, BF
        _PRINTSTRING (x, y), t$
        _DISPLAY
        current$ = t$
        mtime! = TIMER + secs
    END IF
    IF (mtime! > 0) AND (TIMER > mtime!) THEN
        LINE (x1, 0)-(x2, 28), black&, BF
        _DISPLAY
        mtime! = 0
    END IF
END SUB
 
 

Title: Re: A 90% complete chess engine
Post by: TempodiBasic on March 01, 2020, 10:17:34 am

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

Title: Re: A 90% complete chess engine
Post by: TempodiBasic on March 01, 2020, 10:43:40 am

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

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

Title: Re: A 90% complete chess engine
Post by: Richard Frost on March 01, 2020, 11:11:44 am

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

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

Title: Re: A 90% complete chess engine
Post by: Richard Frost on March 01, 2020, 11:51:03 am

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

Code: QB64: [Select]

_TITLE "Chess"
DEFINT A-Z
CONST true = -1, false = 0, Rook = 1, Knight = 2, Bishop = 3, Queen = 4, King = 5, Pawn = 6
' sort these alphabetically and document them, dummy
COMMON SHARED WorB, Move, Score, Index, opening, invert, i$, m$, lm$, msg$, abort, MaxRow, xq, yq, xc, yc, xm, ym, castle$, OtherK$
COMMON SHARED mkr, mkc, okr, okc, k$, MasterLevel, MasterLevel1, SaveWorB, GameFile$, check, incheck, debug, DebugR, DebugC, Start1!, Start2!
COMMON SHARED MaxElapse!, human, humanc, OnAuto, graphics, rflag, tlimit, boardwhite&, boardblack&, black&, red&, green&, blue&, white&, gray&
COMMON SHARED Enter$, Esc$, lf$, crlf$, debug$, pinit, takebackflag, tbc, waitflag, pause, cursoron!, quitflag, smode, vflag, MakeNoise
COMMON SHARED bri, hold!, dtime!, mtime!, altblack, epfc, epfr, eptc, eptr, eprc, eprr, best, best$, ep$, rick, lcount&, alpha$, ocount&
COMMON SHARED iflag, showthink, history, showlegalf, showprotf, bscore, maxtime&, l, p, b, q1, q2, emin, useidiot, main&, alfred!
COMMON SHARED fg0&, bg0&, bg1&, bg2&
l = 10: p = 6: b = 8: q1 = 300: q2 = 500
DIM SHARED b(b, b), t(b, b, l), o(b, b), tb(b, b, 10), castle$(l), Moves(l), Move$(l, q1), Score(l, q1), TieTo(l), Index(l, q1), prot(l), prot$(l, q1)
DIM SHARED x(p, q2), y(p, q2), c(12, q2), MoveLog$(q2), cp&(32), etime!(3), myr(32), myg(32), myb(32), icon&(10), mcount&(10), du(p, 7), dd(p, 7)
DIM SHARED dl(p, 7), dr(p, 7), value(p), alphal$(8), abuff(30000), s1(b, b), s2(b, b), s3(b, b), s4(b, b), s5(b, b), s9(b, b)
DIM SHARED m(9) AS _MEM
m(0) = _MEM(b(0, 0))
m(1) = _MEM(s1(0, 0)): m(2) = _MEM(s2(0, 0)): m(3) = _MEM(s3(0, 0)): m(4) = _MEM(s4(0, 0)): m(5) = _MEM(s5(0, 0)): m(9) = _MEM(s9(0, 0))
 
rick = _FILEEXISTS("rick.")
MasterLevel1 = VAL(COMMAND$) '                                       only 4 really tested....2 is plenty stupid, odds not tested!
IF MasterLevel1 = 0 THEN MasterLevel1 = 4
 
begin:
Init
OPEN "chess.txt" FOR OUTPUT AS #2
DO
    IF icon&(1) <> 0 THEN _ICON icon&(1) '                           chess.png
    SaveWorB = WorB
 
    mking = 5: oking = 11
    IF humanc = 0 THEN SWAP mking, oking
    FOR r = 1 TO 8
        FOR c = 1 TO 8
            IF b(c, r) = mking THEN mkr = r: mkc = c
            IF b(c, r) = oking THEN okr = r: okc = c
        NEXT c
    NEXT r
    ks$ = alphal$(mkc) + CHR$(48 + mkr)
 
    IF WorB = humanc THEN SaveForTakeBack
 
    redo:
    Reset_To_Zero
    IF Moves(0) = 0 THEN msg$ = "Stalemate": GOTO yoyo
    Start1! = TIMER: Start2! = Start1!
    DebugR = 99
 
    IF human AND (humanc = WorB) OR (human = 2) THEN '               2 is two humans
        IF (iflag = 0) AND (human = 2) THEN invert = -(WorB = 0)
        DO
            pinit = 0 '                                              nudge for the graphics, vary it a little
            _MOUSESHOW
            HumanMove '                                              get a move
            _MOUSEHIDE
            IF LEN(msg$) THEN GOTO yoyo
            IF takebackflag THEN
                TakeBack '                                           restores board & castling status
                PlotBoard
                takebackflag = 0
                GOTO redo
            END IF
            sm$ = m$
            _MEMCOPY m(0), m(0).OFFSET, m(0).SIZE TO m(9), m(9).OFFSET '         save board
            MoveIt m$, false
            WorB = WorB XOR 1
            CheckBoard 1
            WorB = WorB XOR 1
            m$ = sm$
            _MEMCOPY m(9), m(9).OFFSET, m(9).SIZE TO m(0), m(0).OFFSET '     restore board
            IF Score <> 777 THEN
                FOR i = 1 TO Moves(0) '                              check against legal list
                    IF m$ = Move$(0, i) THEN EXIT DO '               move found, skip more checking
                NEXT i
            END IF
            alfred! = TIMER + 5: IF alfred! > maxtime& THEN alfred! = 0
            IF MakeNoise THEN PlaySound "bad"
        LOOP
    ELSE
        abort = false
        DebugR = 99
        rflag = true '                                               flag in recursion to stop displaying board
        bscore = -9999
        Center 0, "", true
        MasterLevel = 2 '                                            fast check in case slow aborted
        Recurse 1 '                                                  try all moves & responses
        TakeBest 0, true '
        ShowBest
        IF (Score < -700) OR (Score > 500) THEN
            rflag = 0
            IF Moves(0) THEN msg$ = "Checkmate!" ELSE msg$ = "Stalemate!"
            msg$ = msg$ + STR$(Score)
            GOTO yoyo
        END IF
        MasterLevel = MasterLevel1 '                                 slow check
        FOR i = 1 TO MasterLevel: Moves(i) = 0: NEXT
        Recurse 1 '                                                  try all moves & responses
        IF MakeNoise THEN PlaySound "ding"
        TakeBest 0, true '
        ShowBest
        rflag = false
        Center 0, "", true
        IF abort THEN _MEMCOPY m(1), m(1).OFFSET, m(1).SIZE TO m(0), m(0).OFFSET '         restore board
        IF msg$ = "abort" THEN msg$ = ""
        IF LEN(msg$) THEN WorBs = WorB + 1: GOTO yoyo
    END IF
 
    IF LEN(msg$) THEN GOTO yoyo
 
    WorB = SaveWorB
 
    sm$ = m$: m2$ = m$ '                                             save move for display in case modified for castling
    IF m$ = "O-O" THEN '                                             castle kingside
        IF WorB THEN
            m$ = "e1g1": m2$ = "h1f1"
        ELSE
            m$ = "e8g8": m2$ = "h8f8"
        END IF
    END IF
    IF m$ = "O-O-O" THEN '                                           castle queenside
        IF WorB THEN
            m$ = "e1c1": m2$ = "a1c1"
        ELSE
            m$ = "e8c8": m2$ = "a8d8"
        END IF
    END IF
 
    IF human <> 1 THEN GOTO doit '                                   people playing, or computer playing itself
 
    waitflag = 1
    IF icon&(2) THEN _ICON icon&(2) '                                clockx or clockx2
 
    FlashMove true
 
    waitflag = 0
 
    doit:
    m$ = sm$
    lm$ = m$
    MoveIt m$, true
    AddMove
    PlotScreen true
    _DISPLAY
 
    check = false
    CheckBoard 0
    IF Score = 777 THEN check = true: TempMess "Check!", 2
 
    'check = 0: incheck = 0
 
    'check = false: z = Level XOR 1
    'k1$ = MID$(alpha$, mkc, 1) + CHR$(48 + mkr) '                   location of King
    'k2$ = MID$(alpha$, okc, 1) + CHR$(48 + okr) '                   location of King
    'ic = 0
    'FOR i = 1 TO Moves(0) '                                         can any opponent piece move there?
    '    s$ = RIGHT$(Move$(z, 0), 2)
    '    IF k1$ = s$ THEN ic = 1 '                                   in check
    '    IF k2$ = s$ THEN ic = 2 '                                   in check
    'NEXT i
    'IF ic THEN
    '    check = true
    '    ic$ = CHR$(48 + ic) + " Check!"
    '    TempMess ic$
    'END IF
 
    WorB = SaveWorB XOR 1 '                                          toggle white/black
LOOP UNTIL Move = 500
 
IF Move = 500 THEN msg$ = "Over 500 moves...."
PRINT #1, ""
PRINT #1, msg$
 
yoyo:
Playagain msg$
msg$ = ""
CLS 0, bg0&
IF i$ = "n" THEN GOTO begin '                                        n for new game
IF WorBs THEN
    WorB = WorBs - 1: WorBs = 0
    WorB = WorB XOR 1
END IF
PlotScreen true
GOTO redo
 
o1:
DATA e2e4,e7e5,g1f3,b8c6,f1b5,a7a6,b5a4,b7b5,a4b3,g8f6,b1c3,f8e7,f3g5,h7h6
'DATA g5f7,O-O
'DATA f7d8,g8h7
DATA end
 
Setup:
DATA 1,2,3,4,5,3,2,1
DATA 6,6,6,6,6,6,6,6
DATA 0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0
DATA 12,12,12,12,12,12,12,12
DATA 7,8,9,10,11,9,8,7
 
test:
DATA 0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0
DATA 0,11,0,0,0,0,0,0
DATA 0,7,0,12,0,0,0,0
DATA 0,0,0,0,0,0,0,0
DATA 9,0,0,0,6,0,0,0
DATA 5,9,0,0,0,0,0,0
 
Legal:
'      udlr,udlr,udlr,udlr,udlr,udlr,udlr,udlr
DATA R,7000,0700,0070,0007,0000,0000,0000,0000
DATA N,2010,2001,0210,0201,1020,1002,0120,0102
DATA B,7070,7007,0770,0707,0000,0000,0000,0000
DATA Q,7000,0700,0070,0007,7070,7007,0770,0707
DATA K,1000,0100,0010,0001,1010,1001,0110,0101
DATA P,1000,1001,1010,0000,0000,0000,0000,0000
 
hg:
'                   1         2         3         4         5
'          12345678901234567890123456789012345678901234567890
DATA "01","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "02","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "03","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "04","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "05","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "06","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "07","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "08","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "09","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "10","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "11","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "12","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "13","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "14","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "15","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "16","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "17","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "18","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "19","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "20","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "21","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "22","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "23","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "24","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "25","               XXXXXXXXXXXXXXXXXXXX               "
DATA "26","                XXXXXXXXXXXXXXXXXX                "
DATA "27","                 XXXXXXXXXXXXXXXX                 "
DATA "28","                  XXXXXXXXXXXXXX                  "
DATA "29","                   XXXXXXXXXXXX                   "
DATA "30","                    XXXXXXXXXX                    "
DATA "31","                     XXXXXXXX                     "
DATA "32","                      XXXXXX                      "
 
DATA "33","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "34","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "35","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "36","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "37","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "38","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "39","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "40","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "41","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "42","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "43","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "44","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "45","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "46","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "47","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "48","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "49","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "50","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "51","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "52","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "53","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "54","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "55","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "56","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "57","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "58","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "59","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "51","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "60","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "61","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "62","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "63","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
DATA "64","XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
 
PiecePatterns:
DATA ........................
DATA ........................
DATA ........................
DATA ........................
DATA ....X..XX..XX..XX..X....
DATA ....X..XX..XX..XX..X....
DATA ....X..XX..XX..XX..X....
DATA ....X..XX..XX..XX..X....
DATA ....X..XX..XX..XX..X....
DATA .....X.XX..XX..XX.X.....
DATA ......XXXXXXXXXXXX......
DATA .....XX..........XX.....
DATA ......X.XXXXXXXX.X......
DATA ......X.XXXXXXXX.X......
DATA ......X.XXXXXXXX.X......
DATA ......X.XXXXXXXX.X......
DATA .....X............X.....
DATA .....X..XXXXXXXX..X.....
DATA ....X..............X....
DATA ...X..XXXXXXXXXXXX..X...
DATA ...X................X...
DATA ...XXXXXXXXXXXXXXXXXX...
 
DATA ........................
DATA ........................
DATA ........................
DATA ........................
DATA ............XXX.........
DATA ..........XX.X.X........
DATA .........X..X.X.XX......
DATA ........X.X.XX.X..X.....
DATA .......X.XXXX.X.X..X....
DATA .......X.X...XXX.X..X...
DATA .....X..XX..X.XXX.X.X...
DATA ....X.XXXXXXX.XXX.X..X..
DATA ...X.XXXXXX.X..XX.X..X..
DATA ...X.XX..XXX.X.XX.X..X..
DATA ....X..XXXX..X.XX.X..X..
DATA .....XX..X..X.XXX.X..X..
DATA ........X..XX.XX.XX.X...
DATA .......X..XX.XX.XX.X....
DATA ......XXXXXXXXXXXXXX....
DATA .....X..............X...
DATA ....X................X..
DATA .....XXXXXXXXXXXXXXXX...
 
DATA ........................
DATA ........................
DATA ........................
DATA ............X...........
DATA ...........X.X..........
DATA ..........X.X.X.........
DATA ........X...XX..X.......
DATA .......X..X..XX..X......
DATA .......X.XXX..XX.X......
DATA .......X.XXXX..X.X......
DATA ........X.......X.......
DATA .......XX.X.X.X.XX......
DATA ......X...........X.....
DATA .......X.XXX.XX.XX......
DATA ........X.XX.XX.X.......
DATA .......X.XXX.XXX.X......
DATA .......X.XXX.XXX.X......
DATA ......X.X.......X.X.....
DATA .....X.XXXXX.XXXXX.X....
DATA .....X.XXXXX.XXXXX.X....
DATA .....X.............X....
DATA ......XXXXXXXXXXXXX.....
 
DATA ............X...........
DATA ...........X.X..........
DATA .....X....X.X.X....X....
DATA ....X.X.XX.XXX..X.X.X...
DATA ...X.X.X..XX.XXX.X.X.X..
DATA ...X.XX.XXX.X.XXX.XX.X..
DATA ...X.XXX.X.XXX.X.XXX.X..
DATA ...X.XXXX.XXXXX.XXXX.X..
DATA ....X.XXXXXX..XXXXX.X...
DATA .....X.XXXXX..XXXX.X....
DATA .....X.............X....
DATA ......XXXXXXXXXXXXX.....
DATA ....X...............X...
DATA ......XX.XXXXXXX.XX.....
DATA .......X.X.XXX.X.X......
DATA ......X.XX.XXX.XX.X.....
DATA ......X.XX.XXX.XX.X.....
DATA .....XXXXXXXXXXXXXXX....
DATA ....X...............X...
DATA ...X..XX.XX.XX.XX.X..X..
DATA ...X.................X..
DATA ....XXXXXXXXXXXXXXXXX...
 
DATA ...........XX...........
DATA .........XX..XX.........
DATA .......XX.X..X.XX.......
DATA .....XX.X......X.XX.....
DATA ....X..XX.X..X.XX..X....
DATA ...X...XXXX..XXXX...X...
DATA ..X...XX........XX...X..
DATA .X..XXX.XXX..XXX.XXX..X.
DATA X..XXX..XXX..XXX..XXX..X
DATA X.XXXX..XXX..XXXX.XXXX.X
DATA X.XXXX.XXXX..XXXX.XXXX.X
DATA X.XXXX..XXXXXXXX..XXXX.X
DATA .X.XXXX..XXXXXX..XXXX.X.
DATA .X..XXXX..XXXX..XXXX..X.
DATA ..X..XXXX......XXXX..X..
DATA ...X....X......X....X...
DATA ...XXXXXXXXXXXXXXXXXX...
DATA ..X..................X..
DATA .X..XXXXXXXXXXXXXXXX..X.
DATA .X..XXXXXXXXXXXXXXXX..X.
DATA ..X..................X..
DATA ...XXXXXXXXXXXXXXXXXX...
 
DATA ........................
DATA ........................
DATA ........................
DATA ..........XXXX..........
DATA .........X....X.........
DATA ........X.XXXX.X........
DATA ........X.XXXX.X........
DATA .........X....X.........
DATA ........XXXXXXXX........
DATA .......X........X.......
DATA ........XXXXXXXX........
DATA .........X.XX.X.........
DATA .........X.XX.X.........
DATA .........X.XX.X.........
DATA ........X..XX..X........
DATA .......X..XXXX..X.......
DATA ......X.XXXXXXXX.X......
DATA ......X.XXXXXXXX.X......
DATA .....X............X.....
DATA ......XXXXXXXXXXXX......
DATA ........................
DATA ........................
 
rgb:
DATA 0,0,0,0,""
'DATA 1,20,50,0,"board white"
DATA 1,30,60,20,"board white"
DATA 2,1,1,1,"board black"
DATA 3,50,50,50,"white bright"
DATA 4,12,12,30,"white hightlight"
DATA 5,0,0,0,"black bright"
'DATA 6,32,32,32,"black highlight"
DATA 6,50,12,12,"black highlight"
DATA 7,63,0,0,"red"
DATA 8,0,63,0,"green"
DATA 9,0,0,63,"blue"
DATA 10,50,50,50,"white"
DATA 11,20,20,20,""
DATA 12,20,20,20,""
DATA 13,40,10,30,""
DATA 14,25,25,25,"gray"
DATA 15,30,30,30,"printing"
 
cmenu:
DATA "1 Board white"
DATA "2 Board black"
DATA "3 W piece main"
DATA "4 W piece trim"
DATA "5 B piece main"
DATA "6 B piece trim"
 
Oops:
gronk = gronk + 1
IF gronk < 100 THEN
    RESUME
ELSE
    PRINT "Error "; DATE$; "  "; TIME$;
    END
END IF
 
SUB AddIt (Level, tm$, Score)
    IF rflag THEN mcount&(Level) = mcount&(Level) + 1
    Moves(Level) = Moves(Level) + 1 '                                count ok
    Move$(Level, Moves(Level)) = tm$ '                               save move
    Score(Level, Moves(Level)) = Score
    Index(Level, Moves(Level)) = TieTo(Level)
END SUB
 
SUB AddMove
 
    IF WorB THEN '                                                   white=1, black=0
        Move = Move + 1 '                                            number the moves
        PRINT #1, RIGHT$("  " + STR$(Move), 3);
        PRINT #1, RIGHT$(SPACE$(10) + m$, 7);
        MoveLog$(Move) = SPACE$(15)
        MID$(MoveLog$(Move), 1, 3) = Rjust$(Move, 3)
        MID$(MoveLog$(Move), 5, LEN(m$)) = m$
    ELSE
        MID$(MoveLog$(Move), 11, LEN(m$)) = m$
        PRINT #1, " "; m$
        IF (Move MOD 5) = 0 THEN PRINT #1, ""
    END IF
 
END SUB
 
SUB Center (tr, t$, highlight)
    IF t$ = "" THEN
        IF rflag THEN
            t$ = "           Quit   spacebar:move now   Noise           "
        ELSE
            t$ = "Quit Resign Back Color Invert Setup Mode Noise Graphic"
        END IF
    END IF
    z = _WIDTH \ 2 - LEN(t$) * 4 + 8
    SELECT CASE tr
        CASE IS = -1
            y = ym - 40
        CASE IS = 0
            y = ym - 18
        CASE ELSE
            y = tr / (ym / 16) * ym
    END SELECT
    LINE (0, ym)-(xm - 1, ym - 18), bg0&, BF
    'COLOR white&
    _PRINTSTRING (z, y), t$
    IF highlight THEN
        tr = _RED32(cp&(1))
        tg = _GREEN32(cp&(1))
        tb = _BLUE32(cp&(1))
        COLOR _RGB32(255 - tr, 255 - tg, 255 - tb)
        FOR i = 1 TO LEN(t$)
            c$ = MID$(t$, i, 1)
            IF (c$ = UCASE$(c$)) AND (c$ <> ":") THEN
                _PRINTSTRING (z + (i - 1) * 8, y), c$
            END IF
        NEXT
    END IF
    COLOR fg0&, bg0&
END SUB
 
SUB ChangeColors
    LINE (0, 500)-(xm, ym), bg0&, BF '                               clear lower area
    k = 1
    DO
        RESTORE cmenu
        FOR i = 1 TO 6
            READ t$
            tx = 40 + INT((i - 1) / 2) * 150
            ty = 540 + ((i - 1) MOD 2) * 16
            IF i = k THEN COLOR white& ELSE COLOR gray& '            highlight palette for change
            _PRINTSTRING (tx, ty), t$
        NEXT i
        COLOR fg0&, bg0&
        t$ = "rgb:down   RGB:up  Esc:exit"
        tx = _WIDTH \ 2 - LEN(t$) * 4 + 8
        _PRINTSTRING (tx, _HEIGHT - 20), t$
 
        FOR i = 1 TO 3 '                                             show 3 colors lines
            x1 = xc - xq * 4: x2 = xc + xq * 4
            y1 = yc + yq * 4 + 20 + i * 8: y2 = y1 + 4
            LINE (x1, y1)-(x2, y2), black&, BF
            LINE (x1, y1)-(x2, y2), gray&, B
            IF i = 1 THEN j = myr(k): tc& = red&
            IF i = 2 THEN j = myg(k): tc& = green&
            IF i = 3 THEN j = myb(k): tc& = blue&
            j = j / 255 * xq * 8
            LINE (x1, y1)-(x1 + j, y2), tc&, BF
        NEXT i
 
        _DISPLAY
 
        DO: _LIMIT 10: i$ = INKEY$: LOOP UNTIL LEN(i$) '             wait for key
        IF i$ = Esc$ THEN EXIT DO '                                  done
        IF i$ = "" THEN i$ = " " '                                   so instr doesn't bomb
        p = INSTR("123456", i$): IF p THEN k = p '                   select palette
 
        z = 10
        SELECT CASE i$
            CASE IS = "r" '                                          red down
                myr(k) = myr(k) - z
                IF myr(k) < 0 THEN myr(k) = 0
            CASE IS = "g" '                                          green down
                myg(k) = myg(k) - z
                IF myg(k) < 0 THEN myg(k) = 0
            CASE IS = "b" '                                          blue down
                myb(k) = myb(k) - z
                IF myb(k) < 0 THEN myb(k) = 0
            CASE IS = "R" '                                          red up
                myr(k) = myr(k) + z
                IF myr(k) > 255 THEN myr(k) = 255
            CASE IS = "G" '                                          green up
                myg(k) = myg(k) + z
                IF myg(k) > 255 THEN myg(k) = 255
            CASE IS = "B" '                                          blue up
                myb(k) = myb(k) + z
                IF myb(k) > 255 THEN myb(k) = 255
        END SELECT
 
        ColorWrite
        Colorassign
        PlotScreen false
    LOOP
 
    LINE (0, 500)-(xm, ym), black&, BF
 
END SUB
 
SUB CheckBoard (Level)
    Moves(Level) = 0
    prot(Level) = 0
 
    FOR r = 1 TO 8
        FOR c = 1 TO 8
            mp = b(c, r)
            mc = -(mp > 6) - (mp = 0) * 2 '                          evaluates to 0 black 1 white 2 empty
            mp = mp + (mp > 6) * 6
            IF mc = WorB THEN
                TryMove Level, c, r, mp, mc
            END IF
        NEXT
    NEXT
 
    IF Level > 1 THEN GOTO nocastle '                                only do for current move (speed)
 
    cq = true: ck = true '                                           castling
 
    IF WorB THEN rn$ = "1" ELSE rn$ = "8"
    rn = VAL(rn$)
    tp = b(5, rn): tp = tp + (tp > 6) * 6 '                          e1 (white) or e8 (black)
    IF tp <> King THEN cq = 0: ck = 0: GOTO nocastle '               no King here
 
    t$ = "e" + rn$ '                                                 King home spot algebraic
    FOR lm = 1 TO Moves(1) '                                         can any opponent piece move there?
        IF t$ = RIGHT$(Move$(1, lm), 2) THEN cq = 0: ck = 0: GOTO nocastle ' must be in check
    NEXT lm
 
    ' WHITE                      BLACK
    ' 8 R N B Q K B N R          1 R N B K Q B N R
    ' 7 P P P P P P P P          2 P P P P P P P P
    ' 6                          3
    ' 5                          4
    ' 4                          5
    ' 3                          6
    ' 2 P P P P P P P P          7 P P P P P P P P
    ' 1 R N B Q K B N R          8 R N B K Q B N R
    '   a b c d e f g h            h g f e d c b a
 
    FOR castle = 1 TO 2 '                                            queenside, then kingside
 
        'debug$(castle) = ""
        nr = 0 '   no rook
        pr = 0 '   prior condition
        ne = 0 '   not empty
        co = 0 '   controlled space
 
        '                 bbww
        ' castle$ format "QKQK" blank if ok, X if nulled by King or Rook move
        IF MID$(castle$, WorB * 2 + castle, 1) <> " " THEN pr = castle: GOTO nocando '  prior condition
 
        IF castle = 1 THEN cn = 1 ELSE cn = 8 '                      column number
        p = b(cn, rn): p = p + (p > 6) * 6
        IF p <> Rook THEN nr = 1: GOTO nocando
 
        '                         bcd              fg
        IF castle = 1 THEN ca$ = "234" ELSE ca$ = "67" '             column number
        FOR cs = 1 TO LEN(ca$) '                                     look at spaces between king and rook
            cn = VAL(MID$(ca$, cs, 1))
            IF b(cn, rn) > 0 THEN ne = castle: GOTO nocando '        not empty
 
            IF NOT ((cs = 1) AND (castle = 1)) THEN '                queenside knight
                t$ = MID$(alpha$, cn, 1) + rn$ '                     controlled square?
                IF Level THEN lm = 0 ELSE lm = 1
                FOR i = 1 TO Moves(lm) '                             see what can move here
                    IF t$ = RIGHT$(Move$(lm, i), 2) THEN
                        'debug$(castle) = Move$(lm, i)
                        co = castle: EXIT FOR ' yes
                    END IF
                NEXT i
            END IF
        NEXT cs
        nocando:
        'debug$(castle) = debug$(castle) + STR$(nr) + STR$(pr) + STR$(ne) + STR$(co)
        IF (nr + pr + ne + co) THEN '                                non-zero means some test failed
            IF castle = 1 THEN cq = false ELSE ck = false
        END IF
    NEXT castle
 
    IF ck THEN AddIt Level, "O-O", 12
    IF cq THEN AddIt Level, "O-O-O", 13
 
    'LOCATE 34 + WorB, 45: PRINT "*"; castle$; "* ";
    'PRINT MID$("K ", ck + 2, 1);
    'PRINT MID$("Q ", cq + 2, 1); cq; ck;
 
    nocastle:
    TakeBest Level, false
END SUB
 
SUB Colorassign
    tf$ = "ccolor.dat"
    tf = FREEFILE
    IF _FILEEXISTS(tf$) THEN
        OPEN tf$ FOR INPUT AS #tf
        INPUT #tf, bri
        IF bri = 0 THEN bri = obri
        IF bri < 2 THEN bri = 2
        FOR i = 0 TO 31
            INPUT #tf, myr(i), myg(i), myb(i)
            cp&(i) = _RGB32(myr(i) * bri, myg(i) * bri, myb(i) * bri)
        NEXT
        CLOSE #tf
    ELSE
        bri = 4
        RESTORE rgb
        FOR i = 0 TO 31
            IF i < 16 THEN
                READ PalNum, myr(i), myg(i), myb(i), Desc$
            ELSE
                myr(i) = 32: myg(i) = 32: myb(i) = 32
            END IF
            cp&(i) = _RGB32(myr(i) * bri, myg(i) * bri, myb(i) * bri)
        NEXT
        ColorWrite
    END IF
    CLOSE #tf
    black& = cp&(0)
    boardwhite& = cp&(1)
    boardblack& = cp&(2)
    red& = cp&(7)
    green& = cp&(8)
    blue& = cp&(9)
    white& = _RGB32(155, 155, 155)
    gray& = _RGB32(40, 40, 40)
    IF altblack THEN cp&(6) = _RGB32(32 * bri, 32 * bri, 32 * bri)
END SUB
 
SUB ColorWrite
    tf$ = "ccolor.dat"
    tf = FREEFILE
    OPEN tf$ FOR OUTPUT AS #tf
    PRINT #tf, bri
    FOR i = 0 TO 31
        PRINT #tf, myr(i); ","; myg(i); ","; myb(i)
    NEXT
    CLOSE #tf
END SUB
 
SUB Cursor (br, bc, fl) STATIC
    DIM garr(8000)
    IF (bc < 1) OR (br < 1) OR (bc > 8) OR (br > 8) THEN EXIT SUB
    x1 = xc + (bc - 5) * xq: x2 = x1 + xq
    y1 = yc + (4 - br) * yq: y2 = y1 + yq
    GET (x1, y1)-(x2, y2), garr()
    IF (ctime! = 0) OR (TIMER > ctime!) THEN
        xx = xx XOR 1
        ctime! = TIMER + .25
        IF ctime! > maxtime& THEN ctime! = 0
    END IF
    IF xx THEN
        IF (useidiot AND (icon&(0) <> 0)) OR (TIMER < alfred!) THEN PUT (x1 + 2, y1 + 2), abuff(), PSET ELSE PUT (x1, y1), garr(), PRESET
    END IF
    IF fl THEN _PRINTSTRING (x1 + 16, y1 + 36), "To?"
    _DISPLAY
END SUB
 
DEFINT A-Z
SUB DispStats
 
    IF waitflag = 0 THEN
        IF rflag = 0 THEN tc = humanc ELSE tc = 1 - humanc
        IF human = 2 THEN tc = WorB
        t! = TIMER - Start2!: IF t! < 0 THEN t! = t! + maxtime&
        etime!(tc) = etime!(tc) + t!
        etime!(2) = TIMER - Start1! + hold! '                        current move
        hold! = 0
        IF etime!(2) > etime!(tc) THEN etime!(2) = etime!(tc)
        etime!(3) = etime!(0) + etime!(1) '                          game total
        emin = etime!(2) \ 60
    END IF
    Start2! = TIMER
 
    IF (dtime! = 0) OR (TIMER > dtime!) THEN
 
        'IF rick AND (vflag = 0) THEN
        '    LOCATE 1, 4
        '    PRINT Moves(0);
        '    FOR i = 1 TO 3
        '        PRINT mcount&(i);
        '    NEXT i
        '    LOCATE 2, 4
        '    FOR i = 0 TO 3
        '        PRINT Moves(i);
        '    NEXT i
        'END IF
 
        'IF tlimit > 0 THEN t$ = LTRIM$(STR$(tlimit)) + "m" ELSE t$ = "unlimited"
        't$ = "Time: " + t$
        'LOCATE 2, 4: PRINT t$;
 
        IF human <> 2 THEN
            IF rick THEN LOCATE 1, 4: PRINT best$; bscore; "        ";
            tcount& = Moves(0) + mcount&(1) + mcount&(2) + mcount&(3)
            mps& = tcount& - ocount&
            IF mps& <= 100 THEN mps& = omps& ELSE opms& = mps&
            t$ = "   " + STR$(mps&)
            tx = _WIDTH - LEN(t$) * 8 - 10
            IF mps& THEN _PRINTSTRING (tx, 2), t$
 
            t$ = STR$(tcount&)
            tx = _WIDTH - LEN(t$) * 8 - 10
            _PRINTSTRING (tx, 16), t$
 
            'bg2& = _RGB32(0, 70, 70)
            'LINE (351, 504)-(xm - 8, ym - 22), bg2&, BF
            COLOR fg0&, bg0&
            ShowTime 32, etime!(0), "Black"
            ShowTime 33, etime!(1), "White"
            ShowTime 34, etime!(3), "Game"
            ShowTime 35, etime!(2), "Move"
            'COLOR white&, black&
        END IF
 
        ocount& = tcount&
        dtime! = TIMER + 1: IF dtime! > maxtime& THEN dtime! = 0
    END IF
 
    IF (showthink = 0) OR (smode < 2) THEN _DISPLAY
 
END SUB
 
DEFSNG A-Z
FUNCTION f_pl (n1, n2, n3) '                                         plasma function
    f_pl = _RGB32(n1 * 255, n2 * 255, n3 * 255)
END FUNCTION
 
DEFINT A-Z
SUB FlashMove (eflag)
    fr = VAL(MID$(m$, 2, 1)) '                                       from row (or rank)
    IF invert THEN fr = 9 - fr '                                     invert means black at bottom
    fc = INSTR(alpha$, LEFT$(m$, 1)) '                               from column
 
    IF invert THEN fc = 9 - fc
 
    tr = VAL(MID$(m$, 4, 1)) '                                       row or rank
    IF invert THEN tr = 9 - tr '                                     black at bottom
    tc = INSTR(alpha$, MID$(m$, 3, 1)) '                             column
    IF invert THEN tc = 9 - tc
 
    DO: _LIMIT 100
        'IF (itime! = 0) OR (TIMER > itime!) THEN
        '    iname = iname XOR 1
        '    _ICON icon&(iname + 2) '                                clockx or clockx2
        '    itime! = TIMER + .5
        'END IF
        KeyScan 1, 1 '                                               plotscreen, _display
        Cursor fr, fc, 0
        Cursor tr, tc, 0
        IF eflag AND (WorB = humanc) THEN EXIT DO
    LOOP UNTIL (i$ = Enter$) OR (human = 0) OR LEN(msg$)
END SUB
 
SUB Init
    xm = 600: ym = 200
    main& = _NEWIMAGE(xm, ym, 32)
    SCREEN main&
    _DELAY .2
    _SCREENMOVE _MIDDLE
    _DELAY .2
 
    RANDOMIZE TIMER '                                                seed generator
    Colorassign '                                                    red&, green&, etc, easier to use than palette numbers
 
    alpha$ = "abcdefgh"
 
    q = 120
    bg0& = _RGB32(q, q, q)
    fg0& = black&
    SWAP bg0&, fg0&
    castle$ = SPACE$(4) '                                            flags QKQK (B then W)
    crlf$ = Enter$ + lf$
    Enter$ = CHR$(13)
    Esc$ = CHR$(27) '                                                to quit program
    graphics = 3 '                                                   graphics for white squares (0-3)
    lcount& = 0 '                                                    line counter for debug output
    lf$ = CHR$(10) '                                                 line feed
    maxtime& = 86400
    Move = 0
    MakeNoise = 1
    showthink = 1
    WorB = 1 '                                                       white=1, black=0
    xq = 56: yq = 56
    xc = 248: yc = 256 '                                             center of board
 
    COLOR fg0&, bg0&
    FOR i = 1 TO 8
        alphal$(i) = MID$(alpha$, i, 1)
    NEXT i
 
    FOR i = 0 TO 3: etime!(i) = 0: NEXT '                            sides, total, current
 
    RESTORE PiecePatterns '                                          bit images
    FOR p = 1 TO 6 '                                                 RNBQKP
        n = 0
        FOR y = 0 TO 21 ' 22 rows
            READ d$
            p1 = INSTR(d$ + "X", "X") '                              find first "on" bit
            FOR t = LEN(d$) TO 1 STEP -1 '                           find last "on" bit
                IF MID$(d$, t, 1) = "X" THEN
                    p2 = t
                    EXIT FOR
                END IF
            NEXT t
            FOR x = p1 TO p2
                pixel = INSTR(".X", MID$(d$, x, 1))
                n = n + 1
                IF pixel = 2 THEN c = 3 ELSE c = 4
                x(p, n) = x + 1
                y(p, n) = y + 2
                c(p, n) = c
                IF pixel = 2 THEN c = 5 ELSE c = 6
                c(p + 6, n) = c
            NEXT x
        NEXT y
        c(p, 0) = n
        FOR scram = 1 TO 256 '                                       scramble (moves nicer)
            c1 = RND * (c(p, 0) - 1) + 1 '                           any bit
            c2 = RND * (c(p, 0) - 1) + 1 '                           any other bit
            SWAP x(p, c1), x(p, c2)
            SWAP y(p, c1), y(p, c2)
            SWAP c(p, c1), c(p, c2) '                                black
            SWAP c(p + 6, c1), c(p + 6, c2) '                        white
        NEXT scram
    NEXT p
 
    RESTORE Legal '                                                  define how piece moves
    FOR p = 1 TO 6 '                                                 RNBQKP
        READ p$ '                                                    piece, not saved
        FOR t = 0 TO 7 '                                             8 each
            READ udlr$
            du(p, t) = VAL(MID$(udlr$, 1, 1)) '                      direction up
            dd(p, t) = VAL(MID$(udlr$, 2, 1)) '                      direction down
            dl(p, t) = VAL(MID$(udlr$, 3, 1)) '                      direction left
            dr(p, t) = VAL(MID$(udlr$, 4, 1)) '                      direction right
        NEXT t
    NEXT p
 
    FOR i = 1 TO 6
        '                    RNBQKP
        value(i) = VAL(MID$("533901", i, 1)) '                       point value for capture
    NEXT i
 
    RESTORE Setup '                                                  initial board position
    FOR r = 8 TO 1 STEP -1 '                                         row
        FOR c = 1 TO 8 '                                             column
            READ b(c, r) '                                           board
            o(c, r) = b(c, r) '                                      initial setup
        NEXT c
    NEXT r
 
    gm = 0: n = 0
    IF LEN(GameFile$) > 0 THEN ReadGame
    gm = 0
 
    CLOSE
    newf:
    f = f + 1
    f$ = "ch" + RIGHT$("0000000" + LTRIM$(STR$(f)), 6) + ".alg" '    save game for analysis
    IF _FILEEXISTS(f$) THEN GOTO newf
 
    OPEN f$ FOR OUTPUT AS #1 '                                       algrebraic moves
 
    FOR i = 0 TO 3
        SELECT CASE i
            CASE IS = 0
                f$ = "alfred.jpg" '                                  Alfred E. Neuman
            CASE IS = 1
                f$ = "chess.png"
            CASE IS = 2
                f$ = "clockx.png"
            CASE IS = 3
                f$ = "clockx2.png"
        END SELECT
        isthere = true
        IF _FILEEXISTS(f$) = 0 THEN '                                accomodate Linux, which cares about case
            f$ = UCASE$(f$) '                                        now try uppercase
            IF _FILEEXISTS(f$) = 0 THEN isthere = false
        END IF
        IF isthere THEN
            li1:
            icon&(i) = _LOADIMAGE(f$)
            IF icon&(i) >= -1 THEN _DELAY .2: GOTO li1
        END IF
    NEXT i
    IF icon&(1) <> 0 THEN
        _ICON icon&(1)
        _DELAY .2
    END IF
 
    IF icon&(0) <> 0 THEN
        _SOURCE icon&(0) '                                               Alfred E. Neuman
        _DISPLAY '                                                       hide idiot
        _PUTIMAGE
        GET (0, 0)-(52, 53), abuff(0)
    END IF
 
    CLS 0, bg0&
    _DELAY .2
    Menubox
    Center 6, "White  Black  Humans  Computer", 1
    Center 0, "Quit or Esc to exit", 1
    _DISPLAY
    DO: _LIMIT 10
        i$ = INKEY$
        IF i$ = "" THEN i$ = " "
        IF (LCASE$(i$) = "q") OR (i$ = Esc$) THEN SYSTEM
        p = INSTR("bwhc", i$)
    LOOP UNTIL p
    SELECT CASE p
        CASE IS = 1 '                                                player is black
            human = 1: humanc = 0: invert = 1
        CASE IS = 2 '                                                player is white
            human = 1: humanc = 1
        CASE IS = 3 '                                                human vs. human
            human = 2
        CASE IS = 4 '                                                computer vs. computer, just watch
            human = 0: OnAuto = 1
    END SELECT
 
    'IF human <> 2 THEN
    '    tlimit = 0
    '    DO
    '        CLS
    '        Menubox
    '        Center 6, "Time limit in minutes?  (0 unlimited)", 0
    '        Center 8, STR$(tlimit), 0
    '        Center 0, "Quit or Esc to exit", 1
    '        _DISPLAY
    '        DO: _LIMIT 10
    '            i$ = INKEY$
    '        LOOP UNTIL LEN(i$)
    '        IF (LCASE$(i$) = "q") OR (i$ = Esc$) THEN SYSTEM
    '        IF i$ = CHR$(8) THEN tlimit = tlimit / 10
    '        p = INSTR("0123456789", i$): IF p THEN tlimit = tlimit * 10 + p - 1
    '    LOOP UNTIL i$ = Enter$
    'END IF
 
    'IF rick THEN smode = 2
    ScreenInit
    PlotBoard
END SUB
 
SUB HumanMove STATIC
    cursoron! = TIMER + 3: IF cursoron! > maxtime& THEN cursoron! = 0
    IF cc = 0 THEN
        rr = 7
        cc = 5 + (WorB = 0)
    END IF
    FOR i = 0 TO 1
        DO: _LIMIT 30
            IF vflag THEN ShowValid cc, rr
            KeyScan 1, 0 '                                           plotscreen, no _display
            IF rr < 1 THEN rr = 1
            IF rr > 8 THEN rr = 8
            IF cc < 1 THEN cc = 1
            IF cc > 8 THEN cc = 8
            IF cursoron! > TIMER THEN Cursor 9 - rr, cc, i
            IF takebackflag OR LEN(msg$) THEN EXIT SUB
            WHILE _MOUSEINPUT
                mx = _MOUSEX
                my = _MOUSEY
                xx = (mx - xc - (4 * xq) + xq \ 2) / xq + 8
                yy = (my - yc - (4 * yq) + yq \ 2) / yq + 8
                IF (xx > 0) AND (xx < 9) AND (yy > 0) AND (yy < 9) THEN rr = yy: cc = xx
                IF _MOUSEBUTTON(1) OR _MOUSEBUTTON(2) THEN i$ = Enter$
            WEND
            IF LEN(i$) = 2 THEN
                kk = ASC(RIGHT$(i$, 1))
                cc = cc + (kk = 75) - (kk = 77) '                    left right
                rr = rr + (kk = 72) - (kk = 80) '                    up down
            END IF
        LOOP UNTIL i$ = Enter$
        IF i = 0 THEN
            fr = rr: fc = cc
            IF invert THEN fr = 9 - fr: fc = 9 - fc
        ELSE
            tr = rr: tc = cc
            IF invert THEN tr = 9 - tr: tc = 9 - tc
        END IF
    NEXT i
 
    fs$ = alphal$(fc) + LTRIM$(STR$(9 - fr))
    ts$ = alphal$(tc) + LTRIM$(STR$(9 - tr))
    m$ = fs$ + ts$
    IF m$ = "e1g1" THEN m$ = "O-O"
    IF m$ = "e1c1" THEN m$ = "O-O-O"
    IF m$ = "e8g8" THEN m$ = "O-O"
    IF m$ = "e8c8" THEN m$ = "O-O-O"
END SUB
 
SUB KeyScan (kf1, kf2) STATIC '                                      plotscreen, _display
    TempMess "", 0
    DispStats
    dot = 0
    i$ = INKEY$
    IF LEN(i$) THEN
        cursoron! = TIMER + 2
        IF cursoron! > maxtime& THEN cursoron! = 0
    END IF
    IF LEN(i$) = 1 THEN
        IF (LCASE$(i$) = "q") OR (i$ = Esc$) THEN abort = 9: msg$ = "Quit!"
        IF i$ = Enter$ THEN EXIT SUB
        IF i$ = " " THEN msg$ = "abort": abort = 1: EXIT SUB '       move now
        c = INSTR("123456789ABCDEF0", i$) '                          experiment with colors
        IF c > 0 THEN
            IF c = 16 THEN
                c = 2
                myr(c) = 0: myg(c) = 0: myb(c) = 0
            ELSE
                myr(c) = RND * 64: myg(c) = RND * 64: myb(c) = RND * 64
            END IF
            cp&(c) = _RGB32(myr(c) * bri, myg(c) * bri, myb(c) * bri)
            ColorWrite
            Colorassign
            PlotBoard
        END IF
        IF i$ = "a" THEN OnAuto = NOT (OnAuto) '                     not currently in use
        IF i$ = "b" THEN takebackflag = 1
        IF i$ = "c" THEN ChangeColors
        IF i$ = "d" THEN SWAP fg0&, bg0&: CLS 0, bg0&
        IF i$ = "f" THEN PlayFile
        IF i$ = "g" THEN '                                           change white square graphics scheme
            graphics = (graphics + 1) MOD 4
            IF graphics = 0 THEN PlotBoard
            t$ = "Mode" + STR$(graphics + 1) + " of 4"
            TempMess t$, 2
        END IF
        IF i$ = "G" THEN pinit = pinit XOR 1 '                       adjust current white square graphics
        IF i$ = "h" THEN dot = 1: history = history XOR 1
        IF i$ = "i" THEN '                                           flip board around
            IF human = 2 THEN
                iflag = iflag XOR 1
            ELSE
                invert = invert XOR 1
                PlotBoard
            END IF
        END IF
        IF i$ = "I" THEN
            useidiot = useidiot XOR 1
            t$ = "Idiot " + OnOff$(useidiot)
            TempMess t$, 2
        END IF
        IF i$ = "l" THEN dot = 1: showlegalf = showlegalf XOR 1
        IF i$ = "L" THEN '                                           look at log file
            CLOSE #2
            SHELL _DONTWAIT "notepad chess.txt"
            OPEN "chess.txt" FOR APPEND AS #2
        END IF
        IF i$ = "m" THEN '                                           screen mode
            smode = (smode + 1) MOD 3
            ScreenInit
        END IF
        IF i$ = "n" THEN '                                           sound effects
            MakeNoise = MakeNoise XOR 1
            t$ = "Sound " + OnOff$(MakeNoise)
            TempMess t$, 2
        END IF
        IF i$ = "p" THEN dot = 1: showprotf = showprotf XOR 1
        IF i$ = "P" THEN
            pause = pause XOR 1
            IF pause THEN
                LOCATE 2, 29: PRINT "PAUSED";
                _DISPLAY
                t! = TIMER - etime!(2)
                IF t! < 0 THEN t! = t! + maxtime&
                hold! = t!
                SLEEP
                Start1! = TIMER
                LOCATE 2, 29: PRINT SPACE$(10);
                _DISPLAY '
            END IF
        END IF
        IF (rflag = 0) AND (i$ = "r") THEN abort = 2: msg$ = "Resign!"
        IF i$ = "s" THEN Setup '                                     setup
        IF i$ = "t" THEN dot = 1: showthink = showthink XOR 1
        IF i$ = "v" THEN '                                           show valid moves at top left
            vflag = vflag XOR 1
            LOCATE 2, 4: PRINT SPACE$(40);
            _DISPLAY
        END IF
        IF i$ = "x" AND MakeNoise THEN PlaySound "ding" '            sound test
        IF i$ = "X" THEN
            SHELL _HIDE "del ccolor.dat" '                           kill color file
            ColorWrite
            Colorassign
            PlotBoard
        END IF
        'IF i$ = "y" THEN itest '                                    see how bad icon problem is
        IF i$ = "z" THEN
            altblack = altblack XOR 1
            Colorassign
            'CLS 0, bg0&
            PlotBoard
            TempMess "Alternate black " + OnOff(altblack), 2
        END IF
        i$ = ""
    END IF
    IF LEN(i$) = 2 THEN
        k = ASC(RIGHT$(i$, 1))
        wbri = bri
        bri = bri - (k = 73) + (k = 81) '                            brightness PgUp/PgDn
        IF bri < 2 THEN bri = 2
        IF bri > 4 THEN bri = 4
        IF bri <> wbri THEN '                                        was changed
            ColorWrite
            Colorassign
            TempMess "Brightness" + STR$(bri), 1
        END IF
    END IF
 
    IF kf1 THEN PlotScreen true
    IF dot THEN DebugR = 99: TextInfo ""
    IF kf2 THEN _DISPLAY
END SUB
 
FUNCTION Make4$ (t$)
    Make4$ = LEFT$(t$ + SPACE$(4), 4)
END FUNCTION
 
DEFINT A-Z
SUB LogThinking () STATIC
    ts = 0: z1$ = "": z2$ = ""
    FOR t = 1 TO 3
        ti = TieTo(t)
        z1$ = z1$ + Make4$(Move$(t - 1, ti)) + " "
        z2$ = z2$ + Rjust$(Score(t - 1, ti), 3) + " "
        ts = ts + Score(t - 1, ti)
    NEXT t
    ts = ts - Score
    zz$ = z1$ + Make4$(m$) + z2$ + Rjust$(Score, 3) + " " + Rjust$(ts, 4)
    PRINT #2, zz$
 
    zz = Score(0, 1)
    z$ = Move$(0, 1)
    IF zz >= bscore THEN
        bscore = zz
        IF zz = bscore THEN best$ = best$ + " " + z$ ELSE best$ = z$
    END IF
 
    TextInfo zz$
END SUB
 
SUB Menubox
    tx = _WIDTH \ 2: ty = _HEIGHT \ 2
    xs = 200: ys = 70
    x1 = tx - xs: y1 = ty - ys
    x2 = tx + xs: y2 = ty + ys
 
    LINE (x1, y1 + 20)-(x2, y2 - 20), _RGBA(1, 1, 1, 220), BF
    FOR q = 2 TO 20 STEP 4
        LINE (x1 - q + 0, y1 + q + 0)-(x2 + q + 0, y2 - q + 0), cp&(1), B
        LINE (x1 - q + 1, y1 + q + 1)-(x2 + q + 1, y2 - q + 1), cp&(1), B
    NEXT q
END SUB
 
SUB MoveIt (m$, real)
    IF m$ = ep$ THEN '                                               epfc, epfr, eptc, eptr, eprc, eprr
        Plotpiece fc, fr, tc, tr
        b(epfc, epfr) = 0
        b(eprc, eprr) = 0
        b(eptc, eptr) = 6 + WorB * 6
        EXIT SUB
    END IF
 
    IF m$ = "res" THEN EXIT SUB '                                    resign?
    fs$ = LEFT$(m$, 2) '                                             from square
    ts$ = RIGHT$(m$, 2) '                                            to square
    tzz = 1 - (LEFT$(m$, 1) = "O") - (L1$ = "e") '                   two moves for a castle
 
    FOR pass = 1 TO tzz
 
        IF m$ = "O-O" THEN '                                         castle Kingside
            IF WorB = 1 THEN '                                       white
                IF pass = 1 THEN '                                   first move of KS castle
                    fs$ = "e1": ts$ = "g1"
                ELSE '                                               else 2nd
                    fs$ = "h1": ts$ = "f1"
                END IF
            ELSE '                                                   black castle
                IF pass = 1 THEN
                    fs$ = "e8": ts$ = "g8"
                ELSE
                    fs$ = "h8": ts$ = "f8"
                END IF
            END IF
        END IF
        IF m$ = "O-O-O" THEN '                                       castle Queenside
            IF WorB THEN '                                           white
                IF pass = 1 THEN
                    fs$ = "e1": ts$ = "c1"
                ELSE
                    fs$ = "a1": ts$ = "d1"
                END IF
            ELSE
                IF pass = 1 THEN
                    fs$ = "e8": ts$ = "c8"
                ELSE
                    fs$ = "a8": ts$ = "d8"
                END IF
            END IF
        END IF
        fc = INSTR(alpha$, LEFT$(fs$, 1)) '                          from column
        fr = VAL(RIGHT$(fs$, 1)) '                                   from row
        pm = b(fc, fr) '                                             piece to move
        p = pm + (pm > 6) * 6
        tc = INSTR(alpha$, LEFT$(ts$, 1)) '                          to column
        tr = VAL(RIGHT$(ts$, 1)) '                                   to row
        b(tc, tr) = pm '                                             move piece in array
        b(fc, fr) = 0 '                                              blank old array spot
        IF real THEN
            IF b(c, r) = o(c, r) THEN o(c, r) = -1
            Plotpiece fc, fr, tc, tr
            IF p = King THEN MID$(castle$, WorB * 2 + 1, 2) = "XX"
            IF p = Rook THEN
                IF WorB THEN
                    IF (fc = 1) AND (fr = 1) THEN MID$(castle$, 3, 1) = "X"
                    IF (fc = 1) AND (fr = 8) THEN MID$(castle$, 4, 1) = "X"
                ELSE
                    IF (fc = 8) AND (fr = 1) THEN MID$(castle$, 1, 1) = "X"
                    IF (fc = 8) AND (fr = 8) THEN MID$(castle$, 2, 1) = "X"
                END IF
            END IF
        END IF
        IF (p = Pawn) AND ((tr = 1) OR (tr = 8)) THEN
            b(tc, tr) = Queen - (pm > 6) * 6 '                       promote to queen
            IF real THEN Plotpiece tc, tr, tc, tr '                  show queen
        END IF
    NEXT pass
END SUB
 
DEFINT A-Z
FUNCTION OnOff$ (v)
    OnOff$ = MID$("OFFON ", v * 3 + 1, 3)
END FUNCTION
 
DEFSNG A-Z
SUB Plasma STATIC
    TYPE xy
        x AS SINGLE
        y AS SINGLE
        dx AS SINGLE
        dy AS SINGLE
    END TYPE
 
    IF pinit% = 0 THEN
        DIM c(360) AS _UNSIGNED LONG, p(10) AS xy, f(10)
        r = RND: g = RND: b = RND: i% = 0: q = .5
        FOR n% = 1 TO 5
            r1 = r: g1 = g: b1 = b
            DO: r = RND: LOOP UNTIL ABS(r - r1) > q
            DO: g = RND: LOOP UNTIL ABS(g - g1) > q
            DO: b = RND: LOOP UNTIL ABS(g - g1) > q
            FOR m% = 0 TO 17: m1% = 17 - m%
                f1 = (m% * r) / 18: f2 = (m% * g) / 18: f3 = (m% * b) / 18: c(i%) = f_pl(f1, f2, f3): i% = i% + 1
            NEXT
            FOR m% = 0 TO 17: m1% = 17 - m%
                f1 = (m% + m1% * r) / 18: f2 = (m% + m1% * g) / 18: f3 = (m% + m1% * b) / 18: c(i%) = f_pl(f1, f2, f3): i% = i% + 1
            NEXT
            FOR m% = 0 TO 17: m1% = 17 - m%
                f1 = (m1% + m% * r) / 18: f2 = (m1% + m% * g) / 18: f3 = (m1% + m% * b) / 18: c(i%) = f_pl(f1, f2, f3): i% = i% + 1
            NEXT
            FOR m% = 0 TO 17: m1% = 17 - m%
                f1 = (m1% * r) / 18: f2 = (m1% * g) / 18: f3 = (m1% * b) / 18: c(i%) = f_pl(f1, f2, f3): i% = i% + 1
            NEXT
        NEXT
 
        FOR n% = 0 TO 5
            p(n%).x = RND * xm%: p(n%).y = RND * ym%: p(n%).dx = RND * 2 - 1: p(n%).dy = RND * 2 - 1
            f(n%) = RND * .1
        NEXT
 
        xm2% = 8 * xq%: ym2% = xm2%: x1% = xc% - 4 * xq%: y1% = yc% - 4 * yq%: x2% = xc% + 4 * xq%: y2% = yc% + 4 * yq%:
        pinit% = 1
    END IF
 
    FOR n% = 0 TO 5
        p(n%).x = p(n%).x + p(n%).dx
        IF p(n%).x > xm2% OR p(n%).x < 0 THEN p(n%).dx = -p(n%).dx
        p(n%).y = p(n%).y + p(n%).dy
        IF p(n%).y > ym2% OR p(n%).y < 0 THEN p(n%).dy = -p(n%).dy
    NEXT
 
    IF graphics% = 2 THEN z% = 1 ELSE z% = 2
 
    FOR y% = y1% TO y2% STEP z%
        FOR x% = x1% TO x2% STEP z%
            p& = POINT(x%, y%)
            'IF (p& = boardwhite&) OR (p& = boardblack&) THEN
            IF (p& = boardwhite&) THEN
                d = 0
                FOR n% = 0 TO 5
                    dx = x% - p(n%).x: dy = y% - p(n%).y
                    k = SQR(dx * dx + dy * dy)
                    d = d + (SIN(k * f(n%)) + 1) / 2
                NEXT
                PSET (x%, y%), c(d * 60)
            END IF
        NEXT
        '_DELAY .001
    NEXT
END SUB
 
DEFINT A-Z
SUB Playagain (t$)
    Menubox
    COLOR _RGBA32(222, 222, 222, 255), _RGBA32(1, 1, 1, 0)
    Center 18, t$, 0
    IF INSTR("QR", LEFT$(t$, 1)) THEN '                              Quit or Resign
        Center 20, "Resume    New game     Quit", 1
        ks$ = "rn"
    ELSE
        Center 20, "New game     Quit", 1
        ks$ = "rn" '                                                 take out r when working properly (false checkmates)
    END IF
    _DISPLAY
    'COLOR _RGBA(155, 155, 155, 255), _RGBA32(0, 0, 0, 255)
    COLOR fg0&, bg0&
 
    DO: _LIMIT 10
        i$ = INKEY$
        IF i$ = "" THEN i$ = " "
        IF (i$ = Esc$) OR (LCASE$(i$) = "q") THEN SYSTEM
        IF human = 0 THEN i$ = "n"
    LOOP UNTIL INSTR(ks$, i$)
END SUB
 
SUB PlayFile
    tryagain:
    LOCATE 1, 1: PRINT SPACE$(20);
    LOCATE 1, 1: INPUT f$
    IF f$ = "" THEN EXIT SUB
    f$ = f$ + ".alg"
    IF NOT (_FILEEXISTS(f$)) THEN GOTO tryagain
    LOCATE 1, 1: PRINT SPACE$(20);
    tf = FREEFILE
    OPEN f$ FOR INPUT AS #tf
    WHILE NOT (EOF(tf))
        LINE INPUT #tf, t$
        IF LEN(LTRIM$(t$)) THEN
            t$ = t$ + SPACE$(20)
            FOR WorB = 1 TO 0 STEP -1
                m$ = RTRIM$(LTRIM$(MID$(t$, 12 - WorB * 6, 5)))
                IF m$ = SPACE$(5) THEN GOTO pbdone
                FlashMove false
                MoveIt m$, true
                PlotScreen true
                _DISPLAY
                IF (i$ = "q") OR (i$ = Esc$) THEN SYSTEM
                IF i$ = " " THEN i$ = "": GOTO pbdone
            NEXT WorB
        END IF
    WEND
    pbdone:
    LOCATE 1, 1: PRINT SPACE$(20):
    CLOSE #tf
    IF MakeNoise THEN PlaySound "ding"
END SUB
 
DEFSNG A-Z
SUB PlaySound (f$) STATIC '         ding,tada,notify,windows xp hardware fail, etc.
    CONST CACHE = 441 '             minimal detected frequency for analyzer is 100 Hz, so this is enought value (with 44100 biterate)
    TYPE head
        chunk AS STRING * 4 '       4 bytes  (RIFF)
        size AS LONG '              4 bytes  (?E??)
        fomat AS STRING * 4 '       4 bytes  (WAVE)
        sub1 AS STRING * 4 '        4 bytes  (fmt )
        subchunksize AS LONG '      4 bytes  (lo / hi), $00000010 for PCM audio
        format AS STRING * 2 '      2 bytes  (0001 = standard PCM, 0101 = IBM mu-law, 0102 = IBM a-law, 0103 = IBM AVC ADPCM)
        channels AS INTEGER '       2 bytes  (1 = mono, 2 = stereo)
        rate AS LONG '              4 bytes  (sample rate, standard is 44100)
        ByteRate AS LONG '          4 bytes  (= sample rate * number of channels * (bits per channel /8))
        Block AS INTEGER '          2 bytes  (block align = number of channels * bits per sample /8)
        Bits AS INTEGER '           2 bytes  (bits per sample. 8 = 8, 16 = 16)
        subchunk2 AS STRING * 4 '   4 bytes  ("data")  contains begin audio samples
    END TYPE '                     40 bytes  total
    TYPE Wav16S
        Left AS INTEGER
        Right AS INTEGER
    END TYPE
    REDIM scache(CACHE) AS Wav16S
    DIM H AS head
    ch = FREEFILE
    f$ = f$ + ".wav"
    IF _FILEEXISTS(f$) = 0 THEN EXIT SUB
    OPEN f$ FOR BINARY AS #ch
    GET #ch, , H
    block = H.Block
    RATE = H.rate
    chan = H.channels
    bits = H.Bits
    L = _SNDOPENRAW
    R = _SNDOPENRAW
    REDIM scache(CACHE) AS Wav16S
    DO WHILE NOT EOF(ch)
        GET #ch, , scache()
        FOR P = 0 TO CACHE
            lef = scache(P).Left
            IF chan = 1 THEN righ = lef ELSE righ = scache(P).Right
            lef = lef / RATE
            righ = righ / RATE
            IF RATE > 44100 THEN frekvence = RATE ELSE frekvence = 44100
            FOR plll = 1 TO frekvence / RATE
                _SNDRAW lef, L
                _SNDRAW righ, R
            NEXT plll
        NEXT
    LOOP
    CLOSE ch
END SUB
 
DEFINT A-Z
SUB PlotBoard
    FOR zr = 1 TO 8
        FOR zc = 1 TO 8
            IF rflag = 0 THEN Plotpiece zc, zr, zc, zr
        NEXT zc
    NEXT zr
END SUB
 
SUB Plotpiece (fc, fr, tc, tr)
    x1 = xc + (fc - 5) * xq
    x2 = xc + (tc - 5) * xq
    y1 = yc + (4 - fr) * yq
    y2 = yc + (4 - tr) * yq
    p = b(tc, tr)
    IF invert THEN p = b(9 - tc, 9 - tr)
    IF p > 6 THEN wb = 1: p = p - 6
    i = p - (wb = 0) * 6
 
    FOR ps = 0 TO 1
        IF ps = 0 THEN
            c = fr + fc: tx = x1: ty = y1
        ELSE
            c = tr + tc: tx = x2: ty = y2
        END IF
        IF c MOD 2 THEN
            LINE (tx, ty)-(tx + xq, ty + yq), boardwhite&, BF
        ELSE
            LINE (tx, ty)-(tx + xq, ty + yq), boardblack&, BF '      black square
            LINE (tx, ty)-(tx + xq, ty + yq), boardwhite&, B '       border
        END IF
    NEXT ps
 
    FOR t = 1 TO c(p, 0)
        tx = x1 + x(p, t) * 2
        ty = y1 + y(p, t) * 2
        LINE (tx, ty)-STEP(1, 1), cp&(c(i, t)), B
    NEXT t
END SUB
 
SUB PlotScreen (lflag) STATIC
    'CLS 0, bg0&
    PlotBoard
    TextInfo ""
    r = _RED32(boardwhite&) \ 2 '                                    legend, dim a-h, 1-8 along sides
    g = _GREEN32(boardwhite&) \ 2
    b = _BLUE32(boardwhite&) \ 2
    COLOR _RGB32(r, g, b)
    FOR i = 1 TO 8
        IF invert THEN z = i ELSE z = 9 - i
        n$ = LTRIM$(STR$(z))
        IF invert THEN z = 9 - i ELSE z = i
        a$ = alphal$(z)
        nx = xc - 4 * xq - 12
        ny = yc + (i - 4) * yq - 34
        ax = xc + (i - 5) * xq + 23
        ay = yc + 4 * yq + 3
        _PRINTSTRING (nx, ny), n$
        _PRINTSTRING (ax, ay), a$
    NEXT i
    COLOR fg0&, bg0&
 
    IF lflag THEN Center 0, "", 1
 
    IF graphics = 0 THEN EXIT SUB
    IF graphics > 1 THEN
        Plasma
        EXIT SUB
    END IF
 
    br = 255
    zz = (zz + 1) MOD 50: IF zz = 1 THEN r! = RND: g! = RND: b! = RND
    x1 = xc - 4 * xq
    y1 = yc - 4 * yq
    x2 = x1 + 8 * xq
    y2 = y1 + 8 * yq
    FOR sy = y1 TO y2
        FOR sx = x1 TO x2
            p& = POINT(sx, sy)
            IF p& = boardwhite& THEN
                z = ABS((sx - xc - xq \ 2) * (sy - yc - yq \ 2))
                PSET (sx, sy), _RGB32(br * SIN(.1 * r! * z + zz), br * SIN(.155 * g! * z + zz), br * SIN(2 * b! * z + zz))
            END IF
    NEXT sx: NEXT sy
END SUB
 
SUB ReadGame
    DIM g$(500)
    CLS
    OPEN GameFile$ FOR INPUT AS #8
    WHILE NOT (EOF(8))
        INPUT #8, mn, m1$, m2$
        gm = gm + 1: g$(gm) = LTRIM$(m1$)
        gm = gm + 1: g$(gm) = LTRIM$(m2$)
        PRINT m1$; "*"; m2$
    WEND
    CLOSE #8
    _DISPLAY
    SLEEP
    CLS
    _DISPLAY
END SUB
 
SUB Recurse (Level)
    IF abort OR (Level = MasterLevel) THEN EXIT SUB
 
    FOR t = 1 TO Moves(Level - 1)
 
        IF Level = 1 THEN '                                                              progress bar
            x1 = xc - 4 * xq: x2 = xc + 4 * xq
            y1 = yc + 4 * yq + 20
            z1 = Moves(Level - 1): z2 = z1 - (z1 = 0)
            xx = (z1 - t + 1) / z2 * (x2 - x1)
            IF xx < x1 THEN xx = x1
            IF xx > x2 THEN xx = x2
            LINE (x1, y1)-(x2, y1), bg0&
            IF (xx - x1) > 2 THEN LINE (x1, y1)-(xx, y1), cp&(1)
 
            'x1 = 290: x2 = x1 + 50
            'y1 = 508: y2 = y1 + 64
            'LINE (x1, y1)-(x2, y2), _RGB32(222, 0, 0), B
        END IF
        WorB = SaveWorB
        IF (Level MOD 2) = 1 THEN WorB = WorB XOR 1
        TieTo(Level) = t
        IF ABS(Score(0, t)) <> 777 THEN
            _MEMCOPY m(0), m(0).OFFSET, m(0).SIZE TO m(Level), m(Level).OFFSET '         save board
            m$ = Move$(Level - 1, t)
            MoveIt m$, false
            lm1 = Level - 1
            CheckBoard Level
            Recurse Level + 1
            TakeBest Level, false
            i = Index
            Score = Score(Level, 1)
            levm1 = Level - 1
            IF Score(levm1, 1) <> 777 THEN Score(levm1, i) = Score(levm1, i) - Score
            IF Level = (MasterLevel - 1) THEN
                KeyScan 0, 0 '                                                           no plotscreen or _display
                'IF (tlimit > 0) AND (emin >= tlimit) THEN abort = true
                IF abort THEN EXIT SUB
                LogThinking
            END IF
            _MEMCOPY m(Level), m(Level).OFFSET, m(Level).SIZE TO m(0), m(0).OFFSET '     restore board
        END IF
    NEXT t
END SUB
 
SUB Reset_To_Zero
    WorB = WorB XOR 1 '      reverse who's moving
    CheckBoard 1 '           need to know what opponent can do to ensre legal castling
    WorB = WorB XOR 1 '      restore playing color
    CheckBoard 0 '           determine legal moves
END SUB
 
FUNCTION Rjust$ (t, n)
    Rjust$ = RIGHT$("   " + STR$(t), n)
END FUNCTION
 
SUB SaveForTakeBack STATIC '                                         use MEM later to move arrays
    FOR i = 10 TO 1 STEP -1
        castle$(i) = castle$(i - 1)
        FOR r = 1 TO 8
            FOR c = 1 TO 8
                tb(c, r, i) = tb(c, r, i - 1)
            NEXT c
        NEXT r
    NEXT i
    castle$(0) = castle$
    FOR r = 1 TO 8
        FOR c = 1 TO 8
            tb(c, r, 0) = b(c, r)
        NEXT c
    NEXT r
    tbc = tbc + 1
    IF tbc > 10 THEN tbc = 10
 
END SUB
 
SUB ScreenInit
    xm = 480: ym = 600
    MaxRow = ym \ 16 - 2
    k = 99
    SELECT CASE smode
        CASE IS = 0
            SCREEN _NEWIMAGE(xm, ym), 32
            _SCREENMOVE _DESKTOPWIDTH \ 2 - xm \ 2, _DESKTOPHEIGHT \ 2 - ym \ 2
        CASE IS = 1
            _SCREENMOVE 780, 20
        CASE IS = 2
            SCREEN _NEWIMAGE(800, 600), 32
            _SCREENMOVE 472, 20
    END SELECT
    _ALLOWFULLSCREEN _SQUAREPIXELS , _SMOOTH
END SUB
 
SUB Setup
    t1$ = "rnbkqp:black      clear:one     spacebar:flip"
    t2$ = "RNBKQP:white      Clear:all          Esc:exit"
 
    LINE (0, 500)-(xm, ym), black&, BF
    cc = 1: rr = 8
    DO
        Center -1, t1$, 0
        Center 0, t2$, 0
        _DISPLAY
        DO: _LIMIT 20
            PlotBoard
            z = z XOR 1
            IF z THEN Cursor 9 - rr, cc, 0
            i$ = INKEY$: z = LEN(i$)
        LOOP UNTIL z
        SELECT CASE z
            CASE IS = 1
                r2 = 9 - rr
                IF i$ = Esc$ THEN EXIT DO
                IF (i$ = CHR$(9)) OR (i$ = "c") THEN b(cc, r2) = 0 ' Del or "c" to delete piece
                IF i$ = "C" THEN '                                   delete all pieces
                    FOR c = 1 TO 8: FOR r = 1 TO 8
                            b(c, r) = 0
                    NEXT: NEXT
                END IF
                p = INSTR("rnbqkpRNBQKP", i$)
                IF p THEN b(cc, r2) = p '                            set piece by letter
                IF INSTR(" t", i$) THEN '                            t or space toggle color
                    mp = b(cc, r2)
                    IF mp < 7 THEN mp = mp + 6 ELSE mp = mp - 6
                    b(cc, r2) = mp
                END IF
                IF i$ = "x" THEN
                    FOR c = 1 TO 8
                        FOR r = 1 TO 8
                            t = b(c, r)
                            IF t THEN
                                IF t < 7 THEN t = t + 6 ELSE t = t - 6
                                s9(c, r) = t
                            END IF
                        NEXT r
                    NEXT c
                    FOR c = 1 TO 8
                        FOR r = 1 TO 8
                            b(c, 9 - r) = s9(c, r)
                        NEXT r
                    NEXT c
                END IF
                IF i$ = "z" THEN
                    RESTORE test
                    FOR r = 1 TO 8
                        FOR c = 1 TO 8
                            READ b(c, r)
                    NEXT: NEXT
                END IF
            CASE IS = 2
                kk = ASC(RIGHT$(i$, 1))
                cc = cc + (kk = 75) - (kk = 77) '                    left right
                rr = rr + (kk = 72) - (kk = 80) '                    up down
                IF rr < 1 THEN rr = 1
                IF rr > 8 THEN rr = 8
                IF cc < 1 THEN cc = 1
                IF cc > 8 THEN cc = 8
        END SELECT
    LOOP
    LINE (0, 500)-(xm, ym), black&, BF
    '                        board probably changed - reinitialize legal moves
    Reset_To_Zero
END SUB
 
SUB ShowBest
    'bg1& = _RGB32(0, 90, 0)
    'LINE (22, 504)-(350, ym - 22), bg1&, BF
 
    yy = 505
    ty = yy
    tx = 29
    FOR t = 1 TO 20
        IF t <= Moves(0) THEN
            t$ = Make4$(Move$(0, t)) + Rjust$(Score(0, t), 5)
            FOR i = 1 TO LEN(t$) '                                   shift "g" up 2 pixels
                c$ = MID$(t$, i, 1)
                y2 = ty + (c$ = "g") * 2
                _PRINTSTRING (tx + (i - 1) * 8, y2), c$
            NEXT
        END IF
        ty = ty + 14
        IF ty > 570 THEN ty = yy: tx = tx + 80
    NEXT t
END SUB
 
SUB ShowMe (dr, dc, t$)
    EXIT SUB
    sr = CSRLIN '                                                    save row
    sc = POS(0) '                                                    save column
    IF (dr > 0) AND (dr < MaxRow) AND (dc > 0) AND (dc < 76) THEN
        LOCATE dr, dc '                                              display row & column
        PRINT t$;
    END IF
    LOCATE sr, sc '                                                  restore to old location
END SUB
 
SUB ShowTime (trow, z!, Desc$)
    t! = z!
    SELECT CASE t!
        CASE IS > 3600
            unit$ = "h"
            t! = t! / 3600
        CASE IS > 60
            unit$ = "m"
            t! = t! / 60
        CASE ELSE
            unit$ = "s"
    END SELECT
    x1 = 408
    x2 = x1 - (LEN(Desc$) + 1) * 8
    yy = trow / (600 / 16) * 600 - 4
    t! = INT(t! * 1000) / 1000
    t$ = LTRIM$(STR$(t!))
    IF INSTR(t$, ".") = 0 THEN
        IF t! < 1 THEN t$ = "." + t$ ELSE t$ = t$ + "."
    END IF
    zz = 0
    WHILE INSTR(t$, ".") <> (LEN(t$) - 3)
        t$ = t$ + "0"
        zz = zz + 1
        IF zz > 5 THEN GOTO dammit
    WEND
    dammit:
 
    IF LEFT$(t$, 1) = "." THEN t$ = "0" + t$
    t$ = RIGHT$(SPACE$(10) + t$, 6)
    _PRINTSTRING (x1, yy), t$ + unit$
    _PRINTSTRING (x2, yy), Desc$
END SUB
 
SUB ShowValid (cc, rr) '                                             show valid moves for piece at cursor
 
    IF (cc < 0) OR (rr < 0) OR (cc > 8) OR (rr > 8) THEN EXIT SUB
    tc = cc: tr = rr
    IF invert THEN tc = 9 - tc: tr = 9 - tr
    mp = b(tc, tr): mp = mp + (mp > 6) * 6
    z$ = alphal$(tc) + LTRIM$(STR$(9 - tr))
    t$ = z$ + ":"
    FOR i = 1 TO Moves(0)
        IF z$ = LEFT$(Move$(0, i), 2) THEN t$ = t$ + " " + RIGHT$(Move$(0, i), 2)
        IF (mp = King) AND (LEFT$(Move$(0, i), 1) = "O") THEN t$ = t$ + " " + Move$(0, i)
    NEXT i
    'IF (tc = epfc) AND (tr = epfc) THEN t$ = t$ + " ep"
 
    sw = _WIDTH \ 8 - 3
    LOCATE 2, 4: PRINT SPACE$(sw);
    LOCATE 2, 4: PRINT LEFT$(t$, sw);
    IF LEN(t$) > sw THEN PRINT "..";
 
END SUB
 
SUB TakeBack '                                                       use MEM to move arrays? speed not an issue here
    IF tbc < 2 THEN EXIT SUB
    IF MakeNoise THEN PlaySound "tb" '                               so your mom knows you're cheating  :)
    castle$ = castle$(2)
    FOR r = 1 TO 8
        FOR c = 1 TO 8
            b(c, r) = tb(c, r, 2)
        NEXT c
    NEXT r
    FOR i = 0 TO 9
        castle$(i) = castle$(i + 1)
        FOR r = 1 TO 8
            FOR c = 1 TO 8
                tb(c, r, i) = tb(c, r, i + 1)
            NEXT c
        NEXT r
    NEXT i
    tbc = tbc - 1
    Reset_To_Zero
END SUB
 
SUB TakeBest (Level, final)
 
    IF final THEN '                                                  feeble attempt to vary response when scores equal
        upto = 10
        IF upto > Moves(Level) THEN upto = Moves(Level)
        FOR scram = 0 TO 199
            s1 = RND * updo + 1
            s2 = RND * upto + 1
            SWAP Score(Level, s1), Score(Level, s2)
            SWAP Move$(Level, s1), Move$(Level, s2)
            SWAP Index(Level, s1), Index(Level, s2)
        NEXT scram
    END IF
 
    passes = 0
    ReSort:
    Score = -999 '                                                   assume no moves
    DO
        Sorted = true
        FOR s = 2 TO Moves(Level)
            IF Score(Level, s - 1) < Score(Level, s) THEN
                Sorted = false
                SWAP Score(Level, s - 1), Score(Level, s)
                SWAP Move$(Level, s - 1), Move$(Level, s)
                SWAP Index(Level, s - 1), Index(Level, s)
            END IF
        NEXT s
    LOOP UNTIL Sorted
 
    m$ = Move$(Level, 1)
    Score = Score(Level, 1)
    Index = Index(Level, 1)
 
    best$ = Move$(0, 1)
    bscore = Score(0, 1)
 
    IF final AND (Level < 2) THEN
        IF Score = -777 THEN '                                       in check, no escape
            abort = 3: msg$ = "Checkmate!"
        ELSEIF Score = -999 THEN '                                   no moves
            abort = 3: msg$ = "Stalemate!"
        END IF
 
        tm = Moves(1)
        FOR lb = 1 TO 9 '                                            stop repeats
            IF tm > 8 THEN
                IF INSTR(MoveLog$(tm - lb), m$) THEN
                    'SOUND 888, 1
                    Score(1, 1) = Score(1, 1) - 10
                    passes = passes + 1
                    IF passes < 5 THEN GOTO ReSort '                 repeat may be only move
                END IF
            END IF
        NEXT lb
    END IF
 
    IF (Level = 1) AND (Score = 777) THEN Score(0, TieTo(1)) = -777
END SUB
 
SUB TextInfo (zz$)
    IF smode <> 2 THEN EXIT SUB
 
    t$ = "History Thinking Legal Protection"
    LOCATE 3, 61
    FOR i = 1 TO LEN(t$)
        c$ = MID$(t$, i, 1)
        IF c$ = UCASE$(c$) THEN COLOR cp&(1) ELSE COLOR white&
        PRINT c$;
    NEXT
    COLOR fg0&, bg0&
 
    'LOCATE 1, 4: PRINT showthink; history; showlegalf; showprotf;
 
    z = 0
    IF showthink THEN z = 1
    IF history THEN z = 2
    IF showlegalf THEN z = 3
    IF showprotf THEN z = 4
    IF z = 0 THEN EXIT SUB
 
    IF DebugR > MaxRow THEN
        _DISPLAY
        DebugR = 3: DebugC = 61
        FOR r = DebugR TO MaxRow
            LOCATE r, DebugC
            PRINT SPACE$(100 - DebugC);
        NEXT r
    END IF
 
    SELECT CASE z '                                                  thinking
        CASE IS = 1
            DebugR = DebugR + 1
            LOCATE DebugR, DebugC
            PRINT zz$;
            IF DebugR = MaxRow THEN DebugR = 99
        CASE IS = 2 '                                                move log
            BeginAt = Move - 28
            IF BeginAt < 1 THEN BeginAt = 1
            tr = 4
            FOR i = BeginAt TO Move
                LOCATE tr, DebugC
                PRINT MoveLog$(i);
                tr = tr + 1
                IF tr > MaxRow THEN EXIT FOR
            NEXT i
        CASE IS = 3 '                                                legal
            FOR i = 1 TO Moves(0)
                tr = i + 3
                IF tr > MaxRow THEN EXIT FOR
                LOCATE tr, 63
                PRINT USING "## "; i;
                PRINT Move$(0, i);
            NEXT i
            FOR i = 1 TO Moves(1)
                tr = i + 3
                IF tr > MaxRow THEN EXIT FOR
                LOCATE tr, 73
                PRINT USING "## "; i;
                PRINT Move$(1, i);
            NEXT i
        CASE IS = 4 '                                                protected
            FOR i = 1 TO prot(0)
                tr = i + 3
                IF tr > MaxRow THEN EXIT FOR
                LOCATE tr, 63
                PRINT USING "## "; i;
                PRINT prot$(0, i);
            NEXT i
            FOR i = 1 TO prot(1)
                tr = i + 3
                IF tr > MaxRow THEN EXIT FOR
                LOCATE tr, 73
                PRINT USING "## "; i;
                PRINT prot$(1, i);
            NEXT i
    END SELECT
END SUB
 
SUB TryMove (Level, fc, fr, mp, mc) '                                from row, from column
    IF mc = 1 THEN s = -1 ELSE s = 1 '                               direction a pawn moves
    incheck = (mc = SaveWorB) AND check
 
    '                  rnbqkp
    nmoves = VAL(MID$("373772", mp, 1))
 
    FOR n = 0 TO nmoves '                                            possible 8 dirs
        du = du(mp, n): dd = dd(mp, n): dl = dl(mp, n): dr = dr(mp, n)
        IF mp <> Knight THEN du = SGN(du) * s: dd = SGN(dd) * s: dl = SGN(dl) * s: dr = SGN(dr) * s
        IF du(mp, 0) = 7 THEN TrySq = 7 ELSE TrySq = 1
        IF (mp = Pawn) AND (n = 0) THEN '                            pawn first move?
            IF (fr = 2) AND (WorB = 1) THEN TrySq = 2 '              gambit for white
            IF (fr = 7) AND (WorB = 0) THEN TrySq = 2 '              gambit for black
        END IF
        tc = fc: tr = fr '                                           row, column
        fs$ = alphal$(fc) + CHR$(48 + fr) '                          from square
        cap = false
        FOR sq = 1 TO TrySq '                                        up to 7 steps in current direction
            Score = 0 '                                              must init
            tc = tc - dl + dr '                                      column=column-left+right
            tr = tr - du + dd '                                      row=row-up+down
            IF (tr < 1) OR (tr > 8) OR (tc < 1) OR (tc > 8) THEN EXIT FOR
            ts$ = alphal$(tc) + CHR$(48 + tr) '                      to square
            IF fs$ = ts$ THEN SYSTEM
            cp = b(tc, tr) '                                         capture piece
            cc = -(cp > 6) - (cp = 0) * 2 '                          capture color
            cp = cp + (cp > 6) * 6
            IF mc = cc THEN '                                        own piece
                prot(Level) = prot(Level) + 1
                IF prot(Level) < q1 THEN prot$(Level, prot(Level)) = fs$ + ts$
                IF (mp = Pawn) AND (n = 0) THEN EXIT FOR
                IF mp = Knight THEN GOTO nsquare ELSE EXIT FOR
            ELSEIF (mc XOR 1) = cc THEN '                            capture
                IF (mp = Pawn) AND (n = 0) THEN EXIT FOR '           no diag, no cap!
                cap = true
                Score = Score + value(cp) * 10
                IF value(cp) = 0 THEN Score = 777 '                  king capture
            ELSE
                IF (mp = Pawn) AND (n > 0) THEN EXIT FOR
            END IF
 
            IF mp = King THEN
                IF Level = 0 THEN lm = 1 ELSE lm = 0 '               wonka
                'FOR i = 1 TO Moves(lm) '                            can any opponent piece move there?
                '    s$ = RIGHT$(Move$(lm, i), 2)
                'IF ts$ = s$ THEN GOTO nsquare '                     would be moving into check
                'NEXT
                FOR i = 1 TO prot(lm) '                              opponent piece protecting?
                    s$ = RIGHT$(prot$(lm, i), 2)
                    IF ts$ = s$ THEN GOTO nsquare '                  would be moving into check
                NEXT
                IF incheck THEN
                    Score = Score + 20
                ELSE
                    IF Move < 30 THEN Score = Score - 4 '            usually not good to be moving the King
                END IF
            ELSE
                dis1 = ABS(fr - okr) + ABS(fc - okc) '               get closer to king
                dis2 = ABS(tr - okr) + ABS(tc - okc)
                Score = Score + dis1 - dis2
                IF Move < 20 THEN
                    dir = SGN((fr - tr) * s)
                    IF dir = 1 THEN Score = Score + 2 '              move ahead at begin & mid game
                END IF
 
                ' priority to getting a piece off the bottom rank
                IF (fr = 1) AND (tr > 1) AND (WorB = 1) THEN Score = Score + 1
                IF (fr = 8) AND (tf < 8) AND (WorB = 0) THEN Score = Score + 1
                IF mp <> Rook THEN '                                 priority to getting a piece first moved
                    IF b(fc, fr) = o(fc, fr) THEN Score = Score + 1
                END IF
            END IF
            's1 = Score
 
            'IF (Score <> 777) AND (NOT (incheck)) THEN
 
            IF mp = Pawn THEN
                Score = Score + TrySq
                IF (tr = 1) OR (tr = 8) THEN '                       promote pawn
                    Score = Score + 99
                END IF
            END IF
            'END IF
            'IF s1 = 777 THEN Score = s1
 
            AddIt Level, fs$ + ts$, Score
 
            IF cap AND (mp = Pawn) AND (n = 0) THEN EXIT FOR
            IF cap AND (mp <> Knight) THEN EXIT FOR
            nsquare:
        NEXT sq
    NEXT n
 
    IF mp = Pawn THEN '                                              en passant
        IF WorB THEN othp = 6 ELSE othp = 12 '                       opponent pawn
        l1 = 7 + (WorB = 0) * 5 '                                    rank 7 for white, 2 for black
        l2 = 5 - (WorB = 0) '                                        rank 5 for white, 6 for black
    END IF
    IF (mp = Pawn) AND (fr = l2) AND (Level < 2) THEN
        FOR z = -1 TO 1 STEP 2 '                                     look each side
            lc = fc + z '                                            look column
            IF (lc > 0) AND (lc < 9) THEN '                          in bounds of board
                IF b(lc, fr) = othp THEN '                           it is a pawn
                    tc$ = alphal$(lc)
                    tm$ = tc$ + CHR$(48 + l1) + tc$ + CHR$(48 + l2) '  form coordinate
                    IF tm$ = lm$ THEN '                              yes, add e.p. to list of legal moves
                        epfc = fc: epfr = fr '                       en passant from row, column
                        eptc = lc: eptr = fr - s '                   en passant to row, column
                        eprc = lc: eprr = fr '                       en passant remove piece
                        ep$ = alphal$(epfc) + CHR$(48 + epfr) + alphal$(eptc) + CHR$(48 + eptr)
                        AddIt Level, ep$, 1 '                        add with score of 1
                    END IF
                END IF
            END IF
        NEXT z
    END IF
 
END SUB
 
SUB TempMess (t$, secs) STATIC
    'EXIT SUB
    zz = 100: x1 = xc - zz: x2 = xc + zz
    IF (LEN(t$) > 0) AND (t$ <> current$) THEN
        x = xc - LEN(t$) * 4
        y = 12
        LINE (x1, 0)-(x2, 28), black&, BF
        _PRINTSTRING (x, y), t$
        _DISPLAY
        current$ = t$
        mtime! = TIMER + secs: IF mtime! > maxtime& THEN mtime! = 0
    END IF
    IF (mtime! > 0) AND (TIMER > mtime!) THEN
        LINE (x1, 0)-(x2, 28), black&, BF
        _DISPLAY
        mtime! = 0
    END IF
END SUB
 
 

Title: Re: A 90% complete chess engine
Post by: TempodiBasic on March 01, 2020, 12:46:39 pm

Hi Richard
thanks for fast reply

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

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

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

[ This attachment cannot be displayed inline in 'Print Page' view ]

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

[ This attachment cannot be displayed inline in 'Print Page' view ]

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

Thanks to share and to improve

Title: Re: A 90% complete chess engine
Post by: Richard Frost on March 01, 2020, 01:12:27 pm

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

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

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

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

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

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

Title: Re: A 90% complete chess engine
Post by: Adrian on December 18, 2020, 10:49:37 am

Hi bplus snd Tempodibasic,

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

Cheers,
Adrian

Title: Re: A 90% complete chess engine
Post by: bplus on December 18, 2020, 11:30:35 am

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

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

Welcome!

Title: Re: A 90% complete chess engine
Post by: STxAxTIC on December 18, 2020, 11:45:58 am

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

Title: Re: A 90% complete chess engine
Post by: bplus on December 18, 2020, 11:58:23 am

Quote from: STxAxTIC on December 18, 2020, 11:45:58 am

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

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

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

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

Title: Re: A 90% complete chess engine
Post by: TempodiBasic on December 18, 2020, 09:33:11 pm

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

Title: Re: A 90% complete chess engine
Post by: Adrian on December 18, 2020, 10:56:33 pm

Hi bplus and TempodiBasic,

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

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

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

Text Only | Text with Attachments

QB64.org Forum

Active Forums => Programs => Topic started by: STxAxTIC on January 24, 2020, 06:52:46 pm