masquerader
2006-12-03 21:42:35
after hearing that wallfire had made one that would actually solve minesweeper back at kaitnieks, i decided to try my hand at this puzzle
it works 100% as long as it doesnt have to guess
i coded it in under 2 hours, but i think the logic is solid
if it says guessing, thats bad, because it just picks a random unknown square
anyway, it is under 200 lines and solves the beginner level in 5 seconds on my computer :)
i have to say i am pretty proud of it
it works 100% as long as it doesnt have to guess
i coded it in under 2 hours, but i think the logic is solid
if it says guessing, thats bad, because it just picks a random unknown square
anyway, it is under 200 lines and solves the beginner level in 5 seconds on my computer :)
i have to say i am pretty proud of it
program minesweep;
//by masquerader
//built for xp minesweeper
//for best results, run after youve clicked a couple times to open the board up a bit
const
boardwidth=9;
boardheight=9;
{ Beginner: 9 × 9
Intermediate: 16 × 16
Expert: 30 × 16 }
var
board: array[0..boardwidth-1] of array[0..boardheight-1] of integer;
w,h,winbmp,losebmp:integer;
function win:boolean;
var
x,y:integer;
begin
result:=findbitmap(winbmp,x,y);
end;
function lose:boolean;
var
x,y:integer;
begin
result:=findbitmap(losebmp,x,y);
end;
procedure getboard;
var
i,j,x,y,x1,y1:integer;
begin
for i:=0 to w do
begin
for j:=0 to h do
begin
x1:=16*i+15;
y1:=16*j+105;
if(findcolor(x,y,0,x1,y1,x1+15,y1+8))then
begin
if(findcolor(x,y,255,x1,y1,x1+15,y1+8))then
board[i][j]:=99
else
board[i][j]:=7;
end else
if(findcolor(x,y,16777215,x1,y1,x1+15,y1+8))then
board[i][j]:=-1
else
if(findcolor(x,y,16711680,x1,y1,x1+15,y1+8))then
begin
board[i][j]:=1
end else
if(findcolor(x,y,32768,x1,y1,x1+15,y1+8))then
board[i][j]:=2
else
if(findcolor(x,y,255,x1,y1,x1+15,y1+8))then
board[i][j]:=3
else
if(findcolor(x,y,8388608,x1,y1,x1+15,y1+5))then
board[i][j]:=4
else
if(findcolor(x,y,128,x1,y1,x1+15,y1+5))then
board[i][j]:=5
else
if(findcolor(x,y,8421376,x1,y1,x1+15,y1+5))then
board[i][j]:=6
else
if(findcolor(x,y,8421504,x1,y1,x1+15,y1+5))then
board[i][j]:=8
else
board[i][j]:=0;
end;
end;
end;
procedure guess;
var
i,j,l:integer;
unknowncoords:tpointarray;
begin
writeln('guessing...');
for j:=0 to h do
for i:=0 to w do
begin
if(board[i][j]=-1)then
begin
l:=l+1;
setarraylength(unknowncoords,l);
unknowncoords[l-1].x:=i;
unknowncoords[l-1].y:=j;
end;
end;
i:=random(l);
clickmouse(16*unknowncoords[i].x+20,16*unknowncoords[i].y+110,true)
getboard;
end;
function check(number:integer):boolean;
var
checkx,checky,i,j,c,x,y,unknown,bombs:integer;
unknowncoords:tpointarray;
begin
for j:=0 to h do
for i:=0 to w do
begin
if(board[i][j]=number)then
begin
unknown:=0;
bombs:=0;
setarraylength(unknowncoords,0)
for x:=-1 to 1 do
for y:=-1 to 1 do
begin
checkx:=i+x;
checky:=j+y;
if((checkx>-1)and(checkx<w+1)and(checky>-1)and(checky<h+1))then
begin
if(board[checkx][checky]=99)then
bombs:=bombs+1
else
if(board[checkx][checky]=-1)then
begin
setarraylength(unknowncoords,unknown+1)
unknowncoords[unknown].x:=checkx;
unknowncoords[unknown].y:=checky;
unknown:=unknown+1;
end;
end;
end
if(unknown+bombs=number)then
begin
for c:=0 to unknown-1 do
begin
clickmouse(16*unknowncoords[c].x+20,16*unknowncoords[c].y+110,false);
board[unknowncoords[c].x][unknowncoords[c].y]:=99;
result:=true;
end;
end;
if(bombs=number)then
begin
for c:=0 to unknown-1 do
begin
clickmouse(16*unknowncoords[c].x+20,16*unknowncoords[c].y+110,true);
getboard;
result:=true;
end;
end;
end;
end;
end;
begin
activateclient;
wait(100);
winbmp:= BitmapFromString(17, 17, 'z78DA7336702608F103670A203270' +
'0302DC2479361263327E1B69673E317651CB7CFC7661DA421EC06' +
'50BA9E613AF065325B2087E738897C5A512D90D16406840203D23' +
'03887AFC6142DD78C71F62B4B3057F4A263EEF939792494D75F4C' +
'F9BB42E67C82B33695726D3A27E0100AF9A822C');
losebmp:= BitmapFromString(17, 17, 'z78DA7336702608F103670A203270' +
'0302DC2479361263327E1B69673E3176619A8F2C82CB76FC6A30E' +
'D22C61CFC2EC7EF23F2DC49AA1A6AC505312970E4D8821F109FAA' +
'699DC688C92FC4870C797973709633E49599B42B936951BF0000D' +
'9168AA4');
w:=boardwidth-1;
h:=boardheight-1;
getboard;
repeat
repeat
repeat
repeat
repeat
repeat
repeat
repeat
until(not(check(1)));
until(not(check(2)));
until(not(check(3)));
until(not(check(4)));
until(not(check(5)));
until(not(check(6)));
until(not(check(7)));
if(win)then
begin
writeln('yay, we win');
terminatescript;
end;
guess;
until(lose)
writeln('oh no, we lost');
end.
