Demonštrační program na téma 3D DUNGEON

{ DUNGEON.PAS                              Copyright (c) Ales Kucik }
{ Demonstracni program na tema 3D DUNGEON                           }
{                                                                   }
{   - tento program by mel jednoduse nastinit techniku, jak         }
{     vykreslit nejaky 3D pohled                                    }
{   - nedostatkem je spatna orientace v takovem dungeonu,           }
{     protoze se muzete otocit jen po 90 stupnich                   }
{   - dalsi nedostatek mnou pouzite metody zobrazeni objevite,      }
{     kdyz se postavite proti zdi rohu tak, ze byste meli           }
{     castecne po strane videt do chodby, po stranach se            }
{     neobjevi zdi (a nebo jen kousek), idyz by mely treba          }
{     pokracovat. Ale tento nedostatek by mel jit odstranit.        }
{                                                                   }
{  Vysvetlivky:                                                     }
{    zdi jsou deleny na Z, A, B, C (od nejvetsi po nejmensi)        }
{    postupne s polovicni delkou strany nez predesla                }
{                                                                   }
{    napr. BSwall znamena - B Side wall - postranni zed velikosti B }
{                                                                   }
{ Datum:29.11.2002                             http://www.trsek.com }
 
program Dungeon3D;
{$G+}
 
uses Crt;
 
const
  VGA = $a000;     {segment pameti VGA}
  Zlength = 128;   {delky strany zdi Z, A, B,C}
  Alength = 64;
  Blength = 32;
  Clength = 16;
  Zmax= 16384;  {veliost zakladniho obrazku 128x128 = 16384}
  Amax= 4096;
  Bmax= 1024;
  Cmax= 256;
  ASmax=8192;   {velikost postranni zdi velikosti A (128*64)}
  maxMap=21;    {velikost strany pole obsahujiciho mapu DUNGEONU}
  GameOver:boolean = false; {prednastavena promenna pro ukonceni programu}
 
 
type
  Tvirt = array [1..64000] of byte; {pole velikosti nasi obrazovky (320x200)}
  Pvirt = ^Tvirt;    {ukazatel na virtualni obrazovku}
  TAwall = array [1..Amax] of byte; {nase zed bude mit rozmery 64x64=4096}
  PAwall = ^TAwall;    {ukazatel na nasi zidku}
  TBwall = array [1..Bmax] of byte;
  PBwall = ^TBwall;
  TCwall = array [1..Cmax] of byte;
  PCwall = ^TCwall;
  TZwall = array [1..Zmax] of byte;
  PZwall = ^TZwall;
  TASwall = array [1..ASmax] of byte;
  PASwall = ^TASwall;
  {ASwall bude dvojnasobne siroka aby zakrila celou A zed}
 
  Tdirection = (No, Ea, So, We);
  Tcase  = (nothing, wall, corner);
  Tmap   = array [1..maxMap,1..maxMap] of Tcase;
 
 
  Tpal  = array [0..255, 1..3] of byte;
  Tplayer = record
    x,y:byte;
    direc:Tdirection;
  end;
 
 
var
  virt:pvirt;         {virtulani obrazovka}
  vaddr:word;         {segment nasi virtualni obrazovky}
  Zwall:pZwall;
  Awall:pAwall;         {nase zidka 64x64}
  Bwall:pBwall;
  Cwall:pCwall;
  ASwall:pASwall;       {jen ASwall ma odlisne rozmery}
  BSwall:pBwall;
  CSwall:pCwall;
  palPCX:Tpal;        {zde ulozime paletu PCX souboru}
  map:Tmap;           {mapa dungeonu}
  player:Tplayer;
 
procedure setVGA; assembler;
{nastaveni VGA modu 320x200x256}
asm
        mov     ax,  13h
        int     10h
end;
 
procedure settext; assembler;
{navrat zpet do textoveho modu}
asm
        mov     ax,  03h
        int     10h
end;
 
procedure putpixel(x,y: word; c:byte; where:word); assembler;
{tato procedura co nejrychleji umisti pixel na misto v pameti
se segmentem where}
asm
        mov     ax,  [where]
        mov     es,  ax
        mov     bx,  [x]
        mov     dx,  [y]
        mov     di,  bx
        mov     bx,  dx
        shl     dx,  8
        shl     bx,  6
        add     dx,  bx
        add     di,  dx
        mov     al,  [c]
        mov     es:[di], al
end;
 
procedure cls(where:word; c:byte); assembler;
{naplni pamet danou segmentem where urcitou barvou}
asm
        mov     cx,  32000
        mov     es,  [where]
        xor     di,  di
        mov     al,  [c]
        mov     ah,  al
        rep     stosw
end;
 
procedure flip(source, dest:word); assembler;
{misto pameti se seg. dest se naplni obsahem pameti se seg. source}
asm
        push    ds
        mov     cx,  32000
        mov     es,  [dest]
        mov     ds,  [source]
        xor     si,  si
        xor     di,  di
        rep     movsw
        pop     ds
end;
 
procedure setpal(colorNo,r,g,b:byte);
{zde je neco pro nastaveni palety}
begin
  port[$3c8]:=colorNo;
  port[$3c9]:=r;
  port[$3c9]:=g;
  port[$3c9]:=b;
end;
 
procedure getpal(colorNo:byte; var r,g,b:byte);
{pomoci teto procedury si muzeme uchovat starou paletu}
begin
  port[$3c7]:=colorNo;
  r:=port[$3c9];
  g:=port[$3c9];
  b:=port[$3c9];
end;
 
procedure setPCXpal;
{nastavy na VGA karte paletu naseho PCX souboru}
var i:byte;
begin
  for i:= 0 to 255 do setpal(i, palPCX[i,1] shr 2, palPCX[i,2] shr 2,
    palPCX[i,3] shr 2); {vsechny hodnoty palPCX se musi vydelit 4, aby
    byly v intervalu 0..63}
end;
 
procedure WaitRetrace; assembler;
{ceka se, az se bude elektronovy paprsek obrazovky vracet do
horniho leveho rohu - nebude se nam na obrazovce obevovat nechutne
blikani}
 
label
  l1,l2;
 
asm
  mov dx,3DAh
 
l1:
  in   al,dx
  and  al,08h
  jnz  l1
l2:
  in   al,dx
  and  al,08h
  jz   l2
end;
 
procedure inicializace;
{zaberem si kus pameti pro nasi virtualni obrazovku a
zjistime si jeji segment, ktery ulozim v vaddr}
begin
  randomize;
  getmem(virt, 64000);
  vaddr:= seg (virt^);
  getmem(Awall, Amax); {pamet pro nasi zidku}
  getmem(Bwall, Bmax);
  getmem(Cwall, Cmax);
  getmem(ASwall, ASmax);
  getmem(BSwall, Bmax);
  getmem(CSwall, Cmax);
end;
 
procedure konec;
{uvolneni pameti}
begin
  freemem(virt, 64000);
  freemem(Awall, Amax);
  freemem(Bwall, Bmax);
  freemem(Cwall, Cmax);
  freemem(ASwall,ASmax);
  freemem(BSwall,Bmax);
  freemem(CSwall,Cmax);
end;
 
procedure ramecek(x1,y1,x2,y2:word; c:byte; where:word);
{neni to zrovna nejrychlejsi, ale budeme ho kreslit asi jen jednou}
var
  i:word;
begin
  for i:=x1 to x2 do
    begin
      putpixel(i, y1, c, where);
      putpixel(i, y2, c, where);
    end;
  for i:=y1 to y2 do
    begin
      putpixel(x1, i, c, where);
      putpixel(x2, i, c, where);
    end;
end;
 
procedure nactiPCX;
{nacte soubor wall.PCX kde je ulozen obrazek zdi}
var
  soubor:file;
  data:byte;
  index:word;
  skupina:byte;
 
begin
  skupina:=0; {obsahuje delku rady stejnych pixelu}
  index:=1;   {obsahuje nasi pozici v obrazku zdi}
  assign(soubor, 'wall.pcx');
  {soubor obrazku zdi wall.pcx musi byt v aktualnim adresari}
  {$I-} {jen pro jistotu}
  reset(soubor,1); {data budeme prenaset po jednom byte}
  {$I+}
  if IOresult <> 0 then
    begin
      writeln('Nenalezl jsem soubor s obrazkem zdi!');
      writeln('Prosim umistete soubor WALL.PCX do adresare, kde se');
      writeln('nachazi tento program');
      konec;
      halt;
    end;
  {Pokud jsme jeste tady, tak byl soubor nalezen :o) }
  seek(soubor, 128);
  {preskocili jsme hlavicku ktera ma 128 bytu, predpokladam totiz, ze
  byl nalezen ten spravny soubor a ze ma spravny tva i velikost}
  {nyni si ulozime do pameti obrazek jako pole delky 16384 (128x128)}
  repeat
    blockread(soubor, data, 1);
    {kdyz jsou data>=$C0 (dekadicky 192 = 1100 0000 - horni dva bity jsou
    nastaveny), pak se v dolnich 4 bitech naleza delka skupinky pixelu
    stejne barvy a nasledujici byte souboru je barva techto pixelu}
    if data >= 192 then
      begin
        skupina:=data and 63;
        {63 = 0000 1111b ve "skupina" zbudou jen dolni 4 bity=delka skupinky}
        blockread(soubor, data, 1);  {prectu barvu}
        repeat
          Zwall^[index]:= data;
          inc(index);
          dec(skupina);
        until skupina = 0;
      end
    else
      begin
        Zwall^[index]:=data;
        inc(index);
      end;
  until index >Zmax; {pamatujte, nas obrazek zdi ma 128x128 pixelu}
  blockread(soubor, data, 1);
  {nyni kontrola jestli jsme uz u palety souboru PCX}
  if data <> 12 then
    begin
      writeln('Shit neco se posralo jako vzdy');
      freemem(Zwall,Zmax);
      konec;
      writeln('PCX ma pravdepodobne nespravne rozmery');
      halt;
    end
  else blockread(soubor, palPCX, 768);
  {nebudem se stim babrat, takhle jsme nacetli celou paletu PCX souboru
  do promenne palPCX (chapete to ne? 3 slozky barvy - RGB x 256 barev
  palety = 768 (bytu) - pred pouzitim je bude treba vydelit 4}
  close(soubor);
end; {nyni mame obrazek nacten v pameti, to lehci je za nama}
 
procedure zobrazAImage(x,y:word);
{zobrazi predni A zed na urcene souradnice}
var
  i,j:byte;
begin
  for i:=1 to Alength do
    for j:=1 to Alength do
      if Awall^[(i-1)*Alength+j]<>0 then
        putpixel(j+x-1, i+y-1, Awall^[(i-1)*Alength+j], vaddr);
end;
 
procedure zobrazBImage(x,y:word); {stejne jako zobrzAImage}
var
  i,j:byte;
begin
  for i:=1 to Blength do
    for j:=1 to Blength do
      if Bwall^[(i-1)*Blength+j]<>0 then
        putpixel(j+x-1, i+y-1, Bwall^[(i-1)*Blength+j], vaddr);
end;
 
procedure zobrazCImage(x,y:word);
var
  i,j:byte;
begin
  for i:=1 to Clength do
    for j:=1 to Clength do
      if Cwall^[(i-1)*Clength+j]<>0 then
        putpixel(j+x-1, i+y-1, Cwall^[(i-1)*Clength+j], vaddr);
end;
 
procedure zobrazLASImage(x,y:word);
{zobrazi upraveny obrazek postranni zdi takovim zpusobem, ze vypada
jako by leva proto LAS = Left A Side - A postranni zed se lisi je
tim, ze ma dvojnasobnou sirku nez ostatni(B,C)}
var
  i,j:byte;
begin
  for i:=1 to Alength do
    for j:=1 to Zlength do
      if ASwall^[Alength*(j-1)+i]<>0 then
        putpixel(i+x-1, j+y-1, ASwall^[Alength*(j-1)+i], vaddr);
end;
 
procedure zobrazLBSImage(x,y:word); {viz zobrazLASImage}
var
  i,j,z:byte;
begin
  z:= Blength div 2;
  for i:=1 to z do
    for j:=1 to Alength do
      if BSwall^[z*(j-1)+i]<>0 then
        putpixel(i+x-1, j+y-1, BSwall^[z*(j-1)+i], vaddr);
end;
 
procedure zobrazLCSImage(x,y:word);
var
  i,j,z:byte;
begin
  z:= Clength div 2;
  for i:=1 to z do
    for j:=1 to Blength do
      if CSwall^[z*(j-1)+i]<>0 then
        putpixel(i+x-1, j+y-1, CSwall^[(j-1)*z+i], vaddr);
end;
 
procedure zobrazRASImage(x,y:word);
{zobrazi postranni zed z praveho pohledu}
var
  i,j:byte;
begin
  for i:=1 to Alength do
    for j:=1 to Zlength do
      if ASwall^[Alength*(j-1)+Alength-i+1]<>0 then
        putpixel(i+x-1, j+y-1, ASwall^[Alength*(j-1)+Alength-i+1], vaddr);
end;
 
procedure zobrazRBSImage(x,y:word);
var
  i,j,z:byte;
begin
  z:= Blength div 2;
  for i:=1 to z do
    for j:=1 to Alength do
      if BSwall^[z*(j-1)+z-i+1]<>0 then
        putpixel(i+x-1, j+y-1, BSwall^[z*(j-1)+z-i+1], vaddr);
end;
 
procedure zobrazRCSImage(x,y:word);
var
  i,j,z:byte;
begin
  z:= Clength div 2;
  for i:=1 to z do
    for j:=1 to Blength do
      if CSwall^[z*(j-1)+z-i+1]<>0 then
        putpixel(i+x-1, j+y-1, CSwall^[(j-1)*z+z-i+1], vaddr);
end;
 
procedure ZtoA;
{prevod obrazku o rozmerech 128x128(velikost Z) na 64x64(velikost A)
tak ze bude vynechan kazdy druhy pixel}
var
  i,j:byte;
begin
  for i:=1 to Alength do
    for j:=1 to Alength do
      Awall^[(i-1)*Alength+j]:=Zwall^[(2*i-1)*Zlength+2*j];
 
end;
 
procedure AtoB;
{podobne jako ZtoA}
var
  i,j:byte;
begin
  for i:=1 to Blength do
    for j:=1 to Blength do
      Bwall^[(i-1)*Blength+j]:=Awall^[(2*i-1)*Alength+2*j];
 
end;
 
procedure BtoC;
var
  i,j:byte;
begin
  for i:=1 to Clength do
    for j:=1 to Clength do
      Cwall^[(i-1)*Clength+j]:=Bwall^[(2*i-1)*Blength+2*j];
end;
 
procedure ZtoAS;
{z obrazku Zwall udela AS wall (postranni zed A) tak, ze se
odsekne orni a dolni cast, asi nejak takto
 
   ______
  I\    I
  I \   I  <------------ tyto "trojuhelnicky budou odstraneny
  I  \  I              I
  I   \ I             /
  I    \I            /
  I     I           /
  I     I          /
  I     I         /
  I     I        /
  I     I       /
  I    /I      /
  I   / I     /
  I  /  I  <-/
  I /   I
  I/____I
 
tato technika se ponekud lisi od te z GDM4, kde byl obrazek natahovan
do pozadovaneho tvaru
 
jak uz jsem rekl AS ma trochu nestandartni rozmery}
 
 
var
  a:word;
  i,j,z:byte;
 
begin
  for a:=1 to ASmax do ASwall^[a]:=0;
 
  for i:=1 to Alength div 2 do
     for j:=i to Zlength-i do
       begin
         ASwall^[(j-1)*Alength+2*i-1]:=Zwall^[i*4-1+(j-1)*Zlength];
         ASwall^[(j-1)*Alength+2*i  ]:=Zwall^[i*4  +(j-1)*Zlength];
       end;
end;
 
procedure AtoBS;
var
  a:word;
  i,j,y:byte;
 
begin
  for a:=1 to Bmax do BSwall^[a]:=0;
 
  y:= Blength div 2;
  for i:=1 to y do
     for j:=i to Alength-i do
         BSwall^[(j-1)*y+i]:=Awall^[i*4+(j-1)*Alength];
 
end;
 
procedure BtoCS;
var
  a:word;
  i,j,y:byte;
 
begin
  for a:=1 to Cmax do CSwall^[a]:=0;
 
  y:= Clength div 2;
  for i:=1 to y do
      for j:=i to Blength-i do
         CSwall^[(j-1)*y+i]:=Bwall^[i*4+(j-1)*Blength];
end;
 
procedure nactiImages;
{zkonvertuje vsechny potrebne obrazky zdi z puvodni Zwall}
begin
  getmem(Zwall,Zmax);
  nactiPCX;
  ZtoA;
  AtoB;
  BtoC;
  ZtoAS;
  AtoBS;
  BtoCS;
  freemem(Zwall,Zmax);
end;
 
 
 
procedure makeMap;
{Tato procedura 'postavi' nas DUNGEON}
var
  i,j:byte;
  xroh,sum:word;
  direc:Tdirection;
 
  function rohu (mX,mY:byte):word;
  var
    loop1,loop2:byte;
    temp:word;
  begin
    temp:=0;
    for loop1:=1 to mX do
      for loop2:=1 to mY do
        if map[loop1,loop2]=corner then inc(temp);
    rohu:= temp;
  end;
 
  procedure kudykam(xx,yy:byte; xsmer:tdirection);
  var
    k,num:byte;
   begin
    k:=0;
    case xsmer of
      No:repeat
           map[xx,yy-k]:=wall;
           inc(k);
         until map[xx,yy-k]=wall;
      So:repeat
           map[xx,yy+k]:=wall;
           inc(k);
         until map[xx,yy+k]=wall;
      We:repeat
           map[xx-k,yy]:=wall;
           inc(k);
         until map[xx-k,yy]=wall;
      Ea:repeat
           map[xx+k,yy]:=wall;
           inc(k);
         until map[xx+k,yy]=wall;
    end;
  end;
 
 
begin
  for i:=1 to maxMap do
    for j:=1 to maxMap do
      if (odd(i)) and (odd(j)) then map[i,j]:= corner
      else map[i,j]:= nothing;
   for i:=1 to maxMap do {kolem mapy bude 3 policka siroka hranice}
    begin
      map[i, 1]:=wall;
      map[i, 2]:=wall;
      map[i, 3]:=wall;
      map[i, maxMap  ]:=wall;
      map[i, maxMap-1]:=wall;
      map[i, maxMap-2]:=wall;
    end;
  for i:=1 to maxMap do
    begin
      map[1, i]:=wall;
      map[2, i]:=wall;
      map[3, i]:=wall;
      map[maxMap  , i]:=wall;
      map[maxMap-1, i]:=wall;
      map[maxMap-2, i]:=wall;
    end;
   repeat
    xroh:= random(rohu(maxMap,maxMap))+1;
    sum:=0;
    for i:=1 to maxMap do
      for j:=1 to maxMap do
        begin
          if map[i,j]=corner then
            begin
              inc(sum);
              if sum = xroh then
                begin
                  case random(4) of
                    0: direc:=We;
                    1: direc:=So;
                    2: direc:=Ea;
                    3: direc:=No;
                  end;
                  kudykam(i,j,direc);
                end;
            end;
        end;
  until rohu(maxMap,maxMap) = 0;
end;
 
 
procedure zobrazScenu;
{tato procedura vykresli do virtualni obrazovky nas pohled,
podle pozice hrace (player.x a player.y) a smeru jeho pohledu
(player.direc)}
 
var i:byte;
begin
  with player do
    case player.direc of
      No:
        begin
          for i:=0 to 6 do
            if map[x+i-3, y-3]=wall then  zobrazCImage(104+i*Clength,92);
          for i:=0 to 1 do
            begin
              if map[x+i-2, y-2]=wall then
                begin
                  zobrazBImage(80+i*Blength,84);
                  zobrazLCSImage(112+i*Blength,84);
                end;
              if map[x+2-i, y-2]=wall then
                begin
                  zobrazBImage(240-(i+1)*Blength,84);
                  zobrazRCSImage(232-(i+1)*Blength,84);
                end;
            end;
          if map[x,y-2]=wall then zobrazBImage(144,84);
          if map[x-1, y-1]=wall then
            begin
              zobrazAImage(64,68);
              zobrazLBSImage(128,68);
            end;
          if map[x+1, y-1]=wall then
            begin
              zobrazAImage(192,68);
              zobrazRBSImage(176,68);
            end;
          if map[x,y-1]=wall then zobrazAImage(128,68);
          if map[x-1,y]=wall then zobrazLASImage(64,36);
          if map[x+1,y]=wall then zobrazRASImage(192,36);
        end;
 
      So:
        begin
          for i:=0 to 6 do
            if map[x+3-i, y+3]=wall then  zobrazCImage(104+i*Clength,92);
          for i:=0 to 1 do
            begin
              if map[x+2-i, y+2]=wall then
                begin
                  zobrazBImage(80+i*Blength,84);
                  zobrazLCSImage(112+i*Blength,84);
                end;
              if map[x+i-2, y+2]=wall then
                begin
                  zobrazBImage(240-(i+1)*Blength,84);
                  zobrazRCSImage(232-(i+1)*Blength,84);
                end;
            end;
          if map[x,y+2]=wall then zobrazBImage(144,84);
          if map[x+1, y+1]=wall then
            begin
              zobrazAImage(64,68);
              zobrazLBSImage(128,68);
            end;
          if map[x-1, y+1]=wall then
            begin
              zobrazAImage(192,68);
              zobrazRBSImage(176,68);
            end;
          if map[x,y+1]=wall then zobrazAimage(128,68);
          if map[x+1,y]=wall then zobrazLASImage(64,36);
          if map[x-1,y]=wall then zobrazRASImage(192,36);
        end;
 
      Ea:
        begin
          for i:=0 to 6 do
            if map[x+3, y+i-3]=wall then  zobrazCImage(104+i*Clength,92);
          for i:=0 to 1 do
            begin
              if map[x+2, y+i-2]=wall then
                begin
                  zobrazBImage(80+i*Blength,84);
                  zobrazLCSImage(112+i*Blength,84);
                end;
              if map[x+2, y+2-i]=wall then
                begin
                  zobrazBImage(240-(i+1)*Blength,84);
                  zobrazRCSImage(232-(i+1)*Blength,84);
                end;
            end;
          if map[x+2,y]=wall then zobrazBImage(144,84);
          if map[x+1, y-1]=wall then
            begin
              zobrazAImage(64,68);
              zobrazLBSImage(128,68);
            end;
          if map[x+1, y+1]=wall then
            begin
              zobrazAImage(192,68);
              zobrazRBSImage(176,68);
            end;
          if map[x+1,y]=wall then zobrazAimage(128,68);
          if map[x,y-1]=wall then zobrazLASImage(64,36);
          if map[x,y+1]=wall then zobrazRASImage(192,36);
        end;
 
      We:
        begin
          for i:=0 to 6 do
            if map[x-3, y+3-i]=wall then  zobrazCImage(104+i*Clength,92);
          for i:=0 to 1 do
            begin
              if map[x-2, y+2-i]=wall then
                begin
                  zobrazBImage(80+i*Blength,84);
                  zobrazLCSImage(112+i*Blength,84);
                end;
              if map[x-2, y-2+i]=wall then
                begin
                  zobrazBImage(240-(i+1)*Blength,84);
                  zobrazRCSImage(232-(i+1)*Blength,84);
                end;
            end;
          if map[x-2, y]=wall then zobrazBImage(144,84);
          if map[x-1, y+1]=wall then
            begin
              zobrazAImage(64,68);
              zobrazLBSImage(128,68);
            end;
          if map[x-1, y-1]=wall then
            begin
              zobrazAImage(192,68);
              zobrazRBSImage(176,68);
            end;
          if map[x-1,y]=wall then zobrazAimage(128,68);
          if map[x,y+1]=wall then zobrazLASImage(64,36);
          if map[x,y-1]=wall then zobrazRASImage(192,36);
        end;
    end;
 
end;
 
function GetKey:word;
{ceka na stisknuti klavesy a vraci jeji cislo}
var a:word;
begin
  a:=ord(readkey);
  if a=0 then a:=256+ord(readkey);
  getKey:=a;
end;
 
{HLAVNI PROGRAM}
var
  i,j:byte;
 
begin
  writeln('Vitam vas v mem ukazkovem programu pro clanek o 3D-DUNGEONU z GDM4!');
  writeln;writeln;
  writeln('program se ukonci klavesou ESC');
  writeln('muzete se pohybovat pomoci sipek');
  writeln;writeln;writeln;
  writeln('Neco stiskni');
  getkey;
  writeln('Drzte se jizda zacina!');
  inicializace;  {alokujem pamet}
  nactiImages;   {nactem obrazky}
  setVGA;        {nastavime mod 13h}
  setPCXpal;     {nastavime paletu PCX souboru}
  makeMap;       {postavime plan dungeonu}
  with player do {nastavime pozici hrace}
    begin
      x:=10;
      y:=10;
      direc:=We;
    end;
  repeat
    cls(vaddr,0);                   {vymazem virtualni obrazovku}
    ramecek(63,36,256,164,3,vaddr); {nakreslime ramecek pruhledu}
    zobrazScenu;                    {zobrazime 3D scenu}
    waitretrace;                    {chvilku pockame, aby to neblikalo}
    flip(vaddr,VGA);   {zkopirujem virtualni obrazovku, do videopameti}
    delay(50);         {chvilku pockame, aby jsme nebehali moc rychle}
    with player do
      begin
        case getKey of {ceka se na stisk klavesy}
          27: GameOver:=true;
 
          328: {jdeme dopredu - sipka nahoru}
               case direc of
                 No: if map[x,pred(y)]<>wall then dec(y);
                 So: if map[x,succ(y)]<>wall then inc(y);
                 Ea: if map[succ(x),y]<>wall then inc(x);
                 We: if map[pred(x),y]<>wall then dec(x);
               end;
 
          336: {jdeme dozadu - sipka dolu}
               case player.direc of
                 No: if map[x,succ(y)]<>wall then inc(y);
                 So: if map[x,pred(y)]<>wall then dec(y);
                 Ea: if map[pred(x),y]<>wall then dec(x);
                 We: if map[succ(x),y]<>wall then inc(x);
               end;
 
          333: {tocime se doprava - prava sipka}
               if direc=We then direc:=No
               else direc:=succ(direc);
 
          331: {tocime se doleva - leva sipka}
               if direc=No then direc:=We
               else direc:=pred(direc);
        end;
      end;
  until GameOver;
  settext;      {navrat do textoveho modu}
  konec;        {uvolneni pameti}
end.