Chess

[Rod]

Ah it was all going too well! Away from home for a day or so. Someone might debug it be for I get home!


Well as I slept I realized (1) I am not allowing enough space in the movex array for the number of moves a Queen, Rook or Bishop might make. (2) I am using the same space for the incheck() function and it should have its own space so that when the recursion unwinds it finds movex array in the same state as it left it. (3) I also "improved " the incheck() function because Dean's only checked if white was in check, folks had complained it did not know black was in check. Not sure I have that change right, (4) or the reversal if you move into check, which is why Anatoly's Queen might have disappeared.

All in all I would just ignore the code till I come back with a fresh version.

[Rod]

Ok, this seems to hold together better but it takes a long time to test chess moves!. I probably need a set move routine to start play from a known position. The last bug was all about reversing the move when found to be illegal. I have still to look at castling moves and such, so more to do.

It seems surprisingly "smart" even at two levels of recursion. Or perhaps I suck at chess.

'Based on How To Write A Chess Programm in QBASIC
'By Dean Menezes. Ported to Liberty BASIC by Rod Bird. 2019

'http://www.petesqbsite.com/sections/express/issue23/Tut_QB_Chess.txt
'https://www.deviantart.com/atskaheart/art/Chess-Pieces-208065294

'In Liberty BASIC arrays are Global. In QuickBasic arrays are not and can be passsed
'to functions and subs. The program made extensive use of passed arrays
'to mimic that I used the Level parameter to add another dimension
'to our arrays so that the recursion had somewhere unique to store its values

'I probably still dont understand the recursive part. Qudos to Mr Menezes for such a
'stunningly short and powerful Chess AI.

'This will have many bugs but I thought as I had got it running
'that I would share. Feel free to rewrite your own version or
'debug and enhance this version.

'LB5 with its multidimensional array capability will shorten and speed the code
'I have a graphics interface ready but it needs more debugging and testing.

dim bvalue(7,7)     'value of piece at board x,y
dim bsign(7,7)      'sign of piece at board x,y -1 black 1 white
dim bpiece(7,7)     'asc name of piece at board x,y
dim movex(30,5)     'list of possible x moves for each Level <=26 queen on blank board
dim movey(30,5)     'list of possible y moves for each Level
dim bestx(5)        'stored best move per Level
dim besty(5)
dim bestx1(5)
dim besty1(5)

global Move,Level,Maxlevel,Score



'global variables
Move=-1         'the number of valid moves found for chosen piece
Level=0         'recursion level for evaluate()
Maxlevel=3      'max recursive calls for evaluate() 5 normal play 3 dumber and quicker
Score=0         'worth of play
Check=0         '1=currently in check
call fillboard
call showboard
result=0
x=-1

'main program loop
do
   call playermove x,y,x1,y1,result
   call showboard
   result=evaluate(-1,10000)
   x=bestx(1)
   y=besty(1)
   x1=bestx1(1)
   y1=besty1(1)
loop while 1


