Lösung zu Blatt 11 --- Allgemeine Informatik I (WS 1998/99)

13. No way out?

(*
   Allgemeine Informatik I / Programmieren I    WS 1998/1999
   Musterloesung fuer das Blatt 11, Aufgabe 13
   Andreas Borchert, 21. Januar 1998
*)
MODULE PathFinder;

   FROM Arguments IMPORT InitArgs, GetFlag, GetArg, AllArgs, Usage;
   FROM ASCII IMPORT nl;
   FROM FtdIO IMPORT FwriteString, FwriteLn;
   FROM InOut IMPORT WriteString, Write, WriteLn, ReadString;
   FROM StdIO IMPORT FILE, MODE, Fopen, Fgetc, stdin, stderr;
   FROM SysExit IMPORT Exit;
   FROM SysPerror IMPORT Perror;

   CONST
      maxsize = 128;  (* maximale Seitenlaenge eines Labyrinths *)
      minsize = 3;    (* Minimalgroesse, alles darunter ist nicht sinnvoll *)
      space = " ";    (* alles andere wird als Wand betrachtet *)
      walk = "*";     (* Markierung des durchlaufenen Weges *)

   TYPE
      MazeSize = INTEGER [0..maxsize];
      MazeIndex = INTEGER [0..maxsize-1];
      Maze = ARRAY MazeIndex, MazeIndex OF CHAR;
	 (* Labyrinth in der graphischen Notierung auf Basis von
	    ASCII-Zeichen, genau so wie es auch in der Eingabe
	    erwartet wird. Hinzu kommen nur Wegemarkierungen.
	 *)
   VAR
      maze: Maze;
      width, height: MazeSize; (* Weite und Hoehe des Labyrinths *)
      entry, exit: MazeIndex; (* Zeilenindizes von Eingang und Ausgang *)

      (* Kommandozeilenargumente *)
      stepwise: BOOLEAN; (* alle Zwischenstaende ausgeben? *)
      query: BOOLEAN; (* impliziert stepwise, jeweils mit Rueckfrage *)
      input: FILE; (* von hier ist das Labyrinth einzulesen *)

   PROCEDURE Error(msg: ARRAY OF CHAR);
      (* Ausgabe einer Fehlermeldung auf stderr mitsamt Zeilenende *)
   BEGIN
      FwriteString(stderr, msg); FwriteLn(stderr);
   END Error;

   PROCEDURE ProcessArgs;
      VAR
	 flag: CHAR;
	 filename: ARRAY [0..511] OF CHAR;
   BEGIN
      query := FALSE; stepwise := FALSE;
      InitArgs("[-q] [-s] [maze]");
      WHILE GetFlag(flag) DO
	 CASE flag OF
	 | "q":   query := TRUE; stepwise := TRUE;
	 | "s":   stepwise := TRUE;
	 ELSE
	    Usage;
	 END;
      END;
      IF GetArg(filename) THEN
	 IF ~Fopen(input, filename, read, (* buffered = *) TRUE) THEN
	    Perror(filename); Exit(1);
	 END;
      ELSE
	 input := stdin;
	 IF query THEN
	    Error("-q vertraegt sich nicht mit einem Labyrinth von stdin!");
	    Exit(1);
	 END;
      END;
      AllArgs;
   END ProcessArgs;

   PROCEDURE ReadMaze(input: FILE;
                      VAR maze: Maze;
                      VAR width, height: MazeSize;
		      VAR entry, exit: MazeIndex) : BOOLEAN;
      (* Einlesen eines Labyrinths von ``input'':
         -  Bei Problemen wird eine Fehlermeldungen ausgegeben und
	    FALSE zurueckgeliefert.
         -  Im Erfolgsfall wird in maze das Labyrinth in der
	    vorgefundenen Form abgelegt.
	 -  Die beiden Seitenlaengen (des Rechtecks) werden in
	    width und height zurueckgegeben.
	 -  Auf der linken Seite wird ein Eingang erwartet und
	    auf der rechten Seite der Ausgang. Die entsprechenden
	    Zeilenindizes werden in entry und exit zurueckgeliefert.
      *)
      VAR
	 line, column: MazeSize; (* aktuelle Position im Labyrinth *)
	 ch: CHAR; (* zuletzt eingelesenes Zeichen *)
	 entryFound, exitFound: BOOLEAN; (* Ein- und Ausgang gefunden? *)
	 spaceSeen: BOOLEAN; (* Freiraum in der letzten Zeile? *)
   BEGIN
      line := 0; column := 0; width := 0;
      entryFound := FALSE; exitFound := FALSE;
      spaceSeen := FALSE;
      WHILE Fgetc(ch, input) DO
	 IF ch = nl THEN
	    IF line = 0 THEN
	       IF column < minsize THEN
		  WriteString("Labyrinth ist zu klein!"); WriteLn;
		  RETURN FALSE
	       END;
	       width := column;
	    ELSIF column # width THEN
	       WriteString("Das Labyrinth ist nicht rechteckig!"); WriteLn;
	       RETURN FALSE
	    END;
	    INC(line); column := 0;
	 ELSE
	    IF ch = space THEN
	       IF line = 0 THEN
		  WriteString("Bitte keinen Eingang in der 1. Zeile!"); WriteLn;
		  RETURN FALSE
	       ELSIF column = 0 THEN
		  IF entryFound THEN
		     WriteString("Mehr als einen Eingang gefunden!"); WriteLn;
		     RETURN FALSE
		  ELSE
		     entry := line; entryFound := TRUE;
		  END;
	       ELSIF column = width-1 THEN
		  IF exitFound THEN
		     WriteString("Mehr als einen Ausgang gefunden!"); WriteLn;
		     RETURN FALSE
		  ELSE
		     exit := line; exitFound := TRUE;
		  END;
	       END;
	       spaceSeen := TRUE;
	    ELSIF column = 0 THEN
	       spaceSeen := FALSE;
	    END;
	    IF (line >= maxsize) OR (column >= maxsize) THEN
	       WriteString("Das Labyrinth ist zu gross!"); WriteLn;
	       RETURN FALSE
	    END;
	    IF ch = walk THEN
	       WriteString("Bitte keine Markierungszeichen verwenden!");
	       WriteLn; RETURN FALSE
	    END;
	    maze[line, column] := ch; INC(column);
	 END;
      END;
      height := line;
      IF (width < minsize) OR (height < minsize) THEN
	 WriteString("Labyrinth ist zu klein!"); WriteLn; RETURN FALSE
      ELSIF spaceSeen THEN
	 WriteString("Bitte keinen Ausgang in der letzten Zeile!"); WriteLn;
	 RETURN FALSE
      ELSIF ~entryFound THEN
	 WriteString("Keinen Eingang gefunden!"); WriteLn;
	 RETURN FALSE
      ELSIF ~exitFound THEN
	 WriteString("Keinen Ausgang gefunden!"); WriteLn;
	 RETURN FALSE
      ELSIF maze[entry, 1] # space THEN
	 WriteString("Eingang ist verbarrikadiert!"); WriteLn;
	 RETURN FALSE
      END;
      IF column # 0 THEN
	 WriteString("Das Ende der letzten Zeile wird vermisst!"); WriteLn;
	 RETURN FALSE
      END;
      RETURN TRUE
   END ReadMaze;

   PROCEDURE SolveMaze(VAR maze: Maze;
                       width, height: MazeSize;
		       startx, starty: MazeIndex);
      (* Finden und Markieren eines Weges durch das Labyrinth `maze'
	 mit den gegebenen Seitenlaengen `width' und `height' und
         mit der Startposition (startx, starty)
	 nach der rechten Hand-Regel;
	 bei einer Startposition in der Mitte des Labyrinths kann
	 der Algorithmus beliebig lange laufen, wenn es Inseln oder
	 Einschluesse gibt;
	 die Optionen (globale Variablen) stepwise und query werden honoriert
      *)
      TYPE
	 Direction = (east, south, west, north);
	    (* Datentyp fuer die Richtung, wobei die Reihenfolge
	       signifikant ist:
	          (east, south, west, north)     linke Hand-Regel
		  (east, north, west, south)     rechte Hand-Regel
	       Wichtig ist, dass east zuerst genannt wird, weil
	       der Eingang auf der linken Seite liegt und wir
	       nicht das Labyrinth sofort wieder verlassen moechten.
	    *)
	 Delta = [-1..1];
	    (* Datentyp fuer die Differenz einer Zeilen- oder
	       Spaltenposition 
	    *)
      VAR
	 dx, dy: ARRAY Direction OF Delta;
	    (* Differenzen der Zeilen- und Spaltenpositionen, die
	       bei den einzelnen Richtungen zu verwenden sind, um
	       eine entsprechende Bewegung durchzufuehren
	    *)
	 x, y: MazeIndex;
	    (* aktuelle Zeilen- und Spaltenposition im Labyrinth *)
	 direction: Direction;
	    (* aktuelle Richtung, beginnt mit MIN(Direction) *)

      PROCEDURE Weiter() : BOOLEAN;
	 (* Implementierung der Option -q *)
	 VAR
	    answer: ARRAY[0..0] OF CHAR;
      BEGIN
	 WriteString("Weiter?"); ReadString(answer);
	 RETURN answer[0] # "n"
      END Weiter;

      PROCEDURE Exit(x, y: MazeIndex) : BOOLEAN;
	 (* Liegt (x,y) am Rand des Labyrinths? *)
      BEGIN
	 RETURN (x = 0) OR (x = height-1) OR
	        (y = 0) OR (y = width-1) OR
		(x = startx) & (y = starty)
      END Exit;

      PROCEDURE PreviousDirection(dir: Direction) : Direction;
	 (* nach links schauen *)
      BEGIN
	 IF dir = MIN(Direction) THEN
	    RETURN MAX(Direction)
	 ELSE
	    DEC(dir); RETURN dir
	 END;
      END PreviousDirection;

      PROCEDURE NextDirection(dir: Direction) : Direction;
	 (* nach rechts schauen *)
      BEGIN
	 IF dir = MAX(Direction) THEN
	    RETURN MIN(Direction)
	 ELSE
	    INC(dir); RETURN dir
	 END;
      END NextDirection;

      PROCEDURE Wall(x, y: MazeIndex; dir: Direction) : BOOLEAN;
	 VAR
	    ch: CHAR;
      BEGIN
	 ch := maze[x + dx[dir], y + dy[dir]];
	 RETURN (ch # space) & (ch # walk)
      END Wall;

      PROCEDURE Find(x, y: MazeIndex; dir: Direction) : Direction;
	 (* entsprechend der Rechte-Hand-Regel umschauen und
	    nach einem freien Weg suchen;
	    Vorbedingung: Es muss mindestens einen freien Weg geben
	 *)
      BEGIN
	 dir := PreviousDirection(dir); (* nach links schauen *)
	 LOOP
	    IF ~Wall(x, y, dir) THEN
	       RETURN dir
	    END;
	    dir := NextDirection(dir); (* naechste rechts untersuchen *)
	 END;
      END Find;

   BEGIN (* SolveMaze *)
      dx[east] := 0; dx[south] := 1; dx[west] := 0; dx[north] := -1;
      dy[east] := 1; dy[south] := 0; dy[west] := -1; dy[north] := 0;
      direction := MIN(Direction); x := startx; y := starty;
      REPEAT
	 maze[x, y] := walk;
	 IF stepwise THEN
	    WriteMaze(maze, width, height);
	    IF query & ~Weiter() THEN
	       RETURN
	    END;
	 END;
	 direction := Find(x, y, direction);
	 INC(x, dx[direction]); INC(y, dy[direction]);
      UNTIL Exit(x, y);
      maze[x, y] := walk;
   END SolveMaze;

   PROCEDURE WriteMaze(maze: Maze; width, height: MazeSize);
      (* Ausgabe des Labyrinths auf stdout *)
      VAR
	 line, column: MazeIndex;
   BEGIN
      FOR line := 0 TO height-1 DO
	 FOR column := 0 TO width-1 DO
	    Write(maze[line, column]);
	 END;
	 WriteLn;
      END;
   END WriteMaze;

BEGIN
   ProcessArgs;
   IF ReadMaze(input, maze, width, height, entry, exit) THEN
      SolveMaze(maze, width, height, entry, 0);
      WriteMaze(maze, width, height);
   END;
END PathFinder.