PROGRAM theseus;

{$a-}

CONST
  maze_cols   = 78;    {maximum maze column number}
  maze_rows   = 20;    {maximum maze row number}
  max_crt_col = 79;    {maximum crt column number}
  max_crt_row = 23;    {maximum crt row number}
  x_indent    = 0;     {number of columns to indent maze}
  y_indent    = 0;     {number of rows to indent maze}
  wall_chr: char = #$7f; {use 'X' or appropriate graphics character}

TYPE
  maze_square = (wall, path);
  maze_array  = ARRAY[0..maze_rows, 0..maze_cols] of maze_square;
  crt_command = (clear, eraseol, up, down, left, right);
  direction   = up..right;

VAR
  maze : maze_array;
  won  : Boolean;
  ch   : Char;
  cells_created, cells_visited : Integer;

PROCEDURE display_title;

BEGIN
  ClrScr;
  GotoXY( 1, 4); write('                                   THESE');
  GotoXY(41, 4); write('US');
  GotoXY( 1, 6); write('                                     by');
  GotoXY( 1, 8); write('                             John E. Ohl');
  GotoXY(41, 8); write('son, Jr.');
  GotoXY( 1,12); write('     THESEUS is adapted from a program o');
  GotoXY(41,12); write('f the same name in the book "Advanced');
  GotoXY( 1,13); write('Pascal Programming Techniques", by Paul');
  GotoXY(41,13); write('A. Sand.  The program does nothing par-');
  GotoXY( 1,14); write('ticularly useful, but is an excellent ex');
  GotoXY(41,14); write('ample of the use of recursive proce-');
  GotoXY( 1,15); write('dures.  It is also fun to watch.');
END; {display_title}

PROCEDURE goto_xy(col, row: Integer);

BEGIN
  GotoXY(col + 1, row + 1)
END;

PROCEDURE crt(cc: crt_command);

BEGIN
  CASE cc OF
    clear   : ClrScr;
    eraseol : ClrEol;
    up      : Write(^U);
    down    : Write(^R);
    left    : Write(^W);
    right   : Write(^Z); END;
END; {crt}

PROCEDURE disp_square(ch: Char; row, col: Integer);
   {Display specified character in maze square}

  BEGIN {disp_square}
    goto_xy(col + x_indent, row + y_indent);
    Write(ch)
  END; {disp_square}

PROCEDURE wait_for_continue;

  BEGIN
    goto_xy(0, max_crt_row);
    Write('Press <C> to continue: ');
    REPEAT
      read(kbd,ch)
    UNTIL ch IN ['C', 'c'];
    goto_xy(0, max_crt_row);
    Write('                      ');
  END; {wait_for_continue}

PROCEDURE create_maze(VAR maze : maze_array);

  VAR
    row, col : Integer;
    dir      : direction;

  PROCEDURE set_square(row, col: Integer; val: maze_square);
     {Set maze square to given value}

    BEGIN {set_square}
      maze[row, col] := val;
      CASE val OF
        path: disp_square(' ', row, col);
        wall: disp_square(wall_chr, row, col); END;
    END; {set_square}

  FUNCTION rnd(low, high: Integer): Integer;
     {Returns random number between low and high}

  BEGIN {rnd}
    rnd := low + random(MaxInt) MOD ( high - low + 1)
  END; {rnd}

  FUNCTION rand_dir: direction;

  BEGIN
    CASE rnd(1, 4) OF
      1: rand_dir := up;
      2: rand_dir := down;
      3: rand_dir := left;
      4: rand_dir := right; END
  END; {rand_dir}

  FUNCTION legal_path(row, col: Integer; dir: direction): Boolean;
     {Returns whether a legal path can be built}

  VAR
    legal: Boolean;

  BEGIN {legal_path}
    legal := False;
    CASE dir OF
        up    : IF row > 2 THEN
                  legal := (maze[row - 2, col] = wall);
        down  : IF row < maze_rows - 2 THEN
                  legal := (maze[row + 2, col] = wall);
        left  : IF col > 2 THEN
                  legal := (maze[row, col -2] = wall);
        right : IF col < maze_cols - 2 THEN
                  legal := (maze[row, col + 2] = wall); END;
    legal_path := legal
  END; {legal_path}

  PROCEDURE build_path(row, col: Integer; dir: direction);
     {Extend path in given direction}

  VAR
    unused : SET of direction;

  BEGIN {build_path}
    CASE dir OF
      up    : BEGIN
              set_square(row - 1, col, path);
              set_square(row - 2, col, path);
              row := row - 2; END;
      down  : BEGIN
              set_square(row + 1, col, path);
              set_square(row + 2, col, path);
              row := row + 2; END;
      left  : BEGIN
              set_square(row, col - 1, path);
              set_square(row, col - 2, path);
              col := col - 2; END;
      right : BEGIN
              set_square(row, col + 1, path);
              set_square(row, col + 2, path);
              col := col + 2; END; END;
    unused := [up..right];
    cells_created := cells_created + 2;
    goto_xy(55, max_crt_row);
    Write(cells_created : 4);
    Delay(200);
    REPEAT
      dir := rand_dir;
      IF dir IN unused THEN BEGIN
        unused := unused - [dir];
        IF legal_path(row, col, dir) THEN
          build_path(row, col, dir); END;
    UNTIL unused = []
  END; {build_path}

  BEGIN {create_maze}
    FOR row := 0 TO maze_rows DO
      FOR col := 0 TO maze_cols DO
        set_square(row, col, wall);
    goto_xy(40, max_crt_row);
    Write('Cells created:');
    cells_created := 0;
    row := 2 * rnd(0, maze_rows div 2 - 1) + 1;
    col := 2 * rnd(0, maze_cols div 2 - 1) + 1;
    set_square(row, col, path);
    REPEAT
      dir := rand_dir
    UNTIL legal_path(row, col, dir);
    build_path(row, col, dir);
    col := 2 * rnd(0, maze_cols div 2 - 1) + 1;
    set_square(0, col, path);
    col := 2 * rnd(0, maze_cols div 2 - 1) + 1;
    set_square(maze_rows, col, path)
  END; {create_maze}