'Firstly show the result of Blacks computer move
'then get and validate players move
sub playermove x,y,x1,y1,result

   if x>=0 then

       'king on king end game
       if result < -2500 then
           print "I resign"
           end
       end if

       'show the move
       print "Computers move ";chr$(65+x);8-y;"-";chr$(65+x1);8-y1;" Piece ";chr$(bpiece(x,y))
       if bvalue(x1,y1)>0 then taken=showtaken(x1,y1,-1)
       call makemove x,y,x1,y1
       check=incheck(1)
       if check then print "You are in check"
       call showboard

   end if
   goto [in]

   [err]
   print

   [in]
   'get input and do basic validation of that input
   input "YOUR MOVE: "; IN$
   if upper$(IN$)="Q" then end
   if len(IN$)<>4 then
       print "Invalid data"
       goto [err]
   end if

   'transform board name to array x,y index ie E2 = 4,6
   x = ASC(UPPER$(MID$(IN$, 1, 1))) - 65
   y = 8 - (ASC(MID$(IN$, 2, 1)) - 48)
   x1 = ASC(UPPER$(MID$(IN$, 3, 1))) - 65
   y1 = 8 - (ASC(MID$(IN$, 4, 1)) - 48)

   'are we on the board and moving a white piece
   print "checking player move for ";chr$(65+x);8-y;"-";chr$(65+x1);8-y1;" Piece ";chr$(bpiece(x,y))
       if x<0 or x>7 or y<0 or y>7 or x1<0 or x1>7 or y1<0 or y1>7 or bvalue(x,y)<=0 then
       print "Off the board or wrong color play"
       goto [err]
   end if


   'validate move is legal for white piece
   'and that it does not put us in check
   sgn=1 'white
   illegal=1
   call movelist x,y,sgn
   for m=0 to Move
       if x1=movex(m,Level) and y1=movey(m,Level) then
           illegal=0
           taken=showtaken(x1,y1,1)
           'store mover and target data so that it may be restored
           movervalue=bvalue(x,y)
           moverpiece=bpiece(x,y)
           moversign=bsign(x,y)
           targetvalue=bvalue(x1,y1)
           targetpiece=bpiece(x1,y1)
           targetsign=bsign(x1,y1)
           call makemove x,y,x1,y1
           check=incheck(1)
           if check then
               'reset play
               illegal=1
               print "You are incheck"
               bvalue(x,y)=movervalue
               bpiece(x,y)=moverpiece
               bsign(x,y)=moversign
               bvalue(x1,y1)=targetvalue
               bpiece(x1,y1)=targetpiece
               bsign(x1,y1)=targetsign
           end if
           exit for
       end if
   next
   if illegal then
       print "Illegal move"
       goto [err]
   end if
end sub


'get a list of valid moves for a particular piece
sub movelist x,y,sgn
   Move=-1
   select case bpiece(x,y)
       case asc("P")
           call pawn x,y,sgn
       case asc("N")
           call knight x,y,sgn
       case asc("B")
           call bishop x,y,sgn
       case asc("R")
           call rook x,y,sgn
       case asc("Q")
           call queen x,y,sgn
       case asc("K")
           call king x,y,sgn
   end select
end sub

sub pawn x,y,sgn
   'capture right?
   if x+1<=7 and y-sgn >=0 and y-sgn <=7 then
       if bsign(x+1,y-sgn)=0-sgn then
           Move=Move+1
           movex(Move,Level)=x+1
           movey(Move,Level)=y-sgn
       end if
   end if
   'capture left?
   if x-1>=0 and y-sgn >=0 and y-sgn <=7 then
       if bsign(x-1,y-sgn)=0-sgn then
           Move=Move+1
           movex(Move,Level)=x-1
           movey(Move,Level)=y-sgn
       end if
   end if
   'one forward?
   if y-sgn >=0 and y-sgn<=7 then
       if bsign(x,y-sgn)=0 then
           Move=Move+1
           movex(Move,Level)=x
           movey(Move,Level)=y-sgn
           'two forward?
           if (y=1 and sgn<0) or (y=6 and sgn>0) then
               if bvalue(x,y-sgn*2)=0 then
                   Move=Move+1
                   movex(Move,Level)=x
                   movey(Move,Level)=y-sgn*2
               end if
           end if
       end if
   end if
end sub

sub knight x,y,sgn
   x1=x-1
   y1=y-2
   gosub [addmove]
   x1=x-2
   y1=y-1
   gosub [addmove]
   x1=x+1
   y1=y-2
   gosub [addmove]
   x1=x+2
   y1=y-1
   gosub [addmove]
   x1=x-1
   y1=y+2
   gosub [addmove]
   x1=x-2
   y1=y+1
   gosub [addmove]
   x1=x+1
   y1=y+2
   gosub [addmove]
   x1=x+2
   y1=y+1
   gosub [addmove]
   exit sub

   [addmove]
   if x1<0 or x1>7 or y1<0 or y1>7 then return
   if sgn <> bsign(x1,y1) then
       Move=Move+1
       movex(Move,Level)=x1
       movey(Move,Level)=y1
   end if
   return
