Make your own free website on Tripod.com
program mouse;
uses graph3, crt, maze;

type JUNCTION_RECORD = RECORD
  x: INTEGER;
  y: INTEGER;
  back: INTEGER;
end; { Record }

var name: STRING;
    any_maze, new_maze: MAZE_ARRAY;
    choice, key: CHAR;
    loop, loop2, x_pos, y_pos, x_wall, y_wall, stack, direction, null: INTEGER;
    is_junction: ARRAY [1..16,1..16] OF BOOLEAN;
    junction: ARRAY [0..100] OF JUNCTION_RECORD;
    path: ARRAY [1..50] OF INTEGER;

procedure move (turtle_direction: INTEGER);
begin
  setheading(turtle_direction*90); forwd (10);

  case turtle_direction of
    0: y_pos := y_pos - 1;
    1: x_pos := x_pos + 1;
    2: y_pos := y_pos + 1;
    3: x_pos := x_pos - 1;
  end; { Case }

  x_wall := x_pos * 2; y_wall := y_pos * 2;
end; {move}

procedure move_and_log (turtle_direction: INTEGER);
begin
  move (turtle_direction);

  if is_junction [x_pos,y_pos] then
  begin
    junction[stack].x := x_pos; junction[stack].y := y_pos;
    junction[stack].back := (turtle_direction+2) MOD 4;
    stack:=stack+1;
  end;
end; {move_and_log}

procedure goto_next_junction (junction_heading: INTEGER);
var opersite, heading: INTEGER;
begin
  if is_junction [x_pos,y_pos] AND
  NOT ((junction[stack-1].x = x_pos) AND (junction[stack-1].y = y_pos)) then
  begin
    opersite := (junction_heading+2) MOD 4;
    move_and_log (junction_heading);
  end;

  while NOT is_junction [x_pos,y_pos] do
  begin
    if (new_maze [y_wall-1][x_wall  ] <> '-') AND (opersite <> 0) then
      heading:=0;
    if (new_maze [y_wall  ][x_wall+1] <> '') AND (opersite <> 1) then
      heading:=1;
    if (new_maze [y_wall+1][x_wall  ] <> '-') AND (opersite <> 2) then
      heading:=2;
    if (new_maze [y_wall  ][x_wall-1] <> '') AND (opersite <> 3) then
      heading:=3;

    opersite := (heading+2) MOD 4;
    move_and_log (heading);
  end;
end; { goto_next_junction }

function goto_and_log (junction_heading: INTEGER):INTEGER;
var opersite, heading: INTEGER;
begin
  heading:=junction_heading;
  opersite := (heading+2) MOD 4;
  move (heading);

  while NOT is_junction [x_pos,y_pos] do
  begin
    if (new_maze [y_wall-1][x_wall  ] <> '-') AND (opersite <> 0) then
      heading:=0;
    if (new_maze [y_wall  ][x_wall+1] <> '') AND (opersite <> 1) then
      heading:=1;
    if (new_maze [y_wall+1][x_wall  ] <> '-') AND (opersite <> 2) then
      heading:=2;
    if (new_maze [y_wall  ][x_wall-1] <> '') AND (opersite <> 3) then
      heading:=3;

    opersite := (heading+2) MOD 4;
    move (heading);
  end;

  goto_and_log:=(heading+2) MOD 4;
end; {goto_and_log}

procedure go_back;
var exit: INTEGER;
begin
  if (wall_count (x_pos, y_pos, new_maze) = 3)  then
  begin
    if (new_maze [y_wall-1][x_wall  ] <> '-') then exit:=0;
    if (new_maze [y_wall  ][x_wall+1] <> '') then exit:=1;
    if (new_maze [y_wall+1][x_wall  ] <> '-') then exit:=2;
    if (new_maze [y_wall  ][x_wall-1] <> '') then exit:=3;

    goto_next_junction (exit);
    stack:=stack-1;
  end
  else if is_junction[x_pos,y_pos] then
  begin
    stack:=stack-1;
    goto_next_junction (junction[stack].back);
  end;
end; {go_back}

procedure block_and_move (turtle_direction: INTEGER);
begin
  case turtle_direction of
    0: new_maze [y_wall-1][x_wall  ] := 'B';
    1: new_maze [y_wall  ][x_wall+1] := 'B';
    2: new_maze [y_wall+1][x_wall  ] := 'B';
    3: new_maze [y_wall  ][x_wall-1] := 'B';
  end;

  move_and_log (turtle_direction);