FUNCTION solve_maze(VAR maze: maze_array): Boolean;

  VAR
    solved : Boolean;
    row, col: Integer;
    cells_on_path : Integer;
    tried : ARRAY[0..maze_rows, 0..maze_cols] of Boolean;

  FUNCTION try(row, col: Integer; dir: direction): Boolean;
     {Attempt maze solution from point in given direction}

    VAR
      ok: Boolean;

    PROCEDURE show_move(row, col: Integer; dir: direction);

      BEGIN
        CASE dir OF
          up, down    : disp_square(chr($7c), row, col);
          right, left : disp_square('-', row, col); END;
        cells_visited := Succ(cells_visited);
        cells_on_path := Succ(cells_on_path);
        goto_xy(75, max_crt_row);
        Write(cells_visited : 4);
        Delay(200);
      END; {show_move}

    PROCEDURE erase_move(row, col: Integer);

      BEGIN
        disp_square('~', row, col);
        cells_on_path := Pred(cells_on_path);
        goto_xy(max_crt_col,max_crt_row);
        Delay(200);
      END; {erase_move}

    BEGIN {try}
      ok := (maze[row, col] = path);
      IF ok THEN BEGIN
        tried[row, col] := True;
        CASE dir OF
          up    : row := row - 1;
          down  : row := row + 1;
          left  : col := col - 1;
          right : col := col + 1; END;
        ok := (maze[row, col] = path) AND NOT tried[row, col];
        IF ok THEN BEGIN
          show_move(row, col, dir);
          ok := (row <= 0) OR (row >= maze_rows) OR
                (col <= 0) OR (col >= maze_cols);
          IF NOT ok THEN
            ok := try(row, col, left);
          IF NOT ok THEN
            ok := try(row, col, down);
          IF NOT ok THEN
            ok := try(row, col, right);
          IF NOT ok THEN
            ok := try(row, col, up);
          IF NOT ok THEN  {no solution from this point}
            erase_move(row, col); END; END;
      try := ok;
    END; {try}

BEGIN {solve_maze}
  FOR row := 0 to maze_rows DO
    FOR col := 0 to maze_cols DO
      tried[row, col] := False;
  solved := False;
  cells_on_path := 0;
  col := 0;
  row := 1;
  WHILE NOT solved AND (row < maze_rows) DO BEGIN
    solved := try(row, col, right);
    row := row + 1; END;
  col := maze_cols;
  row := 1;
  WHILE NOT solved AND (row < maze_rows) DO BEGIN
    solved := try(row, col, left);
    row := row + 1; END;
  row := 0;
  col := 1;
  WHILE NOT solved AND (col < maze_cols) DO BEGIN
    solved := try(row, col,down);
    col := col + 1; END;
  WHILE NOT solved AND (col < maze_cols) DO BEGIN
    solved := try(row, col, up);
    col := col + 1; END;
  goto_xy(40, max_crt_row - 1);
  Write('Cells on solution path: ',cells_on_path);
  solve_maze := solved
END; {solve_maze}

BEGIN {theseus}
  display_title;
  wait_for_continue;
  randomize;
  REPEAT
    crt(clear);
    create_maze(maze);
    wait_for_continue;
    goto_xy(60, max_crt_row);
    Write('Cells visited:');
    cells_visited := 0;
    won := solve_maze(maze);
    goto_xy(0, max_crt_row);
    Write('Press <C> to continue, <Q> to quit: ');
    REPEAT
      read(kbd,ch)
    UNTIL ch IN ['C', 'c', 'Q', 'q'];
  UNTIL ch IN ['Q', 'q'];
  crt(clear)
END.