end sub

sub bishop x,y,sgn
   for dxy=1 to 7
       x1=x-dxy
       y1=y+dxy
       'off the board?
       if x1<0 or x1>7 or y1<0 or y1>7 then exit for
       gosub [addmove]
       'found a piece to capture? then stop
       if bsign(x1,y1) then exit for
   next
   for dxy=1 to 7
       x1=x+dxy
       y1=y+dxy
       if x1<0 or x1>7 or y1<0 or y1>7 then exit for
       gosub [addmove]
       if bsign(x1,y1) then exit for
   next
   for dxy=1 to 7
       x1=x-dxy
       y1=y-dxy
       if x1<0 or x1>7 or y1<0 or y1>7 then exit for
       gosub [addmove]
       if bsign(x1,y1) then exit for
   next
   for dxy=1 to 7
       x1=x+dxy
       y1=y-dxy
       if x1<0 or x1>7 or y1<0 or y1>7 then exit for
       gosub [addmove]
       if bsign(x1,y1) then exit for
   next
   exit sub

   [addmove]
   if sgn <> bsign(x1,y1) then
       Move=Move+1
       movex(Move,Level)=x1
       movey(Move,Level)=y1
   end if
   return
end sub

sub rook x,y,sgn
   for x1=x-1 to 0 step-1
       if sgn <> bsign(x1,y) then
           Move=Move+1
           movex(Move,Level)=x1
           movey(Move,Level)=y
       end if
       if bvalue(x1,y)<>0 then exit for
   next
   for x1=x+1 to 7
       if sgn <> bsign(x1,y) then
           Move=Move+1
           movex(Move,Level)=x1
           movey(Move,Level)=y
       end if
       if bvalue(x1,y)<>0 then exit for
   next
   for y1=y-1 to 0 step-1
       if sgn <> bsign(x,y1) then
           Move=Move+1
           movex(Move,Level)=x
           movey(Move,Level)=y1
       end if
       if bvalue(x,y1)<>0 then exit for
   next
   for y1=y+1 to 7
       if sgn <> bsign(x,y1) then
           Move=Move+1
           movex(Move,Level)=x
           movey(Move,Level)=y1
       end if
       if bvalue(x,y1)<>0 then exit for
   next
end sub

sub queen x,y,sgn
   call bishop x,y,sgn
   call rook x,y,sgn
end sub

sub king x,y,sgn
   for dy=-1 to 1
       if y+dy<0 or y+dy>7 then [bypass2]
       for dx=-1 to 1
           if x+dx<0 or x+dx>7 then goto [bypass1]
           if sgn <> bsign(x+dx,y+dy) then
               Move=Move+1
               movex(Move,Level)=x+dx
               movey(Move,Level)=y+dy
           end if
           [bypass1]
       next
       [bypass2]
   next
end sub


sub makemove x,y,x1,y1
   'fill square taken
   bvalue(x1,y1)=bvalue(x,y)
   bpiece(x1,y1)=bpiece(x,y)
   bsign(x1,y1)=bsign(x,y)

   'erase square vacated
   bvalue(x,y)=0
   bpiece(x,y)=0
   bsign(x,y)=0
   'promote pawn if it reaches board edge
   if y1=0 and bvalue(x1,y1)=100 then bvalue(x1,y1)=900 : bpiece(x1,y1)=asc("Q")
   if y1=7 and bvalue(x1,y1)=-100 then bvalue(x1,y1)=-900 : bpiece(x1,y1)=asc("Q")
end sub

