uses dos,MyUnit,smfont13,smfont19,smfont21;
const
XField = 25;
YField = 20;
NrMines = 70;
flag : array[1..6,1..6] of byte = (
(0,4,4,4,114,0),(4,40,40,40,114,0),(4,40,40,40,114,0),
(0,4,4,4,114,0),(0,0,0,0,114,0),(0,0,114,114,114,114));
cross : array[1..6,1..6] of byte = (
(42,40,0,0,40,42),(40,42,40,40,42,40),(0,40,42,42,40,0),
(0,40,42,42,40,0),(40,42,40,40,42,40),(42,40,0,0,40,42));
mine : array[1..6,1..6] of byte = (
(0,0,0,0,0,0),(0,0,1,1,0,0),(0,1,32,32,1,0),
(0,1,32,32,1,0),(0,0,1,1,0,0),(0,0,0,0,0,0));
var
MinesMas : array[1..4,1..XField,1..YField] of boolean;
{
1 - opened blocks
2 - flags
3 - mines
4 - virtual cleared fields
}
FNumber : array[1..XField,1..YField] of integer;
flags,time : integer;
oldtime : longint;
back : pointer;
procedure DrawFlag(xfl,yfl : integer);
var
xf,yf : integer;
begin
for xf:=1 to 6 do
for yf:=1 to 6 do
If flag[xf,yf] <> 0 then
Putpixel(xfl+yf,yfl+xf,flag[xf,yf]);
end;
procedure DrawWrongFlag(xfl,yfl : integer);
var
xf,yf : integer;
begin
for xf:=1 to 6 do
for yf:=1 to 6 do
If cross[xf,yf] <> 0 then
Putpixel(xfl+yf,yfl+xf,cross[xf,yf]);
end;
procedure DrawMine(x,y : integer);
var
xf,yf : integer;
begin
for xf:=1 to 6 do
for yf:=1 to 6 do
If mine[xf,yf] <> 0 then
Putpixel(x+yf,y+xf,mine[xf,yf]);
end;
procedure DrawField;
var
xdf,ydf : integer;
begin
for ydf:=1 to (YField*8)+YField do
begin
inc(ydf,8);
for xdf:=1 to (XField*8)+XField do
begin
inc(xdf,8);
box3d(xdf,ydf,xdf+8,ydf+8,false,VGA);
end;
end;
rectangle(7,7,235,190,1);
rectangle(6,6,236,191,32);
rectangle(5,5,237,192,1);
font13('flags',245,20,27,24,21,1,1,2);
box(256,40,310,55,0,vga);font13(int2str(flags),265,40,30,27,24,1,1,2);
box(260,80,310,95,0,VGA);
font13('time',250,60,27,24,21,1,1,2);font13(int2str(time),265,80,30,27,24,1,1,2);
box3d(250,110,300,120,false,VGA);OutTextXY(256,112,30,'NEW',VGA);
box3d(250,125,300,135,false,VGA);OutTextXY(249,127,30,'ABOUT',VGA);
box3d(250,140,300,150,false,VGA);OutTextXY(244,142,30,'ADJUST',VGA);
box3d(250,155,300,165,false,VGA);OutTextXY(252,157,30,'EXIT',VGA);
end;
procedure CheckMine(xe,ye : integer);
var
k : integer;
begin
If MinesMas[3,xe,ye] then exit;
k:=0;
If MinesMas[3,xe-1,ye] and (xe > 1) then inc(k);
If MinesMas[3,xe,ye-1] and (ye > 1) then inc(k);
If MinesMas[3,xe-1,ye-1] and (ye > 1) and (xe > 1) then inc(k);
If MinesMas[3,xe+1,ye] and (xe < Xfield) then inc(k);
If MinesMas[3,xe,ye+1] and (ye < Yfield) then inc(k);
If MinesMas[3,xe+1,ye+1] and (xe < Xfield) and (ye < Yfield) then inc(k);
If MinesMas[3,xe-1,ye+1] and (xe > 1) and (ye < Yfield) then inc(k);
If MinesMas[3,xe+1,ye-1] and (ye > 1) and (xe < Xfield) then inc(k);
FNumber[xe,ye]:=k;
end;
procedure CheckEnd;
var x,y,k : integer;
begin
k:=0;
for x:=1 to XField do
for y:=1 to YField do
If not MinesMas[1,x,y] then inc(k);
If k = NrMines then
begin
HideMouse;
for x:=1 to XField do
for y:=1 to YField do
If not MinesMas[2,x,y] and MinesMas[3,x,y] then
begin
DrawFlag(x*9,y*9);
box(256,40,310,55,0,vga);
font13('0',265,40,30,27,24,1,1,2);
end;
ShowMouse;
repeat
mousebuttons;
If mouse.lbutton and mousein(250,155,300,165) then EXIT;
If (port[$60]=$3C) or (port[$60]=1) then EXIT;
until mouse.lbutton and mousein(250,110,300,120);
end;
end;
procedure Timer;
var
newtime : longint;
h,m,s,hs : word;
begin
GetTime(h,m,s,hs);
newtime:=s;
If (oldtime <> newtime) and (time < 999) then
begin
Inc(time);
box(260,80,310,95,0,VGA);
font13(int2str(time),265,80,30,27,24,1,1,2);
oldtime:=newtime;
end;
end;
procedure NewGame;
var
xm,ym,n : integer;
begin
flags:=NrMines;
time:=0;
for n:=1 to 4 do
for xm:=1 to Xfield do
for ym:=1 to Yfield do
MinesMas[n,xm,ym]:=false;
for xm:=1 to Xfield do
for ym:=1 to Yfield do
FNumber[xm,ym]:=0;
for n:=1 to NrMines do
begin
repeat
xm:=Random(XField+1);
ym:=Random(YField+1);
until not MinesMas[3,xm,ym] and (xm > 0) and (ym > 0);
MinesMas[3,xm,ym]:=true;
end;
for xm:=1 to Xfield do
for ym:=1 to Yfield do
CheckMine(xm,ym);
DrawField;
ShowMouse;
repeat mousebuttons until keypressed or mouse.anybutton;
HideMouse;
end;
procedure ClearEmptyBlocks(xstart,ystart : integer);
var
xm,ym,l,r,u,d,
foundMines : integer;
begin
for xm:=1 to XField do
for ym:=1 to XField do
MinesMas[4,xm,ym]:=false;
MinesMas[4,xstart,ystart]:=true;
repeat
foundMines:=0;
for xm:=1 to XField do
for ym:=1 to YField do
begin
if xm=1 then l:=-1else l:=1;
if xm=XField then r:=-1else r:=1;
if ym=1 then u:=-1else u:=1;
if ym=YField then d:=-1else d:=1;
If not MinesMas[1,xm,ym] and not MinesMas[3,xm,ym] then
If MinesMas[4,xm-l,ym] or MinesMas[4,xm,ym-u] or
MinesMas[4,xm-l,ym-u] or MinesMas[4,xm+r,ym] or
MinesMas[4,xm,ym+d] or MinesMas[4,xm+r,ym+d] or
MinesMas[4,xm+r,ym-u] or MinesMas[4,xm-l,ym+d] then
begin
If not MinesMas[2,xm,ym] then
begin
box3d(xm * 9,ym * 9,(xm * 9)+8,(ym * 9)+8,true,VGA);
MinesMas[1,xm,ym]:=true;
inc(foundMines);
end;
If (FNumber[xm,ym] <> 0) and not MinesMas[2,xm,ym] then
font19((xm*9)+2,(ym*9)+1,FNumber[xm,ym]+9,0,1,int2str(FNumber[xm,ym]))
else MinesMas[4,xm,ym]:=true;
end;
end;
until foundMines=0;
end;
procedure GameOver(x,y : integer);
var
xm,ym : integer;
begin
for xm:=1 to XField do
for ym:=1 to YField do
If MinesMas[3,xm,ym] and not MinesMas[2,xm,ym] then
begin
box3d(xm*9,ym*9,(xm*9)+8,(ym*9)+8,true,vga);
DrawMine((xm*9),ym*9);
end else
If not MinesMas[3,xm,ym] and MinesMas[2,xm,ym] and not MinesMas[1,xm,ym]
then DrawWrongFlag((xm*9)+1,(ym*9)+1);
box(x+1,y+1,x+7,y+7,40,vga);
DrawMine(x,y);
font13('BOOOOM!',30,80,41,40,42,2,2,2);
ShowMouse;
repeat
mousebuttons;
If mouse.lbutton and mousein(250,155,300,165) then EXIT;
If (port[$60]=$3C) or (port[$60]=1) then EXIT;
until mouse.lbutton and mousein(250,110,300,120);
end;
procedure Adjust;
var
k : integer;
OK,CANCEL : boolean;
begin
k:=2;OK:=false;CANCEL:=false;
GetImage(8,8,234,188,back,VGA);
box3d(50,30,150,150,false,VGA);
font19(67,35,4,0,1,'Select Difficultly:');
circle(60,55,3,15);fill(60,55,15);font19(70,52,0,0,1,'Easyest');
circle(60,70,3,15);fill(60,70,15);font19(70,67,0,0,1,'Easy');
circle(60,85,3,15);fill(60,85,15);font19(70,82,0,0,1,'Normal');
circle(60,100,3,15);fill(60,100,15);font19(70,97,0,0,1,'Hard');
circle(60,115,3,15);fill(60,115,15);font19(70,112,0,0,1,'Imposible');
Box(59,69,61,71,0,VGA);
Box3d(60,130,95,140,false,VGA);font19(73,133,0,0,1,'OK');
Box3d(105,130,140,140,false,VGA);font19(108,133,0,0,1,'CANCEL');
repeat
mousebuttons;
If mouse.lbutton and mouseIn(58,53,62,57) then
begin
k:=1;
HideMouse;
circle(60,55,3,15);fill(60,55,15);
circle(60,70,3,15);fill(60,70,15);
circle(60,85,3,15);fill(60,85,15);
circle(60,100,3,15);fill(60,100,15);
circle(60,115,3,15);fill(60,115,15);
Box(59,54,61,56,0,VGA);
ShowMouse;
end;
If mouse.lbutton and mouseIn(58,68,62,72) then
begin
k:=1;
HideMouse;
circle(60,55,3,15);fill(60,55,15);
circle(60,70,3,15);fill(60,70,15);
circle(60,85,3,15);fill(60,85,15);
circle(60,100,3,15);fill(60,100,15);
circle(60,115,3,15);fill(60,115,15);
Box(59,69,61,71,0,VGA);
ShowMouse;
end;
If mouse.lbutton and mouseIn(58,82,62,84) then
begin
k:=1;
HideMouse;
circle(60,55,3,15);fill(60,55,15);
circle(60,70,3,15);fill(60,70,15);
circle(60,85,3,15);fill(60,85,15);
circle(60,100,3,15);fill(60,100,15);
circle(60,115,3,15);fill(60,115,15);
Box(59,84,61,86,0,VGA);
ShowMouse;
end;
If mouse.lbutton and mouseIn(58,98,62,102) then
begin
k:=1;
HideMouse;
circle(60,55,3,15);fill(60,55,15);
circle(60,70,3,15);fill(60,70,15);
circle(60,85,3,15);fill(60,85,15);
circle(60,100,3,15);fill(60,100,15);
circle(60,115,3,15);fill(60,115,15);
Box(59,99,61,101,0,VGA);
ShowMouse;
end;
If mouse.lbutton and mouseIn(58,113,62,117) then
begin
k:=1;
HideMouse;
circle(60,55,3,15);fill(60,55,15);
circle(60,70,3,15);fill(60,70,15);
circle(60,85,3,15);fill(60,85,15);
circle(60,100,3,15);fill(60,100,15);
circle(60,115,3,15);fill(60,115,15);
Box(59,114,61,116,0,VGA);
ShowMouse;
end;
If mouse.lbutton and mouseIn(60,130,95,140) then
begin
HideMouse;
Box3d(60,130,95,140,true,VGA);font19(73,133,0,0,1,'OK');
ShowMouse;
repeat mousebuttons until not mouse.lbutton;
If mouseIn(60,130,95,140) then OK:=true;
HideMouse;
Box3d(60,130,95,140,false,VGA);font19(73,133,0,0,1,'OK');
ShowMouse;
end;
If mouse.lbutton and mouseIn(105,130,140,140) then
begin
HideMouse;
Box3d(105,130,140,140,true,VGA);font19(108,133,0,0,1,'CANCEL');
ShowMouse;
repeat mousebuttons until not mouse.lbutton;
If mouseIn(105,130,140,140) then CANCEL:=true;
HideMouse;
Box3d(105,130,140,140,false,VGA);font19(108,133,0,0,1,'CANCEL');
ShowMouse;
end;
until OK or CANCEL or (Port[$60]=1);
HideMouse;
PutImage(8,8,back);
ShowMouse;
end;
procedure About;
begin
HideMouse;
GetImage(8,8,234,188,back,VGA);
box3d(50,50,200,150,false,VGA);
font21('MineField 1.0',63,55,4,4,1,2,40,5);
font19(75,75,14,0,1,'by Dimitar Todorov Dimitrov');
font19(60,85,14,0,1,'Copyright MitkoSoft(R) Sofia,Bulgaria');
font19(60,95,1,0,1,'this game is freeware only for YOU');
font19(85,105,4,0,1,'e-mail:no-reply@test.com');
font19(60,115,4,0,1,'web-page:www.web.tripod.com');
font19(65,135,2,0,2,'TELL ME IF YOU LIKE IT!!!');
repeat mousebuttons; until mouse.anybutton or keypressed;
PutImage(8,8,back);
ShowMouse;
end;
procedure Play;
begin
NewGame;
ShowMouse;
repeat
mousebuttons;Timer;
If (mouse.lbutton) and mouseIn(9,7,(XField*9)+8,(YField*9)+6) then
If not MinesMas[1,(MouseX) div 9,(MouseY+2) div 9] then
If not MinesMas[2,(MouseX) div 9,(MouseY+2) div 9] then
begin
HideMouse;
box3d((((MouseX) div 9) * 9),(((MouseY+2) div 9) * 9),
(((MouseX) div 9) * 9)+8,(((MouseY+2) div 9) * 9)+8,true,VGA);
If (FNumber[(MouseX) div 9,(MouseY+2) div 9] = 0) and
not MinesMas[3,(MouseX) div 9,(MouseY+2) div 9] then
ClearEmptyBlocks((MouseX) div 9,(MouseY+2) div 9);
If MinesMas[3,(MouseX) div 9,(MouseY+2) div 9] then
GameOver((((MouseX) div 9) * 9),(((MouseY+2) div 9) * 9));
If FNumber[(MouseX) div 9,(MouseY+2) div 9] <> 0 then
font19((((MouseX) div 9)*9)+2,(((MouseY+2) div 9)*9)+1,
FNumber[(MouseX) div 9,(MouseY+2) div 9]+9,0,1,
int2str(FNumber[(MouseX) div 9,(MouseY+2) div 9]));
ShowMouse;
MinesMas[1,(MouseX) div 9,(MouseY+2) div 9]:=true;
CheckEnd;
end;
If (mouse.rbutton) and mouseIn(9,7,(XField*9)+8,(YField*9)+6) then
If not MinesMas[1,(MouseX) div 9,(MouseY+2) div 9] then
If not MinesMas[2,(MouseX) div 9,(MouseY+2) div 9] then
begin
HideMouse;
Drawflag(((MouseX) div 9) * 9,((MouseY+2) div 9) * 9);
dec(flags);
if flags > -99 then
begin
box(256,40,310,55,0,vga);
font13(int2str(flags),265,40,30,27,24,1,1,2);
end;
ShowMouse;
MinesMas[2,(MouseX) div 9,(MouseY+2) div 9]:=true;
repeat Mousebuttons;timer until not mouse.rbutton;
end else
begin
HideMouse;
MinesMas[2,(MouseX) div 9,(MouseY+2) div 9]:=false;
box3d((((MouseX) div 9) * 9),(((MouseY+2) div 9) * 9),
(((MouseX) div 9) * 9)+8,(((MouseY+2) div 9) * 9)+8,false,VGA);
inc(flags);
if flags > -99 then
begin
box(256,40,310,55,0,vga);
font13(int2str(flags),265,40,30,27,24,1,1,2);
end;
ShowMouse;
repeat Mousebuttons; timer until not mouse.rbutton;
end;
If (mouse.lbutton) and mouseIn(250,110,300,120) then
begin
HideMouse;
box3d(250,110,300,120,true,VGA);OutTextXY(256,112,22,'NEW',VGA);
ShowMouse;
repeat mousebuttons; timer; until not mouse.lbutton;
HideMouse;
box3d(250,110,300,120,false,VGA);OutTextXY(256,112,30,'NEW',VGA);
NewGame;
ShowMouse;
end;
If (mouse.lbutton) and mouseIn(250,125,300,135) then
begin
HideMouse;
box3d(250,125,300,135,true,VGA);OutTextXY(249,127,22,'ABOUT',VGA);
ShowMouse;
repeat mousebuttons; timer; until not mouse.lbutton;
HideMouse;
box3d(250,125,300,135,false,VGA);OutTextXY(249,127,30,'ABOUT',VGA);
about;
ShowMouse;
end;
If (mouse.lbutton) and mouseIn(250,140,300,150) then
begin
HideMouse;
box3d(250,140,300,150,true,VGA);OutTextXY(244,142,22,'ADJUST',VGA);
ShowMouse;
repeat mousebuttons; timer; until not mouse.lbutton;
adjust;
HideMouse;
box3d(250,140,300,150,false,VGA);OutTextXY(244,142,30,'ADJUST',VGA);
ShowMouse;
end;
If (mouse.lbutton) and mouseIn(250,155,300,165) then
begin
HideMouse;
box3d(250,155,300,165,true,VGA);OutTextXY(252,157,22,'EXIT',VGA);
ShowMouse;
repeat mousebuttons; timer; until not mouse.lbutton;
HideMouse;
box3d(250,155,300,165,false,VGA);OutTextXY(252,157,30,'EXIT',VGA);
CloseGraph;
HALT(0);
ShowMouse;
end;
If Port[$60]=$3C then
begin
HideMouse;
NewGame;
ShowMouse;
end;
until Port[$60]=1;
end;
begin
InitGraph;
InitMouse;
Randomize;
Play;
CloseGraph;
end.
************AAAAAAh, my first mine field, I`m glad I`v made it**************
****************MineField for DOS by Dimitar Dimitrov***********************
*************Copyright MitkoSoft(c) 2000 Sofia Bulgaria********************