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