sub showboard

   'print "Pause Press any key"

   'paus$=input$(1)

   print "     0  1  2  3  4  5  6  7"

   print "     A  B  C  D  E  F  G  H"

   print "   --------------------------"

   for y= 8 to 1 step -1

       print 8-y;" ";y;"|";

       for x=0 to 7

       f1$=mid$(" [",(x+y) mod 2+1,1)

       f2$=mid$(" ]",(x+y) mod 2+1,1)

       if bsign(x,8-y)=-1 then

           print f1$;chr$(bpiece(x,8-y));f2$;

           else

           print f1$;lower$(chr$(bpiece(x,8-y)));f2$;

       end if

       next

       print "|"

   next

   print "   --------------------------"

   print "     A  B  C  D  E  F  G  H"



end sub
sub fillboard
   restore [data]
   for y = 0 TO 7
       for x = 0 TO 7
           read z
           read z$
           bvalue(x,y) = z
           bpiece(x,y)=asc(z$)
           if z<0 then bsign(x,y)=-1
           if z>0 then bsign(x,y)=1
       next
   next
   [data]
   DATA -500,"R",-270,"N",-300,"B",-900,"Q",-7500,"K",-300,"B",-270,"N",-500,"R"
   DATA -100,"P",-100,"P",-100,"P",-100,"P",-100,"P",-100,"P",-100,"P",-100,"P"
   DATA 0," ",0," ",0," ",0," ",0," ",0," ",0," ",0," "
   DATA 0," ",0," ",0," ",0," ",0," ",0," ",0," ",0," "
   DATA 0," ",0," ",0," ",0," ",0," ",0," ",0," ",0," "
   DATA 0," ",0," ",0," ",0," ",0," ",0," ",0," ",0," "
   DATA 100,"P",100,"P",100,"P",100,"P",100,"P",100,"P",100,"P",100,"P"
   DATA 500,"R",270,"N",300,"B",900,"Q",5000,"K",300,"B",270,"N",500,"R"
end sub



'this function checks all squares to see if
'any opposition piece has the king in check
function incheck(sgn)
   for x=0 to 7
       for y=0 to 7
           if bsign(x,y)=0-sgn then
               call movelist x,y,0-sgn
               for m=0 to Move
                   if abs(bvalue(movex(m,Level),movey(m,Level)))>=5000 then
                       incheck = 1
                       exit function
                   end if
               next
           end if
       next
  next
end function

'this function checks all squares for players to move then recursively test plays
'it plays its own move then plays the opponents best move, recursively over four moves.
'So getting the potential net worth of each moveable player on the board. The highest
'scored determines the computers next move.
'It is a classic mini max evaluation shortened to its a negamax form with pruning
'ie it does not waste time on lower value plays.

function evaluate(sgn,prune)
   Level=Level+1
   bestscore=10000*sgn
   for y= 7 to 0 step -1
       for x= 7 to 0 step -1
           if bsign(x,y)=sgn then
               call movelist x,y,sgn
               for m=0 to Move
                   x1=movex(m,Level)
                   y1=movey(m,Level)
                   oldscore=Score
                   'store mover and target data so that it may be restored
                   movervalue=bvalue(x,y)
                   moverpiece=bpiece(x,y)
                   moversign=bsign(x,y)
                   targetvalue=bvalue(x1,y1)
                   targetpiece=bpiece(x1,y1)
                   targetsign=bsign(x1,y1)
                   call makemove x,y,x1,y1
                   'if Level=1 then print "Evaluating ";sgn;" Move ";chr$(65+x);8-y;"-";chr$(65+x1);8-y1
                   if Level<Maxlevel then Score=Score+evaluate(0-sgn,bestscore - targetvalue + sgn*(8-abs(4-x1)-abs(4-y1)))
                   Score=Score+targetvalue-sgn*(8-abs(4-x1)-abs(4-y1))
                   if (sgn<0 and Score > bestscore) or (sgn>0 and Score < bestscore) then
                       bestx(Level)=x
                       besty(Level)=y
                       bestx1(Level)=x1
                       besty1(Level)=y1
                       bestscore = Score
                       if (sgn<0 and bestscore>=prune) or (sgn>0 and bestscore<=prune) then
                           'reset play
                           bvalue(x,y)=movervalue
                           bpiece(x,y)=moverpiece
                           bsign(x,y)=moversign
                           bvalue(x1,y1)=targetvalue
                           bpiece(x1,y1)=targetpiece
                           bsign(x1,y1)=targetsign
                           Score=oldscore
                           Level=Level-1
                           evaluate=bestscore
                           exit function
                       end if
                   end if
                   bvalue(x,y)=movervalue
                   bpiece(x,y)=moverpiece
                   bsign(x,y)=moversign
                   bvalue(x1,y1)=targetvalue
                   bpiece(x1,y1)=targetpiece
                   bsign(x1,y1)=targetsign
                   Score=oldscore
               next
           end if
       next
   next
   Level=Level-1
   evaluate=bestscore
