Posts
' Declaration of Subroutines
DECLARE SUB PrintLogo ()
DECLARE SUB Initialize ()
DECLARE SUB CommandLoop ()
DECLARE FUNCTION AlphaBeta% (Alpha%, Beta%, Distance%)
DECLARE SUB GenerateMoves (AllMoves%)
DECLARE SUB PerformMove (CurrMove%)
DECLARE SUB TakeBackMove (CurrMove%)
DECLARE SUB CopyMainVariant (CurrMove%)
DECLARE FUNCTION AttackingField% (Feld%, Side%)
DECLARE FUNCTION AssessPosition% (Alpha%, Beta%, Side%)
DECLARE SUB InitAssessment ()
DECLARE SUB DisplayBoard (BoardOnly%)
DECLARE SUB ComputerMove ()
DECLARE SUB InitGameTree ()
DECLARE SUB DisplayMove (CurrMove%)
DECLARE SUB DisplayMVar ()
DECLARE SUB PrintMove (CurrMove%)
DECLARE SUB PrintPosition ()
DECLARE SUB PrintBack ()
DECLARE FUNCTION Fieldnotation$ (Fieldnum%)
DECLARE FUNCTION Fieldnumber% (Fieldnote$)
DECLARE SUB SavePromotion (from%, too%)
DECLARE SUB SaveMove (from%, too%)
DECLARE SUB SaveCaptureMove (from%, too%)
DECLARE SUB SaveEpMove (from%, too%, ep%)
DECLARE SUB FlipBoard ()
DECLARE SUB GameOver ()
DECLARE SUB InputPosition ()
DECLARE SUB MoveList ()
DECLARE SUB MoveBack ()
DECLARE SUB ComputingDepth ()
DECLARE SUB ReadPiece (Side%)
DECLARE FUNCTION NextBestMove% ()
DECLARE FUNCTION BPAssessment% (Feld%, Column%, row%, developed%)
DECLARE FUNCTION WPAssessment% (Feld%, Column%, row%, developed%)
DECLARE FUNCTION InputMove% (Move$)
'--------------------------------------------------------------------
' Definition of symbolic Constants.
'--------------------------------------------------------------------
CONST BoardDim% = 119 ' Dimension of Expanded Chess Board
CONST MaxDepth% = 19 ' Maximum search depth
CONST Movedirections% = 15 ' Number of Move directions for all Piece.
CONST PieceTypes% = 6 ' Number of Piecetypes - considering
' the Move directions (wQueen = bQueen)
CONST MoveStackDim% = 1000 ' Dimension of move stacks
' Piece
CONST BK% = -6 ' Black piece
CONST BQ% = -5
CONST BN% = -4
CONST BB% = -3
CONST BR% = -2
CONST BP% = -1
CONST Empty% = 0 ' Empty field
CONST WP% = 1 ' White piece
CONST WR% = 2
CONST WB% = 3
CONST WN% = 4
CONST WQ% = 5
CONST WK% = 6
CONST Edge% = 100 ' The edge of the chess board
' Material value of the Pieces
CONST MatP% = 100
CONST MatR% = 500
CONST MatB% = 350
CONST MatN% = 325
CONST MatQ% = 900
CONST MatK% = 0 ' As both Sides have just one king,
' the value can be set to 0
' Assessment for Mate
CONST MateValue% = 32000
CONST MaxPos% = MatB% ' Maximum of the position assessment
' Bonus for main variants and Killer moves
' used for the sorting of moves
CONST MainVariantBonus% = 500
CONST Killer1Bonus% = 250
CONST Killer2Bonus% = 150
' Total material value in the initial position
CONST MaterialSum% = 4 * (MatR% + MatB% + MatN%) + (2 * MatQ%)
CONST EndgameMaterial% = 4 * MatR% + 2 * MatB%
' Field numbers of frequently used Fields
' ("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 columns and rows
CONST ARow% = 1
CONST BRow% = 2
CONST CRow% = 3
CONST DRow% = 4
CONST ERow% = 5
CONST FRow% = 6
CONST GRow% = 7
CONST HRow% = 8
CONST Column1% = 2
CONST Column2% = 3
CONST Column3% = 4
CONST Column4% = 5
CONST Column5% = 6
CONST Column6% = 7
CONST Column7% = 8
CONST Column8% = 9
' Castling numbering (Index into castling array)
' of move is not a castling move
CONST NoCastlingMove% = 0
CONST ShortCastlingMove% = 1
CONST LongCastlingMove% = 2
' Color of the man who is moving
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 stacks
TYPE MoveType
from AS INTEGER ' From field
too AS INTEGER ' To field
CapturedPiece AS INTEGER ' Captured piece
PromotedPiece AS INTEGER ' Promoted piece
CastlingNr AS INTEGER ' Type of castling move
EpField AS INTEGER ' Enpassant field
Value AS INTEGER ' Assessment for the sorting of moves
END TYPE
' Index of the pieces in the offset list and long/short paths
' (used by the move generator)
TYPE PieceOffsetType
Start AS INTEGER
Ends AS INTEGER
Longpaths AS INTEGER
END TYPE
' Information on pawn/piece constellations
TYPE BothColourTypes
White AS INTEGER
Black AS INTEGER
END TYPE
' Information on From/Too field (Moves without additional Information)
' Used for the storing promising moves in (main variants,
' killer moves)
TYPE FromTooType
from AS INTEGER
too AS INTEGER
END TYPE
' Data structure for storing killer moves.
TYPE KillerType
Killer1 AS FromTooType
Killer2 AS FromTooType
END TYPE
'--------------------------------------------------------------------
' Definition of global variables and tables
'--------------------------------------------------------------------
DIM SHARED Board(BoardDim%) AS INTEGER
DIM SHARED EpField(MaxDepth%) AS INTEGER
DIM SHARED MoveStack(MoveStackDim%) AS MoveType
DIM SHARED MoveControl(H8%) AS INTEGER
' Counts how often a piece has moved from
' a field. 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 in MoveStack
' Saves the position in the 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 FromTooType ' Main variants table
DIM SHARED KillerTab(MaxDepth%) AS KillerType ' Killer moves table
' Tables for Assessment function
DIM SHARED PawnControlled(BoardDim%) AS BothColourTypes ' Fields that are
' controlled by pawns
DIM SHARED Pawns(HRow% + 1) AS BothColourTypes ' Number of pawns per row
DIM SHARED Rooks(HRow% + 1) AS BothColourTypes ' Number of rooks per row
DIM SHARED Mobility(MaxDepth%) AS INTEGER ' Mobility of bishops and rooks
DIM SHARED TooFeld(MaxDepth%) AS INTEGER ' TooField 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 ' Material balance between White/Black
DIM SHARED MaterialTotal(MaxDepth%) AS INTEGER ' Total material on board
DIM SHARED Colour AS INTEGER ' Who is to make a move
DIM SHARED PlayerPlayer AS INTEGER ' Player vs Player (Memo)Mode on/off
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 search tree because of
' Checks and Captures are only carried out
' until MaxExtension (otheriwse the
' search can explode)
DIM SHARED Depth AS INTEGER ' Search depth = the number of half moves
' from the initial position
DIM SHARED NodeCount AS LONG ' Number 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 ' Number of half moves done so far
DIM SHARED IsWhiteLast AS INTEGER ' For printing control
' InitialPosition 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 paths
Offset(1) = -11
Offset(2) = 9
Offset(3) = 11
Offset(4) = -1 ' Straight paths
Offset(5) = 10
Offset(6) = 1
Offset(7) = -10
Offset(8) = 19 ' Knight paths
Offset(9) = 21
Offset(10) = 12
Offset(11) = -8
Offset(12) = -19
Offset(13) = -21
Offset(14) = -12
Offset(15) = 8
DIM SHARED FigOffset(PieceTypes%) AS PieceOffsetType
FigOffset(Empty%).Start = 0 ' Empty field
FigOffset(Empty%).Ends = 0
FigOffset(Empty%).Longpaths = False%
FigOffset(WP%).Start = -1 ' Pawn Moves are produced seperately
FigOffset(WP%).Ends = -1
FigOffset(WP%).Longpaths = False%
FigOffset(WR%).Start = 4 ' Rook
FigOffset(WR%).Ends = 7
FigOffset(WR%).Longpaths = True%
FigOffset(WB%).Start = 0 ' Bishop
FigOffset(WB%).Ends = 3
FigOffset(WB%).Longpaths = True%
FigOffset(WN%).Start = 8 ' Knight
FigOffset(WN%).Ends = 15
FigOffset(WN%).Longpaths = False%
FigOffset(WQ%).Start = 0 ' Queen
FigOffset(WQ%).Ends = 7
FigOffset(WQ%).Longpaths = True%
FigOffset(WK%).Start = 0 ' King
FigOffset(WK%).Ends = 7
FigOffset(WK%).Longpaths = False%
' Centralization tables. We only need files 0..H8, as
' piece can't stand on a field outside H8.
' The lower edge is preserved as we would otherwise have to
' transform board coordinates into centrality coordinates.
' H1 is is further away from the center than is G1. In spite of this,
' H1 has a better center value than G1.
' This Table is used i.e. for king Assessment.
' 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 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 fields for the pawns.
' Is used the position assessment.
' Center pawns on the 2nd row is bad (they belong in the front).
' F-H pawns should be behind for protection of the king.
DIM SHARED wPFieldValue(H7%) AS INTEGER ' White pawns
FOR i% = 0 TO H7%
READ wPFieldValue(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 bPFieldValue(H7%) AS INTEGER ' Black pawns
FOR i% = 0 TO H7%
READ bPFieldValue(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 PieceMaterial(PieceTypes%) AS INTEGER
PieceMaterial(Empty%) = 0 ' Emptyfield
PieceMaterial(WP%) = MatP% ' Pawn
PieceMaterial(WR%) = MatR% ' Rook
PieceMaterial(WB%) = MatB% ' Bishop
PieceMaterial(WN%) = MatN% ' Knight
PieceMaterial(WQ%) = MatQ% ' Queen
PieceMaterial(WK%) = MatK% ' King
' Symbolic representation of the pieces
DIM SHARED FigSymbol(PieceTypes%) AS STRING * 1
FigSymbol(Empty%) = "." ' Emptyfield
FigSymbol(WP%) = "P" ' Pawn
FigSymbol(WR%) = "R" ' Rook
FigSymbol(WB%) = "B" ' Bishop
FigSymbol(WN%) = "N" ' Knight
FigSymbol(WQ%) = "Q" ' Queen
FigSymbol(WK%) = "K" ' King
' Symbolic representations of the pieces for printing
DIM SHARED PrintSymbol(PieceTypes%) AS STRING * 1
PrintSymbol(Empty%) = " " ' Emptyfield
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 ColourSymbol(2) AS STRING * 1
ColourSymbol(0) = "." ' Black
ColourSymbol(1) = "." ' Empty field
ColourSymbol(2) = "*" ' White
'--------------------------------------------------------------------
' The actual program begins here.
'--------------------------------------------------------------------
CLS
'CALL PrintLogo
CALL Initialize
CALL CommandLoop
'--------------------------------------------------------------------
' Here ends the Program
'--------------------------------------------------------------------
'--------------------------------------------------------------------
' AlphaBeta: Function
' Alpha-Beta Tree search
' Returns Assessment from the viewpoint of the player who is to make
' a move. "Alpha" is lower limit, "Beta" is the upper limit and "Distance"
' the Number of half-moves until the horizon.
' If "Distance" positive, a normal Alpha-Beta search is performed,
' if less than 0 the quiescense search.
' Returns the NegaMax-Value form the point of view of the player who is
' to make a move.
' This procedure is called recursively.
' Locale Variables: i%, Value%, BestValue%, Check%
' Calls: GenerateMoves; PerformMove; TakeBackMove;CopyMainVariant;
' AssessPosition;NextBestMove;
' Calledby: ComputerMove
'---------------------------------------------------------------------
FUNCTION AlphaBeta% (Alpha%, Beta%, Distance%)
NodeCount = NodeCount + 1 ' Additional position examined
MVar(Depth, Depth).from = 0 ' Delete current main variant
' Position is always assessed, i.e. also inside of 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%, Colour)
' In the case of 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
' Side that is moving is in check, extend the search
Condition1% = (Check% = True% AND Depth + Distance% < MaxExtension + 1)
' By capture and re-capture on the same field, 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 TooFeld(Depth) = TooFeld(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 quiescense search
' or the opponent is checkmated or we have reached maximunm search
' depth imposed by data structures, end the search.
IF Distance% < -5 OR Value% = MateValue% - 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 beter during the quiescense 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 <= 0 then (quiescense search) only
' capture moves and promotion moves are computed.
CALL GenerateMoves(Distance%) ' Examine if any moves are available
IF Distance% > 0 THEN ' is directly done by determining
BestValue% = -MateValue% ' BestValue.
ELSE ' In quiescence search, the current
BestValue% = Value% ' position assessment is the lower limit
END IF ' of the search value.
i% = NextBestMove% ' Examine all moves in sorted sequence.
DO WHILE i% >= 0 ' So Long as any moves are left.
CALL PerformMove(i%)
' NegaMax principal: The sign is reversed and
' 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, the main variants are still saved
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%) ' Main variants Saved
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.from = MoveStack(i%).from
KillerTab(Depth).Killer1.too = MoveStack(i%).too
END IF
' If player has no more legal moves...
IF BestValue% = -(MateValue% - (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
'--------------------------------------------------------------------
' AssessPosition: Function
' PositionsAssessment
' 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 (CheckMateValue -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 move.
'
' Local Variables:
' Value%, PosValue%, i%, j%, k%, Feld%, wBishlop%, bBishlop%
' PawnCount%, MatNum%, wRookon7%, bRookon2%
' wDeveloped%, bDeveloped%
' Calls: InitAssessment; PerformMove; TakeBackMove; AttackingField;
' Calledby: AttackingField; BPAssessment; QPAssessment; CommandLoop;
' AlphaBeta; ComputerMove
'--------------------------------------------------------------------
FUNCTION AssessPosition% (Alpha%, Beta%, Side%)
' First examine if opponent is checkmated
' of "Side" is being checked.
IF Side% = White% THEN
IF AttackingField%(bKing, White%) = True% THEN
AssessPosition% = MateValue% - Depth
EXIT FUNCTION
END IF
InCheck = AttackingField%(wKing, Black%) ' Is white being checked?
ELSE
IF AttackingField%(wKing, Black%) = True% THEN
AssessPosition% = MateValue% - Depth
EXIT FUNCTION
END IF
InCheck = AttackingField%(bKing, White%) ' Is Black being checked?
END IF
' Positional Assessments factors do not outwiegh a heavy material
' imbalance. Hence, we omit the position assessment in this case
' Exception: The late endgame. Free Pawns have a high value.
' A minor piece without pawns is without effect.
Value% = MaterialBalance(Depth)
MatNum% = MaterialTotal(Depth)
IF MatNum% > MatB% + MatB% 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, EnPassant, and promotion.
' You could also build a list of pieces in 'IninAssessment' 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 prinipal (Keep It Simple Stupid) this
' solution was chosen in MiniMAX.
CALL InitAssessment
PosValue% = 0
' Used for Assessing the Bishop pair.
bBishlop% = 0
wBishlop% = 0
' Used for determining insufficient material.
PawnCount% = 0
' White rooks on 7/8th row, black rooks on the 1/2nd
wRookon7% = 0
bRookon2% = 0
' Developement state: Castled and minor piece developed.
wDeveloped% = Castling(White% + 1)
bDeveloped% = Castling(Black% + 1)
' Knight on B1 developed?
IF MoveControl(B1%) > 0 THEN wDeveloped% = wDeveloped% + 1
' Bishop on C1 developed?
IF MoveControl(C1%) > 0 THEN wDeveloped% = wDeveloped% + 1
' Bishop on F1 developed?
IF MoveControl(F1%) > 0 THEN wDeveloped% = wDeveloped% + 1
' Knight on G1 developed?
IF MoveControl(G1%) > 0 THEN wDeveloped% = wDeveloped% + 1
' Knight on B8 developed?
IF MoveControl(B8%) > 0 THEN bDeveloped% = bDeveloped% + 1
' Bishop on C8 developed?
IF MoveControl(C8%) > 0 THEN bDeveloped% = bDeveloped% + 1
' Bishop on F8 developed?
IF MoveControl(F8%) > 0 THEN bDeveloped% = bDeveloped% + 1
' Knight on G8 developed?
IF MoveControl(G8%) > 0 THEN bDeveloped% = bDeveloped% + 1
' Read the entire board and assess each piece.
' The assessment takes white's point of view. For the black
' pieces, a positive assessment means that this evaluation
' is unfavorable for black.
FOR i% = Column1% TO Column8%
Feld% = i% * 10
FOR j% = ARow% TO HRow%
Feld% = Feld% + 1
SELECT CASE Board(Feld%)
CASE BK%
IF MatNum% < EndgameMaterial% THEN ' Endgame assessment for king
' Centralisze the king in the endgame.
PosValue% = PosValue% - CenterTable(Feld%)
ELSE
' Not yet castled, but castling rights lost
IF Castling(Black% + 1) = False% THEN
IF MoveControl(E8%) > 0 OR (MoveControl(H8%) > 0 AND MoveControl(A8%) > 0) THEN
PosValue% = PosValue% + 35
END IF
END IF
' King preferably not in the center
PosValue% = PosValue% + 4 * CenterTable(Feld%)
FOR k% = -1 TO 1
' Bonus for pawn shield before the king
IF Board(Feld% - 10 + k%) = BP% THEN PosValue% = PosValue% - 15
' Pawn shield 2 rows before the king
IF Board(Feld% - 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 Feld% < A8% THEN PosValue% = PosValue% + 15
ELSE ' If development is completed, place the queen near
' the enemy king. Column and row distance.
' between queen and enemy king should be small.
ColumnnDiff% = ABS(wKing \ 10 - Feld% \ 10)
RownDiff% = ABS(wKing MOD 10 - Feld% MOD 10)
PosValue% = PosValue% + 2 * (ColumnnDiff% + RownDiff%)
END IF
CASE BN% ' Black Knight
PosValue% = PosValue% - CenterTable(Feld%) / 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 (Feld% = D6% OR Feld% = E6%) AND Board(Feld% + 10) = BP% THEN
PosValue% = PosValue% + 20
END IF
bBishlop% = bBishlop% + 1 ' No. of bishops for the bishop pair
CASE BR% ' Rook influences the king assessment
' Black rook has penetrated row 1 or 2
IF Feld% <= H2% THEN bRookon2% = bRookon2% + 1
' Bring rooks from a and h Columns into the center
IF j% >= CRow% AND j% <= ERow% 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% ' Pawn assessment is relatively complex.
' thus it is accomplised in a seperate routine.
PosValue% = PosValue% - BPAssessment%((Feld%), (i%), (j%), (bDeveloped%))
PawnCount% = PawnCount% + 1
CASE Empty%
' Do nothing
CASE WP% ' White Assessment is analogous to the black
PosValue% = PosValue% + WPAssessment%((Feld%), (i%), (j%), (wDeveloped%))
PawnCount% = PawnCount% + 1
CASE WR%
' White rook on 7th or 8th row
IF Feld% >= A7% THEN wRookon7% = wRookon7% + 1
' Bring rooks from a and h columns into the center
IF j% >= CRow% AND j% <= ERow% 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 (Feld% = D3% OR Feld% = E3%) AND Board(Feld% - 10) = WP% THEN
PosValue% = PosValue% - 20
END IF
wBishlop% = wBishlop% + 1
CASE WN%
PosValue% = PosValue% + CenterTable(Feld%) \ 2
CASE WQ%
' Avoid queen outings in the begining of the game.
IF wDeveloped% < 4 THEN
IF Feld% > H1% THEN PosValue% = PosValue% - 15
ELSE ' Place the queen near the enemy king.
' Column and row distance.
' between queen and enemy king should be small.
ColumnnDiff% = ABS(bKing \ 10 - Feld% \ 10)
RownDiff% = ABS(bKing MOD 10 - Feld% MOD 10)
PosValue% = PosValue% - 2 * (ColumnnDiff% + RownDiff%)
END IF
CASE WK%
IF MatNum% < EndgameMaterial% THEN ' Endgame assessment for king
' Centralize the king in the endgame
PosValue% = PosValue% + CenterTable(Feld%)
' Near opposition of the kings
IF ABS(Feld% - bKing) = 20 OR ABS(Feld% - bKing) = 2 THEN
k% = 10
' Opposition in the pawn endgame
IF MatNum% = 0 THEN k% = 30
IF Colour = 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 MoveControl(E1%) > 0 OR (MoveControl(H1%) > 0 AND MoveControl(A1%) > 0) THEN
PosValue% = PosValue% - 35
END IF
END IF
' king preferable not in the center
PosValue% = PosValue% - 4 * CenterTable(Feld%)
FOR k% = -1 TO 1
' Bonus for pawn shield before the king
IF Board(Feld% + 10 + k%) = WP% THEN PosValue% = PosValue% + 15
' Pawns shield 2 rows before the king
IF Board(Feld% + 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 board and insufficient material
' Recognized all elementary draw situations.
' KK, KLK, KSK, KSSK, KLKL, KSKL.
IF PawnCount% = 0 THEN
Bed1% = MatNum% <= MatB% ' Less than a bishop
Bed2% = MatNum% = 2 * MatN% ' Two knights
' Two bishops, but material differece less than a pawn
Bed3% = MatNum% <= 2 * MatB% AND ABS(MaterialBalance(Depth)) < MatP%
IF Bed1% OR Bed2% OR Bed3% THEN
AssessPosition% = 0
EXIT FUNCTION
END IF
END IF
' Bishop pare bonus for White
IF wBishlop% >= 2 THEN PosValue% = PosValue% + 15
' Bishop pair bonus for Black
IF bBishlop% >= 2 THEN PosValue% = PosValue% - 15
' White rooks on 7/8th row and black king also
' on these rows
IF wRookon7% > 0 AND bKing >= A7% THEN
PosValue% = PosValue% + 10
' Double rooks extra dangerous
IF wRookon7% > 1 THEN PosValue% = PosValue% + 25
END IF
' Black rooks on 1/2nd row and white king also
' on these rows
IF bRookon2% > 0 AND wKing <= H2% THEN
PosValue% = PosValue% - 10
IF bRookon2% > 1 THEN PosValue% = PosValue% - 25
END IF
IF Side% = Black% THEN ' Assessment was from white's point of view,
PosValue% = -PosValue% ' changed sign for black
END IF
' Consider the mobility of bishop and rooks
' by the move generator. Mobility(Depth) is the
' mobility of the oppenent, Mobility(Depth-1) that of
' "Side" (before the oppenent has made a move).
IF Depth >= 1 THEN
PosValue% = PosValue% - ((Mobility(Depth) - Mobility(Depth - 1)) / 16)
END IF
AssessPosition% = Value% + PosValue%
END FUNCTION
'--------------------------------------------------------------------
' AttackingField: Function
' Examine whether Player "Side" is attacking the field "Field".
' Returns "True" if field is attacked by "Side", otherwise "False".
' Algorithm: Imagine "Field" occupied by a super piece, that can move
' in any direction. If this super piece 'captures' e.g.
' a rook belonging to "Side" then the rook is actually
' attacking the field.
'
' Locale Variables: i%, Direction%, too%, Piece%, slide%
' Calls:
' Calledby: AssessPosition; GenerateMoves; InputMove; MoveList
'--------------------------------------------------------------------
FUNCTION AttackingField% (Feld%, Side%)
' First test the special case of pawns. They have the same direction
' as bishops but don't slide.
IF Side% = White% THEN
' Must go in the opposite direction of pawns. D5 is attacked
' by pawn on E4.
IF Board(Feld% - 9) = WP% OR Board(Feld% - 11) = WP% THEN
AttackingField% = True%
EXIT FUNCTION
END IF
END IF
IF Side% = Black% THEN
IF Board(Feld% + 9) = BP% OR Board(Feld% + 11) = BP% THEN
AttackingField% = True%
EXIT FUNCTION
END IF
END IF
' Examine the knight
FOR i% = 8 TO 15 ' Knight directions
too% = Feld% + Offset(i%)
IF Board(too%) = Empty% OR Board(too%) = Edge% THEN GOTO w1
IF Side% = White% THEN
IF Board(too%) = WN% THEN
AttackingField% = True%
EXIT FUNCTION
END IF
ELSEIF Board(too%) = BN% THEN
AttackingField% = True%
EXIT FUNCTION
END IF
w1:
NEXT i%
' Examine sliding pieces and king.
FOR i% = 0 TO 7
too% = Feld%
Direction% = Offset(i%)
Slide% = 0
Slideon1:
Slide% = Slide% + 1
too% = too% + Direction%
IF Board(too%) = Empty% THEN
GOTO Slideon1
END IF
' When the edge is reached then new direction
IF Board(too%) = Edge% THEN GOTO w2
' Hit a piece. Piece must be color side.
' Also, the current direction must be a possible move direction
' of the piece. The king can only do one step.
Piece% = Board(too%)
IF Side% = White% THEN
IF Piece% > 0 THEN ' White Ppece
IF Piece% = WK% THEN
IF Slide% <= 1 THEN ' king is slow paced
AttackingField% = True%
EXIT FUNCTION
END IF
ELSE
' As far as sliding pieces are concerned, the current
' direction muse be a possible move diection of the piece.
IF FigOffset(Piece%).Start <= i% THEN
IF FigOffset(Piece%).Ends >= i% THEN
AttackingField% = 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
AttackingField% = True%
EXIT FUNCTION
END IF
ELSE
IF FigOffset(-Piece%).Start <= i% THEN
IF FigOffset(-Piece%).Ends >= i% THEN
AttackingField% = 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 in not attacking the field.
AttackingField% = False%
END FUNCTION
'--------------------------------------------------------------------
' BPAssessment: 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 point of view.
' Calls:
' Calledby: AssessPosition
'--------------------------------------------------------------------
FUNCTION BPAssessment% (Feld%, Column%, row%, developed%)
Column% = (Column8% + Column1%) - Column% ' Flip row. This makes higher
'row = better as for white.
IF MaterialTotal(Depth) > EndgameMaterial% THEN ' Opening or midgame
Value% = bPFieldValue(Feld%)
' If development incomplete, don't push edge pawns forward
IF developed% < 4 THEN
IF (row% >= FRow% OR row% <= BRow%) AND Column% > Column3% THEN
Value% = Value% - 15
END IF
END IF
ELSE ' In the endgame, all lines are equally good.
' Bring pawns forward.
Value% = Column% * 4
END IF
' Is the pawn isolated?
' Edge pawns don't require extra treatment. Pawns(ARow-1) is
' the left edge, Pawns(HRow+1) the right edge. No pawn is
' placed on these edges.
IF Pawns(row% - 1).Black = 0 AND Pawns(row% + 1).Black = 0 THEN
Value% = Value% - 12 ' Isolated
' Isolated double pawn
IF Pawns(row%).Black > 1 THEN Value% = Value% - 12
END IF
' double pawn
IF Pawns(row%).Black > 1 THEN Value% = Value% - 15
' Duo or guarded pawns get a bonus
' e.g. e5,d5 is a Duo, d6 guards e5
IF PawnControlled(Feld%).Black > 0 OR PawnControlled(Feld% - 10).Black > 0 THEN
Value% = Value% + Column%
END IF
IF Pawns(row%).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(Feld%).Black = 0
' ... and can't advance because of enemy pawns
' control the field in front of him.
Condition2% = PawnControlled(Feld% - 10).White > PawnControlled(Feld% - 10).Black
IF Condition1% AND Condition2% THEN
Value% = Value% - 10
' Rook impeded by left-behind pawn
IF Rooks(row%).White > 0 THEN Value% = Value% - 8
ELSE
' Pawn is a free pawn, on an half-open column and the
' fields ahead on his column are not controlled by
' enemy pawns.
FOR j% = Feld% 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 midgame.
IF MaterialTotal(Depth) < EndgameMaterial% THEN
Value% = Value% + Column% * 16 ' The more advanced, the better
' Rook guards a free pawn on the same column
IF Rooks(row%).Black > 0 THEN Value% = Value% + Column% * 2
' Enemy rook on the same column
IF Rooks(row%).White > 0 THEN Value% = Value% - Column% * 2
' Pure pawn endgame. Free pawn particularly valuable.
IF MaterialTotal(Depth) = 0 THEN Value% = Value% + Column% * 8
' Guarded free pawn
IF PawnControlled(Feld%).Black > 0 OR PawnControlled(Feld% - 10).Black > 0 THEN
Value% = Value% + Column% * 4
END IF
' Free pawn blocked by a white piece. This piece is not
' threatened by fellow pawns.
IF Board(Feld% - 10) < 0 AND PawnControlled(Feld% - 10).Black = 0 THEN
Value% = Value% - Column% * 4
END IF
ELSE ' Free pawn in the midgame
Value% = Value% + Column% * 8
' Guarded free pawn
IF PawnControlled(Feld%).Black > 0 OR PawnControlled(Feld% - 10).Black > 0 THEN
Value% = Value% + Column% * 2
END IF
END IF
END IF
END IF
BPAssessment% = Value%
END FUNCTION
'--------------------------------------------------------------------
' CommandLoop:
' 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-field,to-field).
' and ignored as a command. See also: PrintLogo
' Calls: Gameover; Initialize; Displayboard; InputPosition;
' ComputerMove; Flipboard; MoveList; MoveBack;
' ComputingDepth; InitGameTree; AssessPosition;
' Calledby: Main
'--------------------------------------------------------------------
SUB CommandLoop
Ends% = False%
DO
CALL DisplayBoard(False%) ' my new line
INPUT "Your Input: ", Commands$
Commands$ = UCASE$(Commands$) ' Change to upper case
SELECT CASE Commands$
CASE "EN"
Ends% = 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 "ML"
CALL MoveList
CASE "TB"
CALL MoveBack
CASE "SD"
CALL ComputingDepth
CASE "DA"
CALL InitGameTree
PRINT " Assessment= "; AssessPosition%(-MateValue%, MateValue%, Colour)
CASE ELSE
IF InputMove%(Commands$) = False% THEN
PRINT " Illegal move or unknown Command"
ELSEIF PlayerPlayer = False% THEN
CALL ComputerMove
END IF
END SELECT
LOOP WHILE Ends% = False%
END SUB
'--------------------------------------------------------------------
' ComputerMove:
' Computes the next computer move.
' The search is iteratively deepened until MinDepth.
' The search uses "Aspiration"-Alpha-Beta.
' The search process can be interupted by
' a keypress.
' If the search wasn't interupted and no checkmate/stalemate
' exists, the best move is performed.
' Calls: InitGameTree; GenerateMoves; DisplayMove; TakeBackMove;
' PerformMove; CopyMainVariant; DisplayMVar; PrintMove
' AssessPosition;
' Calledby: CopyMainVariant; AlphaBeta; AssessPosition; CommandLoop
'--------------------------------------------------------------------
SUB ComputerMove
DIM tmp AS MoveType ' Temporary MoveType Variable
CALL InitGameTree
' Assess the initial position. End search if opponent is already checkmate.
Value% = AssessPosition%(-MateValue%, MateValue%, Colour)
IF Value% = MateValue% THEN
PRINT " Checkmate!"
EXIT SUB
END IF
' Store "Checked state". Required to recognize
' stalemate at the end of the search.
Check% = InCheck
NodeCount = 0
' Start time of the computation. Used for displaying nodes/second.
Starttime = TIMER
' Generate all pseudo-legal moves
CALL GenerateMoves(1)
' You should/could 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
' increased 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% = -MateValue% ' We have no good assessment value for
Beta% = MateValue% ' the position yet.
ELSE ' On the higher levels, the result shold 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
LOCATE 0 + Distance%, 52
PRINT 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).from = 0
CALL DisplayMove(i%)
IF MovesInLine% MOD 9 = 8 THEN ' Eight moves per line
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 'falls down' out the
' window (the program understands the mishap). Requires
' a renewed search with windows opened 'below'.
Alpha% = -MateValue%
Beta% = Value%
' PRINT "? ["; Alpha%; ","; Beta%; "]"
MovesInLine% = 0
' PRINT " ";
CALL PerformMove((i%))
Value% = -AlphaBeta(-Beta%, -Alpha%, Distance% - 1)
CALL TakeBackMove((i%))
ELSEIF Value% >= Beta% THEN ' Falls up
Alpha% = Value%
Beta% = MateValue%
' 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 t,
' even better. We continue calculating with a null window
' as this expedites the search.
Alpha% = Value%
Beta% = Alpha% + 1
LOCATE 15, 51
PRINT " Best Move: ";
CALL DisplayMove(i%)
LOCATE 16, 51
PRINT "Value ="; Value%
CALL CopyMainVariant(i%)
' LOCATE 0 + Distance%, 58
CALL DisplayMVar
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% = MateValue%
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 " Best Move: ";
' CALL DisplayMove(i%)
' PRINT "Value ="; Value%
CALL CopyMainVariant(i%)
' LOCATE 0 + Distance%, 54
CALL DisplayMVar
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%
Endtime = TIMER
IF Alpha% > -(MateValue% - 1) THEN
' PRINT " Computer Player: ";
CALL DisplayMove(0) ' Best Move is always sorted into
' position 0 of the Movestacks
' LOCATE 17, 51
' PRINT " Value ="; Alpha%; ", Positions ="; NodeCount;
Time% = Endtime - Starttime
Comtime% = Comtime% + Time%: LOCATE 20, 50: PRINT "TOT "; Comtime%
' Prevent division by zero on nodes/second
IF Time% = 0 THEN Time% = 1
LOCATE 18, 51
PRINT ", Time="; Time%; "Sec., Positions/Sec. ="; NodeCount \ Time%
CALL PerformMove(0)
CALL PrintMove(0)
IF Alpha% >= MateValue% - 10 THEN
PRINT " I checkmate in "; (MateValue% - 2 - Alpha%) \ 2; " moves "
ELSE
IF Alpha% <= -MateValue% + 10 THEN
PRINT " I'm checkmate in "; (Alpha% + MateValue% - 1) \ 2; " moves"
END IF
END IF
ELSE
IF Check% = True% THEN
PRINT " Congratulations: MiniMAX is checkmated!"
ELSE
PRINT " Stalemate!"
END IF
END IF
END SUB
' -----------------------------------------------------------------
' ComputingDepth:
' Input minimum computing depth
' Calls: None
' Calledby:
' -----------------------------------------------------------------
SUB ComputingDepth
PRINT " Computing depth is"; MinDepth
INPUT " New computing depth: ", Inputs$
tmp% = VAL(Inputs$)
IF tmp% > 0 AND tmp% < MaxDepth% - 9 THEN
MinDepth = tmp%
ELSE
PRINT " Invalid computing depth"
END IF
END SUB
'--------------------------------------------------------------------
' CopyMainVariant:
' Saves the current move in the Main variant and copies
' the continuation that was found on the next depth.
' Calls:
' Calledby: ComputerMove;
'--------------------------------------------------------------------
SUB CopyMainVariant (CurrMove%)
' New main variant is a continuation of this variant
MVar(Depth, Depth).from = MoveStack(CurrMove%).from
MVar(Depth, Depth).too = MoveStack(CurrMove%).too
i% = 0
DO
i% = i% + 1
MVar(Depth, Depth + i%) = MVar(Depth + 1, Depth + i%)
LOOP UNTIL MVar(Depth + 1, Depth + i%).from = 0
END SUB
'--------------------------------------------------------------------
' DisplayBoard:
' Display of the game board and the game/Board state
' Only displays game/board state if "BoardOnly" is false
'
' The SGN-Function (Sign) returns the sign, i.e. -1 or +1
' The ABS-Function returns the absolute value (without sign)
' Calls: Fieldnotation
' Calledby:
'--------------------------------------------------------------------
SUB DisplayBoard (BoardOnly%)
' Display board
LOCATE 1, 1
FOR i% = Column8% TO Column1% STEP -1 ' For all rows
PRINT i% - 1; " "; ' Row coordinates
FOR j% = ARow% TO HRow% ' For all lines
Piece% = Board(i% * 10 + j%)
Side% = SGN(Piece%) ' Compute color from piece.
' Empty field has Color 0
Piece% = ABS(Piece%) ' Piece type
PRINT ColourSymbol(Side% + 1); FigSymbol(Piece%); " ";
NEXT j%
NEXT i%
PRINT " ";
FOR j% = ARow% TO HRow% ' Line coordinates 'a'...'h'
PRINT " "; CHR$(ASC("a") - 1 + j%);
NEXT j%
PRINT ' Empty line
PRINT ' Empty line
EXIT SUB 'my new line
IF BoardOnly% THEN EXIT SUB
' Remaining board/game state
IF Colour = White% THEN
PRINT " White";
ELSE
PRINT " Black";
END IF
PRINT " is to make a move"
PRINT " Material balance = "; MaterialBalance(Depth)
PRINT " En Passant Field = "; Fieldnotation$(EpField(Depth))
' Castling is in principle possible if the king and appropriate
' rook have not moved.
PRINT " Castling state black = ";
IF MoveControl(E8%) + MoveControl(H8%) = 0 THEN PRINT "0-0 ";
IF MoveControl(E8%) + MoveControl(A8%) = 0 THEN PRINT "0-0-0";
PRINT " Castling State white = ";
IF MoveControl(E1%) + MoveControl(H1%) = 0 THEN PRINT "0-0 ";
IF MoveControl(E1%) + MoveControl(A1%) = 0 THEN PRINT "0-0-0";
END SUB
'--------------------------------------------------------------------
' DisplayMove:
' Display the current move in chess notation.
' Castling is 'E1-G1' and not O-O
' CurrMove% is the index of the move into MoveStack.
' Calls:
' Calledby:
'--------------------------------------------------------------------
SUB DisplayMove (CurrMove%)
from% = MoveStack(CurrMove%).from
too% = MoveStack(CurrMove%).too
' PRINT FigSymbol(ABS(Board(from%))); ' Type of piece
' PRINT Fieldnotation$(from%); ' Initial field
IF MoveStack(CurrMove%).CapturedPiece = Empty% THEN
' PRINT "-"; ' Normal move
ELSE
' PRINT "x"; ' Capture move
END IF
' PRINT Fieldnotation$(too%); ' Target field
' If promoted, add promotion piece
IF MoveStack(CurrMove%).PromotedPiece <> Empty% THEN
' PRINT FigSymbol(MoveStack(CurrMove%).PromotedPiece);
END IF
' PRINT " ";
END SUB
'--------------------------------------------------------------------
' DisplayMVar:
' Display the current main variant, Only the from-to fields
' are output.
' Calls: Fieldnotation;
' Calledby:
'--------------------------------------------------------------------
SUB DisplayMVar
'PRINT " Main variants: ";
i% = 0
DO WHILE MVar(0, i%).from <> 0
LOCATE 1 + i%, 56
PRINT Fieldnotation$(MVar(0, i%).from); "-";
PRINT Fieldnotation$(MVar(0, i%).too); " ";
i% = i% + 1
LOOP
END SUB
'-----------------------------------------------------------------------
' Fieldnotation: Function
' Converts internal FieldNumber to Fieldnotation.
' Returns '--' if the number is not on the board
'
' Notes:
' The \ Operator is integer division.
' The Mod (Modulo) operator returns the remainder of an intege division.
' Calls:
' Calledby:
'-----------------------------------------------------------------------
FUNCTION Fieldnotation$ (Fieldnum%)
' See if correct
IF Fieldnum% < A1% OR Fieldnum% > H8% OR Board(Fieldnum%) = Edge% THEN
Fieldnotation$ = "--"
ELSE
s$ = CHR$(ASC("A") - 1 + Fieldnum% MOD 10) ' Line
s$ = s$ + CHR$(ASC("1") - 2 + Fieldnum% \ 10) ' Row
Fieldnotation$ = LCASE$(s$)
END IF
END FUNCTION
'--------------------------------------------------------------------
' Fieldnumber: Function
' Converts Fieldnotation (e.g. "A1") to internal Fieldnumber.
' Returns "Illegal" if input is incorrect
' Line coordinates must be passed as uppercase letters.
' Calls:
' Calledby: Fieldnotation
'--------------------------------------------------------------------
FUNCTION Fieldnumber% (Fieldnote$)
row$ = LEFT$(Fieldnote$, 1)
Column$ = MID$(Fieldnote$, 2, 1)
' See if correct
IF row$ < "A" OR row$ > "H" OR Column$ < "1" OR Column$ > "8" THEN
Fieldnumber% = Illegal%
EXIT FUNCTION
END IF
Fieldnumber% = (ASC(row$) - ASC("A") + 1) + 10 * (ASC(Column$) - ASC("1") + 2)
END FUNCTION
'---------------------------------------------------------------------
' FlipBoard:
' Flips the representation of the board on the monitor
' Note: Not implemented in version 1.0
' Calls:
' Calledby:
'---------------------------------------------------------------------
SUB FlipBoard
END SUB
'--------------------------------------------------------------------
' GameOver:
' Stores the game and game parameters on the harddisk.
' Note: Not implemented in version 1.0
' Calls:
' Calledby:
'--------------------------------------------------------------------
SUB GameOver
END SUB
'--------------------------------------------------------------------
' GenerateMoves:
' 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.
' Calls: SavePromotion; SaveMove; SaveCaptureMove; SaveEpMove
' AttackingField;
' Calledby: AttackingField, InputMove, MoveList, AlphaBeta,ComputerMove
'--------------------------------------------------------------------
SUB GenerateMoves (AllMoves%)
Index = StackLimit(Depth) ' Start of MoveList on current depth
Mobility(Depth) = 0
' Search the board for pieces
FOR from% = A1% TO H8%
Piece% = Board(from%)
' Empty and edge fields make no moves
IF Piece% = Empty% OR Piece% = Edge% THEN GOTO NextField
' Piece must also be of correct color
IF Colour = White% AND Piece% < 0 THEN GOTO NextField
IF Colour = Black% AND Piece% > 0 THEN GOTO NextField
Piece% = ABS(Piece%) ' Type of Piece. Color doesn't influence
' (except for pawns) the move diretion.
IF Piece% = WP% THEN ' Pawns moves
IF Colour = White% THEN
IF Board(from% + 10) = Empty% THEN
IF from% >= A7% THEN
CALL SavePromotion(from%, from% + 10)
ELSEIF AllMoves% > 0 THEN
CALL SaveMove(from%, from% + 10)
' double-step possible?
IF from% <= H2% AND Board(from% + 20) = Empty% THEN
CALL SaveMove(from%, from% + 20)
' Move has already increased Index
MoveStack(Index - 1).EpField = from% + 10
END IF
END IF
END IF
IF Board(from% + 11) < 0 THEN ' Pawn can capture black piece
IF from% >= A7% THEN
CALL SavePromotion(from%, from% + 11)
ELSE
CALL SaveCaptureMove(from%, from% + 11)
END IF
END IF
IF Board(from% + 9) < 0 THEN ' Likewise in other capture direction
IF from% >= A7% THEN
CALL SavePromotion(from%, from% + 9)
ELSE
CALL SaveCaptureMove(from%, from% + 9)
END IF
END IF
ELSEIF Colour = Black% THEN ' Same for black pawns
IF Board(from% - 10) = Empty% THEN
IF from% <= H2% THEN
CALL SavePromotion(from%, from% - 10)
ELSEIF AllMoves% > 0 THEN
CALL SaveMove(from%, from% - 10)
' double-steps possible?
IF from% >= A7% AND Board(from% - 20) = Empty% THEN
CALL SaveMove(from%, from% - 20)
' Move has already increased Index
MoveStack(Index - 1).EpField = from% - 10
END IF
END IF
END IF
' For black pawns also examine the edge,
' not for white as the edge > 0.
IF Board(from% - 11) > 0 AND Board(from% - 11) <> Edge% THEN
IF from% <= H2% THEN
CALL SavePromotion(from%, from% - 11)
ELSE
CALL SaveCaptureMove(from%, from% - 11)
END IF
END IF
IF Board(from% - 9) > 0 AND Board(from% - 9) <> Edge% THEN
IF from% <= H2% THEN
CALL SavePromotion(from%, from% - 9)
ELSE
CALL SaveCaptureMove(from%, from% - 9)
END IF
END IF
END IF
GOTO NextField ' Examine next field
END IF
' Moves for all other pieces are computed
' by way of move offset.
Longpaths% = FigOffset(Piece%).Longpaths
FOR i% = FigOffset(Piece%).Start TO FigOffset(Piece%).Ends
Direction% = Offset(i%)
too% = from%
Slideon2:
too% = too% + Direction%
IF Board(too%) = Empty% THEN
IF AllMoves% > 0 THEN
CALL SaveMove(from%, too%)
END IF
IF Longpaths% THEN ' Bishop, rook and queen
GOTO Slideon2
ELSE ' Knight and king
GOTO NextDirection
END IF
END IF
IF Board(too%) = Edge% THEN ' Hit the edge, keep searching
GOTO NextDirection ' in an another direction.
END IF
' Hit a piece. Must be of the correct color.
CaptureMove% = Colour = White% AND Board(too%) < 0
CaptureMove% = CaptureMove% OR (Colour = Black% AND Board(too%) > 0)
IF CaptureMove% THEN CALL SaveCaptureMove(from%, too%)
NextDirection:
NEXT i%
NextField:
NEXT from%
' En Passant Move
IF EpField(Depth) <> Illegal% THEN
ep% = EpField(Depth)
IF Colour = White% THEN
IF Board(ep% - 9) = WP% THEN
CALL SaveEpMove(ep% - 9, ep%, ep% - 10)
END IF
IF Board(ep% - 11) = WP% THEN
CALL SaveEpMove(ep% - 11, ep%, ep% - 10)
END IF
ELSE
IF Board(ep% + 9) = BP% THEN
CALL SaveEpMove(ep% + 9, ep%, ep% + 10)
END IF
IF Board(ep% + 11) = BP% THEN
CALL SaveEpMove(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 amoung leading programmers).
' Compute castling
IF Colour = White% THEN
IF wKing = E1% AND MoveControl(E1%) = 0 THEN
' Is short castling allowed?
OK% = Board(H1%) = WR% AND MoveControl(H1%) = 0
OK% = OK% AND Board(F1%) = Empty% AND Board(G1%) = Empty%
OK% = OK% AND AttackingField%(E1%, Black%) = False%
OK% = OK% AND AttackingField%(F1%, Black%) = False%
OK% = OK% AND AttackingField%(G1%, Black%) = False%
IF OK% THEN
CALL SaveMove(E1%, G1%) ' Save king's move
MoveStack(Index - 1).CastlingNr = ShortCastlingMove%
END IF
' Is long castling allowed?
OK% = Board(A1%) = WR% AND MoveControl(A1%) = 0
OK% = OK% AND Board(D1%) = Empty%
OK% = OK% AND Board(C1%) = Empty%
OK% = OK% AND Board(B1%) = Empty%
OK% = OK% AND AttackingField%(E1%, Black%) = False%
OK% = OK% AND AttackingField%(D1%, Black%) = False%
OK% = OK% AND AttackingField%(C1%, Black%) = False%
IF OK% THEN
CALL SaveMove(E1%, C1%) ' Save king's move
' Save type of castling
MoveStack(Index - 1).CastlingNr = LongCastlingMove%
END IF
END IF
ELSE ' Black is to make a move
IF bKing = E8% AND MoveControl(E8%) = 0 THEN
' Is short castling allowed?
OK% = Board(H8%) = BR% AND MoveControl(H8%) = 0
OK% = OK% AND Board(F8%) = Empty% AND Board(G8%) = Empty%
OK% = OK% AND AttackingField%(E8%, White%) = False%
OK% = OK% AND AttackingField%(F8%, White%) = False%
OK% = OK% AND AttackingField%(G8%, White%) = False%
IF OK% THEN
CALL SaveMove(E8%, G8%) ' Save king's move
MoveStack(Index - 1).CastlingNr = ShortCastlingMove%
END IF
' Is long castling allowed?
OK% = Board(A8%) = BR% AND MoveControl(A8%) = 0
OK% = OK% AND Board(D8%) = Empty%
OK% = OK% AND Board(C8%) = Empty%
OK% = OK% AND Board(B8%) = Empty%
OK% = OK% AND AttackingField%(E8%, White%) = False%
OK% = OK% AND AttackingField%(D8%, White%) = False%
OK% = OK% AND AttackingField%(C8%, White%) = False%
IF OK% THEN
CALL SaveMove(E8%, C8%) ' Save king's move
' Save type of castling
MoveStack(Index - 1).CastlingNr = LongCastlingMove%
END IF
END IF
END IF
StackLimit(Depth + 1) = Index ' Mark end of MoveList
END SUB
'--------------------------------------------------------------------
' InitAssessment:
' Compute the Pawn controls and the columns on which pawns and
' rooks are placed. Called by the assessment function
' for initialization.
' Calls:
' Calledby:
'--------------------------------------------------------------------
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% = ARow% - 1 TO HRow% + 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 NextFeld
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
NextFeld:
NEXT i%
END SUB
'--------------------------------------------------------------------
' InitGameTree:
' Initialize the GameTree
' Calls:
' Calledby:
'--------------------------------------------------------------------
SUB InitGameTree
' In Depth 0 nothing has been computed, game tree already initialized
IF Depth = 0 THEN EXIT SUB
EpField(0) = EpField(1)
MaterialBalance(0) = MaterialBalance(1)
MaterialTotal(0) = MaterialTotal(1)
Depth = 0
END SUB
'--------------------------------------------------------------------
' Initialize:
' Initialize the board and the game status
' Calls: None
' Calledby: Main
'--------------------------------------------------------------------
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%
' Positions of the kings 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%
MoveControl(i%) = 0 ' Initially no piece has moved
NEXT i%
EpField(0) = Illegal% ' En Passant status
MaterialTotal(0) = MaterialSum% ' Material value (of pieces) in InitialPosition
MaterialBalance(0) = 0 ' Material balance even
PlayerPlayer = False%
StackLimit(0) = 0 ' Limit of Movestacks
MinDepth = 4 ' Default ComputingDepth
Depth = 0 ' Current depth in the game tree
Colour = White% ' White has the first move
END SUB
'--------------------------------------------------------------------
' InputMove: Function
' 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%'.
' Calls: GenerateMoves; InitGameTree; DisplayMove; PerformMove
' TakeBackMove; PrintMove; AttackingField; Fieldnotation;
' Fieldnumber;
' Calledby:
'--------------------------------------------------------------------
FUNCTION InputMove% (Move$)
IF LEN(Move$) < 4 THEN ' Only from-to representation is allowed
InputMove% = False%
EXIT FUNCTION
END IF
from% = Fieldnumber%(Move$)
too% = Fieldnumber%(MID$(Move$, 3, 2))
CALL GenerateMoves(1)
FOR i% = StackLimit(Depth) TO StackLimit(Depth + 1) - 1
IF MoveStack(i%).from = from% AND MoveStack(i%).too = too% THEN
IF MoveStack(i%).PromotedPiece <> 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
' the Color. Next inquiry of color must
' compensate for this.
IF Colour = Black% THEN
IF AttackingField%(wKing, Black%) = True% THEN
PRINT " White king on "; Fieldnotation$(wKing); " is being checked"
CALL TakeBackMove((i%))
LastMove = tmp% ' No new move made. Restore
InputMove% = False% ' last move.
EXIT FUNCTION
END IF
ELSEIF AttackingField%(bKing, White%) = True% THEN
PRINT " Blackr king on "; Fieldnotation$(bKing); " is being checked"
CALL TakeBackMove((i%))
LastMove = tmp%
InputMove% = False%
EXIT FUNCTION
END IF
CALL PrintMove(i%)
InputMove% = True%
EXIT FUNCTION
END IF
NEXT i%
InputMove% = False% ' The input move was not found in MoveList
END FUNCTION
'--------------------------------------------------------------------
' InputPosition:
' Input of any position
' Calls: DisplayBoard; PrintPosition; ReadPiece;
' Calledby: CommandLoop
'--------------------------------------------------------------------
SUB InputPosition
Depth = 0 ' Position becomes root of the search tree
PieceInput:
INPUT " Delete Board (Y/N) ", Inputs$
Inputs$ = UCASE$(Inputs$) ' change to upper case
IF Inputs$ = "Y" THEN
FOR i% = Column1% TO Column8%
FOR j% = ARow% TO HRow%
Board(i% * 10 + j%) = Empty%
NEXT j%
NEXT i%
END IF
' Do not interpret "Y" as no
PRINT " White:"
ReadPiece (White%)
PRINT " Black:"
ReadPiece (Black%)
' Compute material balance and examine if each side
' has just one king.
MaterialBalance(0) = 0
MaterialTotal(0) = 0
wKings% = 0
bKings% = 0
FOR i% = A1% TO H8% ' Read each field
IF Board(i%) = Empty% OR Board(i%) = Edge% THEN
GOTO Continue ' Empty or edge field found, go to next field
END IF
' New Material balance
' White piece positively affects the balance, back negatively
MaterialBalance(0) = MaterialBalance(0) + SGN(Board(i%)) * PieceMaterial(ABS(Board(i%)))
IF ABS(Board(i%)) <> WP% THEN
MaterialTotal(0) = MaterialTotal(0) + PieceMaterial(ABS(Board(i%)))
END IF
IF Board(i%) = WK% THEN
wKings% = wKings% + 1 ' Number and position of 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 " Whose move (W/B): "; Inputs$
Inputs$ = UCASE$(Inputs$)
IF Inputs$ = "W" THEN
Colour = White%
ELSEIF Inputs$ = "B" THEN
Colour = Black% ' Material balance was computed from
MaterialBalance(0) = -MaterialBalance(0) 'white's viewpoint until now.
ELSE
GOTO Repeat
END IF
FOR i% = A1% TO H8% ' To simplify, we assume here that
MoveControl(i%) = 1 ' all pieces have already moved once.
NEXT i% ' Otherwise, the assessment function
' believes this is an
' Initial position.
MoveControl(E1%) = 0
MoveControl(A1%) = 0 ' Single exception: The king and rook
MoveControl(H1%) = 0 ' fields represent the castling state
MoveControl(E8%) = 0 ' and must therefore be reset
MoveControl(A8%) = 0 ' to zero.
MoveControl(H8%) = 0
EpField(0) = Illegal%
INPUT " Change the status (Y/N): "; Inputs$
Inputs$ = UCASE$(Inputs$)
IF Inputs$ = "Y" THEN
' Input the enpassant Field. if following input ins't correct,
' enpassant is not possible.
INPUT " En passant column: "; Inputs$
Inputs$ = UCASE$(Inputs$)
ep$ = LEFT$(Inputs$, 1)
IF ep$ >= "A" AND ep$ <= "H" THEN
IF Colour = White% THEN
EpField(0) = A6% + ASC(ep$) - ASC("A")
ELSE
EpField(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) : "; Inputs$
Inputs$ = UCASE$(Inputs$)
IF Inputs$ = "N" THEN
MoveControl(H8%) = 1 ' Move the rook. This eliminates
' the castling.
END IF
INPUT " Black 0-0-0 legal (Y/N): "; Inputs$
Inputs$ = UCASE$(Inputs$)
IF Inputs$ = "N" THEN
MoveControl(A8%) = 1
END IF
INPUT " White 0-0 legal (Y/N) : "; Inputs$
Inputs$ = UCASE$(Inputs$)
IF Inputs$ = "N" THEN
MoveControl(H1%) = 1
END IF
INPUT " White 0-0-0 legal (Y/N) : "; Inputs$
Inputs$ = UCASE$(Inputs$)
IF Inputs$ = "N" THEN
MoveControl(A1%) = 1
END IF
END IF
MoveCount = 0 ' Reset the move count
CALL DisplayBoard(False%) ' Display the new board
CALL PrintPosition
END SUB
' -----------------------------------------------------------------
' MoveBack:
' Takes back a move
' Since the pllayer moves aaaaare not stored, a mizimun of
' one move can be taken back.
' Calls: TakeBackMove; DisplayBoard; PrintBack
' Calledby:
' -----------------------------------------------------------------
SUB MoveBack
IF Depth <> 1 THEN
PRINT " Unfortunately not possible."
EXIT SUB
END IF
CALL TakeBackMove(LastMove)
CALL DisplayBoard(False%)
CALL PrintBack
END SUB
' -----------------------------------------------------------------
' MoveList:
' Generate all moves and display them on the monitor
' Calls: GenerateMoves; DisplayMove; AttackingField;
' Calledby:
' -----------------------------------------------------------------
SUB MoveList
CALL GenerateMoves(1)
IF Colour = White% THEN
CheckMated% = AttackingField%(bKing, White%)
ELSE
CheckMated% = AttackingField%(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
'--------------------------------------------------------------------
' NextBestMove: Function
' 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.
' Calls:
' Calledby:
'--------------------------------------------------------------------
FUNCTION NextBestMove%
BestMove% = -1
BestValue% = -MateValue%
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 = -MateValue%
NextBestMove% = BestMove%
END FUNCTION
'--------------------------------------------------------------------
' PerformMove:
' Performs a move at the board and updates the status and
' the search depth.
' CurrMove% is the index of the move into MoveStack.
' Calls:
' Calledby:
'--------------------------------------------------------------------
SUB PerformMove (CurrMove%)
MoveCount = MoveCount + 1 ' Increase move count by one half-move
from% = MoveStack(CurrMove%).from
too% = MoveStack(CurrMove%).too
ep% = MoveStack(CurrMove%).EpField
LastMove = CurrMove%
Depth = Depth + 1 ' One step deeper in the tree
TooFeld(Depth) = too% ' Used for move sorting and extension
' of the search.
EpField(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)
MaterialTotal(Depth) = MaterialTotal(Depth - 1)
' The piece is moving from the 'from' field to the 'to' field
MoveControl(from%) = MoveControl(from%) + 1
MoveControl(too%) = MoveControl(too%) + 1
IF ep% <> Illegal% THEN
IF Board(ep%) = Empty% THEN ' Pawn move from 2nd to 4th row
EpField(Depth) = ep%
ELSE ' Enemy pawn is captured enpassant
Board(ep%) = Empty% ' Remove captured pawn
MaterialBalance(Depth) = MaterialBalance(Depth) - MatP%
END IF
ELSE ' If a piece is captured, change the material balance
IF MoveStack(CurrMove%).CapturedPiece <> Empty% THEN ' Piece was captured
MatChange% = PieceMaterial(MoveStack(CurrMove%).CapturedPiece)
MaterialBalance(Depth) = MaterialBalance(Depth) - MatChange%
' Sum up only the officer's material value
IF MatChange% <> MatP% THEN
MaterialTotal(Depth) = MaterialTotal(Depth) - MatChange%
END IF
END IF
END IF
Board(too%) = Board(from%) ' Place onto board
Board(from%) = Empty%
' Now the special cases promotion and castling
IF MoveStack(CurrMove%).PromotedPiece <> Empty% THEN ' Pawn promotion
Board(too%) = Colour * MoveStack(CurrMove%).PromotedPiece
MatChange% = PieceMaterial(MoveStack(CurrMove%).PromotedPiece) - MatP%
MaterialBalance(Depth) = MaterialBalance(Depth) - MatChange%
' Pawns are not included in MaterialTotal.
MaterialTotal(Depth) = MaterialTotal(Depth) + MatChange% + MatP%
ELSE
IF MoveStack(CurrMove%).CastlingNr = ShortCastlingMove% THEN
Board(too% + 1) = Empty% ' 'to' is G1 or G8 (depending on color)
Board(too% - 1) = Colour * WR% ' Put white/black Rook on F1/F8
Castling(Colour + 1) = True%
ELSEIF MoveStack(CurrMove%).CastlingNr = LongCastlingMove% THEN
Board(too% - 2) = Empty% ' 'to' is C1 or C8
Board(too% + 1) = Colour * WR%
Castling(Colour + 1) = True%
END IF
END IF
' If king has moved, update the king's position
IF Board(too%) = WK% THEN
wKing = too%
ELSEIF Board(too%) = BK% THEN
bKing = too%
END IF
' Flip the color (the Side who is to make the move)
Colour = -Colour
END SUB
'--------------------------------------------------------------------
' PrintBack:
' Print the take-back command
' Calls:
' Calledby:
'--------------------------------------------------------------------
SUB PrintBack
IF Printing = False% THEN EXIT SUB ' Only if printing is on
IF Colour = White% THEN
LPRINT " Back"
IsWhiteLast = False%
ELSE
LPRINT USING "###. Back!"; MoveCount \ 2 + 1; CHR$(9);
IsWhiteLast = True%
END IF
END SUB
'--------------------------------------------------------------------
' PrintLogo:
' Displays the program logo/menu on the monitor (see CommandLoop
' Calls: None
' Calledby: Main;
'--------------------------------------------------------------------
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 ot the following commands: *"
PRINT "* *"
PRINT "* NG --> New game *"
PRINT "* EN --> End 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 moves 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
'--------------------------------------------------------------------
' PrintMove:
' Prints the current move.
' WARNING: Don't change the format of this output as it will cause
' malfunction of the Noname driver the CHESS232 board
' and the Autoplayer AUTO232.
'
' Notes:
' CHR$(9) is the tab character
' Calls: Fieldnotation;
' Calledby:
'--------------------------------------------------------------------
SUB PrintMove (CurrMove%)
IF Printing = False% THEN EXIT SUB ' Only if Printing is on
IF Colour = 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%).too)));
from$ = LCASE$(Fieldnotation$(MoveStack(CurrMove%).from))
LPRINT from$;
IF MoveStack(CurrMove%).CapturedPiece <> Empty% THEN
LPRINT "x";
ELSE
LPRINT "-";
END IF
too$ = LCASE$(Fieldnotation$(MoveStack(CurrMove%).too))
LPRINT too$;
IF MoveStack(CurrMove%).PromotedPiece <> Empty% THEN
LPRINT PrintSymbol(MoveStack(CurrMove%).PromotedPiece);
END IF
ELSEIF MoveStack(CurrMove%).CastlingNr = ShortCastlingMove% THEN
LPRINT " 0-0 ";
ELSE
LPRINT " 0-0-0"
END IF
' Finish with the tab character for a white move
' or a charriage return for a black move
IF Colour = Black% THEN
LPRINT CHR$(9);
ELSE
LPRINT
END IF
END SUB
'--------------------------------------------------------------------
' PrintPosition:
' Prints the current position im ChessBase / Fritz format.
' WARNING: Don't change the format of this output as it will
' cause malfunction of the Chess332 driver.
' Calls: Fieldnotation;
' Calledby:
'--------------------------------------------------------------------
SUB PrintPosition
IF Printing = False% THEN EXIT SUB
IF IsWhiteLast = True% THEN
LPRINT
IsWhiteLast = False%
END IF
LPRINT "(wK";
LPRINT Fieldnotation$(wKing); ' First the king
FOR i% = A1% TO H8% ' Remaining white pieces
IF Board(i%) > 0 AND Board(i%) < WK% THEN
LPRINT ","; FigSymbol(Board(i%));
LPRINT Fieldnotation$(i%);
END IF
NEXT i%
LPRINT "; sK";
LPRINT Fieldnotation$(bKing); ' First the king
FOR i% = A1% TO H8% ' Remaining black pieces
IF Board(i%) < 0 AND Board(i%) > BK% THEN
LPRINT ","; FigSymbol(ABS(Board(i%)));
LPRINT Fieldnotation$(i%);
END IF
NEXT i%
LPRINT ")"
END SUB
'--------------------------------------------------------------------
' ReadPiece:
' Reads the Piece for the "Side"
' Format is:
' "." is "empty field", i.e. removes any piece from that field.
' Calls: Fieldnumber;
' Calledby:
'--------------------------------------------------------------------
SUB ReadPiece (Side%)
NextPiece:
INPUT Inputs$
IF Inputs$ = "" THEN EXIT SUB ' Exit if input is void
IF LEN(Inputs$) < 3 THEN GOTO BadInput ' Input to short
Inputs$ = UCASE$(Inputs$) ' Uppercase
Piece$ = LEFT$(Inputs$, 1)
Feld$ = MID$(Inputs$, 2, 2)
FOR i% = 0 TO PieceTypes% ' From empty field to king
IF Piece$ = FigSymbol(i%) THEN
' Converts chess notation into field value
' First character of input was already used for the Piece
Feld% = Fieldnumber%(Feld$)
IF Feld% = Illegal% THEN GOTO BadInput
IF i% = WP% THEN ' Pawns only legal on 2nd thru 7th row
IF Feld% <= H1% OR Feld% >= A8% THEN GOTO BadInput
END IF
Piece% = i% * Side% ' If color is black the sign
' of the piece is reversed.
Board(Feld%) = Piece% ' Place piece on the board
GOTO NextPiece
END IF
NEXT i%
BadInput:
PRINT " Bad Input Entered "
GOTO NextPiece
END SUB
'--------------------------------------------------------------------
' SaveCaptureMove:
' Save a capture move in MoveStack.
' Calls:
' Calledby:
'--------------------------------------------------------------------
SUB SaveCaptureMove (from%, too%)
' King cannot be captured
IF Board(too%) = WK% OR Board(too%) = BK% THEN EXIT SUB
FigValue% = PieceMaterial(ABS(Board(too%)))
MoveStack(Index).from = from%
MoveStack(Index).too = too%
MoveStack(Index).CapturedPiece = ABS(Board(too%))
' Rule for move sorting: Capturee the mose valuable piece
' using the the least valuable piece
MoveStack(Index).Value = FigValue% - (PieceMaterial(ABS(Board(from%))) \ 8)
' Extra Bonus for capturing the piece just moved
IF Depth > 0 THEN
IF too% = TooFeld(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.from = from%
Killer1% = Killer1% AND KillerTab(Depth).Killer1.too = too%
Killer2% = KillerTab(Depth).Killer2.from = from%
Killer2% = Killer2% AND KillerTab(Depth).Killer2.too = too%
MVarMove% = MVar(0, Depth).from = from% AND MVar(0, Depth).too = too%
IF MVarMove% THEN
MoveStack(Index).Value = MoveStack(Index).Value + MainVariantBonus%
ELSEIF Killer1% THEN
MoveStack(Index).Value = MoveStack(Index).Value + Killer1Bonus%
ELSEIF Killer2% THEN
MoveStack(Index).Value = MoveStack(Index).Value + Killer2Bonus%
END IF
MoveStack(Index).PromotedPiece = Empty%
MoveStack(Index).CastlingNr = NoCastlingMove%
MoveStack(Index).EpField = Illegal%
IF Index < MoveStackDim% THEN ' Prevent MoveStack overflow
Index = Index + 1
ELSE
PRINT " ERROR: Move stack overflow"
SYSTEM ' Exit to DOS
END IF
END SUB
'--------------------------------------------------------------------
' SaveEpMove:
' Save En Passant Move in the MoveStack.
' Calls:
' Calledby:
'--------------------------------------------------------------------
SUB SaveEpMove (from%, too%, ep%)
' King cannot be captured
IF Board(too%) = WK% OR Board(too%) = BK% THEN EXIT SUB
MoveStack(Index).from = from%
MoveStack(Index).too = too%
MoveStack(Index).CapturedPiece = WP%
MoveStack(Index).PromotedPiece = Empty%
MoveStack(Index).CastlingNr = NoCastlingMove%
MoveStack(Index).EpField = ep%
MoveStack(Index).Value = MatP%
IF Index < MoveStackDim% THEN ' Prevent MoveStack overflow
Index = Index + 1
ELSE
PRINT " ERROR: Move stack overflow"
SYSTEM ' Exit to DOS
END IF
END SUB
'---------------------------------------------------------------------
' SaveMove:
' Save a normal move in the 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.
' Calls:
' Calledby:
'---------------------------------------------------------------------
SUB SaveMove (from%, too%)
' Increse the mobility of the bishop and Rook.
' Mobility in the center is rated higher
' than mobility at the edge.
IF Colour = White% THEN
IF Board(from%) = WB% OR Board(from%) = WR% THEN
Mobility(Depth) = Mobility(Depth) + CenterTable(too%)
END IF
ELSE
IF Board(from%) = BB% OR Board(from%) = BR% THEN
Mobility(Depth) = Mobility(Depth) + CenterTable(too%)
END IF
END IF
' Assess the move for move sorting. Bonus for main variant or "killer"
Killer1% = KillerTab(Depth).Killer1.from = from%
Killer1% = Killer1% AND KillerTab(Depth).Killer1.too = too%
Killer2% = KillerTab(Depth).Killer2.from = from%
Killer2% = Killer2% AND KillerTab(Depth).Killer2.too = too%
MVarMove% = MVar(0, Depth).from = from% AND MVar(0, Depth).too = too%
IF MVarMove% THEN
MoveStack(Index).Value = MainVariantBonus%
ELSEIF Killer1% THEN
MoveStack(Index).Value = Killer1Bonus%
ELSEIF Killer2% THEN
MoveStack(Index).Value = Killer2Bonus%
ELSE
MoveStack(Index).Value = Empty%
END IF
MoveStack(Index).from = from%
MoveStack(Index).too = too%
MoveStack(Index).CapturedPiece = Empty%
MoveStack(Index).PromotedPiece = Empty%
MoveStack(Index).CastlingNr = NoCastlingMove%
MoveStack(Index).EpField = Illegal%
IF Index < MoveStackDim% THEN ' Prevent MoveStack overflow
Index = Index + 1
ELSE
PRINT " ERROR: Move stack overflowed"
SYSTEM ' In this case "ease out" to DOS
END IF
END SUB
'--------------------------------------------------------------------
' SavePromotion:
' Produce all possible pawn promotions
' Calls: SaveMove; SaveCaptureMove;
' Calledby:
'--------------------------------------------------------------------
SUB SavePromotion (from%, too%)
IF Board(too%) = Empty% THEN
FOR i% = WQ% TO WR% STEP -1 ' Sequence queen,knight,bishop,rook
CALL SaveMove(from%, too%)
MoveStack(Index - 1).PromotedPiece = i%
NEXT i%
ELSE ' Promotion with capture
FOR i% = WQ% TO WR% STEP -1
CALL SaveCaptureMove(from%, too%)
MoveStack(Index - 1).PromotedPiece = i%
NEXT i%
END IF
END SUB
'--------------------------------------------------------------------
' TakeBackMove:
' Takes back a move in the tree.
' CurrMove% is the index of the move in MoveStack.
' Calls:
' Calledby:
'--------------------------------------------------------------------
SUB TakeBackMove (CurrMove%)
MoveCount = MoveCount - 1
from% = MoveStack(CurrMove%).from
too% = MoveStack(CurrMove%).too
ep% = MoveStack(CurrMove%).EpField
Colour = -Colour ' Other side to move
Depth = Depth - 1 ' One level higher in tree
Board(from%) = Board(too%) ' Put back the piece
Board(too%) = Empty%
IF ep% <> Illegal% AND MoveStack(CurrMove%).CapturedPiece = WP% THEN
Board(ep%) = -Colour ' WP%=White%, BP%=Black%
' Put back captured piece
ELSEIF MoveStack(CurrMove%).CapturedPiece <> Empty% THEN
Board(too%) = (-Colour) * MoveStack(CurrMove%).CapturedPiece
END IF
' Adjust move counter
MoveControl(from%) = MoveControl(from%) - 1
MoveControl(too%) = MoveControl(too%) - 1
' If castling put back rook
IF MoveStack(CurrMove%).CastlingNr = ShortCastlingMove% THEN
Board(too% + 1) = Colour * WR%
Board(too% - 1) = Empty%
Castling(Colour + 1) = False%
ELSEIF MoveStack(CurrMove%).CastlingNr = LongCastlingMove% THEN
Board(too% - 2) = Colour * WR%
Board(too% + 1) = Empty%
Castling(Colour + 1) = False%
END IF
IF MoveStack(CurrMove%).PromotedPiece <> Empty% THEN
Board(from%) = Colour ' Take back pawn promotion
END IF
' IF the king has moved, update the king's Position
IF Board(from%) = WK% THEN
wKing = from%
ELSEIF Board(from%) = BK% THEN
bKing = from%
END IF
END SUB
'--------------------------------------------------------------------
' WPAssessment: Function
' Assessment of one white Pawn.
' Analogous to the assessment of black pawns.
' Returns the assessment from white's viewpoint.
' Calls:
' Calledby: AssessPosition
'--------------------------------------------------------------------
FUNCTION WPAssessment% (Feld%, Column%, row%, developed%)
IF MaterialTotal(Depth) > EndgameMaterial% THEN ' Opening of midgame
Value% = wPFieldValue(Feld%)
' If development incomplete, don't push edge pawns forward
IF developed% < 4 THEN
IF (row% >= FRow% OR row% <= BRow%) AND Column% > Column3% THEN
Value% = Value% - 15
END IF
END IF
ELSE ' In then endgame, all lines are equally good.
Value% = Column% * 4 ' Bring pawns forward.
END IF
' Is the pawn isolated?
' Edge pawns don't require extra treatment. Pawns(ARow-1) is
' the left edge, Pawns(HRow+1) the right edge. No pawn is
' placed on these edges.
IF Pawns(row% - 1).White = 0 AND Pawns(row% + 1).White = 0 THEN
Value% = Value% - 12 ' Isolated
' Isolated double pawn
IF Pawns(row%).White > 1 THEN Value% = Value% - 12
END IF
' Double pawns
IF Pawns(row%).White > 1 THEN Value% = Value% - 15
' Duo or guarded pawn gets a bonus
IF PawnControlled(Feld%).White > 0 OR PawnControlled(Feld% + 10).White > 0 THEN
Value% = Value% + Column%
END IF
IF Pawns(row%).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(Feld%).White = 0
' ... and can't advance because of enemy pawns
' control the field in front of him.
Condition2% = PawnControlled(Feld% + 10).Black > PawnControlled(Feld% + 10).White
IF Condition1% AND Condition2% THEN
Value% = Value% - 10
' Rook impeded by left-behind pawn
IF Rooks(row%).Black > 0 THEN Value% = Value% - 8
ELSE
' Pawn is a free pawn, on a half-open column and the
' fields ahead on his column are not controlled by
' enemy pawns.
FOR j% = Feld% TO H6% STEP 10 ' Until 6th row
IF PawnControlled(j%).Black > 0 THEN
WPAssessment% = Value%
EXIT FUNCTION
END IF
NEXT j%
' Free pawn found. In the endgame, a free pawn is more important
' than in midgame.
IF MaterialTotal(Depth) < EndgameMaterial% THEN
Value% = Value% + Column% * 16 ' The more advanced the better
' Rook guards free pawn on the same column
IF Rooks(row%).White > 0 THEN Value% = Value% + Column% * 2
' Enemy rook on the same column.
IF Rooks(row%).Black > 0 THEN Value% = Value% - Column% * 2
' Pure pawn endgame. Free pawn particularly valuable.
IF MaterialTotal(Depth) = 0 THEN Value% = Value% + Column% * 8
' Guarded free pawn
IF PawnControlled(Feld%).White > 0 OR PawnControlled(Feld% + 10).White > 0 THEN
Value% = Value% + Column% * 4
END IF
' Free pawn blocked by a black piece. This piece is not
' threatened by fellow pawns.
IF Board(Feld% + 10) < 0 AND PawnControlled(Feld% + 10).White = 0 THEN
Value% = Value% - Column% * 4
END IF
ELSE ' Free pawn in the midgame
Value% = Value% + Column% * 8
' Guarded free pawn
IF PawnControlled(Feld%).White > 0 OR PawnControlled(Feld% + 10).White > 0 THEN
Value% = Value% + Column% * 2
END IF
END IF
END IF
END IF
WPAssessment% = Value%
END FUNCTION
Comments
Post a Comment
🤔