Pascal MineField Game Code Library

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:=-1 else l:=1;
        if  xm=XField then r:=-1 else r:=1;
        if  ym=1 then u:=-1 else u:=1;
        if  ym=YField then d:=-1 else 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:PxL@mail.bg');
   font19(60,115,4,0,1,'web-page:www.mitkophilia.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********************