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 }