end function


function showtaken(x,y,sgn)
   showtaken=abs(bvalue(x,y))
   if showtaken>0 then
       if sgn<0 then print "Black took your ";
       if sgn>0 then print "White took your ";
       if showtaken=100 then print "Pawn"
       if showtaken=270 then print "Knight"
       if showtaken=300 then print "Bishop"
       if showtaken=500 then print "Rook"
       if showtaken=900 then print "Queen"
       if showtaken=5000 then print "King"
   end if
end function




[tsh73]

Had a hard time figuring bishop moves without checkers on board.
so
    0  1  2  3  4  5  6  7
    A  B  C  D  E  F  G  H
  --------------------------
0 8| R [N] B [Q] K [B] N [R]|
1 7|[P] P [P] P [P] P [P] P |
2 6|   [ ]   [ ]   [ ]   [ ]|
3 5|[ ]   [ ]   [ ]   [ ]   |
4 4|   [ ]   [ ]   [ ]   [ ]|
5 3|[ ]   [ ]   [ ]   [ ]   |
6 2| p [p] p [p] p [p] p [p]|
7 1|[r] n [b] q [k] b [n] r |
  --------------------------
    A  B  C  D  E  F  G  H
YOUR MOVE:

sub showboard
   'print "Pause Press any key"
   'paus$=input$(1)
   print "     0  1  2  3  4  5  6  7"
   print "     A  B  C  D  E  F  G  H"
   print "   --------------------------"
   for y= 8 to 1 step -1
       print 8-y;" ";y;"|";
       for x=0 to 7
       f1$=mid$(" [",(x+y) mod 2+1,1)
       f2$=mid$(" ]",(x+y) mod 2+1,1)
       if bsign(x,8-y)=-1 then
           print f1$;chr$(bpiece(x,8-y));f2$;
           else
           print f1$;lower$(chr$(bpiece(x,8-y)));f2$;
       end if
       next
       print "|"
   next
   print "   --------------------------"
   print "     A  B  C  D  E  F  G  H"

end sub


[Rod]

Ok, still in the debugging phase but I have a graphics frontend now. If you get time to test please let me know what you would like to see in the way of improvements or tweaks.

No help file as yet, all you do is click on the player you wish to move and then the target square. Click in the square not on the chess pieces.

Read the game history on the right to see what happened. I need to slow the moves down or leave a graphic trail of what happened.


gamebin.webs.com/Games/LB%20Chess.zip



Click on the download, select open, then select extract all. You will be prompted for a directory to extract to. The program is contained within a folder called LB Chess. You can just delete that when you are done and it will be erased from your PC.

[Rod]

This is how it looks right now, not sure if the original sprite set looked better, or indeed if j-board is a better frontend.

[cundo]

These sprites, looks more like those classic DOS games, and the previous one it's more realistic. Both are great, I can't choose.
I like this board more, but can't decide about the pieces.

[tsh73]

Sometimes pieces are hard to see one after another
Probably that could not be helped - I remember switching to 2d view in some chess program just to see things more clearly.