end; {block_and_move}

begin {main}

  repeat

    clrscr;
    writeln ('(C)hicago');
    writeln ('(J)apan');
    writeln ('(L)ondon');
    writeln ('(Q)uit');
    repeat
      choice:=readkey;
      choice:=upcase(choice);
      if choice = 'C' then init_chicago_maze (name, any_maze);
      if choice = 'J' then init_japan_maze (name, any_maze);
      if choice = 'L' then init_london_maze (name, any_maze);
    until (choice='C') OR (choice='J') OR (choice='L') OR (choice='Q');

    if choice <> 'Q' then
    begin
      for loop:=1 to 50 do path[loop]:=0;
      for loop:=0 to 100 do
      begin
        junction[loop].x:=0;
        junction[loop].y:=0;
        junction[loop].back:=0;
      end;
      stack:=1;
      new_maze := any_maze;
      new_maze[33][2]:='-'; { Block start }
      write_text (name);
      draw_maze (new_maze, GREEN);

      for x_pos := 1 to 16 do
        for y_pos := 1 to 16 do
          if wall_count (x_pos, y_pos, new_maze) < 2 then
          begin
            draw ((x_pos*10)+12,(y_pos*10)+14,(x_pos*10)+20,(y_pos*10)+22,RED);
            draw ((x_pos*10)+20,(y_pos*10)+14,(x_pos*10)+12,(y_pos*10)+22,RED);
            is_junction [x_pos,y_pos] := TRUE;
          end else
            is_junction [x_pos,y_pos] := FALSE;

      penup;   setposition (-133, -80);
      pendown; showturtle;

      x_pos := 1; y_pos := 16;
      x_wall := x_pos * 2; y_wall := y_pos * 2;
      for loop := 1 to 20000 do
      begin
        randomize; direction := random(4); delay (10);

        if (roadblock_count (x_pos, y_pos, new_maze) = 3) AND
           is_junction [x_pos,y_pos] then
        begin
          if (new_maze [y_wall-1][x_wall  ] = ' ') then direction:=0;
          if (new_maze [y_wall  ][x_wall+1] = ' ') then direction:=1;
          if (new_maze [y_wall+1][x_wall  ] = ' ') then direction:=2;
          if (new_maze [y_wall  ][x_wall-1] = ' ') then direction:=3;
          block_and_move (direction);
        end
        else
        begin
          if (direction = 0) AND (new_maze [y_wall-1][x_wall] = ' ') then
            block_and_move (0);

          if (direction = 1) AND (new_maze [y_wall][x_wall+1] = ' ') then
            block_and_move (1);

          if (direction = 2) AND (new_maze [y_wall+1][x_wall] = ' ') then
            block_and_move (2);

          if (direction = 3) AND (new_maze [y_wall][x_wall-1] = ' ') then
            block_and_move (3);
        end;

        { Check if centre reached }
        if ((x_pos = 8) AND (y_pos = 8)) OR ((x_pos = 8) AND (y_pos = 9))
        OR ((x_pos = 9) AND (y_pos = 8)) OR ((x_pos = 9) AND (y_pos = 9)) then
        begin
          key := readkey;
          loop:=20000;
        end
        else if (roadblock_count (x_pos, y_pos, new_maze) = 4) then go_back;

      end;

      penup;
      setheading(270); forwd(63);
      pendown;
      x_pos:=junction[stack-1].x; y_pos:=junction[stack-1].y;
      x_wall:=x_pos*2; y_wall:=y_pos*2;

      loop2:=1;
      stack:=stack-1;
      for loop:=stack downto 2 do
      begin
        if NOT ((junction[loop].y = junction[loop-1].y) AND
                (junction[loop].x = junction[loop-1].x)) then
        begin
          path[loop2]:=goto_and_log(junction[loop].back);
          loop2:=loop2+1;
        end;

      end;

      write_text (name);
      draw_maze (new_maze, GREEN);

      penup;
      setheading(270); forwd(133);
      setheading(180); forwd(80);
      pendown;
      x_pos := 1; y_pos := 16;
      x_wall:=x_pos*2; y_wall:=y_pos*2;

      for loop:=loop2 downto 1 do
        null:=goto_and_log(path[loop]);

      key:=readkey;

    end; {if}

  until choice = 'Q';

  clrscr;
  textmode(BW80);

end. { mouse }