home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / TURBOPAS / MAZE.LBR / MAZE3D.PZS / MAZE3D.PAS
Pascal/Delphi Source File  |  2000-06-30  |  8KB  |  247 lines
  1. const
  2.      hsize=10;
  3.      vsize=10;
  4.      dsize=10;
  5.      cpoints=5;
  6.      points=6;
  7. type
  8.     mazetype=array[1..hsize,1..vsize,1..dsize] of byte;
  9.  
  10. var
  11.    maze:mazetype;
  12.    j:byte;
  13. procedure mazeinit(var maze:mazetype);
  14. begin
  15.      fillchar(maze,hsize*vsize*dsize,$FF);
  16. end;
  17.  
  18. procedure move(x,y,z:integer; dir:byte; var tx,ty,tz:integer);
  19. begin
  20.      tx:=x; ty:=y; tz:=z;
  21.      case (dir mod points) of
  22.           0:ty:=ty-1;
  23.           1:tx:=tx+1;
  24.           2:tz:=tz-1;
  25.           3:ty:=ty+1;
  26.           4:tx:=tx-1;
  27.           5:tz:=tz+1;
  28.      end; {case}
  29. end; {move}
  30.  
  31. function bit(t:byte; tbit:byte):boolean;
  32. begin
  33.      bit:=(t and (1 shl tbit))>0;
  34. end;
  35.  
  36. function empty(var x,y,z:integer; var maze:mazetype):boolean;
  37. begin
  38.      if not ((x in [1..hsize]) and (y in [1..vsize]) and (z in [1..dsize])) then
  39.         empty:=false
  40.      else
  41.         empty:=(maze[x,y,z]=$FF);
  42. end;
  43.  
  44. procedure makedoor(var x,y,z:integer; dir:byte; var maze:mazetype);
  45. begin
  46.      dir:=dir mod points;
  47.      maze[x,y,z]:=maze[x,y,z] and ($FF xor (1 shl dir));
  48.      move(x,y,z,dir,x,y,z);
  49.      dir:=(dir+3) mod points;
  50.      maze[x,y,z]:=maze[x,y,z] and ($FF xor (1 shl dir));
  51. end; {makedoor}
  52.  
  53. procedure mazefill(var maze:mazetype);
  54. var
  55.    m,x,y,z,tx,ty,tz:integer;
  56.    done:boolean;
  57.    d:byte;
  58.    filled:integer;
  59.  
  60. begin
  61.      filled:=1;
  62.      mazeinit(maze);
  63.      x:=random(hsize)+1;
  64.      y:=random(vsize)+1;
  65.      z:=random(dsize)+1;
  66.      repeat {fill}
  67.             repeat {advance}
  68.                    d:=random(cpoints);
  69.                    done:=false;
  70.                    for m:=0 to cpoints do
  71.                    begin
  72.                         move(x,y,z,d+m,tx,ty,tz);
  73.                         if empty(tx,ty,tz,maze) and not done then
  74.                         begin
  75.                              done:=true;
  76.                              filled:=filled+1;
  77.                              makedoor(x,y,z,d+m,maze);
  78.                         end;
  79.                    end; {for}
  80.             until not done; {no place to advance}
  81.             d:=0;
  82.             write('Blocks:',filled:0,'    '^M);
  83.             repeat {retreat}
  84.                    done:=false;
  85.                    maze[x,y,z]:=maze[x,y,z] and $7F; {no need to reexplore}
  86.                    for m:=cpoints to cpoints+points do {find retreat}
  87.                        if not bit(maze[x,y,z],m mod points) and not done then
  88.                        begin
  89.                             move(x,y,z,m,tx,ty,tz);
  90.                             if bit(maze[tx,ty,tz],7) then
  91.                             begin
  92.                                done:=true;
  93.                                x:=tx; y:=ty; z:=tz;
  94.                             end;
  95.                        end;
  96.                    if not done then write('Error in Retreat');
  97.                    done:=false;
  98.                    for m:=0 to cpoints do {empty space near?}
  99.                    begin
  100.                         move(x,y,z,m,tx,ty,tz);
  101.                         if empty(tx,ty,tz,maze) then done:=true;
  102.                    end;
  103.             until done or (filled=hsize*vsize*dsize);
  104.      until filled=hsize*vsize*dsize;
  105.      for m:=0 to (hsize+vsize+dsize) do
  106.      begin
  107.           d:=random(points);
  108.           x:=random(hsize-2)+2;
  109.           y:=random(vsize-2)+2;
  110.           z:=random(dsize-2)+2;
  111.           makedoor(x,y,z,d,maze);
  112.      end;
  113. end; {mazefill}
  114.  
  115. procedure map(var maze:mazetype; lvl:byte);
  116. var i,j,k,l:integer;
  117. begin
  118.      k:=lvl; begin
  119.          writeln(#1#27'~uLevel #',k:0,'    ');
  120.          writeln;
  121.          for i:=1 to hsize do write('__');
  122.          writeln('_');
  123.          for j:=1 to vsize do
  124.          begin
  125.               for i:=1 to hsize do
  126.               begin
  127.                   l:=maze[i,j,k];
  128.                   write(#27'~U');
  129.                   if bit(l,4) then write('|') else write(' ');
  130.                   if not bit(l,3) then write(#27,'~u');
  131.                   l:=l and 36;
  132.                   if l=4 then write('+');
  133.                   if l=32 then write('-');
  134.                   if l=0 then write(':');
  135.                   if l=36 then write(' ');
  136.               end;
  137.               writeln(#27'~U|');
  138.          end;
  139.      end;
  140. end; {map}
  141.  
  142. procedure help;
  143. begin
  144.      writeln(
  145. 'Mission Impossible: (OxWold Computing presents Version 0.1)'^J^M,
  146. ^J,
  147. 'Your mission, Mr. Phelps, should you choose to accept it, is to apprehend'^J^M,
  148. 'the infamous Blohn Feuws, alias the Mad Bomber.  The suspect is currently'^J^M,
  149. 'residing in his mansion in Los Altos.  Move with extreme caution.  He is'^J^M,
  150. 'carrying a 20 mega-Ton bomb, and has threatened to kill himself, and sink'^J^M,
  151. 'California with him, if he isn''t given 400 million dollars by 5 o''clock.'^J^M,
  152. ^J,
  153. '   Your task will be complicated by the fact that the bomber''s mansion is'^J^M,
  154. 'actually a 10 level maze of a hundred rooms each.  Central will issue you'^J^M,
  155. 'special equipment to complete your task.'^J^M,
  156. '   As usual, the California authorities refuse to capitulate to the threats'^J^M,
  157. 'of a terrorist.  It is now five minutes before 5 o''clock.  You have only '^J^M,
  158. 'five minutes to complete your task.'^J^M,
  159. '   As usual, the secretary will disavow any knowlege of your actions.  This'^J^M,
  160. 'tape will self-destruct in 10 seconds.');
  161.       while not keypressed do j:=random(10);
  162.       read(kbd);
  163.       clrscr;
  164.       writeln(
  165. 'Your equipment includes:'^J^M,
  166. '               1 tracing locator locked on to the mad bomber'^J^M,
  167. '               1 count up timer (up to 500)'^J^M,
  168. '     <F>       2 pieces of plastique'^J^M,
  169. '               1 remote display device'^J^M,
  170. '         <N>      Move remote north'^J^M,
  171. '         <E>      Move remote east'^J^M,
  172. '         <S>      Move remote south'^J^M,
  173. '         <W>      Move remote west'^J^M,
  174. '         <U>      Move remote up'^J^M,
  175. '         <D>      Move remote down'^J^M,
  176. '     <Q>       1 way to quit the game'^J^M);
  177. end;
  178. var
  179.    x,tx,y,ty,z,tz,m,gx,gy,gz,fire,t:integer;
  180.    c:char;
  181.    pd,phi,theta,r:real;
  182. begin
  183.      t:=0;
  184.      clrscr;
  185.      help;
  186.      fire:=0;
  187.      mazefill(maze);
  188.      while not keypressed do;
  189.      clrscr;
  190.      x:=1; y:=1; z:=1;
  191.      Gx:=random(hsize)+1;
  192.      Gy:=random(vsize)+1;
  193.      Gz:=random(dsize)+1;
  194.      map(maze,z);
  195.      repeat
  196.            gotoxy(1,23);
  197.            pd:=sqrt(sqr(x-gx)+sqr(y-gy));
  198.            r:=sqrt(sqr(pd)+sqr(z-gz));
  199.            theta:=arctan((y-gy+0.001)/(x-gx+0.002))/pi*180;
  200.            phi:=arctan((z-gz+0.001)/(pd+0.002))/pi*180;
  201.            writeln(#27'~uDistance-- R:',r:0:2,' Theta:',theta:0:0,' Phi:',phi:0:0,'     ');
  202.            while not keypressed do begin
  203.                  gotoxy(40,23);
  204.                  write('Time:',t);
  205.                  t:=t+1;
  206.                  gotoxy(x*2,y+3);
  207.                  m:=0;
  208.                  while not keypressed and (m<1000) do
  209.                        m:=m+1;
  210.            end;
  211.            read(kbd,c);
  212.            c:=upcase(c);
  213.            case c of
  214.                 'Q':;
  215.                 'F':if fire<2 then begin
  216.                          fire:=fire+1;
  217.                          for m:=0 to cpoints do begin
  218.                              move(x,y,z,m,tx,ty,tz);
  219.                              if (tx in [1..hsize]) and
  220.                                 (ty in [1..vsize]) and
  221.                                 (tz in [1..dsize]) then
  222.                                     makedoor(tx,ty,tz,m+3,maze);
  223.                          end;
  224.                          map(maze,z);
  225.                     end;
  226.                 'N':if not bit(maze[x,y,z],0) then y:=y-1;
  227.                 'S':if not bit(maze[x,y,z],3) then y:=y+1;
  228.                 'E':if not bit(maze[x,y,z],1) then x:=x+1;
  229.                 'W':if not bit(maze[x,y,z],4) then x:=x-1;
  230.                 'U':if not bit(maze[x,y,z],2) then
  231.                     begin
  232.                          z:=z-1;
  233.                          map(maze,z);
  234.                     end;
  235.                 'D':if not bit(maze[x,y,z],5) then
  236.                     begin
  237.                          z:=z+1;
  238.                          map(maze,z);
  239.                     end;
  240.            end;
  241.      until (c='Q') or ((gx=x) and (gy=y) and (gz=z)) or (t>500);
  242.      clrscr;
  243.      if (c='Q') or (t>500) then writeln('Kaboom! You died.')
  244.      else writeln('Hurrah! You saved the day!');
  245.      write(#27'~u');
  246. end.
  247.