Still intend working on your chess program. For me playing with the chess program was learning how they did it and writing one would have been more about showing myself I understood how they did it.
As a hobby programmer I see it more of an exercise in puzzle solving.
This is more like I might have tackled the Four In A Row game using the fb graphics to roll my own GUI.
I haven't tested it enough to iron out all the bugs but it sort of works. The only AI however is to block a potential four in a row or make a four in a row for a win. Otherwise its moves are random without any strategy or analysis of the game state.
Code: Select all
screenres 406,480,32
color rgb(124,252,0),rgb(72,61,139) 'lime green ink, purple paper
cls 'executes colors
'GLOBAL VARIABLES
dim shared as integer mx,my,mb 'mouse variables
dim shared as integer board(7,6)
dim shared as integer selection,player,winPosition,win
dim shared as string key
sub clearBoard()
for j as integer = 0 to 5
for i as integer = 0 to 6
board(i,j)= 0
next i
next j
end sub
const TLX = 10 'displacement on screen
const TLY = 100
type vector
x as integer
y as integer
end type
dim shared as vector moves(7)
for i as integer = 0 to 6
moves(i).x = i
moves(i).y = 5
next i
sub drawBoard()
for j as integer = 0 to 5
for i as integer = 0 to 6
if board(i,j)=0 then
circle (i*48+48+TLX,j*48+48+TLY),18,rgb(106,90,205),,,,f
end if
if board(i,j)=1 then
circle (i*48+48+TLX,j*48+48+TLY),18,rgb(255,69,0),,,,f
end if
if board(i,j)=-1 then
circle (i*48+48+TLX,j*48+48+TLY),18,rgb(255,204,0),,,,f
end if
next i
next j
'draw ribbon top/bottom
line (0,0)-(405,49),rgb(44,76,76),bf
line (0,430)-(405,479),rgb(44,76,76),bf
'draw select buttons
for i as integer = 0 to 6
line (i*48+TLX+30,336+TLY)-(i*48+19+30+TLX+18,336+18+TLY),rgb(57,89,89),bf
next i
draw string (TLX+40,442)," A B C D E F G"
'draw label
line (40,22)-(364,50),rgb(57,89,89),bf
if player = 1 then
draw string (50,34)," White to Move "
end if
if player = -1 then
draw string (50,34)," Black to Move "
end if
end sub
function findWin(player as integer) as integer
dim as integer win 'flag four in a row found
dim as integer pieceCount 'count pieces in row
pieceCount = 0
win = 0
for i as integer = 0 to 6
for k as integer = 0 to 2
pieceCount = 0
for j as integer = k to k+3
if board(i,j)=player then
pieceCount = pieceCount + 1
end if
next j
if pieceCount = 4 then
win = 1
end if
next k
next i
for j as integer = 0 to 5
for k as integer = 0 to 3
pieceCount = 0
for i as integer = k to k+3
if board(i,j)=player then
pieceCount = pieceCount + 1
end if
next i
if pieceCount = 4 then
win = 1
end if
next k
next j
for j as integer = 3 to 5
for k as integer = 0 to 3
pieceCount = 0
for i as integer = 0 to 3
if board(i+k,j-i)=player then
pieceCount = pieceCount + 1
end if
next i
if pieceCount = 4 then
win = 1
end if
next k
next j
for j as integer = 0 to 2
for k as integer = 0 to 3
pieceCount = 0
for i as integer = 0 to 3
if board(i+k,j+i)=player then
pieceCount = pieceCount + 1
end if
next i
if pieceCount = 4 then
win = 1
end if
next k
next j
return win
end function
sub playerMove()
selection = -1
while selection = -1
getmouse mx,my,,mb
while mb<>1
getmouse mx,my,,mb
wend
if mx>40 and mx<367 and my>435 and my<454 then
selection = ((mx-40)\48)
end if
while mb=1
getmouse mx,my,,mb
wend
wend
'if move exists make move and swap players
if moves(selection).y <>-1 then
'animated drop
for y as integer = 0 to moves(selection).y
board(moves(selection).x,y)=player
drawBoard()
sleep 100
board(moves(selection).x,y)=0
drawBoard()
sleep 10
next y
board(moves(selection).x,moves(selection).y)=player 'insert player piece
moves(selection).y = moves(selection).y-1
'winning move?
win = findWin(player)
end if
end sub
sub computerMove()
dim as integer block 'flag block move
selection = -1 'no move found
'try each valid move for win
for i as integer = 0 to 6
if moves(i).y<>-1 then
'make move
board(moves(i).x,moves(i).y)=player
win = findWin(player) 'result in win?
'score move
if win = 1 then
selection = i
end if
'undo move
board(moves(i).x,moves(i).y)=0
end if
next i
if selection = -1 then
'try each valid move for block
for i as integer = 0 to 6
if moves(i).y<>-1 then
'make move
board(moves(i).x,moves(i).y)= -player
block = findWin(-player) 'result in block?
'score move
if block = 1 then
selection = i
end if
'undo move
board(moves(i).x,moves(i).y)=0
end if
next i
end if
'if no move found make a random move
if selection = -1 then
selection = int(Rnd(1)*7)
end if
'make move
'animated drop
for y as integer = 0 to moves(selection).y
board(moves(selection).x,y)=player
drawBoard()
sleep 100
board(moves(selection).x,y)=0
drawBoard()
sleep 10
next y
board(moves(selection).x,moves(selection).y)=player
moves(selection).y = moves(selection).y-1
win = findWin(player) 'was that a winning move?
end sub
clearBoard()
drawBoard()
randomize timer
player = 1
do
player = -player 'swap players
drawBoard()
if winPosition = 0 then
if player = 1 then
playerMove()
else
computerMove()
end if
end if
drawBoard()
loop until key=chr(27) or win = 1
'draw label
line (40,22)-(364,50),rgb(57,89,89),bf
if player = 1 then
draw string (50,34)," ORANGE WON "
end if
if player = -1 then
draw string (50,34)," YELLOW WON "
end if
sleep