const
     hsize=10;
     vsize=10;
     dsize=10;
     cpoints=5;
     points=6;
type
    mazetype=array[1..hsize,1..vsize,1..dsize] of byte;

var
   maze:mazetype;
   j:byte;
procedure mazeinit(var maze:mazetype);
begin
     fillchar(maze,hsize*vsize*dsize,$FF);
end;

procedure move(x,y,z:integer; dir:byte; var tx,ty,tz:integer);
begin
     tx:=x; ty:=y; tz:=z;
     case (dir mod points) of
          0:ty:=ty-1;
          1:tx:=tx+1;
          2:tz:=tz-1;
          3:ty:=ty+1;
          4:tx:=tx-1;
          5:tz:=tz+1;
     end; {case}
end; {move}

function bit(t:byte; tbit:byte):boolean;
begin
     bit:=(t and (1 shl tbit))>0;
end;

function empty(var x,y,z:integer; var maze:mazetype):boolean;
begin
     if not ((x in [1..hsize]) and (y in [1..vsize]) and (z in [1..dsize])) then
        empty:=false
     else
        empty:=(maze[x,y,z]=$FF);
end;

procedure makedoor(var x,y,z:integer; dir:byte; var maze:mazetype);
begin
     dir:=dir mod points;
     maze[x,y,z]:=maze[x,y,z] and ($FF xor (1 shl dir));
     move(x,y,z,dir,x,y,z);
     dir:=(dir+3) mod points;
     maze[x,y,z]:=maze[x,y,z] and ($FF xor (1 shl dir));
end; {makedoor}

procedure mazefill(var maze:mazetype);
var
   m,x,y,z,tx,ty,tz:integer;
   done:boolean;
   d:byte;
   filled:integer;

begin
     filled:=1;
     mazeinit(maze);
     x:=random(hsize)+1;
     y:=random(vsize)+1;
     z:=random(dsize)+1;
     repeat {fill}
            repeat {advance}
                   d:=random(cpoints);
                   done:=false;
                   for m:=0 to cpoints do
                   begin
                        move(x,y,z,d+m,tx,ty,tz);
                        if empty(tx,ty,tz,maze) and not done then
                        begin
                             done:=true;
                             filled:=filled+1;
                             makedoor(x,y,z,d+m,maze);
                        end;
                   end; {for}
            until not done; {no place to advance}
            d:=0;
            write('Blocks:',filled:0,'    '^M);
            repeat {retreat}
                   done:=false;
                   maze[x,y,z]:=maze[x,y,z] and $7F; {no need to reexplore}
                   for m:=cpoints to cpoints+points do {find retreat}
                       if not bit(maze[x,y,z],m mod points) and not done then
                       begin
                            move(x,y,z,m,tx,ty,tz);
                            if bit(maze[tx,ty,tz],7) then
                            begin
                               done:=true;
                               x:=tx; y:=ty; z:=tz;
                            end;
                       end;
                   if not done then write('Error in Retreat');
                   done:=false;
                   for m:=0 to cpoints do {empty space near?}
                   begin
                        move(x,y,z,m,tx,ty,tz);
                        if empty(tx,ty,tz,maze) then done:=true;
                   end;
            until done or (filled=hsize*vsize*dsize);
     until filled=hsize*vsize*dsize;
     for m:=0 to (hsize+vsize+dsize) do
     begin
          d:=random(points);
          x:=random(hsize-2)+2;
          y:=random(vsize-2)+2;
          z:=random(dsize-2)+2;
          makedoor(x,y,z,d,maze);
     end;
end; {mazefill}