Managed to win it once. It just closed window.

WHERE'S
YOUR FAT REWARD AND TICKET HOME? WHAT
THE HELL IS THIS? IT'S NOT SUPPOSED TO
END THIS WAY!

lol DOOM

[Rod]

Ha! I have yet to win and find that bug! A few others fixed but more to do.

[carlgundel]

Apr 2, 2019 14:16:21 GMT cundo said:

These sprites, looks more like those classic DOS games, and the previous one it's more realistic. Both are great, I can't choose.
I like this board more, but can't decide about the pieces.

I prefer the first set of sprites FWIW.

[Rod]

OK, hit a bit of a brick wall mentally. I have fixed a few bugs and gone back to original graphics. The problem is that I cannot get the code to recognise Black is in check and to play out of check rather than play the next best move. Its all tied up in the evaluate() function. I will take a break for a day or so. I have still to add Castling and Pawn Promotion. The buttons don't work yet and the clocks need a time limit. So still lots to do. The version in this zip is very easy to beat, increase Maxlevel to 3 or 5 if you want a tougher game. Maxlevel at 1 lets me beat it every time to help test the end game.


gamebin.webs.com/Games/LB%20Chess.zip

[tsh73]

Hello Rod
Why don't you just use texteditor for text?
It would be much easier to share results.
(I was just startled by black king reacts on check by jumping ke8-h4)

[Rod]

Ok, I am probably confusing myself. Having thought about it a bit more I now think Black will play itself out of check or resign. Its all to do with the score and the high value of loosing its black king. So it will always play out of check until cornered when it will resign. I think I had it dumbed down too much and was introducing another bug. In the latest version change this section in evaluate()

Remove the if incheck() and endif to set the code back to normal. Then it will stick to legal moves. 

Yes detailed debugging needs a better audit trail, for the next version. If folks could play a few games at Maxlevel 2 or Maxlevel 3 and tell me if it behaves. Maxlevel 5 is a slow game an hour or more so be warned.


                   'force black to play out of check instead of best move 'remove
                   if incheck(-1)=0 then 'remove
                       bestx(Level)=x
                       besty(Level)=y
                       bestx1(Level)=x1
                       besty1(Level)=y1
                       bestscore = Score
                       if (sgn<0 and bestscore>=prune) or (sgn>0 and bestscore<=prune) then
                           'reset play
                           bsprite$(x,y)=moversprite$
                           bvalue(x,y)=movervalue
                           bpiece(x,y)=moverpiece
                           bsign(x,y)=moversign
                           bsprite$(x1,y1)=targetsprite$
                           bvalue(x1,y1)=targetvalue
                           bpiece(x1,y1)=targetpiece
                           bsign(x1,y1)=targetsign
                           Score=oldscore
                           Level=Level-1
                           evaluate=bestscore
                           exit function
                       end if
                   end if
                   end if 'remove










[Rod]

This version has pawn promotion, castling, pause and resign. I have not implemented load and save games as yet. Fresh new look and some sounds. Now the moves leave a trace, the position they moved from is marked and the moved piece stays highlighted till the next move. It started out as a neat AI routine!

As far as the clocks are concerned I have in mind making it a speed chess challenge, say 15 minutes per player?

Sometimes it recognises black is in check sometimes not. So still some debugging to do but you can have fun playing in the meantime.

gamebin.webs.com/LB%20Chess-1.zip

[tsh73]

Line for " 'player clicked castle right"
should be            #w.g "drawsprites"
both (") are missing

[Rod]

Ok, much debugging completed. Load and Save implemented in a simplistic way. I have changed the timer code and start the timer inside each sub or function. I was getting crashes with the timer set at the head of the program. At least I am assuming it was the timer, still testing. Still refuses to recognise it is in check!

My chess playing has improved enormously!


gamebin.webs.com/Liberty/LB%20Chess.zip


edit: fixed timer error, if black clock does not increment then download the .zip again