Author: Tony Worsman
Date: 10:41:47 02/24/03
Go up one level in this thread
'********************************************************************
' File: MINIMAXE.BAS (1.0a /Me)
' Purpose: A Didactic (Instructional) Chess Program
' Project: MiniMAX in BASIC
' Compiler: The program compiles with
' Visual Basic for DOS
' Authors: D.Steinwender, Ch.Donninger
' Date: May 1st, 1995
'********************************************************************
DEFINT A-Z
' Declaration of subroutines
DECLARE FUNCTION AlphaBeta% (Alpha%, Beta%, Distance%)
DECLARE FUNCTION AssessPosition% (Alpha%, Beta%, Side%)
DECLARE FUNCTION BPAssessment% (Square%, Row%, Column%, developed%)
DECLARE SUB CommandLoop ()
DECLARE SUB ComputerMove ()
DECLARE SUB ComputingDepth ()
DECLARE SUB CopyMainVariant (CurrMove%)
DECLARE SUB DisplayBoard (BoardOnly%)
DECLARE SUB DisplayMainVariant ()
DECLARE SUB DisplayMove (CurrMove%)
DECLARE SUB FlipBoard ()
DECLARE SUB GameOver ()
DECLARE SUB GenerateMoves (AllMoves%)
DECLARE SUB InitAssessment ()
DECLARE SUB InitGameTree ()
DECLARE SUB Initialize ()
DECLARE FUNCTION InputMove% (Move$)
DECLARE SUB InputPosition ()
DECLARE FUNCTION IsAttackingSquare% (Square%, Side%)
DECLARE SUB MoveBack ()
DECLARE SUB MoveList ()
DECLARE FUNCTION NextBestMove% ()
DECLARE SUB PerformMove (CurrMove%)
DECLARE SUB PrintBack ()
DECLARE SUB PrintLogo ()
DECLARE SUB PrintMove (CurrMove%)
DECLARE SUB PrintPosition ()
DECLARE SUB ReadPieces (Side%)
DECLARE SUB RegisterCaptureMove (Source%, Dest%)
DECLARE SUB RegisterEPMove (Source%, Dest%, ep%)
DECLARE SUB RegisterMove (Source%, Dest%)
DECLARE SUB RegisterPromotion (Source%, Dest%)
DECLARE FUNCTION SquareNotation$ (SquareNum%)
DECLARE FUNCTION SquareNumber% (SquareNot$)
DECLARE SUB TakeBackMove (CurrMove%)
DECLARE FUNCTION WPAssessment% (Square%, Row%, Column%, developed%)
'--------------------------------------------------------------------
' Definition of symbolic constants.
'--------------------------------------------------------------------
CONST BoardDim = 119 ' Dimension of expanded chess board
CONST MaxDepth = 19 ' Maximum search depth
CONST MoveDirections = 15 ' No. of move directions for all pieces
CONST PieceTypes = 6 ' No. of piece types - considering
' MoveDirections (wQueen = bQueen)
CONST MoveStackDim = 1000 ' Dimension of the move stack
'CONST MinDepth = 4 ' Minimum full ply search depth
' Pieces <color><piece>
CONST BK = -6 ' Black pieces
CONST BQ = -5
CONST BN = -4 ' Knight
CONST BB = -3
CONST BR = -2
CONST BP = -1
CONST Empty = 0 ' Empty Square
CONST WP = 1 ' White pieces
CONST WR = 2
CONST WB = 3
CONST WN = 4
CONST WQ = 5
CONST WK = 6
CONST Edge = 100 ' Frame of the chess program
' Material value of the pieces
CONST ValP = 100
CONST ValR = 500
CONST ValB = 350
CONST ValN = 325
CONST ValQ = 900
CONST ValK = 0 ' As both sides have just one king
' the value can be set to zero
' Check mate assessment
CONST CheckMateVal = 32000
CONST MaxPos = ValB ' Maximum of the position assessment
' Bonus for main variants and killer moves;
' used for the sorting of moves
CONST MainVarBonus = 500
CONST Killer1Bonus = 250
CONST Killer2Bonus = 150
' Total material value in the initial position
CONST MaterialTotal = 4 * (ValR + ValB + ValN) + (2 * ValQ)
CONST EndgameMaterial = 4 * ValR + 2 * ValB
' Square numbers of frequently used Squares
' ("if Board(E1)=WK" means "if Board(25)=6")
CONST A1 = 21
CONST B1 = 22
CONST C1 = 23
CONST D1 = 24
CONST E1 = 25
CONST F1 = 26
CONST G1 = 27
CONST H1 = 28
CONST C2 = 33
CONST H2 = 38
CONST A3 = 41
CONST C3 = 43
CONST D3 = 44
CONST E3 = 45
CONST A6 = 71
CONST C6 = 73
CONST D6 = 74
CONST E6 = 75
CONST H6 = 78
CONST A7 = 81
CONST C7 = 83
CONST H7 = 88
CONST A8 = 91
CONST B8 = 92
CONST C8 = 93
CONST D8 = 94
CONST E8 = 95
CONST F8 = 96
CONST G8 = 97
CONST H8 = 98
' Values of rows and columns
CONST AColumn = 1
CONST BColumn = 2
CONST CColumn = 3
CONST DColumn = 4
CONST EColumn = 5
CONST FColumn = 6
CONST GColumn = 7
CONST HColumn = 8
CONST Row1 = 2
CONST Row2 = 3
CONST Row3 = 4
CONST Row4 = 5
CONST Row5 = 6
CONST Row6 = 7
CONST Row7 = 8
CONST Row8 = 9
' Castling numbering (index into castling array)
' or move is not a castling move
CONST NoCastlingMove = 0
CONST ShortCastlingMove = 1
CONST LongCastlingMove = 2
' Player who is to make a move
CONST White = 1
CONST Black = -1
' Symbolic logical constants
CONST True = 1
CONST False = 0
CONST Legal = 1
CONST Illegal = 0
'-------------------------------------------------------------------
' Definition of data types.
'-------------------------------------------------------------------
' Information for one move, the data type of the move stack
TYPE MoveType
FromSqr AS INTEGER ' From Square
ToSqr AS INTEGER ' To Square
CapturedPiece AS INTEGER ' captured piece
PromotedPc AS INTEGER ' transformed/promoted piece
CastlingNr AS INTEGER ' type of castling move
EpSquare AS INTEGER ' Enpassant Square
Value AS INTEGER ' Assessment for the sorting of moves
END TYPE
' Index of the pieces into the offset list and
' fast/slow pace indication (used by the move generator)
TYPE PcOffsetType
Begin AS INTEGER
Ende AS INTEGER
Fastpaced AS INTEGER
END TYPE
' Information on pawn/pieces constellations
TYPE BothColorsType
White AS INTEGER
Black AS INTEGER
END TYPE
' Information on From/To Square (moves without additional information)
' Used for storing promising moves (main variants,
' killer moves)
TYPE FromToType
FromSqr AS INTEGER
ToSqr AS INTEGER
END TYPE
' Data structure for storing killer moves.
TYPE KillerType
Killer1 AS FromToType
Killer2 AS FromToType
END TYPE
'--------------------------------------------------------------------
' Definition of global variables and tables
'--------------------------------------------------------------------
DIM SHARED Board(BoardDim) AS INTEGER
DIM SHARED EpSquare(MaxDepth) AS INTEGER
DIM SHARED MoveStack(MoveStackDim) AS MoveType
DIM SHARED MovedCnt(H8) AS INTEGER ' Counts how often a piece has moved from
' a Square. Used to determine castling
' rights (also useable for
' assessment)
DIM SHARED Castling(2) AS INTEGER ' Has white/black already castled?
DIM SHARED Index AS INTEGER ' Index into MoveStack
' Registers the position in MoveStack. Moves of depth 'n' are stored in range
' (StackLimit(n), StackLimit(n+1)) in MoveStack.
DIM SHARED StackLimit(MaxDepth) AS INTEGER
DIM SHARED MVar(MaxDepth, MaxDepth) AS FromToType ' Main variants table
DIM SHARED KillerTab(MaxDepth) AS KillerType ' Killer moves table
' Tables for assessment function
DIM SHARED PawnControlled(BoardDim) AS BothColorsType ' Squares that are
' controlled by pawns
DIM SHARED Pawns(HColumn + 1) AS BothColorsType ' No. of pawns per column
DIM SHARED Rooks(HColumn + 1) AS BothColorsType ' No. of rooks per column
DIM SHARED Mobility(MaxDepth) AS INTEGER ' Mobility of bishop and rook
DIM SHARED ToSquare(MaxDepth) AS INTEGER ' ToSquare of the moves, used for
' sorting of moves and for extension
' of searches
DIM SHARED wKing AS INTEGER ' Position of the white king
DIM SHARED bKing AS INTEGER ' Position of the black king
DIM SHARED MaterialBalance(MaxDepth) AS INTEGER ' Mat. balance betw. white and
black
DIM SHARED MaterialSum(MaxDepth) AS INTEGER ' Total material value at the board
DIM SHARED MoveColor AS INTEGER ' Who is to make a move
DIM SHARED PlayerPlayer AS INTEGER ' Player vs. player (memo) mode
off/on
DIM SHARED Printing AS INTEGER ' Printing moves off/on
DIM SHARED MinDepth AS INTEGER ' Generally, searches are performed
' until MinDepth
DIM SHARED MaxExtension AS INTEGER ' Extensions in the search tree because of
' checks or captures are only carried out
' until MaxExtension (otherwise
' the search can explode)
DIM SHARED Depth AS INTEGER ' Search depth = no. of half moves from the
' initial position
DIM SHARED NodeCount AS LONG ' No. of examined positions/nodes
DIM SHARED LastMove AS INTEGER ' Last performed move
DIM SHARED InCheck AS INTEGER ' Player is being checked
DIM SHARED MoveCount AS INTEGER ' No. of half-moves performed so far
DIM SHARED isWhiteLast AS INTEGER ' For printing control
' Initial position of 10-by-12 board
DIM SHARED InitialPosition(BoardDim) AS INTEGER
FOR i = 0 TO BoardDim
READ InitialPosition(i)
NEXT i
DATA 100,100,100,100,100,100,100,100,100,100
DATA 100,100,100,100,100,100,100,100,100,100
DATA 100, 2 , 4 , 3 , 5 , 6 , 3 , 4 , 2 ,100
DATA 100, 1 , 1 , 1 , 1 , 1 , 1 , 1 , 1 ,100
DATA 100, 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 ,100
DATA 100, 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 ,100
DATA 100, 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 ,100
DATA 100, 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 ,100
DATA 100,-1 ,-1 ,-1 ,-1 ,-1 ,-1 ,-1 ,-1 ,100
DATA 100,-2 ,-4 ,-3 ,-5 ,-6 ,-3 ,-4 ,-2 ,100
DATA 100,100,100,100,100,100,100,100,100,100
DATA 100,100,100,100,100,100,100,100,100,100
' Move generator tables
DIM SHARED Offset(MoveDirections) AS INTEGER
Offset(0) = -9 ' Diagonal steps
Offset(1) = -11
Offset(2) = 9
Offset(3) = 11
Offset(4) = -1 ' Straight steps
Offset(5) = 10
Offset(6) = 1
Offset(7) = -10
Offset(8) = 19 ' Knight steps
Offset(9) = 21
Offset(10) = 12
Offset(11) = -8
Offset(12) = -19
Offset(13) = -21
Offset(14) = -12
Offset(15) = 8
DIM SHARED PcOffset(PieceTypes) AS PcOffsetType
PcOffset(Empty).Begin = 0 ' Empty Square
PcOffset(Empty).Ende = 0
PcOffset(Empty).Fastpaced = False
PcOffset(WP).Begin = -1 ' Pawn moves are produced separately
PcOffset(WP).Ende = -1
PcOffset(WP).Fastpaced = False
PcOffset(WR).Begin = 4 ' Rook
PcOffset(WR).Ende = 7
PcOffset(WR).Fastpaced = True
PcOffset(WB).Begin = 0 ' Bishop
PcOffset(WB).Ende = 3
PcOffset(WB).Fastpaced = True
PcOffset(WN).Begin = 8 ' Knight
PcOffset(WN).Ende = 15
PcOffset(WN).Fastpaced = False
PcOffset(WQ).Begin = 0 ' Queen
PcOffset(WQ).Ende = 7
PcOffset(WQ).Fastpaced = True
PcOffset(WK).Begin = 0 ' King
PcOffset(WK).Ende = 7
PcOffset(WK).Fastpaced = False
' Centralization tables. We only need Squares 0..H8 as
' pieces can't stand on a Square outside H8.
' The lower edge is preserved as we would otherwise have to
' transform board coordinates into centrality coordinates.
' H1 is further away from the center as G1. In spite of this, H1 has a better
' center value than G1. This table is used, a.o., for assessing
' the kings. The values of G1,H1 imply that the king remains on G1
' after castling and doesn't perform the unnecessary move G1-H1.
' (The knight is neither very well placed on G1 nor on H1).
DIM SHARED CenterTable(H8) AS INTEGER
FOR i = 0 TO H8
READ CenterTable(i)
NEXT i
' --- A B C D E F G H ---
DATA 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
DATA 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
DATA 0, 4, 0, 8, 12, 12, 8, 0, 4, 0
DATA 0, 4, 8, 12, 16, 16, 12, 8, 4, 0
DATA 0, 8, 12, 16, 20, 20, 16, 12, 8, 0
DATA 0, 12, 16, 20, 24, 24, 20, 16, 12, 0
DATA 0, 12, 16, 20, 24, 24, 20, 16, 12, 0
DATA 0, 8, 12, 16, 20, 20, 16, 12, 8, 0
DATA 0, 4, 8, 12, 16, 16, 12, 8, 4, 0
DATA 0, 4, 0, 8, 12, 12, 8, 0, 4
' Assessment of the Squares for the pawns.
' Is used in the position assessment.
' Center pawns on 2nd row is bad (they belong in the front).
' F-H pawns should stay behind for protection of the king.
DIM SHARED wPSquareValue(H7) AS INTEGER ' White pawns
FOR i = 0 TO H7
READ wPSquareValue(i)
NEXT i
' --- A B C D E F G H ---
DATA 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
DATA 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
DATA 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
DATA 0, 4, 4, 0, 0, 0, 6, 6, 6, 0
DATA 0, 6, 6, 8, 8, 8, 4, 6, 6, 0
DATA 0, 8, 8, 16, 22, 22, 4, 4, 4, 0
DATA 0, 10, 10, 20, 26, 26, 10, 10, 10, 0
DATA 0, 12, 12, 22, 28, 28, 14, 14, 14, 0
DATA 0, 18, 18, 28, 32, 32, 20, 20, 20
' No pawn can stay on the 8th row
DIM SHARED bPSquareValue(H7) AS INTEGER ' Black pawns
FOR i = 0 TO H7
READ bPSquareValue(i)
NEXT i
' --- A B C D E F G H ---
DATA 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
DATA 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
DATA 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
DATA 0, 18, 18, 28, 32, 32, 20, 20, 20, 0
DATA 0, 12, 12, 22, 28, 28, 14, 14, 14, 0
DATA 0, 10, 10, 20, 26, 26, 10, 10, 10, 0
DATA 0, 8, 8, 16, 22, 22, 4, 4, 4, 0
DATA 0, 6, 6, 8, 8, 8, 4, 6, 6, 0
DATA 0, 4, 4, 0, 0, 0, 6, 6, 6, 0
' No pawn can stay on the 8th row
' Material value of the pieces
DIM SHARED PcMaterial(PieceTypes) AS INTEGER
PcMaterial(Empty) = 0 ' Empty Square
PcMaterial(WP) = ValP ' Pawn
PcMaterial(WR) = ValR ' Rook
PcMaterial(WB) = ValB ' Bishop
PcMaterial(WN) = ValN ' Knight
PcMaterial(WQ) = ValQ ' Queen
PcMaterial(WK) = ValK ' King
' Symbolic representation of the pieces
DIM SHARED PcSymbol(PieceTypes) AS STRING * 1
PcSymbol(Empty) = "." ' Empty Square
PcSymbol(WP) = "P" ' Pawn
PcSymbol(WR) = "R" ' Rook
PcSymbol(WB) = "B" ' Bishop
PcSymbol(WN) = "N" ' Knight
PcSymbol(WQ) = "Q" ' Queen
PcSymbol(WK) = "K" ' King
' Symbolic representation of the pieces for printing
DIM SHARED PrintSymbol(PieceTypes) AS STRING * 1
PrintSymbol(Empty) = " " ' Empty Square
PrintSymbol(WP) = " " ' Pawn
PrintSymbol(WR) = "R" ' Rook
PrintSymbol(WB) = "B" ' Bishop
PrintSymbol(WN) = "N" ' Knight
PrintSymbol(WQ) = "Q" ' Queen
PrintSymbol(WK) = "K" ' King
' Color symbols
DIM SHARED ColorSymbol(2) AS STRING * 1
ColorSymbol(0) = "." ' Black
ColorSymbol(1) = "." ' Empty Square
ColorSymbol(2) = "*" ' White
'--------------------------------------------------------------------
' The actual program begins here
'--------------------------------------------------------------------
CALL PrintLogo
CALL Initialize
CALL CommandLoop
'--------------------------------------------------------------------
' The program ends here
'--------------------------------------------------------------------
'--------------------------------------------------------------------
' Alpha-Beta-Tree search
' Returns assessment from the viewpoint of the player who is to make
' a move. "Alpha" is the lower limit, "Beta" upper limit and "Distance"
' the number of half-moves until horizon.
' If "Distance" is positive, a normal Alpha-Beta search is performed,
' if less than 0 the quiescence search.
' Returns the NegaMax value from the point of view of the player who is
' to make a move.
' This procedure is called recursively.
'
' Local variables: i, Value, BestValue, Check
'---------------------------------------------------------------------
FUNCTION AlphaBeta (Alpha, Beta, Distance)
NodeCount = NodeCount + 1 ' Additional position examined
MVar(Depth, Depth).FromSqr = 0 ' Delete current main variant
' Position is always assessed, i.e. also inside the tree.
' This is necessary to recognize checkmate and stalemate. Also,
' the assessment is used to control search/extension.
' The number of nodes inside the tree is much smaller than that at
' the horizon. I.e. the program does not become significantly slower
' because of that.
' Assessment from the viewpoint of the player who is to make a move.
Value = AssessPosition(Alpha, Beta, MoveColor)
' In the case of a check, the search is extended, by up to four
' half-moves total. Otherwise it may happen that the search tree
' becomes extremely large thru mutual checks and capture sequences.
' As a rule, these move sequences are completely meaningless.
Check = InCheck
' If being checked, then extend the search
Condition1 = (Check = True AND Depth + Distance < MaxExtension + 1)
' By capture and re-capture on the same Square, the search is
' extended if the material balance remains approximately
' the same AND we didn't make too many extensions
' so far.
Condition2 = (Depth >= 2 AND Depth + Distance < MaxExtension)
Condition2 = Condition2 AND ToSquare(Depth) = ToSquare(Depth - 1)
Condition2 = Condition2 AND Value >= Alpha - 150 AND Value <= Beta + 150
IF Condition1 OR Condition2 THEN Distance = Distance + 1
' If more than 5 moves were already performed in the quiescence search
' or the opponent is checkmate or we have reached maximum search depth
' imposed by data structures, end the search.
IF Distance < -5 OR Value = CheckMateVal - Depth OR Depth >= MaxDepth THEN
AlphaBeta = Value
EXIT FUNCTION
END IF
' If - during the quiescence search - the player who is to move has a
' good position, the search is aborted since by definition the value
' can only become better during the quiescence search.
' Warning: Aborts already at Distance 1, i.e. a half-move before the
' horizon, in case the player who is to move is not
' being checked. This is a selective deviation from
' the brute-force-alpha-beta scheme.
IF Value >= Beta AND Distance + Check <= 1 THEN
AlphaBeta = Value
EXIT FUNCTION
END IF
' Compute moves. If Distance is <= 0 (quiescence search) only capture
' moves and promotion moves are computed.
CALL GenerateMoves(Distance) ' Examining if any moves at all are available
IF Distance > 0 THEN ' is indirectly done by determining
BestValue = -CheckMateVal ' BestValue.
ELSE ' In quiescence search, the current position
assessment
BestValue = Value ' is the lower limit of the search value.
END IF
' Examine all moves in the sorted sequence.
i = NextBestMove
DO WHILE i >= 0 ' As long as any moves are left
CALL PerformMove(i)
' NegaMax principle: the sign is reversed,
' the roles of alpha and beta exchanged.
Value = -AlphaBeta(-Beta, -Alpha, Distance - 1)
CALL TakeBackMove(i)
IF Value > BestValue THEN ' New best value found
BestValue = Value
IF Value >= Beta THEN ' Cutoff found
' Inside the tree, new main variants are still registered.
IF Distance > 0 THEN CALL CopyMainVariant(i)
GOTO done
END IF
IF Value > Alpha THEN ' Value is the improved lower limit
IF Distance > 0 THEN CALL CopyMainVariant(i) ' Register main var.
Alpha = Value ' Improved alpha value
END IF
END IF
i = NextBestMove
LOOP
done:
' A good move showing cutoff is entered into the killer table.
' Keep the best killer so far as the 2nd best killer.
IF Value >= Beta AND i >= 0 THEN
KillerTab(Depth).Killer2 = KillerTab(Depth).Killer1
KillerTab(Depth).Killer1.FromSqr = MoveStack(i).FromSqr
KillerTab(Depth).Killer1.ToSqr = MoveStack(i).ToSqr
END IF
' If the player has no more legal moves ...
IF BestValue = -(CheckMateVal - (Depth + 1)) THEN
IF Check = False THEN ' ... but isn't being checked,
AlphaBeta = 0 ' it's stalemate
EXIT FUNCTION
END IF
END IF
AlphaBeta = BestValue
END FUNCTION
'--------------------------------------------------------------------
' Position assessment.
' Returns value from the viewpoint of "Side".
' If material value deviates too far from the Alpha-Beta window,
' only material is assessed.
' If "Side" is checkmating, returns (CheckMateVal - Depth).
' If "Side" is being checked, the variable InCheck is changed
' to "True".
' Warning: The function assumes, both for check/checkmate and for the
' king opposition, that "Side" is the player who is to make a move.
'
' Local variables:
' Value, PosValue, i, j, k, Square, wBishop, bBishop
' PawnCount, MatSum, WRon7, BRon2
' wDeveloped, bDeveloped
'--------------------------------------------------------------------
FUNCTION AssessPosition (Alpha, Beta, Side)
' First examine if opponent is checkmate
' or "Side" is being checked
IF Side = White THEN
IF IsAttackingSquare(bKing, White) = True THEN
AssessPosition = CheckMateVal - Depth
EXIT FUNCTION
END IF
InCheck = IsAttackingSquare(wKing, Black) ' Is white being checked?
ELSE
IF IsAttackingSquare(wKing, Black) = True THEN
AssessPosition = CheckMateVal - Depth
EXIT FUNCTION
END IF
InCheck = IsAttackingSquare(bKing, White) ' Is black being checked?
END IF
' Positional assessment factors do not outweigh a heavy material
' imbalance. Hence, we omit the position assessment in this case.
' Exception: The late endgame. Free pawns have a high value.
' A junior officer without pawns is without effect.
Value = MaterialBalance(Depth)
MatSum = MaterialSum(Depth)
IF MatSum > ValB + ValB THEN
IF Value < Alpha - MaxPos OR Value > Beta + MaxPos THEN
AssessPosition = Value
EXIT FUNCTION
END IF
END IF
' Initialize the lines of rooks and pawns as well as the pawn controls.
' This could be computed incrementally significantly faster when
' performing (and taking back) the moves. However, this incremental
' computation is difficult and error-prone due to the special cases
' castling, En Passant, and promotion.
' You could also build a list of pieces in 'InitAssessment' and
' in the second turn go thru this list (and no longer the entire
' board).
' The fastest solution consists of computing this list of pieces
' incrementally, too. This complicates, however, the functions
' "PerformMove" and "TakeBackMove".
' Following the KISS principle (Keep It Simple and Stupid), this
' solution was chosen in MiniMAX.
CALL InitAssessment
PosValue = 0
' Used for assessing the bishop pair.
bBishop = 0
wBishop = 0
' Used for determining insufficient material.
PawnCount = 0
' White rooks on 7/8th row, black rooks on 1/2nd
WRon7 = 0
BRon2 = 0
' Development state: Castled and junior officers developed.
wDeveloped = Castling(White + 1)
bDeveloped = Castling(Black + 1)
' Knight on B1 developed?
IF MovedCnt(B1) > 0 THEN wDeveloped = wDeveloped + 1
' Bishop on C1 developed?
IF MovedCnt(C1) > 0 THEN wDeveloped = wDeveloped + 1
' Bishop on F1 developed?
IF MovedCnt(F1) > 0 THEN wDeveloped = wDeveloped + 1
' Knight on G1 developed?
IF MovedCnt(G1) > 0 THEN wDeveloped = wDeveloped + 1
' Knight on B8 developed?
IF MovedCnt(B8) > 0 THEN bDeveloped = bDeveloped + 1
' Bishop on C8 developed?
IF MovedCnt(C8) > 0 THEN bDeveloped = bDeveloped + 1
' Bishop on F8 developed?
IF MovedCnt(F8) > 0 THEN bDeveloped = bDeveloped + 1
' Knight on G8 developed?
IF MovedCnt(G8) > 0 THEN bDeveloped = bDeveloped + 1
' Read the entire board and assess each piece.
' The asssessment takes white's point of view. For the black
' pieces, a positive assessment means that this evaluation
' is unfavorable for black.
FOR i = Row1 TO Row8
Square = i * 10
FOR j = AColumn TO HColumn
Square = Square + 1
SELECT CASE Board(Square)
CASE BK
IF MatSum < EndgameMaterial THEN ' Endgame assessment for king
' Centralize the king in the endgame
PosValue = PosValue - CenterTable(Square)
ELSE
' Not castled yet, but castling rights lost
IF Castling(Black + 1) = False THEN
IF MovedCnt(E8) > 0 OR (MovedCnt(H8) > 0 AND MovedCnt(A8) > 0) THEN
PosValue = PosValue + 35
END IF
END IF
' King preferably not in the center
PosValue = PosValue + 4 * CenterTable(Square)
FOR k = -1 TO 1
' Bonus for pawn shield before the king
IF Board(Square - 10 + k) = BP THEN PosValue = PosValue - 15
' Pawn shield 2 rows before the king
IF Board(Square - 20 + k) = BP THEN PosValue = PosValue - 6
' Deduct for half-open line occupied by
' enemy rook.
IF Pawns(j + k).White = 0 AND Rooks(j + k).White > 0 THEN
PosValue = PosValue + 12
END IF
NEXT k
END IF
CASE BQ
' Avoid queen outings in the opening of the game
IF bDeveloped < 4 THEN
IF Square < A8 THEN PosValue = PosValue + 15
ELSE ' If development is completed, place the queen near
' the enemy king. Row and column distance
' between queen and enemy king should be small.
RowDiff = ABS(wKing \ 10 - Square \ 10)
ColDiff = ABS(wKing MOD 10 - Square MOD 10)
PosValue = PosValue + 2 * (RowDiff + ColDiff)
END IF
CASE BN ' Black knight
PosValue = PosValue - CenterTable(Square) / 2 ' Centralize knight
CASE BB
' Bishop should not impede black d7/e7 pawns.
' Bishop is also assessed by variable mobility
' in the move generator
IF (Square = D6 OR Square = E6) AND Board(Square + 10) = BP THEN
PosValue = PosValue + 20
END IF
bBishop = bBishop + 1 ' No. of bishops for the bishop pair
CASE BR ' Rook influences the king assessment
' Black rook has penetrated row 1 or 2
IF Square <= H2 THEN BRon2 = BRon2 + 1
' Bring rooks from a and h columns into the center
IF j >= CColumn AND j <= EColumn THEN PosValue = PosValue - 4
' Rooks on half-open and open lines
IF Pawns(j).White = 0 THEN
PosValue = PosValue - 8 ' Rook on half-open line
' Rook on open line
IF Pawns(j).Black = 0 THEN PosValue = PosValue - 5
END IF
CASE BP ' The pawn assessment is relatively complex. Consequently,
' it is accomplished in a separate routine.
PosValue = PosValue - BPAssessment((Square), (i), (j), (bDeveloped))
PawnCount = PawnCount + 1
CASE Empty
' Do nothing
CASE WP ' White assessment is analogous to the black
PosValue = PosValue + WPAssessment((Square), (i), (j), (wDeveloped))
PawnCount = PawnCount + 1
CASE WR
' White rook on 7th or 8th row
IF Square >= A7 THEN WRon7 = WRon7 + 1
' Bring rooks from a and h columns into the center
IF j >= CColumn AND j <= EColumn THEN PosValue = PosValue + 4
' Rooks on half-open and open lines
IF Pawns(j).Black = 0 THEN
PosValue = PosValue + 8 ' Rook on half-open line
' Rook on open line
IF Pawns(j).White = 0 THEN PosValue = PosValue + 5
END IF
CASE WB
' Bishop should not block pawns on D3/E3.
IF (Square = D3 OR Square = E3) AND Board(Square - 10) = WP THEN
PosValue = PosValue - 20
END IF
wBishop = wBishop + 1
CASE WN
PosValue = PosValue + CenterTable(Square) \ 2
CASE WQ
' Avoid queen outings in the beginning of the game
IF wDeveloped < 4 THEN
IF Square > H1 THEN PosValue = PosValue - 15
ELSE ' Place the queen near the enemy king.
' Row and column distance
' between queen and enemy king should be small.
RowDiff = ABS(bKing \ 10 - Square \ 10)
ColumnDiff = ABS(bKing MOD 10 - Square MOD 10)
PosValue = PosValue - 2 * (RowDiff + ColumnDiff)
END IF
CASE WK
IF MatSum < EndgameMaterial THEN ' Endgame assessment for the king
' Centralize the king in the endgame
PosValue = PosValue + CenterTable(Square)
' Near opposition of the kings
IF ABS(Square - bKing) = 20 OR ABS(Square - bKing) = 2 THEN
k = 10
' Opposition in the pawn endgame
IF MatSum = 0 THEN k = 30
IF MoveColor = White THEN
PosValue = PosValue - k
ELSE
PosValue = PosValue + k
END IF
END IF
ELSE
' Not castled yet, but castling rights lost
IF Castling(White + 1) = False THEN
IF MovedCnt(E1) > 0 OR (MovedCnt(H1) > 0 AND MovedCnt(A1) > 0) THEN
PosValue = PosValue - 35
END IF
END IF
' King preferably not in the center
PosValue = PosValue - 4 * CenterTable(Square)
FOR k = -1 TO 1
' Bonus for pawn shield before the king
IF Board(Square + 10 + k) = WP THEN PosValue = PosValue + 15
' Pawn shield 2 rows before the king
IF Board(Square + 20 + k) = WP THEN PosValue = PosValue + 6
' Deduct for half-open lines occupied by
' enemy rook.
IF Pawns(j + k).Black = 0 AND Rooks(j + k).Black > 0 THEN
PosValue = PosValue - 12
END IF
NEXT k
END IF
END SELECT
NEXT j
NEXT i
' No pawns left on the board and insufficient material
' Recognizes all elementary draw situations
' KK, KBK, KNK, KNNK, KBKB, KNKB.
IF PawnCount = 0 THEN
Bed1 = MatSum <= ValB ' Less than a bishop
Bed2 = MatSum = 2 * ValN ' Two knights
' Two bishops, but material difference less than a pawn
Bed3 = MatSum <= 2 * ValB AND ABS(MaterialBalance(Depth)) < ValP
IF Bed1 OR Bed2 OR Bed3 THEN
AssessPosition = 0
EXIT FUNCTION
END IF
END IF
' Bishop pair bonus for white
IF wBishop >= 2 THEN PosValue = PosValue + 15
' Bishop pair bonus for black
IF bBishop >= 2 THEN PosValue = PosValue - 15
' White rooks on 7/8th row and black king also
' on these rows
IF WRon7 > 0 AND bKing >= A7 THEN
PosValue = PosValue + 10
' Double rooks extra dangerous
IF WRon7 > 1 THEN PosValue = PosValue + 25
END IF
' Black rooks on 1/2nd rows and white king also
' on these rows
IF BRon2 > 0 AND wKing <= H2 THEN
PosValue = PosValue - 10
IF BRon2 > 1 THEN PosValue = PosValue - 25
END IF
IF Side = Black THEN ' Assessment was from white's point of view
PosValue = -PosValue ' Change sign for black
END IF
' Consider the mobility of bishops and rooks. This is done
' by the move generator. Mobility(Depth) is the
' mobility of the opponent, mobility(Depth-1) that of
' "Side" (before the opponent has made a move).
IF Depth >= 1 THEN
PosValue = PosValue - ((Mobility(Depth) - Mobility(Depth - 1)) / 16)
END IF
AssessPosition = Value + PosValue
END FUNCTION
'--------------------------------------------------------------------
' Assessment of one black pawn. Besides passed parameters, the
' pawn controls, pawn lines, and rook lines must be correctly
' engaged.
' Returns the assessment from black's viewpoint.
'--------------------------------------------------------------------
FUNCTION BPAssessment (Square, Row, Column, developed)
Row = (Row8 + Row1) - Row ' Flip row. This makes higher row = better,
' as for white.
IF MaterialSum(Depth) > EndgameMaterial THEN ' Opening or midgame
Value = bPSquareValue(Square)
' If development incomplete, don't push edge pawns forward
IF developed < 4 THEN
IF (Column >= FColumn OR Column <= BColumn) AND Row > Row3 THEN
Value = Value - 15
END IF
END IF
ELSE ' In the endgame, all lines are equally good.
' Bring pawns forward.
Value = Row * 4
END IF
' Is the pawn isolated?
' Edge pawns don't require extra treatment. Pawns(AColumn-1) is
' the left edge, Pawns(HColumn+1) the right edge. No pawn is
' placed on these edges.
IF Pawns(Column - 1).Black = 0 AND Pawns(Column + 1).Black = 0 THEN
Value = Value - 12 ' Isolated pawn
' Isolated double pawn
IF Pawns(Column).Black > 1 THEN Value = Value - 12
END IF
' Double pawn
IF Pawns(Column).Black > 1 THEN Value = Value - 15
' Duo or guarded pawn gets a Bonus
' e.g.. e5,d5 is a Duo, d6 guards e5
IF PawnControlled(Square).Black > 0 OR PawnControlled(Square - 10).Black > 0
THEN
Value = Value + Row
END IF
IF Pawns(Column).White = 0 THEN ' Half-open column
' Pawn left behind on half-open column:
' Left-behind pawn is not guarded by its fellow pawns...
Condition1 = PawnControlled(Square).Black = 0
' ... and can't advance because enemy pawns
' control the Square in front of him.
Condition2 = PawnControlled(Square - 10).White > PawnControlled(Square -
10).Black
IF Condition1 AND Condition2 THEN
Value = Value - 10
' Rook impeded by left-behind pawn
IF Rooks(Column).White > 0 THEN Value = Value - 8
ELSE
' Pawn is a free pawn, on a half-open column and the
' Squares ahead on his column are not controlled by
' enemy pawns.
FOR j = Square TO A3 STEP -10 ' Until 3rd row
IF PawnControlled(j).White > 0 THEN
BPAssessment = Value
EXIT FUNCTION
END IF
NEXT j
' Found a free pawn. In the endgame, a free pawn is more important
' than in the midgame.
IF MaterialSum(Depth) < EndgameMaterial THEN
Value = Value + Row * 16 ' The more advanced, the better
' Rook guards free pawn on the same column
IF Rooks(Column).Black > 0 THEN Value = Value + Row * 2
' Enemy rook on the same column
IF Rooks(Column).White > 0 THEN Value = Value - Row * 2
' Pure pawn endgame. Free pawn particularly valuable.
IF MaterialSum(Depth) = 0 THEN Value = Value + Row * 8
' Guarded free pawn
IF PawnControlled(Square).Black > 0 OR PawnControlled(Square - 10).Black >
0 THEN
Value = Value + Row * 4
END IF
' Free pawn blocked by a white piece. This piece is not
' threatened by fellow pawns.
IF Board(Square - 10) < 0 AND PawnControlled(Square - 10).Black = 0 THEN
Value = Value - Row * 4
END IF
ELSE ' Free pawn in the midgame
Value = Value + Row * 8
' Guarded free pawn
IF PawnControlled(Square).Black > 0 OR PawnControlled(Square - 10).Black >
0 THEN
Value = Value + Row * 2
END IF
END IF
END IF
END IF
BPAssessment = Value
END FUNCTION
'--------------------------------------------------------------------
' Reads the player's commands in a loop and calls
' the appropriate functions. The loop is terminated by
' the "EN" command.
' If the input is not a command it is interpreted as a
' move (on the form "e2e4" (from-Square, to-Square)),
' and ignored as a command. See also: PrintLogo
'--------------------------------------------------------------------
SUB CommandLoop
Ende = False
DO
PRINT
INPUT " Your input: ", Cmd$
Cmd$ = UCASE$(Cmd$) ' Change to uppercase
SELECT CASE Cmd$
CASE "EX"
Ende = True
CALL GameOver
CASE "NG"
PRINT " New game"
CALL Initialize
CASE "DB"
CALL DisplayBoard(False)
CASE "CP"
CALL InputPosition
CASE "PL"
CALL ComputerMove
CASE "FB"
CALL FlipBoard
CASE "PR"
PRINT " Printing ";
IF Printing = False THEN
Printing = True
PRINT "on "
ELSE
Printing = False
PRINT "off"
END IF
CASE "MM"
PRINT " Player-Player ";
IF PlayerPlayer = False THEN
PlayerPlayer = True
PRINT "on "
ELSE
PlayerPlayer = False
PRINT "off"
END IF
CASE "DL"
CALL MoveList
CASE "TB"
CALL MoveBack
CASE "SD"
CALL ComputingDepth
CASE "DA"
CALL InitGameTree
PRINT " Assessment= "; AssessPosition(-CheckMateVal, CheckMateVal,
MoveColor)
CASE "?", "HELP"
CALL PrintLogo
CASE ELSE
IF InputMove(Cmd$) = False THEN
PRINT " Illegal move or unknown command"
ELSEIF PlayerPlayer = False THEN
CALL ComputerMove
END IF
END SELECT
LOOP WHILE Ende = False
END SUB
'--------------------------------------------------------------------
' Computes the next computer move.
' The search is iteratively deepened until MinDepth.
' The search uses "Aspiration"-Alpha-Beta.
' The search process can be interrupted by
' a keypress.
' If the search wasn't interrupted and no checkmate/stalemate
' exists, the best move is performed.
'--------------------------------------------------------------------
SUB ComputerMove
DIM tmp AS MoveType ' Temporary MoveType variable
CALL InitGameTree
' Assess the initial position. End search if opponent is already checkmate.
Value = AssessPosition(-CheckMateVal, CheckMateVal, MoveColor)
IF Value = CheckMateVal THEN
PRINT " Checkmate!"
EXIT SUB
END IF
' Store "checked state". Required to recognize
' stalemate at the end of the search.
Schach = InCheck
NodeCount = 0
' Start time of the computation. Used for displaying nodes/second.
StartTimer& = TIMER
' Generate all pseudo-legal moves
CALL GenerateMoves(1)
' You could/should remove all illegal moves from the MoveStack
' here and only keep computing with legal moves.
' (Has only an optical effect, however, as the search is always aborted
' immediately after performing an illegal move).
' Iterative deepening: Distance is the number of half-moves until the
' horizon. Is not equal to the depth, however, as the distance can increase
' during the search process (e.g. by checks).
FOR Distance = 1 TO MinDepth
IF Distance = 1 THEN ' On Depth 1, we compute with open windows
Alpha = -CheckMateVal ' We have no good assessment value for
Beta = CheckMateVal ' the position yet.
ELSE ' On the higher levels, the result should not
Beta = Alpha + 100 ' differ significantly from the result of the
Alpha = Alpha - 100 ' previous Depth.
END IF
' For capture moves and checks, the search is extended.
' This variable limits the extensions.
MaxExtension = Distance + 3
PRINT
PRINT
PRINT " ComputingDepth="; Distance; ",";
PRINT " Alpha-Beta window= ["; Alpha; ","; Beta; "]"
MovesInLine = 0
PRINT " ";
' Compute the value of each move
FOR i = 0 TO StackLimit(1) - 1
IF INKEY$ <> "" THEN
' Stop the calculation if a key is pressed
PRINT " Computation interrupted!"
EXIT SUB
END IF
MovesInLine = MovesInLine + 1
' Initialize the main variant and display
' the move just examined.
MVar(Depth, Depth).FromSqr = 0
CALL DisplayMove(i)
IF MovesInLine MOD 9 = 8 THEN ' Eight moves per line
PRINT
MovesInLine = 0
PRINT " ";
END IF
' Perform move, compute value, take back move.
CALL PerformMove((i))
Value = -AlphaBeta(-Beta, -Alpha, Distance - 1)
CALL TakeBackMove((i))
IF i = 0 THEN ' Was it the first move (the best yet)?
' This move requires an exact value.
IF Value < Alpha THEN
' Search for the best move until now 'fails low' out the
' window (the program understands the mishap). Requires
' a renewed search with windows opened 'below'.
Alpha = -CheckMateVal
Beta = Value
PRINT "? ["; Alpha; ","; Beta; "]"
MovesInLine = 0
PRINT " ";
CALL PerformMove((i))
Value = -AlphaBeta(-Beta, -Alpha, Distance - 1)
CALL TakeBackMove((i))
ELSEIF Value >= Beta THEN ' Fails high
Alpha = Value
Beta = CheckMateVal
PRINT "! ["; Alpha; ","; Beta; "]"
MovesInLine = 0
PRINT " ";
CALL PerformMove((i))
Value = -AlphaBeta(-Beta, -Alpha, Distance - 1)
CALL TakeBackMove((i))
END IF
' There is just a slim chance that a subsequent move is
' even better. We continue calculating with a null window
' as this expedites the search.
Alpha = Value
Beta = Alpha + 1
PRINT
PRINT " Best move: ";
CALL DisplayMove(i)
PRINT "Value ="; Value
CALL CopyMainVariant(i)
CALL DisplayMainVariant
MovesInLine = 0
PRINT " ";
ELSE ' Already computed the best move yet to SearchDepth
IF Value > Alpha THEN
' New best move found. Currently, it is only known
' that it is better. The exact value must be computed
' again with an open window.
BestValue = Alpha
Alpha = Value
Beta = CheckMateVal
CALL PerformMove((i))
Value = -AlphaBeta(-Beta, -Alpha, Distance - 1)
CALL TakeBackMove((i))
' Is it also better with the open window?
' Solely applying alpha-beta, the move must always
' be better with the open window. Since the window is
' considered by the extensions and in the selectivity,
' the outcome may be different in our case.
IF Value > BestValue THEN
Alpha = Value
Beta = Alpha + 1
PRINT
PRINT " Best move: ";
CALL DisplayMove(i)
PRINT "Value ="; Value
CALL CopyMainVariant(i)
CALL DisplayMainVariant
MovesInLine = 0
PRINT " ";
' Place the best move at the start of the MoveList.
' Push the other moves one position up.
tmp = MoveStack(i)
FOR j = i TO 1 STEP -1
MoveStack(j) = MoveStack(j - 1)
NEXT j
MoveStack(0) = tmp
END IF
END IF
END IF
NEXT i
NEXT Distance
EndTimer& = TIMER
IF Alpha > -(CheckMateVal - 1) THEN
PRINT
PRINT
PRINT " Computer plays: ";
CALL DisplayMove(0) ' Best move is always sorted into position
' zero of the MoveStack
PRINT
PRINT " Value ="; Alpha; ", positions ="; NodeCount;
ETime = EndTimer& - StartTimer&
' Prevent division by zero on nodes/second
IF ETime = 0 THEN ETime = 1
PRINT ", time="; ETime; "sec., positions/sec. ="; NodeCount \ ETime
CALL PerformMove(0)
CALL PrintMove(0)
IF Alpha >= CheckMateVal - 10 THEN
PRINT
PRINT " I checkmate in "; (CheckMateVal - 2 - Alpha) \ 2; " moves"
ELSE
IF Alpha <= -CheckMateVal + 10 THEN
PRINT
PRINT " I'm checkmated in "; (Alpha + CheckMateVal - 1) \ 2; " moves"
END IF
END IF
ELSE
IF Schach = True THEN
PRINT " Congratulations: MiniMAX is checkmated!"
ELSE
PRINT " Stalemate!"
END IF
END IF
END SUB
' -----------------------------------------------------------------
' Input the minimum ComputingDepth
' -----------------------------------------------------------------
SUB ComputingDepth
PRINT " ComputingDepth is"; MinDepth
INPUT " New ComputingDepth: ", LInput
tmp = LInput
IF tmp > 0 AND tmp < MaxDepth - 9 THEN
MinDepth = tmp
ELSE
PRINT " Invalid ComputingDepth"
END IF
END SUB
'--------------------------------------------------------------------
' Registers the current move in the main variant and copies
' the continuation that was found on the next depth.
'--------------------------------------------------------------------
SUB CopyMainVariant (CurrMove)
' New main variant is a continuation of this variant
MVar(Depth, Depth).FromSqr = MoveStack(CurrMove).FromSqr
MVar(Depth, Depth).ToSqr = MoveStack(CurrMove).ToSqr
i = 0
DO
i = i + 1
MVar(Depth, Depth + i) = MVar(Depth + 1, Depth + i)
LOOP UNTIL MVar(Depth + 1, Depth + i).FromSqr = 0
END SUB
'--------------------------------------------------------------------
' Display of the game board and the game/board state.
' Only displays game/board state if "BoardOnly" is false.
'
' The SGN function (Signum) returns the sign, i.e. -1 or +1
' The ABS function returns the absolute value (without sign)
'--------------------------------------------------------------------
SUB DisplayBoard (BoardOnly)
' Display board
FOR i = Row8 TO Row1 STEP -1 ' For all rows
PRINT
PRINT i - 1; " "; ' Row coordinates
FOR j = AColumn TO HColumn ' For all lines
Piece = Board(i * 10 + j)
Side = SGN(Piece) ' Compute color from piece
' Empty Square has color 0
Piece = ABS(Piece) ' Type of piece
PRINT ColorSymbol(Side + 1); PcSymbol(Piece); " ";
NEXT j
NEXT i
PRINT
PRINT " ";
FOR j = AColumn TO HColumn ' Line coordinates 'a'...'h'
PRINT " "; CHR$(ASC("a") - 1 + j);
NEXT j
PRINT ' Empty line
PRINT ' Empty line
IF BoardOnly THEN EXIT SUB
' Remaining board/game state
IF MoveColor = White THEN
PRINT " White";
ELSE
PRINT " Black";
END IF
PRINT " is to make a move"
PRINT " Material balance = "; MaterialBalance(Depth)
PRINT " En Passant Square = "; SquareNotation$(EpSquare(Depth))
' Castling is in principle possible if king and the appropriate
' rook haven't moved.
PRINT " Castling state black = ";
IF MovedCnt(E8) + MovedCnt(H8) = 0 THEN PRINT "0-0 ";
IF MovedCnt(E8) + MovedCnt(A8) = 0 THEN PRINT "0-0-0";
PRINT
PRINT " Castling state white = ";
IF MovedCnt(E1) + MovedCnt(H1) = 0 THEN PRINT "0-0 ";
IF MovedCnt(E1) + MovedCnt(A1) = 0 THEN PRINT "0-0-0";
PRINT
END SUB
'--------------------------------------------------------------------
' Display the current main variant. Only the from-to Squares
' are output.
'--------------------------------------------------------------------
SUB DisplayMainVariant
PRINT " Main variant: ";
i = 0
DO WHILE MVar(0, i).FromSqr <> 0
PRINT SquareNotation$(MVar(0, i).FromSqr); "-";
PRINT SquareNotation$(MVar(0, i).ToSqr); " ";
i = i + 1
LOOP
PRINT
END SUB
'--------------------------------------------------------------------
' Display the current move in chess notation.
' Castling is 'E1-G1' and not O-O
' CurrMove is the index of the move into MoveStack.
'--------------------------------------------------------------------
SUB DisplayMove (CurrMove)
Source = MoveStack(CurrMove).FromSqr
Dest = MoveStack(CurrMove).ToSqr
PRINT PcSymbol(ABS(Board(Source))); ' Type of piece
PRINT SquareNotation$(Source); ' Initial Square
IF MoveStack(CurrMove).CapturedPiece = Empty THEN
PRINT "-"; ' Normal move
ELSE
PRINT "x"; ' Capture move
END IF
PRINT SquareNotation$(Dest); ' Target Square
' If promoted, add promotion piece
IF MoveStack(CurrMove).PromotedPc <> Empty THEN
PRINT PcSymbol(MoveStack(CurrMove).PromotedPc);
END IF
PRINT " ";
END SUB
'---------------------------------------------------------------------
' Flips the representation of the board on the monitor.
' Note: Not implemented in version 1.0
'---------------------------------------------------------------------
SUB FlipBoard
END SUB
'--------------------------------------------------------------------
' Stores the game and game parameters on the harddisk.
' Note: Not implemented in version 1.0
'--------------------------------------------------------------------
SUB GameOver
END SUB
'--------------------------------------------------------------------
' Generates moves and places them on the MoveStack.
' Returns the number of moves.
' If "AllMoves" is greater than 0, all pseudo-legal
' moves are produced, otherwise all pseudo-legal capture moves,
' promotions, En Passant, and castling moves.
'--------------------------------------------------------------------
SUB GenerateMoves (AllMoves)
Index = StackLimit(Depth) ' Start of MoveList on current depth
Mobility(Depth) = 0
' Search the board for pieces
FOR Source = A1 TO H8
Piece = Board(Source)
' Empty and edge Squares make no moves
IF Piece = Empty OR Piece = Edge THEN GOTO NextSquare
' Piece must also be of correct color
IF MoveColor = White AND Piece < 0 THEN GOTO NextSquare
IF MoveColor = Black AND Piece > 0 THEN GOTO NextSquare
Piece = ABS(Piece) ' Type of piece. Color doesn't influence
' (except for pawns) the move direction.
IF Piece = WP THEN ' Pawn moves
IF MoveColor = White THEN
IF Board(Source + 10) = Empty THEN
IF Source >= A7 THEN
CALL RegisterPromotion(Source, Source + 10)
ELSEIF AllMoves > 0 THEN
CALL RegisterMove(Source, Source + 10)
' Double-step possible?
IF Source <= H2 AND Board(Source + 20) = Empty THEN
CALL RegisterMove(Source, Source + 20)
' Move has already increased Index
MoveStack(Index - 1).EpSquare = Source + 10
END IF
END IF
END IF
IF Board(Source + 11) < 0 THEN ' Pawn can capture black piece
IF Source >= A7 THEN
CALL RegisterPromotion(Source, Source + 11)
ELSE
CALL RegisterCaptureMove(Source, Source + 11)
END IF
END IF
IF Board(Source + 9) < 0 THEN ' Likewise in other capture direction
IF Source >= A7 THEN
CALL RegisterPromotion(Source, Source + 9)
ELSE
CALL RegisterCaptureMove(Source, Source + 9)
END IF
END IF
ELSEIF MoveColor = Black THEN ' Same for black pawns
IF Board(Source - 10) = Empty THEN
IF Source <= H2 THEN
CALL RegisterPromotion(Source, Source - 10)
ELSEIF AllMoves > 0 THEN
CALL RegisterMove(Source, Source - 10)
' Double-step possible?
IF Source >= A7 AND Board(Source - 20) = Empty THEN
CALL RegisterMove(Source, Source - 20)
' Move has already increased Index
MoveStack(Index - 1).EpSquare = Source - 10
END IF
END IF
END IF
' For black pawns, also examine the edge,
' not for white as the edge is > 0.
IF Board(Source - 11) > 0 AND Board(Source - 11) <> Edge THEN
IF Source <= H2 THEN
CALL RegisterPromotion(Source, Source - 11)
ELSE
CALL RegisterCaptureMove(Source, Source - 11)
END IF
END IF
IF Board(Source - 9) > 0 AND Board(Source - 9) <> Edge THEN
IF Source <= H2 THEN
CALL RegisterPromotion(Source, Source - 9)
ELSE
CALL RegisterCaptureMove(Source, Source - 9)
END IF
END IF
END IF
GOTO NextSquare ' Examine next Square
END IF
' Moves for all other pieces are computed
' by way of move offset.
Fastpaced = PcOffset(Piece).Fastpaced
FOR i = PcOffset(Piece).Begin TO PcOffset(Piece).Ende
Direction = Offset(i)
Dest = Source
slideon2:
Dest = Dest + Direction
IF Board(Dest) = Empty THEN
IF AllMoves > 0 THEN
CALL RegisterMove(Source, Dest)
END IF
IF Fastpaced THEN ' Bishop, rook, and queen
GOTO slideon2
ELSE ' Knight and king
GOTO NextDirection
END IF
END IF
IF Board(Dest) = Edge THEN ' Hit the edge, keep searching
GOTO NextDirection ' in another direction
END IF
' Hit a piece. Must be of the correct color.
CaptureMove = MoveColor = White AND Board(Dest) < 0
CaptureMove = CaptureMove OR (MoveColor = Black AND Board(Dest) > 0)
IF CaptureMove THEN CALL RegisterCaptureMove(Source, Dest)
NextDirection:
NEXT i
NextSquare:
NEXT Source
' Enpassant move
IF EpSquare(Depth) <> Illegal THEN
ep = EpSquare(Depth)
IF MoveColor = White THEN
IF Board(ep - 9) = WP THEN
CALL RegisterEPMove(ep - 9, ep, ep - 10)
END IF
IF Board(ep - 11) = WP THEN
CALL RegisterEPMove(ep - 11, ep, ep - 10)
END IF
ELSE
IF Board(ep + 9) = BP THEN
CALL RegisterEPMove(ep + 9, ep, ep + 10)
END IF
IF Board(ep + 11) = BP THEN
CALL RegisterEPMove(ep + 11, ep, ep + 10)
END IF
END IF
END IF
' Castling is also performed in the quiescence search because it has a
' strong influence on the assessment. (Whether this is appropriate,
' is a matter of dispute even among leading programmers).
' Compute castling
IF MoveColor = White THEN
IF wKing = E1 AND MovedCnt(E1) = 0 THEN
' Is short castling permitted?
OK = Board(H1) = WR AND MovedCnt(H1) = 0
OK = OK AND Board(F1) = Empty AND Board(G1) = Empty
OK = OK AND IsAttackingSquare(E1, Black) = False
OK = OK AND IsAttackingSquare(F1, Black) = False
OK = OK AND IsAttackingSquare(G1, Black) = False
IF OK THEN
CALL RegisterMove(E1, G1) ' Register king's move
MoveStack(Index - 1).CastlingNr = ShortCastlingMove
END IF
' Is long castling permitted?
OK = Board(A1) = WR AND MovedCnt(A1) = 0
OK = OK AND Board(D1) = Empty
OK = OK AND Board(C1) = Empty
OK = OK AND Board(B1) = Empty
OK = OK AND IsAttackingSquare(E1, Black) = False
OK = OK AND IsAttackingSquare(D1, Black) = False
OK = OK AND IsAttackingSquare(C1, Black) = False
IF OK THEN
CALL RegisterMove(E1, C1) ' Register king's move
' Register type of castling
MoveStack(Index - 1).CastlingNr = LongCastlingMove
END IF
END IF
ELSE ' Black is to make a move
IF bKing = E8 AND MovedCnt(E8) = 0 THEN
' Is short castling permitted?
OK = Board(H8) = BR AND MovedCnt(H8) = 0
OK = OK AND Board(F8) = Empty AND Board(G8) = Empty
OK = OK AND IsAttackingSquare(E8, White) = False
OK = OK AND IsAttackingSquare(F8, White) = False
OK = OK AND IsAttackingSquare(G8, White) = False
IF OK THEN
CALL RegisterMove(E8, G8) ' Register king's move
MoveStack(Index - 1).CastlingNr = ShortCastlingMove
END IF
' Is long castling permitted?
OK = Board(A8) = BR AND MovedCnt(A8) = 0
OK = OK AND Board(D8) = Empty
OK = OK AND Board(C8) = Empty
OK = OK AND Board(B8) = Empty
OK = OK AND IsAttackingSquare(E8, White) = False
OK = OK AND IsAttackingSquare(D8, White) = False
OK = OK AND IsAttackingSquare(C8, White) = False
IF OK THEN
CALL RegisterMove(E8, C8) ' Register king's move
' Register type of castling
MoveStack(Index - 1).CastlingNr = LongCastlingMove
END IF
END IF
END IF
StackLimit(Depth + 1) = Index ' Mark end of MoveList
END SUB
'--------------------------------------------------------------------
' Compute the pawn controls and the columns on which pawns and
' rooks are placed. Called by the assessment function
' for initialization.
'--------------------------------------------------------------------
SUB InitAssessment
' Delete pawn controls
FOR i = A1 TO H8
PawnControlled(i).White = 0
PawnControlled(i).Black = 0
NEXT i
' Also initialize edges. This eliminates the
' need to examine edge columns.
FOR i = AColumn - 1 TO HColumn + 1
Pawns(i).White = 0
Pawns(i).Black = 0
Rooks(i).White = 0
Rooks(i).Black = 0
NEXT i
FOR i = A1 TO H8
IF Board(i) = Empty OR Board(i) = Edge THEN GOTO NextSquare2
SELECT CASE Board(i)
CASE WP
PawnControlled(i + 9).White = PawnControlled(i + 9).White + 1
PawnControlled(i + 11).White = PawnControlled(i + 11).White + 1
Pawns(i MOD 10).White = Pawns(i MOD 10).White + 1
CASE BP
PawnControlled(i - 9).Black = PawnControlled(i - 9).Black + 1
PawnControlled(i - 11).Black = PawnControlled(i - 11).Black + 1
Pawns(i MOD 10).Black = Pawns(i MOD 10).Black + 1
CASE BR
Rooks(i MOD 10).Black = Rooks(i MOD 10).Black + 1
CASE WR
Rooks(i MOD 10).White = Rooks(i MOD 10).White + 1
CASE ELSE
END SELECT
NextSquare2:
NEXT i
END SUB
'--------------------------------------------------------------------
' Initialize the game tree
'--------------------------------------------------------------------
SUB InitGameTree
' In Depth 0 nothing has been computed, game tree already initialized
IF Depth = 0 THEN EXIT SUB
EpSquare(0) = EpSquare(1)
MaterialBalance(0) = MaterialBalance(1)
MaterialSum(0) = MaterialSum(1)
Depth = 0
END SUB
'--------------------------------------------------------------------
' Initializes the board and the game status
'--------------------------------------------------------------------
SUB Initialize
' Board initialization, build InitialPosition
MoveCount = 0 ' Counts the half-moves in the game
FOR i = 0 TO BoardDim
Board(i) = InitialPosition(i)
NEXT i
' Kings's positions in the InitialPosition
wKing = E1
bKing = E8
' No castling yet
FOR i = 0 TO 2
Castling(i) = False
NEXT i
FOR i = A1 TO H8
MovedCnt(i) = 0 ' Initially, no piece has moved
NEXT i
EpSquare(0) = Illegal ' Enpassant status
MaterialSum(0) = MaterialTotal ' Material value (of pieces) in
InitialPosition
MaterialBalance(0) = 0 ' Material balance even
PlayerPlayer = False
StackLimit(0) = 0 ' Limit of MoveStack
MinDepth = 4 ' Default ComputingDepth
Depth = 0 ' Current depth in the game tree
MoveColor = White ' White has the first move
END SUB
'--------------------------------------------------------------------
' Attempts to interpret the passed string as a move.
' If it's a legal move, that move is performed and the function
' returns the value "True". If no (legal) move can be identified
' the function returns the value "False".
'--------------------------------------------------------------------
FUNCTION InputMove (Move$)
IF LEN(Move$) < 4 THEN ' Only from-to representation allowed
InputMove = False
EXIT FUNCTION
END IF
Source = SquareNumber(Move$)
Dest = SquareNumber(MID$(Move$, 3, 2))
CALL GenerateMoves(1)
FOR i = StackLimit(Depth) TO StackLimit(Depth + 1) - 1
IF MoveStack(i).FromSqr = Source AND MoveStack(i).ToSqr = Dest THEN
IF MoveStack(i).PromotedPc <> Empty THEN ' Promotions
IF MID$(Move$, 5, 1) = "N" THEN ' in the sequence queen, knight,
i = i + 1 ' bishop, and rook
ELSEIF MID$(Move$, 5, 1) = "B" THEN
i = i + 2
ELSEIF MID$(Move$, 5, 1) = "R" THEN
i = i + 3
END IF
END IF
CALL InitGameTree
PRINT " Your move: ";
CALL DisplayMove(i)
tmp = LastMove ' Temp. storage for last move so far.
CALL PerformMove(i) ' Warning: PerformMove changes
' Color. Next inquiry of color must
' compensate for this.
IF MoveColor = Black THEN
IF IsAttackingSquare(wKing, Black) = True THEN
PRINT " White king on "; SquareNotation$(wKing); " being checked"
CALL TakeBackMove((i))
LastMove = tmp ' No new move made. Restore
InputMove = False ' last move.
EXIT FUNCTION
END IF
ELSEIF IsAttackingSquare(bKing, White) = True THEN
PRINT " Black king on "; SquareNotation$(bKing); " being checked"
CALL TakeBackMove((i))
LastMove = tmp
InputMove = False
EXIT FUNCTION
END IF
PRINT
CALL PrintMove(i)
InputMove = True
EXIT FUNCTION
END IF
NEXT i
InputMove = False ' The input move was not found in MoveList
END FUNCTION
'--------------------------------------------------------------------
' Input of any position
'--------------------------------------------------------------------
SUB InputPosition
Depth = 0 ' Position becomes root of the search tree
PieceInput:
INPUT " Delete board (Y/N) ", LInput$
LInput$ = UCASE$(LInput$) ' Change to uppercase
IF LInput$ = "Y" THEN
FOR i = Row1 TO Row8
FOR j = AColumn TO HColumn
Board(i * 10 + j) = Empty
NEXT j
NEXT i
END IF
' Interpret not "Y" as no
PRINT " White:"
ReadPieces (White)
PRINT " Black:"
ReadPieces (Black)
' Compute material balance and examine if each side
' has just one king.
MaterialBalance(0) = 0
MaterialSum(0) = 0
wKings = 0
bKings = 0
FOR i = A1 TO H8 ' Read each Square
IF Board(i) = Empty OR Board(i) = Edge THEN
GOTO Continue ' Found empty or edge Square, go on to next Square
END IF
' New material balance
' White piece positively affects the balance, black negatively
MaterialBalance(0) = MaterialBalance(0) + SGN(Board(i)) *
PcMaterial(ABS(Board(i)))
IF ABS(Board(i)) <> WP THEN
MaterialSum(0) = MaterialSum(0) + PcMaterial(ABS(Board(i)))
END IF
IF Board(i) = WK THEN
wKings = wKings + 1 ' Number and position of the white kings
wKing = i
END IF
IF Board(i) = BK THEN
bKings = bKings + 1 ' Black kings
bKing = i
END IF
Continue:
NEXT i
IF bKings <> 1 OR wKings <> 1 THEN
PRINT "Illegal position, each side must have exactly one king"
CALL DisplayBoard(True)
GOTO PieceInput
END IF
Repeat: ' The entry must be complete with a legal position
' otherwise the MoveGenerator doesn't work.
INPUT " Who is to make a move (W/B): "; LInput$
LInput$ = UCASE$(LInput$)
IF LInput$ = "W" THEN
MoveColor = White
ELSEIF LInput$ = "B" THEN
MoveColor = Black ' Material balance was computed from
white's
MaterialBalance(0) = -MaterialBalance(0) ' viewpoint until now.
ELSE
GOTO Repeat
END IF
FOR i = A1 TO H8 ' To simplify, we assume here that
MovedCnt(i) = 1 ' all pieces have already moved once.
NEXT i ' Otherwise, the assessment function
' believes this is an
' initial position.
MovedCnt(E1) = 0
MovedCnt(A1) = 0 ' Single exception: The king and rook
MovedCnt(H1) = 0 ' Squares represent the castling state
MovedCnt(E8) = 0 ' and must therefore be reset
MovedCnt(A8) = 0 ' to zero.
MovedCnt(H8) = 0
EpSquare(0) = Illegal
INPUT " Change the status (Y/N): "; LInput$
LInput$ = UCASE$(LInput$)
IF LInput$ = "Y" THEN
' Input the Enpassant Square. If following input isn't correct,
' Enpassant is not possible.
INPUT " En Passant column: "; LInput$
LInput$ = UCASE$(LInput$)
ep$ = LEFT$(LInput$, 1)
IF ep$ >= "A" AND ep$ <= "H" THEN
IF MoveColor = White THEN
EpSquare(0) = A6 + ASC(ep$) - ASC("A")
ELSE
EpSquare(0) = A3 + ASC(ep$) - ASC("A")
END IF
END IF
' Black short castling. By default, castling is possible.
INPUT " Black 0-0 legal (Y/N) : "; LInput$
LInput$ = UCASE$(LInput$)
IF LInput$ = "N" THEN
MovedCnt(H8) = 1 ' 'Move' the rook. This eliminates
' the castling.
END IF
INPUT " Black 0-0-0 legal (Y/N): "; LInput$
LInput$ = UCASE$(LInput$)
IF LInput$ = "N" THEN
MovedCnt(A8) = 1
END IF
INPUT " White 0-0 legal (Y/N) : "; LInput$
LInput$ = UCASE$(LInput$)
IF LInput$ = "N" THEN
MovedCnt(H1) = 1
END IF
INPUT " White 0-0-0 legal (Y/N) : "; LInput$
LInput$ = UCASE$(LInput$)
IF LInput$ = "N" THEN
MovedCnt(A1) = 1
END IF
END IF
MoveCount = 0 ' Reset the move count
CALL DisplayBoard(False) ' Display the new board
CALL PrintPosition
END SUB
'--------------------------------------------------------------------
' Examine whether player "Side" is attacking the Square "Square".
' Returns "True" if Square is attacked by "Side", otherwise "False".
' Algorithm: Imagine "Square" occupied by a super officer that can move
' in any direction. If this super officer 'captures' e.g.
' a rook belonging to "Side" then the rook is actually
' attacking the Square.
'
' Local variables: i, Direction, Dest, Piece, slide
'--------------------------------------------------------------------
FUNCTION IsAttackingSquare (Square, Side)
' First test the special case pawns. They have the same direction
' as bishops but don't slide (?? /Me).
IF Side = White THEN
' Must go in the opposite direction of pawns. D5 is attacked
' by pawn E4.
IF Board(Square - 9) = WP OR Board(Square - 11) = WP THEN
IsAttackingSquare = True
EXIT FUNCTION
END IF
END IF
IF Side = Black THEN
IF Board(Square + 9) = BP OR Board(Square + 11) = BP THEN
IsAttackingSquare = True
EXIT FUNCTION
END IF
END IF
' Examine the knight
FOR i = 8 TO 15 ' Knight directions
Dest = Square + Offset(i)
IF Board(Dest) = Empty OR Board(Dest) = Edge THEN GOTO w1
IF Side = White THEN
IF Board(Dest) = WN THEN
IsAttackingSquare = True
EXIT FUNCTION
END IF
ELSEIF Board(Dest) = BN THEN
IsAttackingSquare = True
EXIT FUNCTION
END IF
w1:
NEXT i
' Examine sliding pieces and king.
FOR i = 0 TO 7
Dest = Square
Direction = Offset(i)
slide = 0
slideon1:
slide = slide + 1
Dest = Dest + Direction
IF Board(Dest) = Empty THEN
GOTO slideon1
END IF
' If edge reached then next direction
IF Board(Dest) = Edge THEN GOTO w2
' Hit a piece. Piece must be of color "Side".
' Also, the current direction must be a possible move direction
' of the piece. The king can only do one step.
Piece = Board(Dest)
IF Side = White THEN
IF Piece > 0 THEN ' White piece
IF Piece = WK THEN
IF slide <= 1 THEN ' King is slow-paced
IsAttackingSquare = True
EXIT FUNCTION
END IF
ELSE
' As far as sliding pieces are concerned, the current direction
' must be a possible move direction of the piece.
IF PcOffset(Piece).Begin <= i THEN
IF PcOffset(Piece).Ende >= i THEN
IsAttackingSquare = True
EXIT FUNCTION
END IF
END IF
END IF
END IF
ELSE
IF Piece < 0 THEN ' Black piece
IF Piece = BK THEN
IF slide <= 1 THEN
IsAttackingSquare = True
EXIT FUNCTION
END IF
ELSE
IF PcOffset(-Piece).Begin <= i THEN
IF PcOffset(-Piece).Ende >= i THEN
IsAttackingSquare = True
EXIT FUNCTION
END IF
END IF
END IF
END IF
END IF
w2:
NEXT i
' All directions exhausted, didn't hit a piece.
' I.e. "Side" is not attacking the Square.
IsAttackingSquare = False
END FUNCTION
' -----------------------------------------------------------------
' Takes back a move.
' Since the played moves are not stored, a maximum of
' one move can be taken back.
' -----------------------------------------------------------------
SUB MoveBack
IF Depth <> 1 THEN
PRINT " Unfortunately not possible."
EXIT SUB
END IF
CALL TakeBackMove(LastMove)
CALL DisplayBoard(False)
CALL PrintBack
END SUB
' -----------------------------------------------------------------
' Generates all moves and displays them on the monitor
' -----------------------------------------------------------------
SUB MoveList
CALL GenerateMoves(1)
IF MoveColor = White THEN
CheckMated = IsAttackingSquare(bKing, White)
ELSE
CheckMated = IsAttackingSquare(wKing, Black)
END IF
IF CheckMated THEN
PRINT " The king cannot be captured"
EXIT SUB
END IF
PRINT " "; Index - StackLimit(Depth); "pseudo-legal moves"
FOR i = StackLimit(Depth) TO Index - 1
CALL DisplayMove(i)
IF (i - StackLimit(Depth)) MOD 9 = 8 THEN ' After 8 moves, start
PRINT ' a new line.
END IF
NEXT i
PRINT ' Carriage return
END SUB
'--------------------------------------------------------------------
' From the possible moves of a certain depth the best,
' not-yet-played move is selected. Returns the index of the move
' into MoveStack. If all moves were already played, an
' impossible index (-1) is returned.
' The value of a move is determined by the move generator.
' This function finishes the move sorting in the search.
'--------------------------------------------------------------------
FUNCTION NextBestMove
BestMove = -1
BestValue = -CheckMateVal
FOR i = StackLimit(Depth) TO StackLimit(Depth + 1) - 1
IF MoveStack(i).Value > BestValue THEN ' Found new best move
BestMove = i
BestValue = MoveStack(i).Value
END IF
NEXT i
' Mark the selected move so it isn't selected again
' on the next call.
IF BestMove >= 0 THEN MoveStack(BestMove).Value = -CheckMateVal
NextBestMove = BestMove
END FUNCTION
'--------------------------------------------------------------------
' Performs a move at the board and updates the status and
' the search depth.
' CurrMove is the index of the move into MoveStack.
'--------------------------------------------------------------------
SUB PerformMove (CurrMove)
MoveCount = MoveCount + 1 ' Increase move count by one half-move
Source = MoveStack(CurrMove).FromSqr
Dest = MoveStack(CurrMove).ToSqr
ep = MoveStack(CurrMove).EpSquare
LastMove = CurrMove
Depth = Depth + 1 ' One step deeper in the tree
ToSquare(Depth) = Dest ' Used for move sorting and extension
' of the search.
EpSquare(Depth) = Illegal
' Material balance is always seen from the viewpoint of the player who is
' to make a move. Therefore, flip the sign.
MaterialBalance(Depth) = -MaterialBalance(Depth - 1)
MaterialSum(Depth) = MaterialSum(Depth - 1)
' The piece is moving from the 'from' Square to the 'to' Square
MovedCnt(Source) = MovedCnt(Source) + 1
MovedCnt(Dest) = MovedCnt(Dest) + 1
IF ep <> Illegal THEN
IF Board(ep) = Empty THEN ' Pawn move from 2nd to 4th row
EpSquare(Depth) = ep
ELSE ' Enemy pawn is captured enpassant
Board(ep) = Empty ' Remove captured pawn
MaterialBalance(Depth) = MaterialBalance(Depth) - ValP
END IF
ELSE ' If a piece is captured, change the material balance
IF MoveStack(CurrMove).CapturedPiece <> Empty THEN ' Piece was captured
MatChange = PcMaterial(MoveStack(CurrMove).CapturedPiece)
MaterialBalance(Depth) = MaterialBalance(Depth) - MatChange
' Sum up only the officers's material value
IF MatChange <> ValP THEN
MaterialSum(Depth) = MaterialSum(Depth) - MatChange
END IF
END IF
END IF
Board(Dest) = Board(Source) ' Place onto board
Board(Source) = Empty
' Now the special cases promotion and castling
IF MoveStack(CurrMove).PromotedPc <> Empty THEN ' Pawn promotion
Board(Dest) = MoveColor * MoveStack(CurrMove).PromotedPc
MatChange = PcMaterial(MoveStack(CurrMove).PromotedPc) - ValP
MaterialBalance(Depth) = MaterialBalance(Depth) - MatChange
' Pawns are not included in MaterialSum.
MaterialSum(Depth) = MaterialSum(Depth) + MatChange + ValP
ELSE
IF MoveStack(CurrMove).CastlingNr = ShortCastlingMove THEN
Board(Dest + 1) = Empty ' 'to' is G1 or G8 (depending on Color)
Board(Dest - 1) = MoveColor * WR ' Put white/black rook on F1/F8
Castling(MoveColor + 1) = True
ELSEIF MoveStack(CurrMove).CastlingNr = LongCastlingMove THEN
Board(Dest - 2) = Empty ' 'to' is C1 or C8
Board(Dest + 1) = MoveColor * WR
Castling(MoveColor + 1) = True
END IF
END IF
' If king has moved, update the king's position
IF Board(Dest) = WK THEN
wKing = Dest
ELSEIF Board(Dest) = BK THEN
bKing = Dest
END IF
' Flip the Color (the player who is to make a move)
MoveColor = -MoveColor
END SUB
'--------------------------------------------------------------------
' Print the take-back command
'--------------------------------------------------------------------
SUB PrintBack
IF Printing = False THEN EXIT SUB ' Only if printing is on
IF MoveColor = White THEN
LPRINT " BACK" ' "ZURUECK"
isWhiteLast = False
ELSE
LPRINT USING "###. BACK!"; MoveCount \ 2 + 1; CHR$(9);
isWhiteLast = True
END IF
END SUB
'--------------------------------------------------------------------
' Displays the program logo/menu on the monitor (see CommandLoop)
'--------------------------------------------------------------------
SUB PrintLogo
CLS
PRINT "***********************************************************"
PRINT "* MiniMAX 1.0 (Basic) *"
PRINT "* *"
PRINT "* by Dieter Steinwender *"
PRINT "* and Chrilly Donninger *"
PRINT "* *"
PRINT "* Input a move (e.g. G1F3) *"
PRINT "* or one of the following commands: *"
PRINT "* *"
PRINT "* NG --> New game *"
PRINT "* EX --> Exit the program *"
PRINT "* DB --> Display board on the monitor *"
PRINT "* CP --> Input position (chess problem) *"
PRINT "* PL --> Play, computer move *"
PRINT "* PR --> Printing on/off *"
PRINT "* MM --> Multi-move input (player-player) *"
PRINT "* DL --> Display move list *"
PRINT "* TB --> Take back one move *"
PRINT "* SD --> Set computing depth *"
PRINT "* DA --> Display assessment *"
PRINT "***********************************************************"
END SUB
'--------------------------------------------------------------------
' Prints the current move.
' WARNING: Don't change the format of this output as it will cause
' malfunction of the Noname driver for the CHESS232 board
' and the Autoplayer AUTO232.
'
' Notes:
' CHR$(9) is the tab character
'--------------------------------------------------------------------
SUB PrintMove (CurrMove)
IF Printing = False THEN EXIT SUB ' Only if printing is on
IF MoveColor = Black THEN ' If black is to make a move
' the last move was by white.
LPRINT USING "###. "; MoveCount \ 2 + 1;
isWhiteLast = True
ELSE ' Black move
IF isWhiteLast = True THEN
LPRINT " ";
ELSE
LPRINT USING "###. ... ! "; MoveCount \ 2 + 1; CHR$(9);
END IF
isWhiteLast = False
END IF
IF MoveStack(CurrMove).CastlingNr = NoCastlingMove THEN
LPRINT PrintSymbol(ABS(Board(MoveStack(CurrMove).ToSqr)));
Source$ = LCASE$(SquareNotation$(MoveStack(CurrMove).FromSqr))
LPRINT Source$;
IF MoveStack(CurrMove).CapturedPiece <> Empty THEN
LPRINT "x";
ELSE
LPRINT "-";
END IF
Dest$ = LCASE$(SquareNotation$(MoveStack(CurrMove).ToSqr))
LPRINT Dest$;
IF MoveStack(CurrMove).PromotedPc <> Empty THEN
LPRINT PrintSymbol(MoveStack(CurrMove).PromotedPc);
END IF
ELSEIF MoveStack(CurrMove).CastlingNr = ShortCastlingMove THEN
LPRINT " 0-0 ";
ELSE
LPRINT " 0-0-0"
END IF
' Finish with a tab character for a white move
' or a carriage return for a black move
IF MoveColor = Black THEN
LPRINT CHR$(9);
ELSE
LPRINT
END IF
END SUB
'--------------------------------------------------------------------
' Prints the current position in ChessBase / Fritz format.
' WARNING: Don't change the format of this output as it will
' cause malfunction of the Chess332 driver.
'--------------------------------------------------------------------
SUB PrintPosition
IF Printing = False THEN EXIT SUB
IF isWhiteLast = True THEN
LPRINT
isWhiteLast = False
END IF
LPRINT "(wK";
LPRINT SquareNotation$(wKing); ' First the king
FOR i = A1 TO H8 ' Remaining white pieces
IF Board(i) > 0 AND Board(i) < WK THEN
LPRINT ","; PcSymbol(Board(i));
LPRINT SquareNotation$(i);
END IF
NEXT i
LPRINT "; sK";
LPRINT SquareNotation$(bKing); ' First the king
FOR i = A1 TO H8 ' Remaining black pieces
IF Board(i) < 0 AND Board(i) > BK THEN
LPRINT ","; PcSymbol(ABS(Board(i)));
LPRINT SquareNotation$(i);
END IF
NEXT i
LPRINT ")"
END SUB
'--------------------------------------------------------------------
' Reads the pieces for "Side".
' Format is: <piece><Square> e.g. "Ke1".
' "." is an empty Square, i.e. removes any piece from that Square.
'--------------------------------------------------------------------
SUB ReadPieces (Side)
NextPiece:
INPUT LInput$
IF LInput$ = "" THEN EXIT SUB ' Exit if input Empty
IF LEN(LInput$) < 3 THEN GOTO BadInput ' Input too short
LInput$ = UCASE$(LInput$) ' Uppercase
Piece$ = LEFT$(LInput$, 1)
Square$ = MID$(LInput$, 2, 2)
FOR i = 0 TO PieceTypes ' From empty Square to king
IF Piece$ = PcSymbol(i) THEN
' Convert chess notation into Square value
' First character of input was already used for the piece
Square = SquareNumber(Square$)
IF Square = Illegal THEN GOTO BadInput
IF i = WP THEN ' Pawns only legal on 2nd thru 7th row
IF Square <= H1 OR Square >= A8 THEN GOTO BadInput
END IF
Piece = i * Side ' If color is black the sign
' of the piece is reversed.
Board(Square) = Piece ' Place piece onto board
GOTO NextPiece
END IF
NEXT i
BadInput:
PRINT " Bad input "
GOTO NextPiece
END SUB
'--------------------------------------------------------------------
' Register a capture move in MoveStack.
'--------------------------------------------------------------------
SUB RegisterCaptureMove (Source, Dest)
' King cannot be captured
IF Board(Dest) = WK OR Board(Dest) = BK THEN EXIT SUB
PcValue = PcMaterial(ABS(Board(Dest)))
MoveStack(Index).FromSqr = Source
MoveStack(Index).ToSqr = Dest
MoveStack(Index).CapturedPiece = ABS(Board(Dest))
' Rule for move sorting: Capture the most valuable enemy piece
' using the least valuable piece
MoveStack(Index).Value = PcValue - (PcMaterial(ABS(Board(Source))) \ 8)
' Extra bonus for capturing the piece just moved
IF Depth > 0 THEN
IF Dest = ToSquare(Depth - 1) THEN
MoveStack(Index).Value = MoveStack(Index).Value + 300
END IF
END IF
' Bonus for main variant moves and "killer" moves
Killer1 = KillerTab(Depth).Killer1.FromSqr = Source
Killer1 = Killer1 AND KillerTab(Depth).Killer1.ToSqr = Dest
Killer2 = KillerTab(Depth).Killer2.FromSqr = Source
Killer2 = Killer2 AND KillerTab(Depth).Killer2.ToSqr = Dest
MvarMove = MVar(0, Depth).FromSqr = Source AND MVar(0, Depth).ToSqr = Dest
IF MvarMove THEN
MoveStack(Index).Value = MoveStack(Index).Value + MainVarBonus
ELSEIF Killer1 THEN
MoveStack(Index).Value = MoveStack(Index).Value + Killer1Bonus
ELSEIF Killer2 THEN
MoveStack(Index).Value = MoveStack(Index).Value + Killer2Bonus
END IF
MoveStack(Index).PromotedPc = Empty
MoveStack(Index).CastlingNr = NoCastlingMove
MoveStack(Index).EpSquare = Illegal
IF Index < MoveStackDim THEN ' Prevent MoveStack overflow
Index = Index + 1
ELSE
PRINT " ERROR: Move stack overflow"
END ' Exit to DOS
END IF
END SUB
'--------------------------------------------------------------------
' Register an Enpassant move in MoveStack.
'--------------------------------------------------------------------
SUB RegisterEPMove (Source, Dest, ep)
' King cannot be captured
IF Board(Dest) = WK OR Board(Dest) = BK THEN EXIT SUB
MoveStack(Index).FromSqr = Source
MoveStack(Index).ToSqr = Dest
MoveStack(Index).CapturedPiece = WP
MoveStack(Index).PromotedPc = Empty
MoveStack(Index).CastlingNr = NoCastlingMove
MoveStack(Index).EpSquare = ep
MoveStack(Index).Value = ValP
IF Index < MoveStackDim THEN ' Prevent MoveStack overflow
Index = Index + 1
ELSE
PRINT " ERROR: Move stack overflow"
END ' Exit to DOS
END IF
END SUB
'---------------------------------------------------------------------
' Register a normal move in MoveStack.
' As a side effect, this procedure provides the mobility of bishop
' and rook, as well as the value of the move for the pre-sorting.
'---------------------------------------------------------------------
SUB RegisterMove (Source, Dest)
' Increase the mobility of bishop and rook.
' Mobility in the center is rated higher
' than mobility at the edge.
IF MoveColor = White THEN
IF Board(Source) = WB OR Board(Source) = WR THEN
Mobility(Depth) = Mobility(Depth) + CenterTable(Dest)
END IF
ELSE
IF Board(Source) = BB OR Board(Source) = BR THEN
Mobility(Depth) = Mobility(Depth) + CenterTable(Dest)
END IF
END IF
' Assess the move for move sorting. Bonus for main variant or "killer".
Killer1 = KillerTab(Depth).Killer1.FromSqr = Source
Killer1 = Killer1 AND KillerTab(Depth).Killer1.ToSqr = Dest
Killer2 = KillerTab(Depth).Killer2.FromSqr = Source
Killer2 = Killer2 AND KillerTab(Depth).Killer2.ToSqr = Dest
MvarMove = MVar(0, Depth).FromSqr = Source AND MVar(0, Depth).ToSqr = Dest
IF MvarMove THEN
MoveStack(Index).Value = MainVarBonus
ELSEIF Killer1 THEN
MoveStack(Index).Value = Killer1Bonus
ELSEIF Killer2 THEN
MoveStack(Index).Value = Killer2Bonus
ELSE
MoveStack(Index).Value = Empty
END IF
MoveStack(Index).FromSqr = Source
MoveStack(Index).ToSqr = Dest
MoveStack(Index).CapturedPiece = Empty
MoveStack(Index).PromotedPc = Empty
MoveStack(Index).CastlingNr = NoCastlingMove
MoveStack(Index).EpSquare = Illegal
IF Index < MoveStackDim THEN ' Prevent MoveStack overflow
Index = Index + 1
ELSE
PRINT " ERROR: Move stack overflow"
END ' In this case best to "ease out" to DOS
END IF
END SUB
'--------------------------------------------------------------------
' Produce all possible pawn promotions
'--------------------------------------------------------------------
SUB RegisterPromotion (Source, Dest)
IF Board(Dest) = Empty THEN
FOR i = WQ TO WR STEP -1 ' Sequence queen, knight, bishop, rook
CALL RegisterMove(Source, Dest)
MoveStack(Index - 1).PromotedPc = i
NEXT i
ELSE ' Promotion with capture
FOR i = WQ TO WR STEP -1
CALL RegisterCaptureMove(Source, Dest)
MoveStack(Index - 1).PromotedPc = i
NEXT i
END IF
END SUB
'-----------------------------------------------------------------------
' Converts internal SquareNumber to SquareNotation.
' Returns '--' if the number is not on the board.
'
' Notes:
' The \ operator is integer division.
' The mod (Modulo) operator returns the remainder of an integer division.
'-----------------------------------------------------------------------
FUNCTION SquareNotation$ (SquareNum)
' See if correct
IF SquareNum < A1 OR SquareNum > H8 OR Board(SquareNum) = Edge THEN
SquareNotation$ = "--"
ELSE
s$ = CHR$(ASC("A") - 1 + SquareNum MOD 10) ' Line
s$ = s$ + CHR$(ASC("1") - 2 + SquareNum \ 10) ' Row
SquareNotation$ = LCASE$(s$)
END IF
END FUNCTION
'--------------------------------------------------------------------
' Converts SquareNotation (e.g. "A1") to internal SquareNumber.
' Returns "Illegal" if input is incorrect.
' Line coordinates must be passed as uppercase letters.
'--------------------------------------------------------------------
FUNCTION SquareNumber (SquareNot$)
Column$ = LEFT$(SquareNot$, 1)
Row$ = MID$(SquareNot$, 2, 1)
' See if correct
IF Column$ < "A" OR Column$ > "H" OR Row$ < "1" OR Row$ > "8" THEN
SquareNumber = Illegal
EXIT FUNCTION
END IF
SquareNumber = (ASC(Column$) - ASC("A") + 1) + 10 * (ASC(Row$) - ASC("1") +
2)
END FUNCTION
'--------------------------------------------------------------------
' Takes back a move in the tree.
' CurrMove is the index of the move in MoveStack.
'--------------------------------------------------------------------
SUB TakeBackMove (CurrMove)
MoveCount = MoveCount - 1
Source = MoveStack(CurrMove).FromSqr
Dest = MoveStack(CurrMove).ToSqr
ep = MoveStack(CurrMove).EpSquare
MoveColor = -MoveColor ' Other side to move
Depth = Depth - 1 ' One level higher in tree
Board(Source) = Board(Dest) ' Put back the piece
Board(Dest) = Empty
IF ep <> Illegal AND MoveStack(CurrMove).CapturedPiece = WP THEN
Board(ep) = -MoveColor ' WP=White, BP=Black
' Put back captured piece
ELSEIF MoveStack(CurrMove).CapturedPiece <> Empty THEN
Board(Dest) = (-MoveColor) * MoveStack(CurrMove).CapturedPiece
END IF
' Adjust move counter
MovedCnt(Source) = MovedCnt(Source) - 1
MovedCnt(Dest) = MovedCnt(Dest) - 1
' If castling put back rook
IF MoveStack(CurrMove).CastlingNr = ShortCastlingMove THEN
Board(Dest + 1) = MoveColor * WR
Board(Dest - 1) = Empty
Castling(MoveColor + 1) = False
ELSEIF MoveStack(CurrMove).CastlingNr = LongCastlingMove THEN
Board(Dest - 2) = MoveColor * WR
Board(Dest + 1) = Empty
Castling(MoveColor + 1) = False
END IF
IF MoveStack(CurrMove).PromotedPc <> Empty THEN
Board(Source) = MoveColor ' Take back pawn promotion
END IF
' If king has moved, update the king's position
IF Board(Source) = WK THEN
wKing = Source
ELSEIF Board(Source) = BK THEN
bKing = Source
END IF
END SUB
'--------------------------------------------------------------------
' Assessment of one white pawn.
' Analogous to the assessment of black pawns.
' Returns the assessment from white's viewpoint.
'--------------------------------------------------------------------
FUNCTION WPAssessment (Square, Row, Column, developed)
IF MaterialSum(Depth) > EndgameMaterial THEN ' Opening or midgame
Value = wPSquareValue(Square)
' If development incomplete, don't push edge pawns forward
IF developed < 4 THEN
IF (Column >= FColumn OR Column <= BColumn) AND Row > Row3 THEN
Value = Value - 15
END IF
END IF
ELSE ' In the endgame, all lines are equally good.
Value = Row * 4 ' Bring pawns forward.
END IF
' Is the pawn isolated?
' Edge pawns don't require extra treatment. Pawns(AColumn-1) is
' the left edge, Pawns(HColumn+1) the right edge. No pawn is
' placed on these edges.
IF Pawns(Column - 1).White = 0 AND Pawns(Column + 1).White = 0 THEN
Value = Value - 12 ' Isolated
' Isolated double pawn
IF Pawns(Column).White > 1 THEN Value = Value - 12
END IF
' Double pawn
IF Pawns(Column).White > 1 THEN Value = Value - 15
' Duo or guarded pawn gets a Bonus
IF PawnControlled(Square).White > 0 OR PawnControlled(Square + 10).White > 0
THEN
Value = Value + Row
END IF
IF Pawns(Column).Black = 0 THEN ' Half-open column
' Pawn left behind on half-open column:
' Left-behind pawn is not guarded by its fellow pawns...
Condition1 = PawnControlled(Square).White = 0
' ... and can't advance because enemy pawns
' control the Square in front of him.
Condition2 = PawnControlled(Square + 10).Black > PawnControlled(Square +
10).White
IF Condition1 AND Condition2 THEN
Value = Value - 10
' Rook impeded by left-behind pawn
IF Rooks(Column).Black > 0 THEN Value = Value - 8
ELSE
' Pawn is a free pawn, on a half-open column and the
' Squares ahead on his column are not controlled by
' enemy pawns.
FOR j = Square TO H6 STEP 10 ' Until 6th row
IF PawnControlled(j).Black > 0 THEN
WPAssessment = Value
EXIT FUNCTION
END IF
NEXT j
' Found a free pawn. In the endgame, a free pawn is more important
' than in the midgame.
IF MaterialSum(Depth) < EndgameMaterial THEN
Value = Value + Row * 16 ' The more advanced, the better
' Rook guards free pawn on the same column
IF Rooks(Column).White > 0 THEN Value = Value + Row * 2
' Enemy rook on the same column
IF Rooks(Column).Black > 0 THEN Value = Value - Row * 2
' Pure pawn endgame. Free pawn particularly valuable.
IF MaterialSum(Depth) = 0 THEN Value = Value + Row * 8
' Guarded free pawn
IF PawnControlled(Square).White > 0 OR PawnControlled(Square + 10).White >
0 THEN
Value = Value + Row * 4
END IF
' Free pawn blocked by a black piece. This piece is not
' threatened by fellow pawns.
IF Board(Square + 10) < 0 AND PawnControlled(Square + 10).White = 0 THEN
Value = Value - Row * 4
END IF
ELSE ' Free pawn in the midgame
Value = Value + Row * 8
' Guarded free pawn
IF PawnControlled(Square).White > 0 OR PawnControlled(Square + 10).White >
0 THEN
Value = Value + Row * 2
END IF
END IF
END IF
END IF
WPAssessment = Value
END FUNCTION
This page took 0.01 seconds to execute
Last modified: Thu, 15 Apr 21 08:11:13 -0700
Current Computer Chess Club Forums at Talkchess. This site by Sean Mintz.