Простая прога на очередь/стек

uses
  CRT;
 
const
  mx=100; nx=100;
  Left=1; Right=-1;
  Trace=-1;
 
type
  tLabyrinth=array[0..mx,0..nx]of integer;
 
var
  m,n,m1,n1,x,y,dx,dy,k,l,x0,i,j:integer;
  Lab:tLabyrinth;
  f:text;
  c:char;
 
procedure Show;
var
  i,j:integer;
begin
  for j:=0 to n1 do begin
    for i:=0 to m1 do begin
      l:=Lab[i,j];
      if l>0 then begin
        TextColor(l+7);
        Write('*');
        TextColor(7)
      end
      else if l=0 then Write(' ')
      else Write('#');
    end;
    WriteLn
  end
end;
 
 
procedure Turn(dir:integer; var x,y:integer);
var
  z:integer;
begin
  z:=x;
  x:=dir*y;
  y:=-dir*z
end;
 
 
procedure Step(var x,y,dx,dy:integer);
begin
  Turn(Left,dx,dy);
  while Lab[x+dx,y+dy]>0 do Turn(Right,dx,dy);
  x:=x+dx;
  y:=y+dy
end;
 
 
begin
  {Read the data file}
  Assign(f,'labyrinth_0_0.dat');
  ReSet(f);
  m1:=-1;
  while not EoLn(f) do begin
    Read(f,c);
    Inc(m1);
    case c of
      '1',' ': Lab[m1,0]:=1;
      '0': Lab[m1,0]:=0
    end
  end;
  ReadLn(f);
  n1:=0;
  while not EoF(f) do begin
    Inc(n1);
    for i:=0 to m1 do begin
      Read(f,c);
      case c of
        '1',' ': Lab[i,n1]:=1;
        '0': Lab[i,n1]:=0
      end
    end;
    ReadLn(f)
  end;
  m:=m1-1; n:=n1-1;
  Close(f);
 
  {Passing}
  k:=0;
  WriteLn('Labyrinth ',m,'x',n);
  {Probing all the entries}
  for x0:=m downto 1 do if Lab[x0,0]=0 then begin
    Inc(k);
    x:=x0;
    y:=1;
    dx:=0;
    dy:=1;
    while (y>0)and(y<n1) do begin
      Inc(Lab[x,y],Trace);
      Step (x,y,dx,dy);
    end;
    Write('Entry ',k,': ');
    if y=0 then WriteLn('No way!') else WriteLn('Passed.');
    for j:=1 to n do for i:=1 to m do if Lab[i,j]<0 then Lab[i,j]:=k+1;
    Show;
    Write('Press Enter..');
    ReadLn;
    WriteLn
  end;
  WriteLn('Done.')
end.