BASIC Chess (UCI engine based on Dean Menezes QBASIC chess program)
-
- Posts: 1007
- Joined: Nov 24, 2011 19:49
- Location: France
- Contact:
BASIC Chess (UCI engine based on Dean Menezes QBASIC chess program)
Hello!
I would like to present BASIC Chess. It is the QBASIC chess program by Dean Menezes, ported to FreeBASIC and turned into a UCI engine.
I made only one quick successful test with Arena. Arena is good for developers because it has a protocol window where you can see all that happens.
I have no idea how strong is BASIC Chess but anyway it's a very nice little program. Four hundred lines of code!
If you are interested in that kind of stuff, you can try Basic Chess in your favorite chess GUI and report the result. ;)
Download Basic Chess (source code and Win32 binary)
I would like to present BASIC Chess. It is the QBASIC chess program by Dean Menezes, ported to FreeBASIC and turned into a UCI engine.
I made only one quick successful test with Arena. Arena is good for developers because it has a protocol window where you can see all that happens.
I have no idea how strong is BASIC Chess but anyway it's a very nice little program. Four hundred lines of code!
If you are interested in that kind of stuff, you can try Basic Chess in your favorite chess GUI and report the result. ;)
Download Basic Chess (source code and Win32 binary)
Last edited by Roland Chastain on Apr 24, 2018 22:40, edited 1 time in total.
-
- Posts: 375
- Joined: Mar 15, 2015 12:41
Re: BASIC Chess (UCI engine based on Dean Menezes QBASIC chess program)
Glad to see another FreeBasic chess engine!! :-)
I did some tests in 40/4 mode against my engine Soberango 0.09.8 (around 1150 ELO points in CCRL 40/4 Rank) and did BasicChess not manage time intelligently.
Which time mode BasicChess use to play?
I did some tests in 40/4 mode against my engine Soberango 0.09.8 (around 1150 ELO points in CCRL 40/4 Rank) and did BasicChess not manage time intelligently.
Which time mode BasicChess use to play?
-
- Posts: 1007
- Joined: Nov 24, 2011 19:49
- Location: France
- Contact:
Re: BASIC Chess (UCI engine based on Dean Menezes QBASIC chess program)
Thank you Luis for testing. There is no time management. It's a very simple program. ;)
-
- Posts: 375
- Joined: Mar 15, 2015 12:41
Re: BASIC Chess (UCI engine based on Dean Menezes QBASIC chess program)
I found that using 80/1 time mode, both engines uses near the same amount of time.
Here 10 games:
https://www.dropbox.com/s/ehvdjicx2x1bw ... d.pgn?dl=0
Here 10 games:
https://www.dropbox.com/s/ehvdjicx2x1bw ... d.pgn?dl=0
-
- Posts: 1007
- Joined: Nov 24, 2011 19:49
- Location: France
- Contact:
Re: BASIC Chess (UCI engine based on Dean Menezes QBASIC chess program)
Very interesting, thank you. I watched the first game. It was funny (the absurd king moves). I saw that all games are lost on illegal move. With your data it will be easier to find the bug.Luis Babboni wrote:I found that using 80/1 time mode, both engines uses near the same amount of time.
Here 10 games:
By the way, it would be great if someone would write a PGN parser in FreeBASIC. :)
Re: BASIC Chess (UCI engine based on Dean Menezes QBASIC chess program)
Sorry to ask, I'm kind of noobish in this area (which I consider very interesting), but what PGN stands for?Roland Chastain wrote:By the way, it would be great if someone would write a PGN parser in FreeBASIC. :)
-
- Posts: 1007
- Joined: Nov 24, 2011 19:49
- Location: France
- Contact:
Re: BASIC Chess (UCI engine based on Dean Menezes QBASIC chess program)
PGN (Portable Game Notation) is a format used to store chess games. Here is for instance a part of the file provided by Luis. The file was generated by Arena.paul doe wrote:Sorry to ask, I'm kind of noobish in this area (which I consider very interesting), but what PGN stands for?
[Event "Basichess vs Soberango 0098 T02d"]
[Site "LUIS-PC"]
[Date "2018.04.09"]
[Round "1"]
[White "Basicchess"]
[Black "Soberango0098"]
[Result "0-1"]
[BlackElo "2200"]
[ECO "B00"]
[Opening "St. George Defence"]
[Time "09:30:35"]
[WhiteElo "2200"]
[TimeControl "80/60:80/60:80/60"]
[Termination "rules infraction"]
[PlyCount "24"]
[WhiteType "program"]
[BlackType "program"]
1. e4 a6 2. Bc4 c5 3. Qf3 Nf6 4. Qf4 a5 5. Qe5 d6 6. Qf4 b6 7. e5 dxe5 8.
Qxe5 g6 9. f4 Bg7 10. Nf3 a4 11. Ke2 e6 12. Ke3 Ng4 {Arena Adjudication.
Illegal move!} 0-1
I can open that file in my favourite software (for instance ChessBase Reader) and see the replay of a game.
-
- Posts: 862
- Joined: May 05, 2015 5:35
- Location: Germany
Re: BASIC Chess (UCI engine based on Dean Menezes QBASIC chess program)
And what exactly shall this parser do? Convert the moves list to a series of FEN strings? Or display the game on a chessboard, controlled by keys (forward / backward)?Roland Chastain wrote:By the way, it would be great if someone would write a PGN parser in FreeBASIC. :)
Re: BASIC Chess (UCI engine based on Dean Menezes QBASIC chess program)
Oh yeah, I see it now. Well, the format seems straightforward enough, so writing a parser doesn't look complicated. The most difficult part should be to parse the movelist. I think I'll give it a go, as this topic has long interested me (I read a little book when I was 8 and it explained Chess Computers of the 80's era, which I found to be quite amusing). As gridstone already asked, what should this parser do, besides making sense of the input, of course?
EDIT: Been looking at the different notations (wow, it's been a long time since I approached chess). Love the Shakesperean one: "Then the black king for his second draught brings forth his queene, and placest her in the third house, in front of his bishop's pawne" hahaha =D
EDIT: Been looking at the different notations (wow, it's been a long time since I approached chess). Love the Shakesperean one: "Then the black king for his second draught brings forth his queene, and placest her in the third house, in front of his bishop's pawne" hahaha =D
-
- Posts: 3917
- Joined: Jan 01, 2009 7:03
- Location: Australia
Re: BASIC Chess (UCI engine based on Dean Menezes QBASIC chess program)
Have you seen this one? Found it in my CHESS folders but can't remember where it came from.
I started adding a simple GUI interface to the code and will post if I complete it.
It is too long for one post so you will have to copy/paste the code in the next post to the end of this code.
I started adding a simple GUI interface to the code and will post if I complete it.
It is too long for one post so you will have to copy/paste the code in the next post to the end of this code.
Code: Select all
'********************************************************************
'********************************************************************
' File: MINIMAX.BAS
' Purpose: A Didactics Chessprogram
' Project: MiniMAX in BASIC
' Compiler: The Program compiles with Visual Basic for DOS
' Authors: D.Steinwender, Ch.Donninger
' Attempt adapted on FreeBasic: Stanislav Budinov(Ïîïûòêà àäàïòèðîâàòü ïîä Freebasic Ñòàíèñëàâ Áóäèíîâ)
' Date: May 1,1995
' Calls: PrintLogo; Initialize; CommandLoop
' Calledby: None
'********************************************************************
' Declaration of Subroutines
DECLARE SUB PrintLogo ()
DECLARE SUB Initialize ()
DECLARE SUB CommandLoop ()
DECLARE FUNCTION AlphaBeta ( Alpha_ As INTEGER, Beta As INTEGER, Distance As INTEGER) As INTEGER
DECLARE SUB GenerateMoves ( AllMoves As INTEGER)
DECLARE SUB PerformMove ( CurrMove As INTEGER)
DECLARE SUB TakeBackMove ( CurrMove As INTEGER)
DECLARE SUB CopyMainVariant ( CurrMove As INTEGER)
DECLARE FUNCTION AttackingField ( Feld As INTEGER, Side As INTEGER) As INTEGER
DECLARE FUNCTION AssessPosition ( Alpha_ As INTEGER, Beta As INTEGER, Side As INTEGER) As INTEGER
DECLARE SUB InitAssessment ()
DECLARE SUB DisplayBoard ( BoardOnly As INTEGER)
DECLARE SUB ComputerMove ()
DECLARE SUB InitGameTree ()
DECLARE SUB DisplayMove ( CurrMove As INTEGER)
DECLARE SUB DisplayMVar ()
DECLARE SUB PrintMove ( CurrMove As INTEGER)
DECLARE SUB PrintPosition ()
DECLARE SUB PrintBack ()
DECLARE FUNCTION Fieldnotation ( Fieldnum As INTEGER)As String
DECLARE FUNCTION Fieldnumber ( Fieldnote As String) As INTEGER
DECLARE SUB SavePromotion ( from As INTEGER, too As INTEGER)
DECLARE SUB SaveMove ( from As INTEGER, too As INTEGER)
DECLARE SUB SaveCaptureMove ( from As INTEGER, too As INTEGER)
DECLARE SUB SaveEpMove ( from As INTEGER, too As INTEGER, ep As INTEGER)
DECLARE SUB FlipBoard ()
DECLARE SUB GameOver ()
DECLARE SUB InputPosition ()
DECLARE SUB MoveList ()
DECLARE SUB MoveBack ()
DECLARE SUB ComputingDepth ()
DECLARE SUB ReadPiece ( Side As INTEGER)
DECLARE FUNCTION NextBestMove() As INTEGER
DECLARE FUNCTION BPAssessment ( Feld As INTEGER, Column As INTEGER, row As INTEGER, developed As INTEGER) As INTEGER
DECLARE FUNCTION WPAssessment ( Feld As INTEGER, Column As INTEGER, row As INTEGER, developed As INTEGER) As INTEGER
DECLARE FUNCTION InputMove ( Move As String) As INTEGER
'--------------------------------------------------------------------
' Definition of symbolic Constants.
'--------------------------------------------------------------------
CONST BoardDim As INTEGER = 119 ' Dimension of Expanded Chess Board
CONST MaxDepth As INTEGER = 19 ' Maximum search depth
CONST Movedirections As INTEGER = 15 ' Number of Move directions for all Piece.
CONST PieceTypes As INTEGER = 6 ' Number of Piecetypes - considering
' the Move directions (wQueen = bQueen)
CONST MoveStackDim As INTEGER = 1000 ' Dimension of move stacks
' Piece <Colour><Piece>
CONST BK As INTEGER = -6 ' Black piece
CONST BQ As INTEGER = -5
CONST BN As INTEGER = -4
CONST BB As INTEGER = -3
CONST BR As INTEGER = -2
CONST BP As INTEGER = -1
CONST Empty As INTEGER = 0 ' Empty field
CONST WP As INTEGER = 1 ' White piece
CONST WR As INTEGER = 2
CONST WB As INTEGER = 3
CONST WN As INTEGER = 4
CONST WQ As INTEGER = 5
CONST WK As INTEGER = 6
CONST Edge As INTEGER = 100 ' The edge of the chess board
' Material value of the Pieces
CONST MatP As INTEGER = 100
CONST MatR As INTEGER = 500
CONST MatB As INTEGER = 350
CONST MatN As INTEGER = 325
CONST MatQ As INTEGER = 900
CONST MatK As INTEGER = 0 ' As both Sides have just one king,
' the value can be set to 0
' Assessment for Mate
CONST MateValue As INTEGER = 32000
CONST MaxPos As INTEGER = MatB ' Maximum of the position assessment
' Bonus for main variants and Killer moves
' used for the sorting of moves
CONST MainVariantBonus As INTEGER = 500
CONST Killer1Bonus As INTEGER = 250
CONST Killer2Bonus As INTEGER = 150
' Total material value in the initial position
CONST MaterialSum As INTEGER = 4 * (MatR + MatB + MatN) + (2 * MatQ)
CONST EndgameMaterial As INTEGER = 4 * MatR + 2 * MatB
' Field numbers of frequently used Fields
' ("if Board(E1)=WK" means "if Board(25)=6")
CONST A1 As INTEGER = 21
CONST B1 As INTEGER = 22
CONST C1 As INTEGER = 23
CONST D1 As INTEGER = 24
CONST E1 As INTEGER = 25
CONST F1 As INTEGER = 26
CONST G1 As INTEGER = 27
CONST H1 As INTEGER = 28
CONST C2 As INTEGER = 33
CONST H2 As INTEGER = 38
CONST A3 As INTEGER = 41
CONST C3 As INTEGER = 43
CONST D3 As INTEGER = 44
CONST E3 As INTEGER = 45
CONST A6 As INTEGER = 71
CONST C6 As INTEGER = 73
CONST D6 As INTEGER = 74
CONST E6 As INTEGER = 75
CONST H6 As INTEGER = 78
CONST A7 As INTEGER = 81
CONST C7 As INTEGER = 83
CONST H7 As INTEGER = 88
CONST A8 As INTEGER = 91
CONST B8 As INTEGER = 92
CONST C8 As INTEGER = 93
CONST D8 As INTEGER = 94
CONST E8 As INTEGER = 95
CONST F8 As INTEGER = 96
CONST G8 As INTEGER = 97
CONST H8 As INTEGER = 98
' Values of columns and rows
CONST ARow As INTEGER = 1
CONST BRow As INTEGER = 2
CONST CRow As INTEGER = 3
CONST DRow As INTEGER = 4
CONST ERow As INTEGER = 5
CONST FRow As INTEGER = 6
CONST GRow As INTEGER = 7
CONST HRow As INTEGER = 8
CONST Column1 As INTEGER = 2
CONST Column2 As INTEGER = 3
CONST Column3 As INTEGER = 4
CONST Column4 As INTEGER = 5
CONST Column5 As INTEGER = 6
CONST Column6 As INTEGER = 7
CONST Column7 As INTEGER = 8
CONST Column8 As INTEGER = 9
' Castling numbering (Index into castling array)
' of move is not a castling move
CONST NoCastlingMove As INTEGER = 0
CONST INTEGERCastlingMove As INTEGER = 1
CONST LongCastlingMove As INTEGER = 2
' Color of the man who is moving
CONST White As INTEGER = 1
CONST Black As INTEGER = -1
' Symbolic logical Constants
'CONST True As INTEGER = 1
'CONST False As INTEGER = 0
CONST Legal As INTEGER = 1
CONST Illegal As INTEGER = 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/INTEGER 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 As INTEGER = 0 TO BoardDim
READ InitialPosition(i)
NEXT
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 As INTEGER = 0 TO H8
READ CenterTable(i)
Next
' --- 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 As INTEGER = 0 TO H7
READ wPFieldValue(i)
NEXT
' --- 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 As INTEGER = 0 TO H7
READ bPFieldValue(i)
NEXT
' --- 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
'PrintLogo
Initialize
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_ As INTEGER, Beta As INTEGER, Distance As INTEGER) As INTEGER
NodeCount = NodeCount + 1 ' Additional position examined
MVar(Depth, Depth).from = 0 ' Delete current main variant
Dim As INTEGER BestValue,i,Value,Check
' 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
Dim As INTEGER 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.
Dim As INTEGER 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.
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.
PerformMove(i)
' NegaMax principal: The sign is reversed and
' the roles of alpha and beta exchanged.
Value = -AlphaBeta(-Beta, -Alpha_, Distance - 1)
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 CopyMainVariant(i)
GOTO Done
END IF
IF Value > Alpha_ THEN ' Value is the improved lower limit
IF Distance > 0 THEN 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_ As INTEGER, Beta As INTEGER, Side As INTEGER ) As INTEGER
' First examine if opponent is checkmated
' of "Side" is being checked.
Dim As INTEGER Value, PosValue, i, j, k, Feld
Dim As INTEGER wBishlop, bBishlop,PawnCount
Dim As INTEGER MatNum, wRookon7, bRookon2,wDeveloped, bDeveloped
Dim As INTEGER ColumnnDiff,RownDiff,Bed1,Bed2,Bed3
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.
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 As INTEGER, Side As INTEGER)As INTEGER
' First test the special case of pawns. They have the same direction
' as bishops but don't slide.
Dim As INTEGER i, Direction, too, Piece, 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 As INTEGER, Column As INTEGER, row As INTEGER, developed As INTEGER) As INTEGER
Dim As INTEGER Value,Condition1,Condition2,j
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
Dim As INTEGER Ends
Dim As String Commands
DO
DisplayBoard(False) ' my new line
PRINT
INPUT "Your Input: ", Commands
Commands = UCASE(Commands) ' Change to upper case
SELECT CASE Commands
CASE "EN"
Ends = True
GameOver
CASE "NG"
PRINT " New Game"
Initialize
CASE "DB"
DisplayBoard(False)
CASE "CP"
InputPosition
CASE "PL"
ComputerMove
CASE "FB"
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"
MoveList
CASE "TB"
MoveBack
CASE "SD"
ComputingDepth
CASE "DA"
InitGameTree
PRINT " Assessment= "; AssessPosition(-MateValue, MateValue, Colour)
CASE ELSE
IF InputMove(Commands) = False THEN
PRINT " Illegal move or unknown Command"
ELSEIF PlayerPlayer = False THEN
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
Dim As INTEGER Value,Check,Distance,Alpha_,Beta,MovesInLine,i,BestValue,j
Dim As Integer Starttime,Endtime,Time_,Comtime
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
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
' PRINT
' PRINT
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
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.
PerformMove((i))
Value = -AlphaBeta(-Beta, -Alpha_, Distance - 1)
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 " ";
PerformMove((i))
Value = -AlphaBeta(-Beta, -Alpha_, Distance - 1)
TakeBackMove((i))
ELSEIF Value >= Beta THEN ' Falls up
Alpha_ = Value
Beta = MateValue
' PRINT "! ["; Alpha; ","; Beta; "]"
MovesInLine = 0
' PRINT " ";
PerformMove((i))
Value = -AlphaBeta(-Beta, -Alpha_, Distance - 1)
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
' PRINT
LOCATE 15, 51
PRINT " Best Move: ";
DisplayMove(i)
LOCATE 16, 51
PRINT "Value ="; Value
CopyMainVariant(i)
' LOCATE 0 + Distance, 58
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
PerformMove((i))
Value = -AlphaBeta(-Beta, -Alpha_, Distance - 1)
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: ";
' DisplayMove(i)
' PRINT "Value ="; Value
CopyMainVariant(i)
' LOCATE 0 + Distance, 54
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
' PRINT
' PRINT " Computer Player: ";
DisplayMove(0) ' Best Move is always sorted into
' position 0 of the Movestacks
' PRINT
' 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_
PerformMove(0)
PrintMove(0)
IF Alpha_ >= MateValue - 10 THEN
' PRINT
PRINT " I checkmate in "; (MateValue - 2 - Alpha_) \ 2; " moves "
ELSE
IF Alpha_ <= -MateValue + 10 THEN
' PRINT
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
Last edited by BasicCoder2 on Apr 10, 2018 10:36, edited 2 times in total.
-
- Posts: 3917
- Joined: Jan 01, 2009 7:03
- Location: Australia
Re: BASIC Chess (UCI engine based on Dean Menezes QBASIC chess program)
Rest of code ...
Code: Select all
' -----------------------------------------------------------------
' ComputingDepth:
' Input minimum computing depth
' Calls: None
' Calledby:
' -----------------------------------------------------------------
SUB ComputingDepth
Dim As String Inputs
Dim As INTEGER tmp
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 As INTEGER)
Dim As INTEGER i
' 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 As INTEGER)
' Display board
Dim As INTEGER i,j,Piece,Side
LOCATE 1, 1
FOR i = Column8 TO Column1 STEP -1 ' For all rows
PRINT
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
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
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";
PRINT
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 As INTEGER)
Dim As INTEGER from,too
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: ";
Dim As INTEGER i
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
'PRINT
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 As INTEGER) As string
' See if correct
Dim As String s
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 As String ) As INTEGER
Dim As String row = LEFT(Fieldnote, 1)
Dim As String 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 As INTEGER)
Dim As INTEGER from,Piece,Longpaths,i,Direction,too,CaptureMove,ep,OK
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
SavePromotion(from, from + 10)
ELSEIF AllMoves > 0 THEN
SaveMove(from, from + 10)
' double-step possible?
IF from <= H2 AND Board(from + 20) = Empty THEN
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
SavePromotion(from, from + 11)
ELSE
SaveCaptureMove(from, from + 11)
END IF
END IF
IF Board(from + 9) < 0 THEN ' Likewise in other capture direction
IF from >= A7 THEN
SavePromotion(from, from + 9)
ELSE
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
SavePromotion(from, from - 10)
ELSEIF AllMoves > 0 THEN
SaveMove(from, from - 10)
' double-steps possible?
IF from >= A7 AND Board(from - 20) = Empty THEN
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
SavePromotion(from, from - 11)
ELSE
SaveCaptureMove(from, from - 11)
END IF
END IF
IF Board(from - 9) > 0 AND Board(from - 9) <> Edge THEN
IF from <= H2 THEN
SavePromotion(from, from - 9)
ELSE
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
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 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
SaveEpMove(ep - 9, ep, ep - 10)
END IF
IF Board(ep - 11) = WP THEN
SaveEpMove(ep - 11, ep, ep - 10)
END IF
ELSE
IF Board(ep + 9) = BP THEN
SaveEpMove(ep + 9, ep, ep + 10)
END IF
IF Board(ep + 11) = BP THEN
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 INTEGER 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
SaveMove(E1, G1) ' Save king's move
MoveStack(Index - 1).CastlingNr = INTEGERCastlingMove
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
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 INTEGER 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
SaveMove(E8, G8) ' Save king's move
MoveStack(Index - 1).CastlingNr = INTEGERCastlingMove
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
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
Dim As INTEGER i ' 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
Dim As INTEGER i
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 As String ) as INTEGER
Dim As INTEGER from,too,i,tmp
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))
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
InitGameTree
PRINT " Your Move: ";
DisplayMove(i)
tmp = LastMove ' Temp storage for last move so far.
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"
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"
TakeBackMove((i))
LastMove = tmp
InputMove = False
EXIT FUNCTION
END IF
PRINT
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
Dim As String Inputs,ep
Dim As INTEGER i,j,wKings,bKings
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"
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 INTEGER 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
DisplayBoard(False) ' Display the new board
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
TakeBackMove(LastMove)
DisplayBoard(False)
PrintBack
END SUB
' -----------------------------------------------------------------
' MoveList:
' Generate all moves and display them on the monitor
' Calls: GenerateMoves; DisplayMove; AttackingField;
' Calledby:
' -----------------------------------------------------------------
SUB MoveList
Dim As INTEGER CheckMated,i
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
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() As INTEGER
Dim As INTEGER BestMove ,BestValue,i
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 As INTEGER)
Dim As INTEGER from,too,ep,MatChange
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 = INTEGERCastlingMove 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 As INTEGER)
Dim As String from,too
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 = INTEGERCastlingMove 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
Dim As INTEGER i
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: <piece><field> e.g. "Ke1".
' "." is "empty field", i.e. removes any piece from that field.
' Calls: Fieldnumber;
' Calledby:
'--------------------------------------------------------------------
SUB ReadPiece ( Side As INTEGER)
Dim As String Inputs,Piece,Felds
Dim As INTEGER i,Feld,Pieces
NextPiece:
INPUT Inputs
IF Inputs = "" THEN EXIT SUB ' Exit if input is void
IF LEN(Inputs) < 3 THEN GOTO BadInput ' Input to INTEGER
Inputs = UCase(Inputs) ' Uppercase
Piece = Left(Inputs, 1)
Felds = 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(Felds)
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
Pieces = i * Side ' If color is black the sign
' of the piece is reversed.
Board(Feld) = Pieces ' 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 As INTEGER, too As INTEGER)
' King cannot be captured
Dim As INTEGER FigValue,Killer1,Killer2,MVarMove,i
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 As INTEGER, too As INTEGER, ep As INTEGER)
' 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 As INTEGER, too As INTEGER)
' Increse the mobility of the bishop and Rook.
' Mobility in the center is rated higher
' than mobility at the edge.
Dim As INTEGER Killer1,Killer2,MVarMove
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 As INTEGER, too As INTEGER)
Dim As INTEGER i
IF Board(too) = Empty THEN
FOR i = WQ TO WR STEP -1 ' Sequence queen,knight,bishop,rook
SaveMove(from, too)
MoveStack(Index - 1).PromotedPiece = i
NEXT i
ELSE ' Promotion with capture
FOR i = WQ TO WR STEP -1
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 As INTEGER)
Dim As INTEGER from,too,ep
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 = INTEGERCastlingMove 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 As INTEGER, Column As INTEGER, row As INTEGER, developed As INTEGER)As INTEGER
Dim As INTEGER Value,Condition1,Condition2,j
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
Re: BASIC Chess (UCI engine based on Dean Menezes QBASIC chess program)
No, I havent. Pretty useful resource, thanks! I looked at the code and seems pretty straightforward. This, coupled with the engines by Roland and Luis, should get me rolling. As soon as I have something to show, I will (if I can spare the time to code it, that is =D)BasicCoder2 wrote:Have you seen this one? Found it in my CHESS folders but can't remember where it came from.
-
- Posts: 1007
- Joined: Nov 24, 2011 19:49
- Location: France
- Contact:
Re: BASIC Chess (UCI engine based on Dean Menezes QBASIC chess program)
The parser, as I imagine it, should just extract the data. It should do something like this :grindstone wrote:And what exactly shall this parser do? Convert the moves list to a series of FEN strings? Or display the game on a chessboard, controlled by keys (forward / backward)?
Code: Select all
dim games as pgn = ParsePGNFile("myfile.pgn")
for i = 0 to games.Count - 1
print games(i).event
print games(i).whiteplayername
print games(i).result
for j = 0 to games(i).moveCount - 1
print games(i).moves(j)
next j
next
-
- Posts: 1007
- Joined: Nov 24, 2011 19:49
- Location: France
- Contact:
Re: BASIC Chess (UCI engine based on Dean Menezes QBASIC chess program)
In my opinion, it would be enough if the parser would give the moves as they appear in the file:paul doe wrote:The most difficult part should be to parse the movelist.
Code: Select all
print games(i).moves(0) ' e4
print games(i).moves(1) ' a6
print games(i).moves(2) ' Bc4
print games(i).moves(3) ' c5
-
- Posts: 1007
- Joined: Nov 24, 2011 19:49
- Location: France
- Contact:
Re: BASIC Chess (UCI engine based on Dean Menezes QBASIC chess program)
It comes from this discussion.BasicCoder2 wrote:Have you seen this one? Found it in my CHESS folders but can't remember where it came from.
VANYA's link seems to be broken. Here is an alternative link.
MINIMAX adaptated to FreeBASIC (ZIP file)