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 }