Localize file www.TrSek.com/cover/draco/mines2.pas

{ MINES2.PAS                               Copyright (c) Soul-Draco }
{                                                                   }
{ Mines v 1.0                                                       }
{ ===========                                                       }
{ Created by soul_draco www.soul-draco.tk                           }
{ Program na hratie min simulujuce Mines z Windows.                 }
{                                                                   }
{ Datum:02.06.2005                             http://www.trsek.com }

uses crt,graph,mouse;

const mines = 200; { pocet min v poli }
      width = 42; { sirka pole ( v polickach ) max 42 }
      height = 32; { sirka pole ( v polickach ) max 32 }
      size = 15; { strana policka }

type tfield = record
  content : shortint; { policko, jak je ve skutecnosti }
  visible : shortint; { policko, jak ho hrac vidi }
  onscreen : shortint; { policko, jak je vykreslene }
end;

var gd,gm,i,j : integer;
    ch : char;
    field : array[-2..43,-2..33] of tfield;
    { hodnoty ve field :
      0 - nezname policko
      1 - 8 - cislice znacici pocet prilehlych min
      9 - mina
      10 - praporek
      11 - prazdne policko }

{ inicializuje grafiku, generator nahodnych cisel a mys }
procedure init;
var gd,gm : integer;
begin
randomize;
gd:=detect;
initgraph(gd,gm,'');
limitmousex(0,639);
limitmousey(0,479);
end;

{ ***************************************************************************
                                 Prace s polem
*************************************************************************** }

{ spocita miny prilehle k policku[x,y]. pokud je policko samo mina, vrati 9 }
function countadjacentmines(x,y : integer) : shortint;
var i,j,counter : integer;
begin
counter:=0;
if (field[x,y].content = 9) then begin
  countadjacentmines:=9;
  exit;
end;
for j:=(y - 1) to (y + 1) do for i:=(x - 1) to (x + 1) do
if (field[i,j].content = 9) then inc(counter);
if (counter = 0) then counter:=11;
countadjacentmines:=counter;
end;

{ odhali vsechna policka prilehla k policku[x,y]
  pokud jsou jiz vsechna odhalena, vrati false }
function showadjancedfields(x,y : integer) : boolean;
var i,j : integer;
    b : boolean;
begin
b:=false;
for j:=(y - 1) to (y + 1) do for i:=(x - 1) to (x + 1) do
if (field[i,j].visible <> field[i,j].content) then begin
  field[i,j].visible:=field[i,j].content;
  b:=true;
end;
showadjancedfields:=b;
end;

{ vygeneruje nove pole }
procedure generatefield;
var i,j : integer;
begin
{ ********************* vyprazdneni pole onscreen ************************* }
for j:=-1 to height do for i:=-1 to width do
field[i,j].onscreen:=99; { nesmysl - musi prekreslit }
{ *********************** generovani pole VISIBLE ************************* }
{ vyplneni celeho pole neznamymy policky }
for j:=-1 to height do for i:=-1 to width do
field[i,j].visible:=0;
{ *********************** generovani pole CONTENT ************************* }
{ vyplneni celeho pole prazdnymi policky }
for j:=-1 to height do for i:=-1 to width do field[i,j].content:=11;
{ vygenerovani min . . . potom predelat, aby nesly pres sebe }
for i:=0 to (mines - 1) do
field[random(width),random(height)].content:=9;
{ vygenerovani cislic oznacujicich pocet min }
for j:=-1 to height do for i:=-1 to width do
field[i,j].content:=countadjacentmines(i,j);
end;

{ projede pole a okolo kazdeho prazdneho policka odkryje prilehla policka }
procedure a;
var i,j : integer;
    b : boolean;
begin
b:=false;
for j:=-1 to height do for i:=-1 to width do
if (field[i,j].visible = 11) then begin
  if showadjancedfields(i,j) then a;
end;
end;

{ ***************************************************************************
                       Vykresleni jednotlivych policek
*************************************************************************** }

procedure drawunknown(x,y : integer);
begin
setcolor(white);
line(x,y,x + (size - 1),y);
line(x,y,x,y + (size - 1));
line(x,y + 1,x + (size - 1) - 1,y + 1);
line(x + 1,y,x + 1,y + (size - 1) - 1);
setcolor(darkgray);
line(x + (size - 1),y,x + (size - 1),y + (size - 1));
line(x,y + (size - 1),x + (size - 1),y + (size - 1));
line(x + (size - 1) - 1,y + 1,x + (size - 1) - 1,y + (size - 1));
line(x + 1,y + (size - 1) - 1,x + (size - 1) - 1,y + (size - 1) - 1);
setfillstyle(1,lightgray);
bar(x + 2,y + 2,x + (size - 1) - 2,y + (size - 1) - 2);
end;

procedure drawempty(x,y : integer);
begin
setfillstyle(1,lightgray);
bar(x + 1,y + 1,x + (size - 1),y + (size - 1));
setcolor(darkgray);
line(x,y,x + (size - 1),y);
line(x,y,x,y + (size - 1));
end;

procedure drawmine(x,y : integer);
begin
drawempty(x - 7,y - 7);
setcolor(black);
setfillstyle(1,black);
fillellipse(x,y,3,3);
line(x - 3,y - 3,x + 3,y + 3);
line(x - 3,y + 3,x + 3,y - 3);
line(x - 5,y,x + 5,y);
line(x,y - 5,x,y + 5);
setcolor(white);
rectangle(x - 1,y - 1,x,y);
end;

procedure drawflag(x,y : integer);
begin
setcolor(black);
line(x + 6,y + 9,x + 8,y + 9);
line(x + 5,y + 10,x + 9,y + 10);
line(x + 7,y + 2,x + 7,y + 8);
setcolor(red);
line(x + 3,y + 4,x + 7,y + 2);
line(x + 3,y + 4,x + 7,y + 5);
line(x + 3,y + 4,x + 7,y + 4);
line(x + 4,y + 3,x + 7,y + 3);
end;

{ vypise ciselo oznacujucich pocet prilehlych min }
procedure drawnumber(x,y,number : integer);
var s : string;
begin
drawempty(x,y);
case number of
  1 : setcolor(blue);
  2 : setcolor(green);
  3 : setcolor(lightred);
  4 : setcolor(blue);
  5 : setcolor(lightred);
  6 : setcolor(cyan);
  7 : setcolor(blue);
  8 : setcolor(blue);
end;
str(number,s);
outtextxy(x + 4,y + 4,s);
end;

{ vrati x souradnici policka, na kterem je mys }
function getmousex : integer;
begin
getmousex:=mousex div size;
end;

{ vrati y souradnici policka, na kterem je mys }
function getmousey : integer;
begin
getmousey:=mousey div size;
end;

procedure redrawfield;
var i,j : integer;
begin
setmousecursor(vypnuto);
for j:=0 to (height - 1) do for i:=0 to (width - 1) do
{ zjisteni, zda je policko potreba prekreslit }
if (field[i,j].visible <> field[i,j].onscreen) then begin
   case field[i,j].visible of
    0 : drawunknown(i * size,j * size);
    1 : drawnumber(i * size,j * size,1);
    2 : drawnumber(i * size,j * size,2);
    3 : drawnumber(i * size,j * size,3);
    4 : drawnumber(i * size,j * size,4);
    5 : drawnumber(i * size,j * size,5);
    6 : drawnumber(i * size,j * size,6);
    7 : drawnumber(i * size,j * size,7);
    8 : drawnumber(i * size,j * size,8);
    9 : drawmine((i * size) + (size div 2),(j * size) + (size div 2));
    10 : drawflag(i * size,j * size);
    11 : drawempty(i * size,j * size);
   end;
   field[i,j].onscreen:=field[i,j].visible;
  end;
setmousecursor(zapnuto);
end;

procedure win;
var x,y,sizex,sizey : integer;
begin
x:=200;
y:=200;
sizex:=220;
sizey:=50;
setcolor(white);
line(x,y,x + (sizex - 1),y);
line(x,y,x,y + (sizey - 1));
line(x,y + 1,x + (sizex - 1) - 1,y + 1);
line(x + 1,y,x + 1,y + (sizey - 1) - 1);
setcolor(darkgray);
line(x + (sizex - 1),y,x + (sizex - 1),y + (sizey - 1));
line(x,y + (sizey - 1),x + (sizex - 1),y + (sizey - 1));
line(x + (sizex - 1) - 1,y + 1,x + (sizex - 1) - 1,y + (sizey - 1));
line(x + 1,y + (sizey - 1) - 1,x + (sizex - 1) - 1,y + (sizey - 1) - 1);
setfillstyle(1,lightgray);
bar(x + 2,y + 2,x + (sizex - 1) - 2,y + (sizey - 1) - 2);
setcolor(black);
outtextxy(x + 55,y + 10,'!! YOU WON !!');
outtextxy(x + 10,y + 30,'press any key to continue');
readkey;
ch:=#13;
end;

procedure checkfield;
var i,j,counter : integer;
begin
counter:=0;
for j:=0 to height - 1 do for i:=0 to width - 1 do begin
  if (field[i,j].content <> field[i,j].visible) then inc(counter);
  if (field[i,j].content = 9) and (field[i,j].visible = 10) then dec(counter);
end;
if (counter = 0) then win;
end;

{ odhali vsechny miny a zepta se na pokracovani }
procedure gameover;
var i,j : integer;
begin
for j:=-1 to height do for i:=-1 to width do
if (field[i,j].content = 9) then begin
  field[i,j].visible:=9;
end;
redrawfield;
readkey;
ch:=#13;
end;

begin
init;
generatefield;
redrawfield;
setmousecursor(zapnuto);
repeat
  ch:=#0;
  { pri kliknuti }
  if mousebut(1) then begin
   { odhaleni policka }
   field[getmousex,getmousey].visible:=field[getmousex,getmousey].content;
   if (field[getmousex,getmousey].visible = 9) then gameover;
   {}
   a;
   redrawfield;
   checkfield;
  end;
  if mousebut(2) then begin
   { odhaleni policka }
   if (field[getmousex,getmousey].visible = 0) then
   field[getmousex,getmousey].visible:=10 else
   if (field[getmousex,getmousey].visible = 10) then
   field[getmousex,getmousey].visible:=0;
   {}
   a;
   redrawfield;
   checkfield;
   delay(200);
  end;
  if keypressed then ch:=readkey;
  if ch = #13 then begin
   generatefield;
   redrawfield;
  end;
until ch = #27;
setmousecursor(vypnuto);
closegraph;
end.

Copyrigth by Zdeno Sekerak 2007, http://www.trsek.com