Bludište naprogramované v pascale

{ BLUDISTE.PAS                             Copyright (c) Ales Kucik }
{ Je to jednoducha textovka. Cilem je vymotat se z bludiste         }
{ po sebrani dvou klicu. Muzete si zahrat i dvojhru.                }
{ Mam ale dojem ze dvojhra trochu zlobi.                            }
{                                                                   }
{ Datum:29.11.2002                             http://www.trsek.com }
 
program BludisteMaze;
uses Crt,Dos;
type
  tsize=(small,large);
  tpl  =1..2;
 
const
  {Nataveni textoveho modu}
  male =3+256;
  velke=3;
 
  {Neco pro klavesnici}
  keyboardintr = 9;
  keyboardport = $60;
 
  {Rozmery}
  smallX=39;
  smallY=39;
  largeX=79;
  largeY=49;
  dvojX =79;
  dvojY =25;
 
  {Klavesy}
  l1:boolean =false;
  l2:boolean =false;
  p1:boolean =false;
  p2:boolean =false;
  u1:boolean =false;
  u2:boolean =false;
  d1:boolean =false;
  d2:boolean =false;
  esc:boolean =false;
 
  {Prednastaveni}
  {nickname      ='Succer';}
  speed         =60;         {Pozor dulezite - nastaveni rychlosti behu hry}
  size:tsize    =small;
  players:tpl   =1;
  konec:boolean =false;
  kol:byte      =3;
 
  {Znaky pouzite ve hre a barvy}
  pl1=1;        {Nuber of char for 1st Player}
  pl2=2;        {                  2nd Player}
  plcol=yellow; {Color of players}
  wcol=green;   {Wall color}
  gbg=blue;     {Game BackGround}
  mbg=black;    {Menu BackGround}
  mnt=blue;     {Menu normal text}
  mht=green;    {Menu haileited text}
 
type
  tvysledky=record
              name:string[10];
              cas:longint;
  end;
 
  tsmer=(No,We,Ea,So);
  tmenuh=(sizeh,hallh,playersh,plname1h,plname2h,gameh,kolh,konech,helph);
  tprvky=(nic,wall,roh,out,key);
  tuplocha= array [1..80,1..50] of tprvky;
  tplocha=^tuplocha;
  thrac=object
    x,y,xol,yol:byte;
    name:string[10];
 
    constructor init(xpost,ypost:byte; s:string);
    procedure erase(relx,rely:byte);
    procedure zobraz(relx,rely:byte; pl:byte);
    procedure vlevo;
    procedure vpravo;
    procedure nahoru;
    procedure dolu;
    procedure nickname(s:string);
    procedure pos(xpost,ypost:byte);
    procedure xypos(var xpos,ypos:byte);
    function zname:string;
  end;
 
constructor thrac.init(xpost,ypost:byte; s:string);
begin
  x:=xpost;
  y:=ypost;
  xol:=xpost;
  yol:=ypost;
  name:=s;
end;
 
procedure thrac.erase(relx,rely:byte);
begin
  gotoxy(relx+xol-1,rely+yol-1);
  write(' ');
end;
 
procedure thrac.zobraz(relx,rely:byte; pl:byte);
begin
  thrac.erase(relx,rely);
  gotoxy(relx+x-1,rely+y-1);
  write(chr(pl));
  xol:=x;
  yol:=y;
end;
 
procedure thrac.vlevo;
begin
  x:=x-1;
end;
 
procedure thrac.vpravo;
begin
  x:=x+1;
end;
 
procedure thrac.nahoru;
begin
  y:=y-1;
end;
 
procedure thrac.dolu;
begin
  y:=y+1;
end;
 
procedure thrac.nickname(s:string);
begin
  name:=s;
end;
 
procedure thrac.pos(xpost,ypost:byte);
begin
  x:=xpost;
  y:=ypost;
end;
 
procedure thrac.xypos(var xpos,ypos:byte);
begin
  xpos:=x;
  ypos:=y;
end;
 
function thrac.zname:string;    {Zobraz Jmeno}
begin
  zname:=name;
end;
 
var
  hrac1,hrac2: thrac;
  plocha:tplocha;
  BIOSKeyboardhandler : procedure;
 
{Ovladani klavesnice}
 
{$F+}
procedure Keyboardhandler (Flags, CS, IP, AX, BX, CX, DX,
                           SI, DI, DS, ES, BP: word);
interrupt;
var
  key:byte;
 
begin
  key:= port[keyboardport];
  port[$20]:= $20;
  case key of
       75: l1:= true;
   128+75: l1:= false;
       30: l2:= true;
   128+30: l2:= false;
       77: p1:= true;
   128+77: p1:= false;
       32: p2:= true;
   128+32: p2:= false;
       72: u1:= true;
   128+72: u1:= false;
       17: u2:= true;
   128+17: u2:= false;
       80: d1:= true;
   128+80: d1:= false;
       31: d2:= true;
   128+31: d2:= false;
        1: esc:= true;
    128+1: esc:= false;
  end;
end;
{$F-}
 
procedure zvetsitext;
begin
  textmode(velke);
end;
 
procedure zmensitext;
begin
  textmode(male);
end;
 
procedure Nastavklavesnici;
begin
  l1:= false;
  l2:= false;
  p1:= false;
  p2:= false;
  u1:= false;
  u2:= false;
  d1:= false;
  d2:= false;
  esc:=false;
end;
 
procedure kurzorOff; assembler;
asm
   mov ah,01
   mov cl,$20
   mov ch,$20
   int $10
end;
 
procedure kurzorOn; assembler;
asm
  mov ah,01
  mov cl,07
  mov ch,06
  int $10
end;
 
function getticks:longint;
var
  q:longint absolute 0:$046c;
 
begin
  getticks:=q;
end;
 
procedure inits;
var
  soubor:file;
  jednotka:tvysledky;
  i:byte;
 
begin
  randomize;
  kurzoroff;
  hrac1.init(2,2,'Mentos');
  hrac2.init(2,2,'Ubozacek');
  new(plocha);
  {Zjistit jestli existuje soubor s tabulkou vysledku}
  {pokud ne tak ji vytvori}
  jednotka.name:= 'Mentacek';
  jednotka.cas:=1505454;
  assign(soubor,'hall.dat');
  {$I-}
  reset(soubor,1);
  {$I+}
  if IOresult<>0 then
    begin
      rewrite(soubor,1);
      for i:=1 to 8 do blockwrite(soubor,jednotka,sizeof(jednotka));
    end;
  close(soubor);
end;
 
procedure final;
begin
  kurzoron;
  dispose(plocha);
end;
 
procedure zobrazh;
begin
  textbackground(mbg);
  window(1,1,80,25);
  clrscr;
    textcolor(green);
    gotoxy(20,1);
    write('              ******************        ');
    gotoxy(20,2);
    write('              *       * *       *       ');
    gotoxy(20,3);
    write('**************** ** ***** **** *********');
    gotoxy(20,4);
    write('* *     * ');
    textcolor(yellow);
    write('M   M  AA  ZZZZ EEEE');
    textcolor(green);
    write('    *    *');
    gotoxy(20,5);
    write('*   * * * ');
    textcolor(yellow);
    write('MM MM A  A   ZZ E');
    textcolor(green);
    write('     *** *');
    gotoxy(20,6);
    write('***** *   ');
    textcolor(yellow);
    write('M M M A  A  ZZ  EE');
    textcolor(green);
    write('    *   ****');
    gotoxy(20,7);
    write('    * * * ');
    textcolor(yellow);
    write('M   M AAAA ZZ   E');
    textcolor(green);
    write('     * *    *');
    gotoxy(20,8);
    write('* *   * * ');
    textcolor(yellow);
    write('M   M A  A ZZZZ EEEE');
    textcolor(green);
    write('    ** * *');
    gotoxy(20,9);
    write('********* ***** **** **** ***** **** ***');
    gotoxy(20,10);
    write('       *        *         *      *    *');
    gotoxy(20,11);
    write('        ******************************');
    gotoxy(3,15);
    textcolor(mht);
    write('H');
    textcolor(mnt);
    write('all of fame');
    gotoxy(3,17);
    textcolor(mht);
    write('N');
    textcolor(mnt);
    write('unber of players: ');
    textcolor(lightblue);
    write(players);
    if players = 1 then
      begin
        gotoxy(3,19);
        textcolor(mht);
        write('S');
        textcolor(mnt);
        write('ize of maze: ');
        textcolor(lightblue);
        if size = small then write('SMALL')
        else write('LARGE');
        gotoxy(3,21);
        textcolor(mht);
        write('P');
        textcolor(mnt);
        write('layers name: ');
        textcolor(lightblue);
        write(hrac1.zname);
        gotoxy(3,23);
        textcolor(mht);
        write('G');
        textcolor(mnt);
        write('ame');
      end
    else
      begin
        gotoxy(3,19);
        textcolor(mht);
        write('1');
        textcolor(mnt);
        write('st player: ');
        textcolor(lightblue);
        write(hrac1.zname);
        gotoxy(3,21);
        textcolor(mht);
        write('2');
        textcolor(mnt);
        write('nd player: ');
        textcolor(lightblue);
        write(hrac2.zname);
        gotoxy(3,23);
        textcolor(mnt);
        write('N');
        textcolor(mht);
        write('u');
        textcolor(mnt);
        write('mber of games: ');
        textcolor(lightblue);
        write(kol);
        gotoxy(3,25);
        textcolor(mht);
        write('G');
        textcolor(mnt);
        write('ame');
      end;
    textcolor(lightred);
    gotoxy(70,25);
    write('F1=HELP');
end;
 
 
procedure sizep;
begin
  if size=small then size:=large
  else size:=small;
end;
 
procedure halloffame;
var
  hracicka:tvysledky;
  soubor: file;
  i,j,delka:byte;
 
 
  function timehall(xcas:longint):string;
  var
    xh,xm,xs,xse:longint;
 
    function LeadingZero(number : word) : string;
     var
       retezec : string;
    begin
      str(number:0,retezec);
      if Length(retezec) = 1 then retezec := '0' + retezec;
      LeadingZero := retezec;
    end;
 
  begin
    xcas:=xcas*55;
    xh  :=xcas div 3600000;
    xcas:=xcas - xh * 3600000;
    xm  :=xcas div 60000;
    xcas:=xcas - xm * 60000;
    xs  :=xcas div 1000;
    xse :=xcas - xs * 1000;
    xse :=xse  div 10;
 
    timehall:=(LeadingZero(xh)+':'+LeadingZero(xm)+':'+
                   LeadingZero(xs)+'.'+LeadingZero(xse));
  end;
 
 
begin
  textbackground(mbg);
  clrscr;
  textcolor(yellow);
  writeln;
  writeln('   H   H   AA   L    L               FFFFFFFFF            EEEEEEE');
  writeln('   H   H  A  A  L    L               F                    E      ');
  writeln('   H   H  A  A  L    L               F       A            E      ');
  writeln('   HHHHH  AAAA  L    L               F      A A   M     M E      ');
  writeln('   H   H A    A L    LLLL   FFFFFFF  F     A   A  MM   MM EEEE   ');
  writeln('   H   H A    A LLLL    OOO F       FFFFFF A   A  M M M M E      ');
  writeln('   H   H A    A        O   O F      F      A AAA  M  M  M E      ');
  writeln('                       O   O FFF    F     AAA   A M     M E      ');
  writeln('                       O   O F      F     A     A M     M E      ');
  writeln('                       O   O F     F      A     A M     M EEEEEEE');
  writeln('                        OOO  F     F                             ');
  textcolor(lightred);
  writeln('Nejlepsi hraci VELKYCH her:');
  {Precteni souboru}
  assign(soubor,'hall.dat');
  reset(soubor,1);
  for i:=1 to 4 do
    begin
      blockread(soubor,hracicka,sizeof(hracicka));
      with hracicka do
        begin
          delka:=length(name);
          delka:=10-delka;
          write(name);
          for j:=1 to 15+delka do write(' ');
          writeln(timehall(cas));
        end;
    end;
  writeln;
  writeln('Nejlepsi hraci MALYCH her:');
  {docteni souboru}
  for i:=1 to 4 do
    begin
      blockread(soubor,hracicka,sizeof(hracicka));
      with hracicka do
        begin
          delka:=length(name);
          delka:=10-delka;
          write(name);
          for j:=1 to 15+delka do write(' ');
          writeln(timehall(cas));
        end;
    end;
  close(soubor);
  repeat until keypressed;
  readkey;
end;
 
procedure noplayers;
begin
  if players=1 then players:=2
  else players:=1;
end;
 
procedure plname(var xplayer:thrac);
var
  s:string [20];
  i:byte;
 
begin
  {Vytvoreni okna}
  textbackground(blue);
  textcolor(yellow);
  window(23,12,64,14);
  clrscr;
  gotoxy(2,1);
  write(#201);
  for i:=1 to 38 do write(#205);
  write(#187);
  gotoxy(2,2);
  write(#186);
  gotoxy(41,2);
  write(#186);
  gotoxy(2,3);
  write(#200);
  for i:=1 to 38 do write(#205);
  write(#188);
  textcolor(lightgreen);
  gotoxy(4,2);
  write('Name: ');
  window(32,13,62,13);
  kurzoron;
  readln(s);
  kurzoroff;
  with xplayer do nickname(s);
end;
 
procedure nogames;
var
  i,no:byte;
  s:string[3];
  code:integer;
 
begin
  {Vytvoreni okna}
  textbackground(blue);
  textcolor(yellow);
  window(23,12,64,14);
  clrscr;
  gotoxy(2,1);
  write(#201);
  for i:=1 to 38 do write(#205);
  write(#187);
  gotoxy(2,2);
  write(#186);
  gotoxy(41,2);
  write(#186);
  gotoxy(2,3);
  write(#200);
  for i:=1 to 38 do write(#205);
  write(#188);
  textcolor(lightgreen);
  gotoxy(4,2);
  write('Number of games: ');
  window(43,13,62,13);
  {Zadani hodnoty}
  kurzoron;
  readln(s);
  kurzoroff;
  val(s,no,code);
  if code=0 then kol:=no;
end;
 
procedure help;
var
  i:byte;
begin
  textbackground(blue);
  textcolor(yellow);
  window(23,9,64,17);
  clrscr;
  gotoxy(2,1);
  write(#201);
  for i:=1 to 38 do write(#205);
  write(#187);
  for i:=2 to 8 do
    begin
      gotoxy(2,i);
      write(#186);
      gotoxy(41,i);
      write(#186);
    end;
  gotoxy(2,9);
  write(#200);
  for i:=1 to 38 do write(#205);
  write(#188);
  textcolor(lightgreen);
  window(25,10,62,16);
  writeln('Ovladaci klavesy pro druheho hrace');
  writeln;
  writeln('  Nahoru - w');
  writeln('  Dolu   - s');
  writeln('  Vlevo  - a');
  writeln('  Vpravo - d');
  repeat until keypressed;
  readkey;
end;
 
procedure game1;
var
  gkonec,kolokonec:boolean;
  kolo,klic,x,y:byte;
  hh,mm,ss,sse:word;
  starttime,cas:longint;
 
  procedure zobrazS;
  var
    i,j:byte;
  begin
    textbackground(black);
    clrscr;
    textbackground(gbg);
    textcolor(wcol);
    for j:=1 to smallY do
      begin
        gotoxy(19,j+5);
        for i:=1 to smallX do
          case plocha^[i,j] of
            wall: write(#178);
            nic : write(' ');
            out : begin
                    textcolor(lightred+blink);
                    write('@');
                    textcolor(wcol);
                  end;
            key : begin
                    textcolor(lightred);
                    write('!');
                    textcolor(wcol);
                  end;
          end;
      end;
  end;
 
  procedure zobrazL;
  var
    i,j:byte;
  begin
    textbackground(black);
    clrscr;
    textbackground(gbg);
    textcolor(wcol);
    for j:=1 to largeY do
      begin
        gotoxy(1,j+1);
        for i:=1 to largeX do
          case plocha^[i,j] of
            wall: write(#178);
            nic : write(' ');
            out : begin
                    textcolor(lightred+blink);
                    write('@');
                    textcolor(wcol);
                  end;
            key : begin
                    textcolor(lightred);
                    write('!');
                    textcolor(wcol);
                  end;
          end;
      end;
  end;
 
  procedure ginit(maxX,maxY:byte);
  var
    i,j:byte;
    xroh,sum:word;
    smer:tsmer;
 
    function rohu (mX,mY:byte):word;
    var
      loop1,loop2:byte;
      temp:word;
    begin
      temp:=0;
      for loop1:=3 to mX-2 do
        for loop2:=3 to mY-2 do
          if plocha^[loop1,loop2]=roh then temp:=temp+1;
      rohu:= temp;
    end;
 
    procedure kudykam(xx,yy:byte; xsmer:tsmer);
    var
      k,num:byte;
      dal:boolean;
 
    begin
      k:=0;
      case xsmer of
        No:repeat
             plocha^[xx,yy-k]:=wall;
             inc(k);
           until plocha^[xx,yy-k]=wall;
        So:repeat
             plocha^[xx,yy+k]:=wall;
             inc(k);
           until plocha^[xx,yy+k]=wall;
        We:repeat
             plocha^[xx-k,yy]:=wall;
             inc(k);
           until plocha^[xx-k,yy]=wall;
        Ea:repeat
             plocha^[xx+k,yy]:=wall;
             inc(k);
           until plocha^[xx+k,yy]=wall;
      end;
    end;
 
 
  begin
    gkonec:=false;              {Prednastaveni ukonceni proc Game1}
    for i:=1 to 80 do
      for j:=1 to 50 do
        if (odd(i)) and (odd(j)) then plocha^[i,j]:= roh
        else plocha^[i,j]:= nic;
    for i:=1 to maxX do
      begin
        plocha^[i,   1]:=wall;
        plocha^[i,maxY]:=wall;
      end;
    for i:=1 to maxY do
      begin
        plocha^[1,   i]:=wall;
        plocha^[maxX,i]:=wall;
      end;
    {start}
    plocha^[3,3]:=wall;
    case random(2) of
      0: plocha^[3,2]:=wall;
      1: plocha^[2,3]:=wall;
    end;
    {konec}
    plocha^[maxX-1,maxY-1]:=out;
    plocha^[maxX-2,maxY-2]:=wall;
    case random(2) of
      0: plocha^[maxX-2,maxY-1]:=wall;
      1: plocha^[maxX-1,maxY-2]:=wall
    end;
    {Umisteni '!'}
    plocha^[maxX-1,2]:=key;
    plocha^[2,maxY-1]:=key;
 
    repeat
      xroh:= random(rohu(maxX,maxY))+1;
      sum:=0;
      for i:=3 to maxX-2 do
        for j:=3 to maxY-2 do
          begin
            if plocha^[i,j]=roh then
              begin
                inc(sum);
                if sum = xroh then
                  begin
                    case random(4) of
                      0: smer:=We;
                      1: smer:=So;
                      2: smer:=Ea;
                      3: smer:=No;
                    end;
                    kudykam(i,j,smer);
                  end;
              end;
          end;
    until rohu(maxX,maxY) = 0;
  end;
 
  procedure zobrazklic;
  begin
    gotoxy(10,1);
    write('Mas ',klic,' ze 2 klicu');
  end;
 
  procedure zobrazkolo;
  begin
    gotoxy(30,1);
    write('Jsi v ',kolo,'. z 5 kol');
  end;
 
  function ztime(var xstart:longint; var xcas:longint):string;
  var
    xh,xm,xs,xse:longint;
    xtime:longint;
 
    function LeadingZero(number : word) : string;
     var
       retezec : string;
    begin
      str(number:0,retezec);
      if Length(retezec) = 1 then retezec := '0' + retezec;
      LeadingZero := retezec;
    end;
 
  begin
    xcas:=getticks-xstart;
    xtime:=xcas*55;
    xh:=xtime div 3600000;
    xtime:=xtime - xh * 3600000;
    xm:=xtime div 60000;
    xtime:=xtime - xm * 60000;
    xs:=xtime div 1000;
    xse:=xtime - xs * 1000;
    xse:=xse div 10;
 
    ztime:=(LeadingZero(xh)+':'+LeadingZero(xm)+':'+
                   LeadingZero(xs)+'.'+LeadingZero(xse));
  end;
 
  procedure zapishall(xcas:longint);
  var
    buf:array[1..8] of tvysledky;
    soubor:file;
    jednotka,jednotka2:tvysledky;
    i:byte;
 
  begin
    jednotka.name:=hrac1.name;
    jednotka.cas :=xcas;
    assign(soubor,'hall.dat');
    reset(soubor,1);
    for i:=1 to 8 do blockread(soubor,buf[i],sizeof(jednotka));
        if size=large then
          begin
            for i:=1 to 4 do
              if buf[i].cas>jednotka.cas then
                begin
                  jednotka2:=buf[i];
                  buf[i]:=jednotka;
                  jednotka:=jednotka2;
                end;
          end
        else
          begin
            for i:=5 to 8 do
              if buf[i].cas>jednotka.cas then
                begin
                  jednotka2:=buf[i];
                  buf[i]:=jednotka;
                  jednotka:=jednotka2;
                end;
          end;
    close(soubor);
    rewrite(soubor);
    for i:=1 to 8 do blockwrite(soubor,buf[i],sizeof(tvysledky));
    close(soubor);
  end;
 
begin
  zmensitext;
  kurzoroff;
  GetIntVec(keyboardintr, @BIOSKeyboardhandler);
  SetIntVec(keyboardintr, addr(keyboardhandler));
  starttime:=getticks;
  kolo:=1;
  if size = small then
    begin
      repeat
        ginit(smallX,smallY);   {Nove nastaveni hraci plochy}
        hrac1.pos(2,2);
        zobrazS;                {Zobrazeni nove plochy}
        textcolor(plcol);
        klic:=0;                {Nastaveni hodnot klic a kolokonec}
        kolokonec:=false;
        zobrazklic;
        zobrazkolo;
        nastavklavesnici;       {Nastaveni hodnot false promennych klaves}
        hrac1.xypos(x,y);
        repeat
          if l1 and (plocha^[x-1,y]<>wall) then hrac1.vlevo;
          hrac1.xypos(x,y);
          if p1 and (plocha^[x+1,y]<>wall) then hrac1.vpravo;
          hrac1.xypos(x,y);
          if u1 and (plocha^[x,y-1]<>wall) then hrac1.nahoru;
          hrac1.xypos(x,y);
          if d1 and (plocha^[x,y+1]<>wall) then hrac1.dolu;
          if esc then
            begin
              gkonec:=true;
              kolokonec:=true;
            end;
          hrac1.xypos(x,y);
          if plocha^[x,y]=key then
            begin
              plocha^[x,y]:=nic;
              inc(klic);
              zobrazklic;
            end;
          gotoxy(60,1);
          write('Time: ',ztime(starttime,cas));
          hrac1.zobraz(19,6,pl1);
          if (plocha^[x,y]=out) and (klic=2) then kolokonec:=true;
          gotoxy(smallX+17,smallY+4);
          textcolor(lightred+blink);
          write('@');
          textcolor(plcol);
          delay(speed);
        until kolokonec;
        inc(kolo);
        if kolo>5 then gkonec:=true;
      until gkonec;
    end
  else
    begin
      repeat
        ginit(largeX,largeY);
        hrac1.pos(2,2);
        zobrazL;
        textcolor(plcol);
        klic:=0;
        kolokonec:=false;
        zobrazklic;
        zobrazkolo;
        nastavklavesnici;      {NAstaveni false pro promenne klavesnice}
        hrac1.xypos(x,y);
        repeat
          if l1 and (plocha^[x-1,y]<>wall) then hrac1.vlevo;
          hrac1.xypos(x,y);
          if p1 and (plocha^[x+1,y]<>wall) then hrac1.vpravo;
          hrac1.xypos(x,y);
          if u1 and (plocha^[x,y-1]<>wall) then hrac1.nahoru;
          hrac1.xypos(x,y);
          if d1 and (plocha^[x,y+1]<>wall) then hrac1.dolu;
          if esc then
            begin
              gkonec:=true;
              kolokonec:=true;
            end;
          hrac1.xypos(x,y);
          if plocha^[x,y]=key then
            begin
              plocha^[x,y]:=nic;
              inc(klic);
              zobrazklic;
            end;
          gotoxy(60,1);
          write('Time: ',ztime(starttime,cas));
          hrac1.zobraz(1,2,pl1);
          if (plocha^[x,y]=out) and (klic=2) then kolokonec:=true;
          gotoxy(largeX-1,largeY);
          textcolor(lightred+blink);
          write('@');
          textcolor(plcol);
          delay(speed);
        until kolokonec;
        inc(kolo);
        if kolo>5 then gkonec:=true;
      until gkonec;
    end;
  SetIntVec(keyboardintr, @BIOSKeyboardhandler);
  if kolo>5 then zapishall(cas);
  zvetsitext;
  kurzoroff;
end;
 
procedure game2;
const
  body1:byte=0;
  body2:byte=0;
 
var
  test,kolokonec,gkonec:boolean;
  x1,y1,x2,y2:byte;
  kolo:byte;
 
 
  procedure ginit;
  var
    i,j:byte;
    xroh,sum:word;
    smer:tsmer;
 
    function rohu (mX,mY:byte):word;
    var
      loop1,loop2:byte;
      temp:word;
    begin
      temp:=0;
      for loop1:=3 to mX-2 do
        for loop2:=3 to mY-2 do
          if plocha^[loop1,loop2]=roh then temp:=temp+1;
      rohu:= temp;
    end;
 
    procedure kudykam(xx,yy:byte; xsmer:tsmer);
    var
      k,num:byte;
      dal:boolean;
 
    begin
      k:=0;
      case xsmer of
        No:repeat
             plocha^[xx,yy-k]:=wall;
             inc(k);
           until plocha^[xx,yy-k]=wall;
        So:repeat
             plocha^[xx,yy+k]:=wall;
             inc(k);
           until plocha^[xx,yy+k]=wall;
        We:repeat
             plocha^[xx-k,yy]:=wall;
             inc(k);
           until plocha^[xx-k,yy]=wall;
        Ea:repeat
             plocha^[xx+k,yy]:=wall;
             inc(k);
           until plocha^[xx+k,yy]=wall;
      end;
    end;
 
 
  begin
    gkonec:=false;              {Prednastaveni ukonceni proc Game1}
    for i:=1 to 80 do
      for j:=1 to 50 do
        if (odd(i)) and (odd(j)) then plocha^[i,j]:= roh
        else plocha^[i,j]:= nic;
    for i:=1 to dvojX do
      begin
        plocha^[i,    1]:=wall;
        plocha^[i,dvojY]:=wall;
      end;
    for i:=1 to dvojY do
      begin
        plocha^[1,   i]:=wall;
        plocha^[dvojX,i]:=wall;
      end;
    {start}
    plocha^[3,3]:=wall;
    case random(2) of
      0: plocha^[3,2]:=wall;
      1: plocha^[2,3]:=wall;
    end;
    {konec}
    plocha^[dvojX-1,dvojY-1]:=out;
    plocha^[dvojX-2,dvojY-2]:=wall;
    case random(2) of
      0: plocha^[dvojX-2,dvojY-1]:=wall;
      1: plocha^[dvojX-1,dvojY-2]:=wall
    end;
 
    repeat
      xroh:= random(rohu(dvojX,dvojY))+1;
      sum:=0;
      for i:=3 to dvojX-2 do
        for j:=3 to dvojY-2 do
          begin
            if plocha^[i,j]=roh then
              begin
                inc(sum);
                if sum = xroh then
                  begin
                    case random(4) of
                      0: smer:=We;
                      1: smer:=So;
                      2: smer:=Ea;
                      3: smer:=No;
                    end;
                    kudykam(i,j,smer);
                  end;
              end;
          end;
    until rohu(dvojX,dvojY) = 0;
  end;
 
  procedure zobrazD;
  var
    i,j:byte;
  begin
    textbackground(black);
    clrscr;
    textbackground(gbg);
    textcolor(wcol);
    for j:=1 to dvojY do
      begin
        gotoxy(1,j+1);
        for i:=1 to dvojX do
          case plocha^[i,j] of
            wall: write(#178);
            nic : write(' ');
            out : begin
                    textcolor(lightred+blink);
                    write('@');
                    textcolor(wcol);
                  end;
          end;
      end;
    for j:=2 to dvojY do
      begin
        gotoxy(1,j+25);
        for i:=1 to dvojX do
          case plocha^[i,j] of
            wall: write(#178);
            nic : write(' ');
            out : begin
                    textcolor(lightred+blink);
                    write('@');
                    textcolor(wcol);
                  end;
          end;
      end;
 
  end;
 
  procedure zobrazskore;
  begin
    gotoxy(1,1);
    write(hrac1.zname,' : ',body1,' bodu');
    gotoxy(30,1);
    write(hrac2.zname,' : ',body2,' bodu');
  end;
 
  procedure remiza;
  begin
    textbackground(black);
    textcolor(yellow);
    clrscr;
    gotoxy(20,25);
    write('LITUJI ALE CILE JSTE OBA DOSAHLI SOUCANE');
    gotoxy(20,26);
    write('      PROTO SI TO MUSITE ZOPAKNOUT      ');
    delay(1000);
  end;
 
  function vytez:boolean;
  var
    gconst:byte;
  begin
    gconst:=kol mod 2 ;
    if (gconst<body1) or (gconst<body2) then
      begin
        vytez:=true;
        textbackground(black);
        clrscr;
        textcolor(lightblue);
        gotoxy(20,25);
        if body1 > body2 then
          write('Vytezem se stal ',hrac1.zname)
        else
          if body1 < body2 then
            write('Vytezem se stal ',hrac2.zname)
          else
            if kol=kolo then
              write('     !!!   REMIZA   !!!    ')
            else
              vytez:=false;
        delay(2000);
      end
    else
      vytez:=false;
  end;
 
 
 
begin
  zmensitext;
  kurzoroff;
  GetIntVec(keyboardintr, @BIOSKeyboardhandler);
  SetIntVec(keyboardintr, addr(keyboardhandler));
  kolo:=1;
  repeat
    ginit;                      {Nove nastaveni hraci plochy}
    hrac1.pos(2,2);
    hrac2.pos(2,2);
    zobrazD;                {Zobrazeni nove plochy}
    textcolor(plcol);
    kolokonec:=false;
    zobrazskore;
    nastavklavesnici;       {Nastaveni hodnot false promennych klaves}
    hrac1.xypos(x1,y1);
    hrac2.xypos(x2,y2);
    repeat
      if l1 and (plocha^[x1-1,y1]<>wall) then hrac1.vlevo;
      hrac1.xypos(x1,y1);
      if p1 and (plocha^[x1+1,y1]<>wall) then hrac1.vpravo;
      hrac1.xypos(x1,y1);
      if u1 and (plocha^[x1,y1-1]<>wall) then hrac1.nahoru;
      hrac1.xypos(x1,y1);
      if d1 and (plocha^[x1,y1+1]<>wall) then hrac1.dolu;
 
      if l2 and (plocha^[x2-1,y2]<>wall) then hrac2.vlevo;
      hrac2.xypos(x2,y2);
      if p2 and (plocha^[x2+1,y2]<>wall) then hrac2.vpravo;
      hrac2.xypos(x2,y2);
      if u2 and (plocha^[x2,y2-1]<>wall) then hrac2.nahoru;
      hrac2.xypos(x2,y2);
      if d2 and (plocha^[x2,y2+1]<>wall) then hrac2.dolu;
 
      if esc then
        begin
          gkonec:=true;
          kolokonec:=true;
        end;
      hrac1.zobraz(1,2 ,pl1);
      hrac2.zobraz(1,26,pl2);
      hrac1.xypos(x1,y1);
      hrac2.xypos(x2,y2);
      if plocha^[x1,y1]=out then
        begin
          kolokonec:=true;
          inc(body1);
          test:=true;
        end;
      if plocha^[x2,y2]=out then
        begin
          kolokonec:=true;
          inc(body2);
        end
      else test:=false;
      textcolor(lightred+blink);
      gotoxy(78,25);
      write('@');
      gotoxy(78,49);
      write('@');
      textcolor(plcol);
      delay(speed-10);
    until kolokonec;
    if test then remiza
    else inc(kolo);
    if vytez then gkonec:=true;
  until gkonec;
  SetIntVec(keyboardintr, @BIOSKeyboardhandler);
  zvetsitext;
  kurzoroff;
end;
 
 
function delejh:tmenuh;
var
  znak:char;
begin
  if players = 1 then
    repeat
      repeat until keypressed;
      znak:=upcase(readkey);
      if ord(znak) = 0 then
        begin
          znak:=readkey;
          if znak = ';' then delejh:= helph;
        end
      else
        case znak of
          'H' : delejh:= hallh;
          'N' : delejh:= playersh;
          'G' : delejh:= gameh;
          'S' : delejh:= sizeh;
          'P' : delejh:= plname1h;
          #27 : delejh:= konech;
        end;
    until znak in ['H','N','G','S','P',';',#27]
  else
    repeat
      repeat until keypressed;
      znak:=upcase(readkey);
      if ord(znak) = 0 then
        begin
          znak:=readkey;
          if znak = ';' then delejh:= helph;
        end
      else
        case znak of
          'H' : delejh:= hallh;
          'N' : delejh:= playersh;
          'G' : delejh:= gameh;
          '1' : delejh:= plname1h;
          '2' : delejh:= plname2h;
          'U' : delejh:= kolh;
          #27 : delejh:= konech;
        end;
    until znak in ['H','N','G','1','2','U',';',#27];
end;
 
 
begin
  inits;
  repeat
    zobrazh;
    case delejh of
      sizeh   : sizep;
      hallh   : halloffame;
      playersh: noplayers;
      plname1h: plname(hrac1);
      plname2h: plname(hrac2);
      gameh   : if players = 1 then game1
                else game2;
      kolh    : nogames;
      helph   : help;
      konech  : konec:=true;
    end;
  until konec;
  final;
end.