program IRR(input,putput);
(* Quelle: http://www.iee.et.tu-dresden.de/~kc-club/09/RUBRIK17.HTM *)

type
  str1         = string[  1];
  str3         = string[  3];
  str80        = string[ 80];
  str255       = string[255];
var
  lbfbc        : str255;
  lbfbb        : char;
  lbfba        : boolean;
  lbfb8        : integer;
  lbfb6        : integer;
  lbfb4        : integer;
  lbfb2        : integer;
  lbfb0        : integer;
  lbfae        : integer;
  lbfac        : integer;
  lbfaa        : integer;
  lbfa8        : integer;
  lbfa6        : integer;
  lbfa4        : integer;
  lbfa2        : integer;
  lbfa0        : integer;
  lbf9e        : integer;
  lbf9c        : integer;
  lbde3        : array[1..20,1..20] of char;    (* ?????? *)
  lbde1        : str1;
  lbddf        : str1;
  lbd8e        : str80;
  lbd3d        : str80;
  lbcec        : str80;
  lbc9b        : str80;
  lbc4a        : str80;
  lbbf9        : str80;
  lbba8        : str80;
  lbb57        : str80;
const
  l1fe7        : array[1..7] of str1=('N','O','S','W','N','O','S');
  l1ff5        : array[1..4,1..4,1..6] of byte =
                      ((($20,$0f,$03,$07,$03,$07),
                        ($14,$09,$02,$05,$02,$05),
                        ($0c,$05,$01,$03,$01,$03),
                        ($08,$03,$00,$01,$00,$01)),
                       (($05,$05,$01,$05,$01,$05),
                        ($08,$08,$05,$08,$05,$08),
                        ($0a,$0a,$08,$0a,$08,$0a),
                        ($0b,$0b,$0a,$0b,$0a,$0b)),
                       (($13,$38,$17,$13,$17,$13),
                        ($10,$32,$13,$10,$13,$10),
                        ($0e,$2e,$10,$0e,$10,$0e),
                        ($0d,$2c,$0e,$0d,$0e,$0d)),
                       (($18,$17,$10,$10,$3f,$39),
                        ($1e,$1d,$18,$18,$37,$33),
                        ($22,$21,$1e,$1e,$31,$2f),
                        ($24,$23,$22,$22,$2d,$2d)));
label 88,99;

procedure l2055(lba57:str255;lba55,lba53:integer);
(* Ausgabe an Cursorposition *)
var
  lba4b        : str3;
Begin
  gotoxy(lba55,lba53);
(*  lba4b:=#$1b+chr(lba55+$7F)+chr(lba53+$7F); *)
  write(lba4b);
  write(lba57);
End;

procedure l20b7;
Begin
  lbfa4:=0;
  lbfa4:=0;
  case lbf9c of
    1 : lbfa4:=-1;
    2 : lbfa2:=+1;
    3 : lbfa4:=+1;
    4 : lbfa2:=-1;
  end;
End;

procedure l210f;
Begin
  lbfb8:=0;
  repeat
    lbfb8:=lbfb8+1;
    case lbfb8 of
      1 : l2055(lbc9b,19,25);
      2 : l2055(lbcec,16,31);
      3 : l2055(lbd3d,14,35);
      4 : l2055(lbd8e,13,36);
    end;
  until lbfb8=lbfaa;
End;

procedure l21a9;
Begin
  if lbfa8>=lbfaa then
  begin
    gotoxy(37,12);
    write('FERTIG');
    lbba8[0]:=chr(l1ff5[1,lbfaa,1]);
    l2055(lbba8,l1ff5[2,lbfaa,1],l1ff5[4,lbfaa,1]);
    l2055(lbba8,l1ff5[3,lbfaa,1],l1ff5[4,lbfaa,1]);
  end else
  begin
    lbc4a[0]:=chr(l1ff5[1,lbfaa,1]);
    lbbf9[0]:=lbc4a[0];
    l2055(lbc4a,l1ff5[2,lbfaa,1],l1ff5[4,lbfaa,1]);
    l2055(lbbf9,l1ff5[3,lbfaa,1],l1ff5[4,lbfaa,1]);
  end;
End;

procedure l23bc;
Begin
  lbb57[0]:=chr(3*l1ff5[1,lbf9e,2]);
  l2055(lbb57,l1ff5[2,lbf9e,2],l1ff5[4,lbf9e,2]);
  l2055(lbb57,l1ff5[2,lbf9e,2],l1ff5[3,lbf9e,2]);
End;

procedure l24ab;
Begin
  for lbfb6:=l1ff5[1,lbf9e,3] downto 0 do
  begin
    l2055(lbde1,l1ff5[2,lbf9e,3]+lbfb6,l1ff5[4,lbf9e,3]+2*lbfb6);
    l2055(lbddf,l1ff5[3,lbf9e,3]-lbfb6,l1ff5[4,lbf9e,3]+2*lbfb6);
  end;
End;

procedure l25ca;
Begin
  for lbfb6:=l1ff5[1,lbf9e,5] downto 0 do
  begin
    l2055(lbddf,l1ff5[2,lbf9e,5]+lbfb6,l1ff5[4,lbf9e,5]-2*lbfb6);
    l2055(lbde1,l1ff5[3,lbf9e,5]-lbfb6,l1ff5[4,lbf9e,5]-2*lbfb6);
  end;
End;

procedure l26ef;
Begin
  lbc4a[0]:=chr(l1ff5[1,lbf9e,4]);
  lbbf9[0]:=lbc4a[0];
  l2055(lbc4a,l1ff5[2,lbf9e,4],l1ff5[4,lbf9e,4]);
  l2055(lbbf9,l1ff5[3,lbf9e,4],l1ff5[4,lbf9e,4]);
End;

procedure l27ef;
Begin
  lbc4a[0]:=chr(l1ff5[1,lbf9e,6]);
  lbbf9[0]:=lbc4a[0];
  l2055(lbc4a,l1ff5[2,lbf9e,6],l1ff5[4,lbf9e,6]);
  l2055(lbbf9,l1ff5[3,lbf9e,6],l1ff5[4,lbf9e,6]);
End;

procedure l28ef;
Begin
  clrscr;
  lbfa8:=0;
  for lbfb8:=1 to 4 do
  begin
    lbfaa:=lbfb8;
    if lbde3[lbfb4+lbfa4*lbfb8,lbfb2+lbfa2*lbfb8]='*' then exit;
    if (((lbfb2+lbfa2*lbfb8)=lbfb0) and ((lbfb2+lbfa2*lbfb8)=lbfae)) then
    begin
      lbfa8:=lbfaa+1;
      exit;
    end;
    lbfa8:=lbfb8;
  end;
  l2055(l1fe7[lbf9c],1,40);
  l2055(l1fe7[lbf9c+1],2,42);
  l2055(l1fe7[lbf9c+3],2,38);
  l2055(l1fe7[lbf9c+2],3,40);
  l210f;
  if lbfa8<>lbfaa then l21a9;
  for lbfb8:=lbfaa-1 downto 0 do
  begin
    lbf9e:=lbfb8+1;
    l23bc;
    if lbde3[lbfb4+lbfa4*lbfb8-lbfa2,lbfb2+lbfa2*lbfb8+lbfa4]='*' then l24ab
                                                                  else l26ef;
    if lbde3[lbfb4+lbfa4*lbfb8+lbfa2,lbfb2+lbfa2*lbfb8-lbfa4]='*' then l25ca
                                                                  else l27ef;
  end;
End;

procedure l2b41;
Begin
  clrscr;
  for lbfb8:=1 to 20 do
  begin
    lbfbc:='';
    for lbfb6:=1 to 20 do
    begin
      lbfbc:=lbfbc+lbde3[lbfb8,lbfb6]+' ';
    end;
    l2055(lbfbc,lbfb8,2+lbfa6);
  end;
  case lbf9c of
    1 : begin
          lbfbc:='^';
          l2055(lbfbc,lbfb4,2*lbfb2+lbfa6);
        end;
    2 : begin
          lbfbc:='>';
          l2055(lbfbc,lbfb4,2*lbfb2+lbfa6);
        end;
    3 : begin
          lbfbc:='v';
          l2055(lbfbc,lbfb4,2*lbfb2+lbfa6);
        end;
    4 : begin
          lbfbc:='<';
          l2055(lbfbc,lbfb4,2*lbfb2+lbfa6);
        end;
  end;
  lbfbc:='#';
  l2055(lbfbc,lbfb0,2*lbfae+lbfa6);
  gotoxy(18,24);
  case lbfac of
     4 : write('  Gute Reise durch''s Labyrinth  !!  ');
     3 : write('  Gib Dir bitte etwas mehr Muehe !! ');
     2 : write('Jetzt hast Du noch eine Chance  ! ');
     1 : write('Allerletzte Orientierungshilfe !!!');
    else write('BETRUG !!! Das ist kein Fairplay !!');
  end;
  write('Taste  ET':20);
  lbfac:=lbfac-1;
  read(kbd,lbfbb);
End;

procedure l2e50;
Begin
  if lbf9c=0 then lbf9c:=4
             else if lbf9c=5 then lbf9c:=1;
  lbfaa:=0;
  lbfa8:=0;
  lbfba:=false;
  case lbf9c of
    1 : lbfaa:=+1;
    2 : lbfa8:=-1;
    3 : lbfaa:=-1;
    4 : lbfa8:=+1;
  end;
End;

procedure l2ede;
Begin
  lbfb4:=2;
  lbfb2:=19;
  lbfb0:=19;
  lbfae:=2;
  lbf9c:=1;
  lbfaa:=1;
  lbfa8:=0;
  lbfb8:=lbfb4;
  lbfb6:=lbfb2;
  repeat
    repeat
      if lbde3[lbfb8+lbfaa,lbfb6+lbfa8]='*' then
      begin
        lbf9c:=lbf9c-1;
        l2e50;
      end else lbfba:=true;
    until lbfba;
    lbfb8:=lbfb8+lbfaa;
    lbfb6:=lbfb6+lbfa8;
    lbf9c:=lbf9c+1;
    lbf9c:=lbf9c+1;
    l2e50;
    lbfba:=true;
    if ((lbfb8=lbfb4) and (lbfb6=lbfb2)) then
    begin
      lbfb8:=lbfb0;
      lbfb6:=lbfae;
      lbfba:=false;
    end;
  until ((lbfb8=lbfb0) and (lbfb6=lbfae));
End;

BEGIN
  lbde1:='\';
  lbddf:='/';
  lbc4a[0]:=chr(80);
  lbbf9[0]:=chr(ord(lbc4a[0]));
  lbba8[0]:=chr(80);
  lbb57:='';
  fillchar(lbc4a[1],80,'~');
  fillchar(lbbf9[1],80,'_');
  fillchar(lbba8[1],80,'*');
  for lbfb8:=1 to 26 do lbb57:=lbb57+'|'+^J+^H;
  lbd8e:=copy(lbbf9,1,8);
  lbd3d:=copy(lbbf9,1,10);
  lbcec:=copy(lbbf9,1,18);
  lbc9b:=copy(lbbf9,1,30);
  lbfa6:=15;
  for lbfb8:=1 to 20 do
  begin
    lbde3[1,lbfb8]:='*';
    lbde3[lbfb8,1]:='*';
    lbde3[20,lbfb8]:='*';
    lbde3[lbfb8,20]:='*';
  end;
88:
  for lbfb8:=1 to 9 do
    for lbfb6:=1 to 9 do
    begin
      lbde3[lbfb8*2,lbfb6*2]:=' ';
      lbde3[lbfb8*2+1,lbfb6*2+1]:='*';
      lbde3[lbfb8*2,lbfb6*2+1]:=' ';
      lbde3[lbfb8*2+1,lbfb6*2]:=' ';
      lbfa0:=random(9);
      if ((lbfa0>3) and (lbfa0<=6)) then lbde3[lbfb8*2,lbfb6*2+1]:='*';
      if lbfa0>=6 then lbde3[lbfb8*2+1,lbfb6*2]:='*';
    end;
  lbde3[18,7]:=' ';
  for lbfb8:=2 to 4 do
  begin
    lbde3[21-lbfb8,2]:=' ';
    lbde3[18,lbfb8]:=' ';
    lbde3[2,21-lbfb8]:=' ';
    lbde3[lbfb8,18]:=' ';
  end;
  l2ede;
  if not lbfba then goto 88;
  clrscr;
  gotoxy(20,3);
  write('* I R R G A R T E N * ');
  gotoxy(5,6);
  writeln('Durchlaufe die Gaenge des Irrgartens bis zum Ausgang! Zu Deiner    ');
  writeln('Orientierung kannst Du viermal den Grundriss einblenden.');
  writeln('Der Ausgang ist mit # markiert, ');
  writeln('Dein Standort mit einem > in Bewegungsrichtung!  ');
  writeln('Du kannst Dich auch nach dem Kompass am oberen Bildrand orientieren, ');
  writeln('der Grundriss ist eingenordet.');
  writeln;
  writeln('Steuertasten:    ');
  writeln('         8 - Vorwaerts   ');
  writeln('         4 - Linkswendung    ');
  writeln('         6 - Rechtswendung    ');
  writeln;
  writeln('Grundriss einblenden - "M"               Abbruch - CTRL C.');
  gotoxy(60,24);
  write('Taste ET');
  read(kbd,lbfbb);
  lbfb0:=2;
  lbfae:=19;
  lbfac:=4;  (* Anzahl Grundrisseinblendungen einstellen *)
  lbfb4:=19;
  lbfb2:=2;
  lbfa4:=-1;
  lbfa2:=0;
  lbf9c:=1;
  l2b41;
  lbfb4:=20;
  lbfbb:='8';  (* Vorwaerts *)
  repeat
    case lbfbb of
      '0' : delay(110);
      'M' : begin (* Grundriss einblenden *)
              if lbfac>0 then
              begin
                l2b41;
                l28ef;
              end else
              begin
                gotoxy(18,24);
                write('  Es gibt keine Hilfestellung mehr !!!   ');
                delay(5000);
                l28ef;
              end;
            end;
      #$1b: begin (* Grundriss IMMER einblenden *)
              l2b41;
              l28ef;
            end;
      '4' : begin  (* Linkswendung *)
              lbf9c:=lbf9c-1;
              if lbf9c=0 then lbf9c:=4;
              l20b7;
              l28ef;
            end;
      '6' : begin  (* Rechtswendung *)
              lbf9c:=lbf9c+1;
              if lbf9c>4 then lbf9c:=1;
              l20b7;
              l28ef;
            end;
      '8' : begin (* Vorwaerts *)
              if lbde3[lbfb4+lbfa4,lbfb2+lbfa2]<>'*' then ;
              begin
                lbfb4:=lbfb4+lbfa4;
                lbfb2:=lbfb2+lbfa2;
              end;
              if ((lbfb4=lbfb0) and (lbfb2=lbfae)) then goto 99
                 else l28ef;
            end;
    end;
    gotoxy(80,24);
    lbfbb:='0';
    if keypressed then
    repeat
      read(kbd,lbfbb);
      lbfbb:=upcase(lbfbb);
    until lbfbb in [^C,'M',#$1b,'4','6','8'];
    if lbfbb=^C then
    begin
      clrscr;
      halt;
    end;
  until false;
99:
  clrscr;
  gotoxy(30,12);
  write(' Hervorragend   !!!');
  repeat
    gotoxy(51,23);
    write(' Nochmal ? J/N ');
    read(kbd,lbfbb);
    lbfbb:=upcase(lbfbb);
  until lbfbb in [^M,'A','N'];
  if lbfbb<>'N' then goto 88;
  clrscr;
END.