home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / MAZE.ZIP / MAZE.PAS
Encoding:
Pascal/Delphi Source File  |  1985-12-28  |  7.0 KB  |  277 lines
  1. program Maze;
  2. (*
  3.  **
  4.  ***   Create and solve mazes on the "tube"
  5.  *
  6.  *  Thanks to: "Advanced PASCAL Programming Techniques"
  7.  *             Paul A. Sand - Osborne/McGraw-Hill
  8.  **
  9.  *)
  10. CONST
  11.   MAZECOLS   = 79;  (* Maximum Maze column index *)
  12.   MAZEROWS   = 22;  (* Maximum Maze row index *0
  13.   MAXCOLS    = 79;  (* Maximum CRT horizontal postion *)
  14.   MAXROWS    = 23;  (* Maximum CRT vertical position *)
  15.   XIndent:integer = 1;   (* left margin amount *)
  16.   YIndent:integer = 1;   (* top margin amount *)
  17.   SPEED:Integer   = 0;   (* speed of action *)
  18.  
  19. TYPE
  20.   mazesquare  = (WALL,PATH);
  21.   mazearray   = array [0..MAZEROWS, 0..MAZECOLS] of mazesquare;
  22.   direction   = (UP, DOWN, LEFT, RIGHT);
  23.  
  24. VAR
  25.   Maze     : mazearray;
  26.   won      : boolean;
  27.   ch       : char;
  28.   mins,
  29.   secs     : integer;
  30.  
  31. (*$I CreateMaze.pas *)
  32. (*
  33.  **
  34.  ***   Create a maze in MAZEARRAY
  35.  **
  36.  *)
  37.  
  38. Procedure DispSquare( CH:Char; row, col : Integer );
  39. (* Display specified character in maze square *)
  40. begin (* DispSquare *)
  41.   gotoXY( col+XINDENT, row+YINDENT );
  42.   write( ch );
  43.   delay( SPEED )
  44.   end;
  45.  
  46. Procedure CREATEMAZE( Var Maze : mazearray );
  47.  
  48. VAR
  49.   row,
  50.   col      : integer;
  51.   dir      : direction;
  52.  
  53. Procedure SetSquare( row, col : Integer; Val:Mazesquare );
  54. (* Set the maze square to a given value *)
  55. begin (* SetSquare *)
  56.   maze[row, col] := val;
  57.   case val of
  58.     PATH : dispsquare(' ', row, col );
  59.     WALL : dispsquare('X', row, col );
  60.     end
  61.   end;
  62.  
  63. Function rnd( low, high : Integer ):Integer;
  64. (* Return random value with limits *)
  65.  
  66. begin (* rnd *)
  67.   rnd := low + random(high-low+1)
  68.   end (* rnd *);
  69.  
  70. Function rnddir : Direction;
  71. (* returns a random, legal direction *)
  72. begin (* rnddir *)
  73.   case rnd(1,4) of
  74.     1: rnddir := UP;
  75.     2: rnddir := DOWN;
  76.     3: rnddir := LEFT;
  77.     4: rnddir := RIGHT
  78.     end
  79.   end (* rnddir *);
  80.  
  81. Function LegalPath( row, col: Integer; dir: Direction): boolean;
  82. (* returns legality of path *)
  83. VAR
  84.   Legal : Boolean;
  85.  
  86. BEGIN (* legal Path *)
  87.   legal := FALSE;
  88.   case dir of
  89.     UP   : if row > 2
  90.            then legal := ( maze[row-2,col] = WALL);
  91.     LEFT : if col > 2
  92.            then legal := ( maze[row,col-2] = WALL);
  93.     DOWN : if row < MAZEROWS - 2
  94.            then legal := ( maze[row+2,col] = WALL);
  95.     RIGHT: if col < MAZECOLS - 2
  96.            then legal := ( maze[row,col+2] = WALL);
  97.     end;
  98.   LegalPath := legal
  99.   end (* LegalPath *);
  100.  
  101. Procedure BuildPath( row,col : Integer; Dir : direction );
  102. (* extend a path in specified direction *)
  103. VAR
  104.   Unused : set of direction;
  105.  
  106. Begin(* BuildPath *)
  107.   case dir of
  108.     UP: begin
  109.       setsquare(row-1,col,path );
  110.       setsquare(row-2,col,path );
  111.       row := row-2
  112.       end;
  113.     DOWN: begin
  114.       setsquare(row+1,col,path );
  115.       setsquare(row+2,col,path );
  116.       row := row+2
  117.       end;
  118.     LEFT: begin
  119.       setsquare(row,col-1,PATH);
  120.       setsquare(row,col-2,PATH);
  121.       col := col-2
  122.       end;
  123.     RIGHT: begin
  124.       setsquare(row,col+1,PATH);
  125.       setsquare(row,col+2,PATH);
  126.       col := col+2
  127.       end
  128.     end;
  129.   unused := [UP..RIGHT];
  130.   repeat
  131.     dir := rnddir;
  132.     if dir in unused
  133.     then begin
  134.       unused := unused - [dir];
  135.       if LegalPath(row,col,dir)
  136.       then buildpath(row,col,dir)
  137.       end;
  138.     until unused = []
  139.     end;
  140.  
  141. begin (* Createmaze *)
  142.   for row := 0 to MAZEROWS do
  143.     for col := 0 to MAZECOLS do
  144.       setsquare( row, col, WALL );
  145.   row := 2 * rnd(0,MAZEROWS div 2 - 1) + 1;
  146.   col := 2 * rnd(0,MAZECOLS div 2 - 1) + 1;
  147.   setsquare( row,col,PATH );
  148.   repeat
  149.     dir := rnddir
  150.     until legalpath( row,col,dir );
  151.   buildpath( row,col,dir );
  152.   col := 2 * rnd(0,MAZECOLS div 2 - 1) + 1;
  153.   setsquare( 0,col,PATH );
  154.   col := 2 * rnd(0,MAZECOLS div 2 - 1) + 1;
  155.   setsquare( MAZEROWS,col,PATH )
  156. end (* CreateMaze *);
  157. (*$I SolveMaze.pas  *)
  158. (*
  159.  **
  160.  ***   Solve the Maze
  161.  **
  162.  *)
  163.  
  164. Procedure ShowMove( row,col : Integer; dir : direction );
  165. (* show a move *)
  166. begin
  167.   case dir of
  168.     UP, DOWN:    dispsquare('!',row,col);
  169.     RIGHT, LEFT: dispsquare('-',row,col)
  170.     end
  171.   end;
  172.  
  173. Procedure EraseMove(row,col:Integer);
  174. (* Erase a move *)
  175. VAR
  176.   SaveSpeed : integer;
  177. begin (* EraseMove *)
  178.   SaveSpeed := Speed; Speed := 0;(* rewind at full speed *)
  179.   dispsquare(' ',row,col); speed := SaveSpeed;
  180.   end;
  181.  
  182.  
  183. Function SolveMaze( VAR maze : mazearray ) : Boolean;
  184. (* attempt to solve the maze *)
  185. VAR
  186.   solved : boolean;
  187.   row, col : Integer;
  188.   tried : array [0..MAZEROWS, 0..MAZECOLS] of Boolean;
  189.  
  190. Function Try(row, col : Integer; dir : direction ): boolean;
  191. (* test solution from this point *)
  192. VAR
  193.   ok : boolean;
  194.  
  195. begin (* try *)
  196.   ok := (maze[row,col] = PATH);
  197.   if ok then begin
  198.     tried[row,col] := TRUE;
  199.     case dir of
  200.       UP: row := pred(row);
  201.       DOWN: row := succ(row);
  202.       LEFT: col := pred(col);
  203.       RIGHT: col := succ(col)
  204.       end;
  205.     ok := ((maze[row,col]=PATH) and (not tried[row,col]));
  206.     if ok then begin
  207.       showmove(row,col,dir);
  208.       ok := (row <= 0) or (row >= MAZEROWS) or
  209.             (col <= 0) or (col >= MAZECOLS);
  210.       if NOT ok
  211.       then ok := try(row,col,DOWN);
  212.       if NOT ok
  213.       then ok := try(row,col,LEFT);
  214.       if NOT ok
  215.       then ok := try(row,col,RIGHT);
  216.       if NOT ok
  217.       then ok := try(row,col,UP);
  218.       if NOT ok
  219.       then (* no solution available from this point *) erasemove(row,col)
  220.       end;
  221.     end;
  222.   try := ok;
  223.   end;
  224.  
  225. begin(* solvemaze *)
  226.   for row := 0 to MAZEROWS do
  227.     for col := 0 to MAZECOLS do
  228.       tried [row,col] := FALSE;
  229.   solved := false;
  230.   col := 0; row := 1;
  231.   while NOT solved and (row < MAZEROWS) do begin
  232.     solved := try(row,col,RIGHT);
  233.     row := succ(row)
  234.     end;
  235.   col := MAZECOLS; row := 1;
  236.   while NOT solved and (row < MAZEROWS) do begin
  237.     solved := try(row,col,LEFT);
  238.     row := succ(row)
  239.     end;
  240.   col := 1; row := 0;
  241.   while NOT solved and (row < MAZEROWS) do begin
  242.     solved := try(row,col,DOWN);
  243.     col := succ(col)
  244.     end;
  245.   col := 1; row := MAZEROWS;
  246.   while NOT solved and (row < MAZEROWS) do begin
  247.     solved := try(row,col,UP);
  248.     col := succ(col)
  249.     end;
  250.   solvemaze := solved
  251.   end (* SolveMaze *);
  252.  
  253. Begin (* Maze *)
  254.   randomize;
  255. (* Note: a timer routine has not been implemented yet *)
  256.   repeat
  257.     ClrScr;
  258.     createmaze( maze );
  259.     gotoXY( 10,MAXROWS+1 );
  260.     write( 'Press <C> to Continue' ); read( ch );
  261.     speed := 100;(* slow it down so we can watch *)
  262.     LowVideo;(* change the appearance of the "snake" *)
  263. (*  start := timer; *)
  264.     won := solvemaze( maze );
  265. (*  finish := timer *)
  266. (*  mins := finish-start mod 60; *)
  267. (*  secs := finish-start div 60; *)
  268.     NormVideo;(* go back to standard intensity *)
  269.     gotoXY( 1,MAXROWS+1 );write( 'Time to solve: xx Mins and xx Seconds' );
  270.     gotoXY( WHereX-22,WhereY );Write( mins:2 );
  271.     gotoXY( WhereX+10,WhereY );Write( secs:2 );
  272.     gotoXY( 40,WhereY );write( 'Press <C> to Continue, <Q> to Quit ' );
  273.     speed := 0;(* reset for re-build *) read( ch )
  274.     until UpCase(ch) = 'Q';
  275.   ClrScr
  276. end (* Maze *).
  277.