Musterlösung zu Aufgabe 8 -- laby.m2

MODULE laby;

FROM Arguments IMPORT GetArg, Usage, InitArgs, AllArgs;
FROM InOut IMPORT Write, WriteCard, WriteString, WriteLn;
FROM StdIO IMPORT FILE, MODE, Fopen, Fclose, Fgetc, stdin, stdout, stderr;
FROM FtdIO IMPORT FwriteString, FwriteLn, FwriteChar;
FROM ASCII IMPORT nl;
FROM SysExit IMPORT Exit;

FROM Labyrinth IMPORT Labyrinth, Lines, Columns, ShowLab, ErrMesg, ReadKey;


VAR char : CHAR;

CONST	Wand = '#';
	Leer = ' ';
	Weg = 'X';
	Mark = '0';

(* ------------------------------------------------------------ *)
(* Labyrinth einlesen und pruefen *)

PROCEDURE ReadLaby(infile : ARRAY OF CHAR; VAR eing : CARDINAL; VAR lab : Labyrinth) : BOOLEAN;
VAR fp : FILE;
    zeile, spalte : CARDINAL;
    ch	: CHAR;
    ausgang : BOOLEAN;
BEGIN
    zeile := 0; spalte := 0; eing := 0;
    ausgang := FALSE;

    IF NOT Fopen(fp, infile, read, TRUE) THEN
	ErrMesg("Kann Datei nicht oeffnen");
    END;

    WHILE Fgetc(ch, fp) DO
	IF zeile > Lines-1 THEN
	    ErrMesg("Labyrinth ist zu hoch");
	ELSIF spalte > Columns THEN
	    ErrMesg("Zeile zu lang");
	END;
	CASE ch OF 
	| nl : 
	    IF spalte = Columns THEN
		lab[zeile, spalte] := 0C;
		spalte := 0; INC(zeile);
	    ELSIF spalte < Columns THEN 
		ErrMesg("Zeile zu kurz");
	    END;
	| Leer :
	    IF ( zeile = 0) OR (zeile = Lines-1) THEN
		ErrMesg("Labyrinth hat oben oder unten einen Eingang !");
	    ELSIF spalte = Columns-1 THEN
		IF ausgang THEN
		    ErrMesg("Labyrinth hat mehr als einen Ausgang");
		END;
		ausgang := TRUE;
	    ELSIF (spalte = 0) THEN
		IF eing <> 0 THEN
		    ErrMesg("Labyrinth hat mehr als einen Eingang");
		END;
		eing := zeile;
	    END;
	    lab[zeile, spalte] := Leer;
	    INC(spalte);
	ELSE
	    lab[zeile, spalte] := Wand;
	    INC(spalte);
	END;
    END;

    IF zeile < Lines THEN
	ErrMesg("Labyrinth hat zu wenig Zeilen");
    END;

    IF NOT ausgang THEN
	ErrMesg("Labyrinth hat keinen Ausgang");
    END;

    IF eing = 0 THEN
	ErrMesg("Labyrinth hat keinen Eingang");
    END;

    IF NOT Fclose(fp) THEN
	ErrMesg("Kann Datei nicht schliessen");
    END;

    RETURN TRUE;
END ReadLaby;

(* ------------------------------------------------------------ *)

PROCEDURE SucheAusgang(zeile, spalte : CARDINAL; VAR lab : Labyrinth) : BOOLEAN;
VAR gefunden : BOOLEAN;
    i : CARDINAL;
    ch : CHAR;
BEGIN
    IF spalte = Columns-1 THEN    	(* Ausgang gefunden *)
	lab[zeile, spalte] := Weg;
	RETURN TRUE;
    END;

    lab[zeile, spalte] := Mark;	    (* Stelle markieren - hier war ich schon *)
    gefunden := FALSE;

    ShowLab(lab);
    ch := ReadKey();

    (* nach Osten *)
    IF  lab[zeile, spalte+1] = Leer THEN
	gefunden := SucheAusgang(zeile, spalte+1, lab);
    END;

    (* nach Norden *)
    IF (NOT gefunden) AND (zeile > 0) AND (lab[zeile-1, spalte] = Leer) THEN
	gefunden := SucheAusgang(zeile-1, spalte, lab);
    END;

    (* nach Sueden *)
    IF (NOT gefunden) AND (lab[zeile+1, spalte] = Leer) THEN
	gefunden := SucheAusgang(zeile+1, spalte, lab);
    END;

    (* nach Westen *)
    IF (NOT gefunden) AND (spalte > 0) AND (lab[zeile, spalte-1] = Leer) THEN
	gefunden := SucheAusgang(zeile, spalte-1, lab);
    END;
    
    IF gefunden THEN
	lab[zeile, spalte] := Weg;	(* Weg markieren *)
	ShowLab(lab);
	ch := ReadKey();
	RETURN TRUE;
    ELSE
	RETURN FALSE;
    END;

END SucheAusgang;

(* ------------------------------------------------------------ *)
(* Labyrinth ausgegen *)

PROCEDURE PrintLaby(fp : FILE; lab : Labyrinth);
VAR zeile, spalte : CARDINAL;
BEGIN
    FOR zeile := 0 TO Lines-1 DO
	FwriteString(fp, lab[zeile]); FwriteLn(fp);
    END;
END PrintLaby;

(* ------------------------------------------------------------ *)

VAR
  lab: Labyrinth;
  infile, outfile: ARRAY[0..20] OF CHAR;
  eingang : CARDINAL;
  infp, outfp : FILE;

BEGIN
    InitArgs("infile [outfile]");

    IF NOT GetArg(infile) THEN		(* es muss mind. 1 Arg. angeg. sein *)
        Usage; Exit(1);
    END;
    IF NOT GetArg(outfile) THEN
	outfp := stdout;
    END;

    AllArgs;	(* Jetzt darf eigentlich kein Argument mehr kommen *)

    IF ReadLaby(infile, eingang, lab) THEN		(* Laby lesen *)
	IF SucheAusgang(eingang, 0, lab) THEN	(* Ausgang suchen *)
	    IF (outfp<>stdout) AND (Fopen(outfp, outfile, write, TRUE)) THEN
		PrintLaby(outfp, lab);			(* Labyrinth ausgeben *)
	    ELSIF outfp = stdout THEN
		ShowLab(lab);
	    ELSE
		ErrMesg("Kann outfile nicht oeffnen");
	    END;
	ELSE 
	    ErrMesg("Weg nicht gefunden");		(* Kein Weg gefunden *)
	END;
    END;

END laby.