Miny z Windows v pascale

{ MINY.PAS                  Copyright (c) TrSek alias Zdeno Sekerak }
{ Znama hra z OS Windows kde mate za ulohu hladat miny.             }
{ Program ukazuje iba pocet min v okoli policka smer musite urcit.  }
{                                                                   }
{ Datum:28.05.1996                            http://www.trsek.com  }
 
program dos_miny;
uses crt,dos;
 
const
      UP   = 0;
      LEFT = 0;
      DLZ_X=15;
      DLZ_Y=22;
      POC_MIN=30;
 
      CPODKL= Blue;
      CTEXT = Yellow;
      CMINY = LightRed;
      CBODY = LightGray;
 
var miny:array[0..DLZ_X+1,0..DLZ_Y+1] of boolean;
         { false-nieje mina, true-mina }
    vminy:array[1..DLZ_X,1..DLZ_Y] of byte;
         { 0-zakryte, 1-odkryte, 2-mina oznacena }
    x,y:integer;
    but:integer;
    odkr :integer;
    oznac:integer;
    finish:boolean;
    omode:integer;
 
 
{ vypise na suradnice x,y text }
procedure WriteXY(x,y:byte;txt:string);
begin
  GotoXY(x,y);
  Write(txt);
end;
 
 
{ vypne/zapne kurzor }
procedure KurzorZap(ZapVyp:boolean);
var Regs : Registers;
begin
  with Regs do
  begin
    AH := $03;
    BH := $00;
    Intr($10,Regs);
    If not(Zapvyp) then
       CH := CH or $20
    else
       CH := CH and $DF;
 
    AH := $01;
    Intr($10,Regs);
  end;
end;
 
 
{ zinicializuje ovladac mysi }
function mys_init:boolean;
var reg:registers;
begin
  reg.ax:=$0000;
  intr($33,reg);
  if reg.ax=$0000 then mys_init:=false
                  else mys_init:=true;
{ but:=reg.bx;}
end;
 
 
{ zobrazi kurzor mysi}
procedure mys_view;
var reg:registers;
begin
  reg.ax:=$0001;
  intr($33,reg);
end;
 
 
{ zistuje stav tlacidiel a polohu mysi }
procedure mys_get(var x,y,but:integer);
var reg:registers;
begin
  reg.ax:=$0003;
  intr($33,reg);
  x:=(Integer(reg.cx)-8*LEFT) div 32;
  y:=(Integer(reg.dx)-8*UP) div 16;
  but:=reg.bx;
end;
 
 
{ do policka vpise cislo, alebo text }
procedure PolXY(x,y:integer);
begin
  GotoXY(LEFT+4*x+1,UP+2*y+1);
end;
 
 
{ zobrazi siet }
procedure siet(dx,dy:byte);
var x,y:byte;
    l,r:char;
    str:string;
begin
  dy:=dy+1;
  TextColor(CTEXT);
  TextBackGround(CPODKL);
 
  for y:=1 to dy do
   for x:=1 to dx do
   begin
     l:='Ĺ'; str:='ÄÄÄ'; r:=' ';
 
     { horna, dolna lista }
     if(y=1) then str:='ÄÄÄ';
     if(y=1) then l:='Â';
     if(y=dy)then l:='Á';
 
     { lavy, pravy okraj }
     if(x=1) then l:='Ă';
     if(x=dx)then r:='´';
 
     { rohy }
     if(x=1) and (y=1) then l:='Ú';
     if(x=1) and (y=dy)then l:='Ŕ';
     if(x=dx)and (y=1) then r:='ż';
     if(x=dx)and (y=dy)then r:='Ů';
 
     WriteXY(LEFT+4*x,UP+2*y,l+str+r);
 
     { vypln }
     if(y<>dy)then
       WriteXY(LEFT+4*x,UP+2*y+1,'ł°ą°ł');
   end;
end;
 
 
{ menu napravo }
procedure menu;
begin
  TextColor(CTEXT);
  WriteXY(68,UP+3,'  MINY DOS  ');
  WriteXY(68,UP+5,'Najst   :');
  WriteXY(68,UP+6,'Oznacene:');
  WriteXY(68,UP+7,'Nezname :');
  WriteXY(44,Hi(WindMax),'Software by TrSek (c), www.trsek.com');
end;
 
 
{ rozmienstni miny }
procedure Rozmiestni(poc:integer);
var x,y,i:integer;
begin
  Randomize;
  odkr:=DLZ_X*DLZ_Y-poc;
 
  { najprv vsetko zmazem }
  for x:=0 to DLZ_X+1 do
    for y:=0 to DLZ_Y+1 do
      miny[x,y]:=false;
 
  { zmazem policka oznacenych }
  for x:=1 to DLZ_X do
    for y:=1 to DLZ_Y do
      vminy[x,y]:=0;
 
  for i:=1 to poc do begin
    { vygeneruj suradnice }
    x:=Random(DLZ_X)+1;
    y:=Random(DLZ_Y)+1;
 
    { najdi ine miesto ak je obsadene }
    while(miny[x,y])do begin
      x:=x+1;
      if(x>DLZ_X)then y:=y+1;
      if(x>DLZ_X)then x:=1;
      if(y>DLZ_Y)then y:=1;
    end;
 
    { tu bude mina }
    miny[x,y]:=true;
  end;
end;
 
 
{ zisti ci je v povolenom rozsahu }
function Rozsah(x,y:integer):boolean;
begin
  Rozsah:=true;
 
  if(x<1)then Rozsah:=false;
  if(y<1)then Rozsah:=false;
  if(x>DLZ_X)then Rozsah:=false;
  if(y>DLZ_Y)then Rozsah:=false;
end;
 
 
{ spocita kolko min je okolo }
function Body(x,y:integer):byte;
var kol:byte;
begin
  kol:=0;
 
  { otestuje miny okolo }
  if(miny[x-1,y-1])then inc(kol);
  if(miny[x-1,y  ])then inc(kol);
  if(miny[x-1,y+1])then inc(kol);
  if(miny[x  ,y-1])then inc(kol);
  if(miny[x  ,y+1])then inc(kol);
  if(miny[x+1,y-1])then inc(kol);
  if(miny[x+1,y  ])then inc(kol);
  if(miny[x+1,y+1])then inc(kol);
 
  Body:=kol;
end;
 
 
{ ukaze kolko je okolo min }
procedure UkazBody(x,y:integer);
var kol:integer;
begin
 
 if(Rozsah(x,y) and (vminy[x,y]<>1))then
  begin
    { ak to bola oznacena mina }
    if(vminy[x,y]=2)then
       oznac:=oznac-1;
 
    { pocet min okolo }
    kol :=Body(x,y);
    odkr:=odkr-1;
    vminy[x,y]:=1;
 
    TextColor(CBODY);
    PolXY(x,y);
 
    { zobrazime cislo alebo medzeru }
    if(kol=0)then Write('   ')
             else Write(' ',kol,' ');
 
    { mensia rekurzia }
    if(kol=0)then begin
      UkazBody(x-1,y-1);
      UkazBody(x-1,y  );
      UkazBody(x-1,y+1);
      UkazBody(x  ,y-1);
      UkazBody(x  ,y+1);
      UkazBody(x+1,y-1);
      UkazBody(x+1,y  );
      UkazBody(x+1,y+1);
    end;
 
  end;
end;
 
 
{ ukaze minu ak je na policku }
procedure UkazMinu(x,y:integer);
begin
  TextColor(CMINY);
  PolXY(x,y);
 
  if(miny[x,y])then
     Write('<*>');
end;
 
 
{ ukaze vsetky miny }
procedure UkazMiny;
var x,y:integer;
begin
  for x:=1 to DLZ_X do
    for y:=1 to DLZ_y do
      UkazMinu(x,y);
end;
 
 
begin
  { zmenime roizsirenie a zmazeme obrazovku }
  OMode:=LastMode;
  TextMode(Lo(LastMode) + Font8x8);
  TextBackGround(Brown);
  ClrScr;
 
  Siet(DLZ_X,DLZ_Y);
  Rozmiestni(POC_MIN);
  Menu;
 
  mys_init;
  mys_view;
  finish:=false;
  KurzorZap(false);
 
  repeat
    mys_get(x,y,but);
 
    { klikol mysou - lavim }
    if(but=1) and Rozsah(x,y)then
    begin
      but:=0;
      UkazBody(x,y);
 
      { odkryl poslednu kocku }
      if(odkr=0)then
         finish:=true;
 
      { trafil minu }
      if(miny[x,y])then begin
         UkazMinu(x,y);
         finish:=true;
         odkr:=odkr+1;
      end;
    end;
 
    { klikol mysou - pravym }
    if(but=2) and Rozsah(x,y) and (vminy[x,y]=0)then
    begin
      vminy[x,y]:=2;
      oznac:=oznac+1;
 
      TextColor(CMINY);
      PolXY(x,y);
      Write('°°ą');
    end;
 
    { obsluha klavesnice - len klaves ESC }
    if(keypressed)then
    begin
      if(readkey=#27)then
         finish:=true;
    end;
 
    { zobraz priebezne body }
    TextColor(CTEXT);
    GotoXY(77,UP+5); Write(odkr:3);
    GotoXY(77,UP+6); Write(oznac:3);
    GotoXY(77,UP+7); Write(POC_MIN-oznac:3);
 
  until finish;
 
  UkazMiny;
  TextColor(CMINY+Blink);
 
  if(odkr=0)then
     WriteXY(16,Hi(WindMax),' -*- GRATULUJEM -*- ')
  else
     WriteXY(16,Hi(WindMax),' -*- TRAFIL SI MINU -*- ');
 
  { stary mod }
  repeat until keypressed;
  TextMode(OMode);
end.