procedure map(var maze:mazetype; lvl:byte);
var i,j,k,l:integer;
begin
     k:=lvl; begin
         writeln(#1#27'~uLevel #',k:0,'    ');
         writeln;
         for i:=1 to hsize do write('__');
         writeln('_');
         for j:=1 to vsize do
         begin
              for i:=1 to hsize do
              begin
                  l:=maze[i,j,k];
                  write(#27'~U');
                  if bit(l,4) then write('|') else write(' ');
                  if not bit(l,3) then write(#27,'~u');
                  l:=l and 36;
                  if l=4 then write('+');
                  if l=32 then write('-');
                  if l=0 then write(':');
                  if l=36 then write(' ');
              end;
              writeln(#27'~U|');
         end;
     end;
end; {map}

procedure help;
begin
     writeln(
'Mission Impossible: (OxWold Computing presents Version 0.1)'^J^M,
^J,
'Your mission, Mr. Phelps, should you choose to accept it, is to apprehend'^J^M,
'the infamous Blohn Feuws, alias the Mad Bomber.  The suspect is currently'^J^M,
'residing in his mansion in Los Altos.  Move with extreme caution.  He is'^J^M,
'carrying a 20 mega-Ton bomb, and has threatened to kill himself, and sink'^J^M,
'California with him, if he isn''t given 400 million dollars by 5 o''clock.'^J^M,
^J,
'   Your task will be complicated by the fact that the bomber''s mansion is'^J^M,
'actually a 10 level maze of a hundred rooms each.  Central will issue you'^J^M,
'special equipment to complete your task.'^J^M,
'   As usual, the California authorities refuse to capitulate to the threats'^J^M,
'of a terrorist.  It is now five minutes before 5 o''clock.  You have only '^J^M,
'five minutes to complete your task.'^J^M,
'   As usual, the secretary will disavow any knowlege of your actions.  This'^J^M,
'tape will self-destruct in 10 seconds.');
      while not keypressed do j:=random(10);
      read(kbd);
      clrscr;
      writeln(
'Your equipment includes:'^J^M,
'               1 tracing locator locked on to the mad bomber'^J^M,
'               1 count up timer (up to 500)'^J^M,
'     <F>       2 pieces of plastique'^J^M,
'               1 remote display device'^J^M,
'         <N>      Move remote north'^J^M,
'         <E>      Move remote east'^J^M,
'         <S>      Move remote south'^J^M,
'         <W>      Move remote west'^J^M,
'         <U>      Move remote up'^J^M,
'         <D>      Move remote down'^J^M,
'     <Q>       1 way to quit the game'^J^M);
end;
var
   x,tx,y,ty,z,tz,m,gx,gy,gz,fire,t:integer;
   c:char;
   pd,phi,theta,r:real;
begin
     t:=0;
     clrscr;
     help;
     fire:=0;
     mazefill(maze);
     while not keypressed do;
     clrscr;
     x:=1; y:=1; z:=1;
     Gx:=random(hsize)+1;
     Gy:=random(vsize)+1;
     Gz:=random(dsize)+1;
     map(maze,z);
     repeat
           gotoxy(1,23);
           pd:=sqrt(sqr(x-gx)+sqr(y-gy));
           r:=sqrt(sqr(pd)+sqr(z-gz));
           theta:=arctan((y-gy+0.001)/(x-gx+0.002))/pi*180;
           phi:=arctan((z-gz+0.001)/(pd+0.002))/pi*180;
           writeln(#27'~uDistance-- R:',r:0:2,' Theta:',theta:0:0,' Phi:',phi:0:0,'     ');
           while not keypressed do begin
                 gotoxy(40,23);
                 write('Time:',t);
                 t:=t+1;
                 gotoxy(x*2,y+3);
                 m:=0;
                 while not keypressed and (m<1000) do
                       m:=m+1;
           end;
           read(kbd,c);
           c:=upcase(c);
           case c of
                'Q':;
                'F':if fire<2 then begin
                         fire:=fire+1;
                         for m:=0 to cpoints do begin
                             move(x,y,z,m,tx,ty,tz);
                             if (tx in [1..hsize]) and
                                (ty in [1..vsize]) and
                                (tz in [1..dsize]) then
                                    makedoor(tx,ty,tz,m+3,maze);
                         end;
                         map(maze,z);
                    end;
                'N':if not bit(maze[x,y,z],0) then y:=y-1;
                'S':if not bit(maze[x,y,z],3) then y:=y+1;
                'E':if not bit(maze[x,y,z],1) then x:=x+1;
                'W':if not bit(maze[x,y,z],4) then x:=x-1;
                'U':if not bit(maze[x,y,z],2) then
                    begin
                         z:=z-1;
                         map(maze,z);
                    end;
                'D':if not bit(maze[x,y,z],5) then
                    begin
                         z:=z+1;
                         map(maze,z);
                    end;
           end;
     until (c='Q') or ((gx=x) and (gy=y) and (gz=z)) or (t>500);
     clrscr;
     if (c='Q') or (t>500) then writeln('Kaboom! You died.')
     else writeln('Hurrah! You saved the day!');
     write(#27'~u');
end.