BASIC Chess (UCI engine based on Dean Menezes QBASIC chess program)

User projects written in or related to FreeBASIC.
Roland Chastain
Posts: 993
Joined: Nov 24, 2011 19:49
Location: France
Contact:

BASIC Chess (UCI engine based on Dean Menezes QBASIC chess program)

Post by Roland Chastain »

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)
Last edited by Roland Chastain on Apr 24, 2018 22:40, edited 1 time in total.
Luis Babboni
Posts: 375
Joined: Mar 15, 2015 12:41

Re: BASIC Chess (UCI engine based on Dean Menezes QBASIC chess program)

Post by Luis Babboni »

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?
Roland Chastain
Posts: 993
Joined: Nov 24, 2011 19:49
Location: France
Contact:

Re: BASIC Chess (UCI engine based on Dean Menezes QBASIC chess program)

Post by Roland Chastain »

Thank you Luis for testing. There is no time management. It's a very simple program. ;)
Luis Babboni
Posts: 375
Joined: Mar 15, 2015 12:41

Re: BASIC Chess (UCI engine based on Dean Menezes QBASIC chess program)

Post by Luis Babboni »

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
Roland Chastain
Posts: 993
Joined: Nov 24, 2011 19:49
Location: France
Contact:

Re: BASIC Chess (UCI engine based on Dean Menezes QBASIC chess program)

Post by Roland Chastain »

Luis Babboni wrote:I found that using 80/1 time mode, both engines uses near the same amount of time.
Here 10 games:
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.

By the way, it would be great if someone would write a PGN parser in FreeBASIC. :)
paul doe
Moderator
Posts: 1730
Joined: Jul 25, 2017 17:22
Location: Argentina

Re: BASIC Chess (UCI engine based on Dean Menezes QBASIC chess program)

Post by paul doe »

Roland Chastain wrote:By the way, it would be great if someone would write a PGN parser in FreeBASIC. :)
Sorry to ask, I'm kind of noobish in this area (which I consider very interesting), but what PGN stands for?
Roland Chastain
Posts: 993
Joined: Nov 24, 2011 19:49
Location: France
Contact:

Re: BASIC Chess (UCI engine based on Dean Menezes QBASIC chess program)

Post by Roland Chastain »

paul doe wrote:Sorry to ask, I'm kind of noobish in this area (which I consider very interesting), but what PGN stands for?
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.

[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.
grindstone
Posts: 862
Joined: May 05, 2015 5:35
Location: Germany

Re: BASIC Chess (UCI engine based on Dean Menezes QBASIC chess program)

Post by grindstone »

Roland Chastain wrote:By the way, it would be great if someone would write a PGN parser in FreeBASIC. :)
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)?
paul doe
Moderator
Posts: 1730
Joined: Jul 25, 2017 17:22
Location: Argentina

Re: BASIC Chess (UCI engine based on Dean Menezes QBASIC chess program)

Post by paul doe »

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
BasicCoder2
Posts: 3906
Joined: Jan 01, 2009 7:03
Location: Australia

Re: BASIC Chess (UCI engine based on Dean Menezes QBASIC chess program)

Post by BasicCoder2 »

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.

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.
BasicCoder2
Posts: 3906
Joined: Jan 01, 2009 7:03
Location: Australia

Re: BASIC Chess (UCI engine based on Dean Menezes QBASIC chess program)

Post by BasicCoder2 »

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
paul doe
Moderator
Posts: 1730
Joined: Jul 25, 2017 17:22
Location: Argentina

Re: BASIC Chess (UCI engine based on Dean Menezes QBASIC chess program)

Post by paul doe »

BasicCoder2 wrote:Have you seen this one? Found it in my CHESS folders but can't remember where it came from.
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)
Roland Chastain
Posts: 993
Joined: Nov 24, 2011 19:49
Location: France
Contact:

Re: BASIC Chess (UCI engine based on Dean Menezes QBASIC chess program)

Post by Roland Chastain »

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)?
The parser, as I imagine it, should just extract the data. It should do something like this :

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
For the conversion to FEN strings, and things like that, I think it is the job of a chess program.
Roland Chastain
Posts: 993
Joined: Nov 24, 2011 19:49
Location: France
Contact:

Re: BASIC Chess (UCI engine based on Dean Menezes QBASIC chess program)

Post by Roland Chastain »

paul doe wrote:The most difficult part should be to parse the movelist.
In my opinion, it would be enough if the parser would give the moves as they appear in the file:

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
The conversion from "e4" to "e2e4" is the job of the chess program. With my existing chess program for example, I already can convert "e4" to "e2e4".
Roland Chastain
Posts: 993
Joined: Nov 24, 2011 19:49
Location: France
Contact:

Re: BASIC Chess (UCI engine based on Dean Menezes QBASIC chess program)

Post by Roland Chastain »

BasicCoder2 wrote:Have you seen this one? Found it in my CHESS folders but can't remember where it came from.
It comes from this discussion.

VANYA's link seems to be broken. Here is an alternative link.

MINIMAX adaptated to FreeBASIC (ZIP file)
Post Reply