|
Post by tsh73 on Jan 15, 2021 17:46:35 GMT
So it plays for black pieces
But it expect them to start, that's rather odd Fixed that.
If set
Maxlevel=2 it is playable (speed wize).
It do resigns on first check - why so? And after saying "White resigns" I do not see piece I chackmated it with.
'nomainwin 'Based on How To Write A Chess Programm in QBASIC By Dean Menezes. 'http://www.petesqbsite.com/sections/express/issue23/Tut_QB_Chess.txt 'graphics originate under Creative commons attribution license but have been largely redrawn. 'https://all-free-download.com/free-vector/download/chess-design-elements-vector-set_571689.html 'ported to Liberty BASIC by rodbird@hotmail.com
'In Liberty BASIC arrays are Global. In QBasic 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 variable 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. No wait. I do understand the 'recursive code, what I dont understand is how it creates such a powerful 'chess AI. Qudos to Mr Menezes.
'the next board parameters never change during play they 'define the physical dimensions of the game board image dim bspritex(7,7) 'x pos to draw sprite on square dim bspritey(7,7) 'y pos to draw sprite on square dim bspritez(7,7) '% size of sprite on square dim bpointrx(8,8) 'x limit for mouse click dim bpointry(8,8) 'y limit for mouse click
'the name of the square changes depending on playing white or black dim bsquare$(7,7)
'now we set up board parameters that move with the player dim bsprite$(7,7) 'sprite name currently occupying the square dim bvalue(7,7) 'value of piece occupying x,y dim bsign(7,7) 'sign of piece occupying x,y -1 black 1 white dim bpiece(7,7) 'asc name of piece occupying x,y
'arrays to hold the legal moves a particular piece can make dim movex(30,5) 'list of possible x moves for each Level dim movey(30,5) 'list of possible y moves for each Level
'arrays to store the best move for each recursion level dim bestx(5) dim besty(5) dim bestx1(5) dim besty1(5)
'text display dim text$(40) text$(2)="Speed Chess," text$(3)="15 minutes" text$(4)="per player." text$(5)="" text$(6)="Click on the" text$(7)="square not the" text$(8)="piece." text$(9)="You are white," text$(10)="select piece first," text$(11)="then your target" text$(12)="square." text$(13)="" text$(14)="Normal rules of" text$(15)="Chess apply"
dim A1$(7,7) 'chess notation from coords, instead of funcion to cut time call fillA1$ 'chess notation from coords
'global variables global AI,Timecounter,Status,Pause,Move,Level,Maxlevel,Score,Whitetime,Blacktime,White,Black,Spritetaken$,Spriteadded$ Timecounter=0 'keeps track elapsed time Pause=0 'game paused=1 playing=0 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 Maxlevel=2 ' Maxlevel=1 'then debugging, speed is the king! Score=0 'worth of play Whitetime=0 'clock for white Blacktime=0 'clock for black White=1 'white constant Black=-1 'black constant Spritetaken$="" 'list of taken sprites Spriteadded$="" 'list of promoted pawns AI=Black 'the color played by the computer
'set out the players and show the board call fillboard call reversegame call showboard
'start tracking the mouse pointer to highlight buttons #w.g "when mouseMove trackit"
'main program loop nMove = 0 do Status=1 if nMove = 0 and AI=White then 'skip first move, if AI black player starts. Else AI starts else call playermove end if call showboard Status=2 if AI=Black then t$="Black to move " else t$="White to move " call text t$ nMove=nMove+1 print print "move "; nMove result=evaluatecomputermove(AI,10000) call actioncomputermove result call showboard playwave "play.wav",async
loop while 1
sub actioncomputermove result
'the results of evaluate are held in best() x=bestx(1) y=besty(1) x1=bestx1(1) y1=besty1(1)
'remove highlights of human players last move #w.g "spritevisible m off" #w.g "spriteimage ";bsprite$(old(1),old(2));" ";left$(bsprite$(old(1),old(2)),2)
'make computer move for real if not in check if AI=Black then t$="Black moves " else t$="White moves " call text t$;chr$(bpiece(x,y));bsquare$(x,y);"-";chr$(bpiece(x1,y1));bsquare$(x1,y1) if bvalue(x1,y1)<>0 then taken=showtaken(x1,y1,AI) #w.g "spritevisible ";bsprite$(x1,y1);" off" Spritetaken$=Spritetaken$+bsprite$(x1,y1)+"," end if
call makemove x,y,x1,y1
if incheck(AI) or result <-2500 then text$(1)="" text$(2)="" if AI=Black then t$="Black resigns " else t$="White resigns " call text t$ call text "Game ends" wait end if
'add highlights of computers last move #w.g "spriteimage ";bsprite$(x1,y1);" ";left$(bsprite$(x1,y1),2);"1" #w.g "spritexy t ";bspritex(x,y);" ";bspritey(x,y) #w.g "spritescale t ";bspritez(x,y) #w.g "spritetoback t" #w.g "spritevisible t on" old(3)=x1 old(4)=y1 if AI=Black then t$="White in check " else t$="Black in check" if incheck(0-AI) then call text t$ call showboard end sub
sub playermove 'get and validate players move ie x y to x1 y1
'save the previous position and store the current position kill "undo1.gam" name "undo.gam" as "undo1.gam" call savegame "undo.gam"
'skip past error routine goto [in]
'come back here if there was an error on input [err] if bsprite$(x,y)<>"" then #w.g "spriteimage ";bsprite$(x,y);" ";left$(bsprite$(x,y),2) if bsprite$(x1,y1)<>"" then #w.g "spriteimage ";bsprite$(x1,y1);" ";left$(bsprite$(x1,y1),2) #w.g "spritevisible m off" #w.g "spritevisible t off" #w.g "drawsprites" playwave "error.wav",async
[in] 'get input and do basic validation of that input if AI=Black then t$="White to move " else t$="Black to move " call text t$
'start event tracking #w.g "when leftButtonUp [playermove]" #w.g "setfocus"
[timerloop] 'must use loop and scan, timer statement crashes out scan if Paused=0 and time$("seconds")>Timecounter then Timecounter=time$("seconds") call clock end if goto [timerloop]
[playermove] 'remove highlights of last move #w.g "spriteimage ";bsprite$(old(3),old(4));" ";left$(bsprite$(old(3),old(4)),2) #w.g "spritevisible t off" xx=MouseX yy=MouseY found=0
'player clicked pause button if xx>210 and xx<290 and yy>3 and yy<25 then playwave "click.wav",async if Paused=1 then Paused=0 call text "Game restarted" else Paused=1 call text "Game paused" end if end if 'if paused go no further if Paused then goto [timerloop]
'player clicked load game if xx>300 and xx<380 and yy>3 and yy<25 then playwave "click.wav",async call loadgame "saved.gam" call showboard call text "Game loaded" if AI=Black then t$="White to move " else t$="Black to move " call text t$ end if
'player clicked save game if xx>410 and xx<490 and yy>3 and yy<25 then playwave "click.wav",async call savegame "saved.gam" call text "Game saved" end if
'player clicked undo if xx>360 and xx<450 and yy>564 and yy<584 then call loadgame "undo1.gam" call showboard call text "Undo" if AI=Black then t$="White to move " else t$="Black to move " call text t$ end if
'player clicked resign button if xx>495 and xx<590 and yy>3 and yy<25 then playwave "click.wav",async if AI=Black then t$="White resigns" else t$="Black resigns " call text t$ call text "Game ends" Paused=1 goto [timerloop] end if
'player clicked castle left if xx>80 and xx<160 and yy>564 and yy<584 then playwave "click.wav",async if bvalue(0,7)=500 and bvalue(4,7)=5000 and bvalue(1,7)=0 and bvalue(2,7)=0 and bvalue(3,7)=0 and incheck(AI)=0 then call makemove 4,7,2,7 call makemove 0,7,3,7 call text "Castles" #w.g "drawsprites" exit sub else call text "Illegal move" goto [err] end if end if
'player clicked castle right if xx>630 and xx<690 and yy>564 and yy<584 then playwave "click.wav",async if bvalue(7,7)=500 and bvalue(4,7)=5000 and bvalue(5,7)=0 and bvalue(6,7)=0 and incheck(AI)=0 then call makemove 4,7,6,7 call makemove 7,7,5,7 call text "Castles" #w.g "drawsprites" exit sub else call text "Illegal move" goto [err] end if end if
'highlight players first click on selected piece if yy>=170 and yy<=516 then for y=0 to 7 for x=0 to 7 if yy>bpointry(x,y) and yy<bpointry(x,y+1) and xx>bpointrx(x,y) and xx<bpointrx(x+1,y) then if bsprite$(x,y)<>"" then #w.g "spriteimage ";bsprite$(x,y);" ";left$(bsprite$(x,y),2);"1" #w.g "spritexy m ";bspritex(x,y);" ";bspritey(x,y) #w.g "spritescale m ";bspritez(x,y) #w.g "spritetoback m" #w.g "spritevisible m on" #w.g "drawsprites" px=x py=y found=1 exit for end if next if found then exit for next if found then #w.g "when leftButtonUp [targetsquare]" end if goto [timerloop]
[targetsquare] xx=MouseX yy=MouseY found=0 if yy>=170 and yy<=516 then for y=0 to 7 for x=0 to 7 if yy>bpointry(x,y) and yy<bpointry(x,y+1) and xx>bpointrx(x,y) and xx<bpointrx(x+1,y) then if x=px and y=py then if bsprite$(x,y)<>"" then #w.g "spriteimage ";bsprite$(x,y);" ";left$(bsprite$(x,y),2) #w.g "spritevisible m off" #w.g "drawsprites" px=-1 py=-1 found=0 exit for else if bsprite$(x,y)<>"" then #w.g "spriteimage ";bsprite$(x,y);" ";left$(bsprite$(x,y),2);"1" old(1)=x old(2)=y #w.g "drawsprites" px1=x py1=y found=1 exit for end if end if next if found then exit for next if found then #w.g "when leftButtonUp" else #w.g "when leftButtonUp [playermove]" goto [timerloop] end if
end if
'this is the players choice of move x=px y=py x1=px1 y1=py1
[movit] 'are we on the board and moving correctly colored piece if AI=Black then t$="White moves " else t$="Black moves " call text t$;chr$(bpiece(x,y));bsquare$(x,y);"-";chr$(bpiece(x1,y1));bsquare$(x1,y1) 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 bsign(x,y)<>0-AI then call text "Off board/wrong color " goto [err] end if
'validate move is legal for piece 'and that it does not put us in check illegal=1 call movelist x,y,0-AI for m=0 to Move if x1=movex(m,Level) and y1=movey(m,Level) then illegal=0 taken=showtaken(x1,y1,0-AI) 'store mover and target data so that it may be restored moversprite$=bsprite$(x,y) movervalue=bvalue(x,y) moverpiece=bpiece(x,y) moversign=bsign(x,y) targetsprite$=bsprite$(x1,y1) targetvalue=bvalue(x1,y1) targetpiece=bpiece(x1,y1) targetsign=bsign(x1,y1) call makemove x,y,x1,y1 check=incheck(0-AI) if check then 'reset play illegal=1 call text "You are in check!" 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 end if exit for end if next if illegal then call text "Illegal move" goto [err] end if
'finaly we have a legal move 'did it take a man if taken then #w.g "spritevisible ";targetsprite$;" off" Spritetaken$=Spritetaken$+targetsprite$+"," end if 'did it check? if AI=Black then t$="Black is in check " else t$="White is in check " if incheck(AI) then call text t$ #w.g "drawsprites" playwave "play.wav",async end sub
'get a list of valid moves for a particular piece 'sgn indicates white or black dop indicates direction of play sub movelist x,y,sgn Move=-1 'no move found if sgn=White and AI=White then dop=-1 if sgn=White and AI=Black then dop=1 if sgn=Black and AI=Black then dop=-1 if sgn=Black and AI=White then dop=1
select case bpiece(x,y) case asc("P") call pawn x,y,sgn,dop case asc("N") call knight x,y,sgn,dop case asc("B") call bishop x,y,sgn,dop case asc("R") call rook x,y,sgn,dop case asc("Q") call queen x,y,sgn,dop case asc("K") call king x,y,sgn,dop end select end sub
sub pawn x,y,sgn,dop 'capture right? if x+1<=7 and y-dop >=0 and y-dop <=7 then if bsign(x+1,y-dop)=0-sgn then Move=Move+1 movex(Move,Level)=x+1 movey(Move,Level)=y-dop end if end if 'capture left? if x-1>=0 and y-dop >=0 and y-dop <=7 then if bsign(x-1,y-dop)=0-sgn then Move=Move+1 movex(Move,Level)=x-1 movey(Move,Level)=y-dop end if end if 'one forward? if y-dop >=0 and y-dop<=7 then if bsign(x,y-dop)=0 then Move=Move+1 movex(Move,Level)=x movey(Move,Level)=y-dop 'two forward? if (y=1 and dop=-1) or (y=6 and dop=1) then if bvalue(x,y-dop*2)=0 then Move=Move+1 movex(Move,Level)=x movey(Move,Level)=y-dop*2 end if end if end if end if end sub
sub knight x,y,sgn,dop 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,dop 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 or own man then stop if bsign(x1,y1)<>0 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)<>0 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)<>0 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)<>0 then exit for next exit sub
[addmove] if bsign(x1,y1)<>sgn then Move=Move+1 movex(Move,Level)=x1 movey(Move,Level)=y1 end if return end sub
sub rook x,y,sgn,dop for x1=x-1 to 0 step-1 if bsign(x1,y)<>sgn 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 bsign(x1,y)<>sgn 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 bsign(x,y1)<>sgn 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 bsign(x,y1)<>sgn 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,dop call bishop x,y,sgn,dop call rook x,y,sgn,dop end sub
sub king x,y,sgn,dop 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 bsign(x+dx,y+dy)<>sgn 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 bsprite$(x1,y1)=bsprite$(x,y) bvalue(x1,y1)=bvalue(x,y) bpiece(x1,y1)=bpiece(x,y) bsign(x1,y1)=bsign(x,y)
'erase square vacated bsprite$(x,y)="" bvalue(x,y)=0 bpiece(x,y)=32 bsign(x,y)=0
'promote pawn if it reaches board edge if y1=0 and bvalue(x1,y1)=100 and Level=0 then 'wp1 wp8 become wq2-wq9 bvalue(x1,y1)=900 bpiece(x1,y1)=asc("Q") 'switch off original sprite #w.g "spritevisible ";bsprite$(x1,y1);" off" Spritetaken$=Spritetaken$+bsprite$(x1,y1)+"," 'add new queen sprite bsprite$(x1,y1)="wq"+str$(val(mid$(bsprite$(x1,y1),3,1))+1) #w.g "addsprite ";bsprite$(x1,y1);" wq wq1" #w.g "spritexy ";bsprite$(x1,y1);" ";x1;" ";y1 Spriteadded$=Spriteadded$+bsprite$(x1,y1)+" wq wq1," call text "New white Queen" end if if y1=7 and bvalue(x1,y1)=-100 and Level=0 then bvalue(x1,y1)=-900 bpiece(x1,y1)=asc("Q") #w.g "spritevisible ";bsprite$(x1,y1);" off" Spritetaken$=Spritetaken$+bsprite$(x1,y1)+"," bsprite$(x1,y1)="bq"+str$(val(mid$(bsprite$(x1,y1),3,1))+1) #w.g "addsprite ";bsprite$(x1,y1);" bq bq1" #w.g "spritexy ";bsprite$(x1,y1);" ";x1;" ";y1 Spriteadded$=Spriteadded$+bsprite$(x1,y1)+" bq bq1," call text "New Black Queen" end if #w.g "drawsprites" end sub
sub showboard for y= 7 to 0 step -1 for x= 0 to 7 if bsprite$(x,y)<>"" then #w.g "spritetoback ";bsprite$(x,y) #w.g "spritescale ";bsprite$(x,y);" ";bspritez(x,y) #w.g "spritexy ";bsprite$(x,y);" ";bspritex(x,y);" ";bspritey(x,y) end if next next #w.g "spritetoback m" #w.g "spritetoback t" #w.g "drawsprites" end sub
sub fillboard
'find how much whitespace the windows scheme is taking 'so that our controls fit neatly in the window, 'Anatoly's tip WindowWidth = 200 WindowHeight = 200 open "Ajusting..." for graphics_nf_nsb as #1 #1, "home ; down ; posxy w h" w=200-2*w : h = 200-2*h close #1 WindowWidth = 1000+w WindowHeight = 600+h UpperLeftX = (DisplayWidth-WindowWidth)/2 UpperLeftY = (DisplayHeight-WindowHeight)/2 graphicbox #w.g, 0,0,802,602 graphicbox #w.tb, 802,0,200,602
open "Liberty BASIC Chess" for window_nf as #w #w "trapclose quit" #w.g "down" #w.tb "down ;backcolor lightgray; color black"
loadbmp "tb","text.bmp" #w.tb "drawbmp tb 0 0 ; flush bak"
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
loadbmp "board", "boardbackground.bmp" loadbmp "wp","wp.bmp" loadbmp "bp","bp.bmp" loadbmp "wr","wr.bmp" loadbmp "br","br.bmp" loadbmp "wn","wn.bmp" loadbmp "bn","bn.bmp" loadbmp "wb","wb.bmp" loadbmp "bb","bb.bmp" loadbmp "wq","wq.bmp" loadbmp "bq","bq.bmp" loadbmp "wk","wk.bmp" loadbmp "bk","bk.bmp" loadbmp "wp1","wp1.bmp" loadbmp "bp1","bp1.bmp" loadbmp "wr1","wr1.bmp" loadbmp "br1","br1.bmp" loadbmp "wn1","wn1.bmp" loadbmp "bn1","bn1.bmp" loadbmp "wb1","wb1.bmp" loadbmp "bb1","bb1.bmp" loadbmp "wq1","wq1.bmp" loadbmp "bq1","bq1.bmp" loadbmp "wk1","wk1.bmp" loadbmp "bk1","bk1.bmp" loadbmp "m","mover.bmp" loadbmp "t","target.bmp"
loadbmp "c0","num0.bmp" loadbmp "c1","num1.bmp" loadbmp "c2","num2.bmp" loadbmp "c3","num3.bmp" loadbmp "c4","num4.bmp" loadbmp "c5","num5.bmp" loadbmp "c6","num6.bmp" loadbmp "c7","num7.bmp" loadbmp "c8","num8.bmp" loadbmp "c9","num9.bmp"
'load the buttons loadbmp "pa","pause.bmp" loadbmp "lo","load.bmp" loadbmp "sa","save.bmp" loadbmp "re","resign.bmp" loadbmp "cl","castlel.bmp" loadbmp "cr","castler.bmp" loadbmp "ud","undo.bmp"
#w.g "addsprite pa pa ; spritexy pa 210 4 ; spritevisible pa off" #w.g "addsprite lo lo ; spritexy lo 300 4 ; spritevisible lo off" #w.g "addsprite sa sa ; spritexy sa 410 4 ; spritevisible sa off" #w.g "addsprite re re ; spritexy re 495 4 ; spritevisible re off" #w.g "addsprite cl cl ; spritexy cl 80 564 ; spritevisible cl off" #w.g "addsprite cr cr ; spritexy cr 630 564; spritevisible cr off" #w.g "addsprite ud ud ; spritexy ud 360 564; spritevisible ud off"
'load the clock xx=220 yy=50 for x=1 to 8 #w.g "addsprite clock";str$(x);" c0 c1 c2 c3 c4 c5 c6 c7 c8 c9" #w.g "spritexy clock";str$(x);" ";xx;" ";yy xx=xx+35 if x=4 then xx=xx+52 if x=2 or x=6 then xx=xx+10 next
'store sprite drawing positions for y = 0 to 7 read zz read yy for x = 0 to 7 read xx bspritez(x,y)=zz bspritey(x,y)=yy bspritex(x,y)=xx next next
'store mouse click positions for y = 0 to 8 read yy for x = 0 to 8 read xx bpointrx(x,y)=xx bpointry(x,y)=yy next next
'store square names for y = 0 to 7 for x = 0 to 7 bsquare$(x,y)=chr$(65+x)+str$(8-y) next next
'load pointer sprites #w.g "background board" #w.g "addsprite m m" #w.g "spritevisible m off" #w.g "addsprite t t" #w.g "spritevisible t off"
'load player sprites normal and highlighted for y=0 to 1 for x = 0 to 7 read spritesname$ bsprite$(x,y)=spritesname$ #w.g "addsprite ";spritesname$;" ";left$(spritesname$,2);" ";left$(spritesname$,2);"1" if instr("bb2 bn2 wb2 wn2",spritesname$,1) then #w.g "spriteorient ";spritesname$;" mirror" #w.g "spritescale ";spritesname$;" ";bspritez(x,y) #w.g "spritexy ";spritesname$;" ";bspritex(x,y);" ";bspritey(x,y) next next for y=6 to 7 for x = 0 to 7 read spritesname$ bsprite$(x,y)=spritesname$ #w.g "addsprite ";spritesname$;" ";left$(spritesname$,2);" ";left$(spritesname$,2);"1" if instr("bb2 bn2 wb2 wn2",spritesname$,1) then #w.g "spriteorient ";spritesname$;" mirror" #w.g "spritescale ";spritesname$;" ";bspritez(x,y) #w.g "spritexy ";spritesname$;" ";bspritex(x,y);" ";bspritey(x,y) next next #w.g "drawsprites"
[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"
data 100,128,187,238,290,343,395,449,501,555 data 105,156,177,231,286,340,395,451,507,560 data 110,190,168,225,281,338,395,454,510,568 data 115,225,157,215,275,335,395,455,516,575 data 120,265,146,208,269,332,395,458,520,584 data 125,310,133,197,265,328,395,461,527,593 data 130,350,120,188,257,326,395,465,534,604 data 135,410,104,176,249,321,395,467,541,614
data 170,187,238,290,343,395,449,501,555,606 data 204,177,231,286,340,395,451,507,560,614 data 237,168,225,281,338,395,454,510,568,623 data 273,157,215,275,335,395,455,516,575,636 data 312,146,208,269,332,395,458,520,584,645 data 355,133,197,265,328,395,461,527,593,660 data 403,120,188,257,326,395,465,534,604,671 data 454,104,176,249,321,395,467,541,614,693 data 516,104,176,249,321,395,467,541,614,693
data br1,bn1,bb1,bq1,bk1,bb2,bn2,br2 data bp1,bp2,bp3,bp4,bp5,bp6,bp7,bp8 data wp1,wp2,wp3,wp4,wp5,wp6,wp7,wp8 data wr1,wn1,wb1,wq1,wk1,wb2,wn2,wr2 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 x 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 negamax form with pruning 'ie it does not waste time on lower value plays.
function evaluatecomputermove(sgn,prune) Level=Level+1 levOffset$=space$(2*Level) bestscore=10000*sgn for y= 7 to 0 step -1 for x= 7 to 0 step -1 if bsign(x,y)=sgn then 'print "Checking ";x;",";y;" ";sgn;" ";chr$(bpiece(x,y)) currPiece$=chr$(bpiece(x,y)) print levOffset$;"Checking ";A1$(x,y);" ";sgn$(sgn);" ";currPiece$ 'A1$(x,y) call movelist x,y,sgn if Move=-1 then print levOffset$;"No Moves" for m=0 to Move
if time$("seconds")>Timecounter then Timecounter=time$("seconds"):call clock x1=movex(m,Level) y1=movey(m,Level) 'print "Testing move at level ";Level;" (";x;",";y;") - (";x1;",";y1;")" print levOffset$;"Testing move at level ";Level;" ";currPiece$;A1$(x,y);"-";A1$(x1,y1) oldscore=Score 'store mover and target data so that it may be restored moversprite$=bsprite$(x,y) movervalue=bvalue(x,y) moverpiece=bpiece(x,y) moversign=bsign(x,y) targetsprite$=bsprite$(x1,y1) targetvalue=bvalue(x1,y1) targetpiece=bpiece(x1,y1) targetsign=bsign(x1,y1) call makemove x,y,x1,y1 if Level<Maxlevel then Score=Score+evaluatecomputermove(0-sgn,bestscore - targetvalue + sgn*(8-abs(4-x1)-abs(4-y1))) 'we unwind the recursion by coming back here until we finaly return to the main program flow 'work out the score adding a small amount to favour forwards and central play Score=Score+targetvalue-sgn*(8-abs(4-x1)-abs(4-y1)) 'if it results in a better score than previously then store it as best 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 'print "New best score for level ";Level;" (";x;",";y;") - (";x1;",";y1;") Score ";Score print levOffset$;"New best score for level ";Level;" ";currPiece$;A1$(x,y);"-";A1$(x1,y1);" Score ";Score 'for z=0 to 3 'looks 0 is never used for z=1 to Level 'print z,bestx(z),besty(z),bestx1(z),besty1(z) print levOffset$;z; space$(2+z);A1$(bestx(z),besty(z));"-";A1$(bestx1(z),besty1(z)) next 'if it isn't as good as as a previous pieces move then cut the search short goto [skipPrune] 'if (sgn<0 and bestscore>=prune) or (sgn>0 and bestscore<=prune) then if abs(bestscore) <= abs(prune) then 'reset play print levOffset$;"pruned ";bestscore;"/";prune 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 evaluatecomputermove=bestscore exit function end if [skipPrune] end if '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 next end if next next Level=Level-1 evaluatecomputermove=bestscore end function
function showtaken(x,y,sgn) showtaken=abs(bvalue(x,y)) if showtaken>0 then if sgn<0 then m$= "Black takes " if sgn>0 then m$= "White takes " if showtaken=100 then m$=m$+ "Pawn" if showtaken=270 then m$=m$+ "Knight" if showtaken=300 then m$=m$+ "Bishop" if showtaken=500 then m$=m$+ "Rook" if showtaken=900 then m$=m$+ "Queen" if showtaken>=5000 then m$=m$+ "King" call text m$ end if end function
sub trackit h$,x,y if x>210 and x<290 and y>3 and y<25 then #w.g "spritevisible pa on" else #w.g "spritevisible pa off" if x>300 and x<380 and y>3 and y<25 then #w.g "spritevisible lo on" else #w.g "spritevisible lo off" if x>410 and x<490 and y>3 and y<25 then #w.g "spritevisible sa on" else #w.g "spritevisible sa off" if x>495 and x<590 and y>3 and y<25 then #w.g "spritevisible re on" else #w.g "spritevisible re off" if x>80 and x<160 and y>564 and y<584 then #w.g "spritevisible cl on" else #w.g "spritevisible cl off" if x>630 and x<690 and y>564 and y<584 then #w.g "spritevisible cr on" else #w.g "spritevisible cr off" if x>360 and x<450 and y>564 and y<584 then #w.g "spritevisible ud on" else #w.g "spritevisible ud off" #w.g "drawsprites" end sub
sub text m$ for n=30 to 2 step -1 text$(n)=text$(n-1) next text$(1)=m$ #w.tb "redraw bak" #w.tb "place 25 80" for n= 1 to 30 #w.tb "\";text$(n) next end sub
sub clock if Status=1 then Whitetime=Whitetime+1 if Status=2 then Blacktime=Blacktime+1 wm=int(Whitetime/60) ws=Whitetime-60*wm wt$=right$("00"+str$(wm),2)+right$("00"+str$(ws),2) bm=int(Blacktime/60) bs=Blacktime-60*bm bt$=right$("00"+str$(bm),2)+right$("00"+str$(bs),2)
for n= 1 to 4 #w.g "spriteimage clock";str$(n);" c";mid$(wt$,n,1) #w.g "spriteimage clock";str$(n+4);" c";mid$(bt$,n,1) next #w.g "drawsprites" if wm>14 or bm>14 then call text "Time limit!" call text "Game ends" wait end if
end sub
sub loadgame f$ 'not all loads are at start of game so for mid game load 'make all sprites visible sl$="br1,bn1,bb1,bq1,bk1,bb2,bn2,br2,bp1,bp2,bp3,bp4,bp5,bp6,bp7,bp8,wp1,wp2,wp3,wp4,wp5,wp6,wp7,wp8,wr1,wn1,wb1,wq1,wk1,wb2,wn2,wr2" n=1 s$=word$(sl$,n,",") while s$<>"" #w.g "spritevisible ";s$;" on" n=n+1 s$=word$(sl$,n,",") wend 'now retrieve saved board open f$ for input as #1 line input #1, AI line input #1, Whitetime line input #1, Blacktime for y=0 to 7 for x=0 to 7 line input #1,bsprite$(x,y) line input #1,bvalue(x,y) line input #1,bsign(x,y) line input #1,bpiece(x,y) line input #1,bsquare$(x,y) next next line input #1,Spriteadded$ line input #1,Spritetaken$ line input #1,old(1) line input #1,old(2) line input #1,old(3) line input #1,old(4) close #1 'add in any new queen sprites and make them visible n=1 a$=word$(Spriteadded$,n,",") while a$<>"" #w.g "addsprite ";a$ #w.g "spritevisible ";a$;" on" n=n+1 a$=word$(Spriteadded$,n,",") wend 'now make all taken sprites invisible n=1 a$=word$(Spritetaken$,n,",") while a$<>"" #w.g "spritevisible ";a$;" off" n=n+1 a$=word$(Spritetaken$,n,",") wend 'save for undo call savegame "undo.gam" end sub
sub savegame f$ open f$ for output as #1 #1, AI #1, Whitetime #1, Blacktime for y=0 to 7 for x=0 to 7 #1,bsprite$(x,y) #1,bvalue(x,y) #1,bsign(x,y) #1,bpiece(x,y) #1,bsquare$(x,y) next next #1,Spriteadded$ #1,Spritetaken$ #1,old(1) #1,old(2) #1,old(3) #1,old(4) close #1 end sub
sub reversegame AI=0-AI for y=0 to 7 for x=0 to 3 sp$=bsprite$(x,y) bv=bvalue(x,y) bs=bsign(x,y) bp=bpiece(x,y) bs$=bsquare$(x,y)
bsprite$(x,y)=bsprite$(7-x,7-y) bvalue(x,y)=bvalue(7-x,7-y) bsign(x,y)=bsign(7-x,7-y) bpiece(x,y)=bpiece(7-x,7-y) bsquare$(x,y)=bsquare$(7-x,7-y)
bsprite$(7-x,7-y)=sp$ bvalue(7-x,7-y)=bv bsign(7-x,7-y)=bs bpiece(7-x,7-y)=bp bsquare$(7-x,7-y)=bs$ next next call showboard end sub
sub quit h$ close #w end end sub
function A1Func$(x,y) A1Func$ = mid$("ABCDEFGH",x+1,1);8-y end function
function sgn$(sgn) if sgn = 1 then sgn$ = "White" else sgn$ = "Black" end function
sub fillA1$ dim A1$(7,7) 'instead of funcion to cut time for x = 0 to 7 for y = 0 to 7 A1$(x,y)=A1Func$(x,y) next next end sub
|
|