Musterlösung zu Aufgabe 2 -- Phones.m2

MODULE Phones;
  IMPORT Arguments;
  FROM SysExit IMPORT Exit;
  FROM Strings IMPORT StrCmp;
  FROM StdIO IMPORT FILE, MODE, stderr, stdout,
                stdin, Fopen, Feof;
  FROM FtdIO IMPORT Done, FreadCard, FwriteCard, 
       FwriteString, FreadString, FwriteLn, FwriteChar;

(* -------- Data of a Person with its Operations ----------*)
  CONST 
     NameLength = 30;
     PhoneLength = 15;
  TYPE
     Name = ARRAY[0..NameLength] OF CHAR;     
     Phone = ARRAY [0..PhoneLength] OF CHAR;

     Date = RECORD
              day : CARDINAL[0..31];
              month: CARDINAL[1..12];
              year: CARDINAL[1900..2100];
            END;

     PersDat = RECORD
                 famName: Name;
                 firstName: Name;
                 birthDate: Date;
                 phone: Phone;
               END;

  PROCEDURE nameIsLess(x,y: PersDat): BOOLEAN;
  BEGIN
	IF StrCmp(x.famName,y.famName) < 0 THEN
		RETURN TRUE
	ELSE
		RETURN FALSE;
	END
  END nameIsLess;

  PROCEDURE isYounger(x,y: PersDat): BOOLEAN;
  BEGIN
	IF (x.birthDate.year <> y.birthDate.year) THEN
		RETURN (x.birthDate.year > y.birthDate.year)
	END;
	(* x.birthDate.year = y.birthDate.year *)
	IF (x.birthDate.month <> y.birthDate.month) THEN
		RETURN (x.birthDate.month > y.birthDate.month)
	END;
	(* same year and same month*)
	RETURN (x.birthDate.day > y.birthDate.day)
  END isYounger;
	
  PROCEDURE WriteRec(f: FILE; pers: PersDat);
        (*f open stream to write *)
  BEGIN
     WITH pers DO
        FwriteString(f,famName);
        FwriteChar(f,' ');
        FwriteString(f,firstName);
        FwriteChar(f,' ');
        FwriteCard(f,birthDate.day,0);
        FwriteChar(f,' ');
        FwriteCard(f,birthDate.month,0);
        FwriteChar(f,' ');
        FwriteCard(f,birthDate.year,0);
        FwriteChar(f,' ');
        FwriteString(f,phone);
        FwriteLn(f);
      END;
  END WriteRec;
     
  PROCEDURE ReadRec(f:FILE; VAR pers: PersDat):BOOLEAN;
        (*f open stream for read *)
        VAR d,m,y: CARDINAL;
  BEGIN
     IF Feof(f) 
     THEN
           RETURN FALSE
     END;
     (*wegen Typpruefung verweigert FreadCard das 
       Einlesen in einen Unterbereich - daher 
       der Umweg ueber die CARDINAl-Variablen
      *)
      WITH pers DO
        FreadString(f,famName);
        FreadString(f,firstName);
        FreadCard(f,d); birthDate.day:=d;
        FreadCard(f,m); birthDate.month:=m;
        FreadCard(f,y); birthDate.year:=y;
        FreadString(f,phone);
      END;
      IF Done 
      THEN
            RETURN TRUE
      ELSE
            RETURN FALSE
      END;
  END ReadRec;
  
(* ---------------- Table of Person Data ---------------*)
  CONST
     NumberOfPers = 50;
  TYPE
     Range = [ 1.. NumberOfPers];
     PersList = ARRAY Range OF PersDat;
     IndexList = ARRAY Range OF Range;
  VAR 
     persList: PersList;
     nameList, ageList: IndexList;

(* -------------- Procedure sort ---------------------*)

  TYPE CmpPersDat = PROCEDURE(PersDat, PersDat):BOOLEAN;

  PROCEDURE Sort(	
		a: PersList;
		number: CARDINAL;
		cmp:CmpPersDat;
		VAR res: IndexList);
  
    VAR 
	minInd,i,j,tmp: CARDINAL;

  BEGIN
	FOR i := 1 TO number DO
	  res[i] := i;
   	END;

	FOR i:=1 TO number-1 DO
	  minInd := i;
	  FOR j:=i+1 TO number DO
	    IF cmp(a[res[j]],a[res[minInd]]) THEN
	      minInd := j;
	    END;
	  END;
	  tmp := res[i];
	  res[i] := res[minInd];
	  res[minInd] := tmp;
	END;
  END Sort;

(* ------------------------ main ------------------------*)
  VAR 
     fromFile: FILE;
     itsFile: BOOLEAN;
     inFile: Name;
     i, number: CARDINAL;

BEGIN
   Arguments.InitArgs(" [ inputfile ]");
   IF  Arguments.GetArg(inFile) 
   THEN 
      (*read from File*)
      itsFile := TRUE;
   ELSE
      (* read from stdin *)
      itsFile := FALSE;
   END;
   Arguments.AllArgs;

   IF itsFile THEN
     IF NOT Fopen(fromFile, inFile, read, TRUE) THEN
        FwriteString(stderr, "Fehler beim Oeffnen!");
        FwriteLn(stderr);
        Exit(1);
     END
   ELSE
      fromFile := stdin;
   END;

   (*Initialization - Separator is whiteSpace - 
    * no test !!!
    *)
    i:= 1;
    WHILE (i <= NumberOfPers) AND 
		ReadRec(fromFile, persList[i]) 
    DO
       INC(i);
    END;
    IF i<=NumberOfPers 
       (*loop terminated with ReadRec = False*)
    THEN
       number := i-1;
    ELSE
       number := i;
    END;
    
    FwriteString(stdout, "Orginal List: ");
    FwriteLn(stdout);
    FOR i := 1 TO number DO
	  WriteRec(stdout,persList[i]);
    END;
    
    Sort(persList, number, nameIsLess, nameList);
    FwriteString(stdout, "List Sorted by Name: ");
    FwriteLn(stdout);
    FOR i := 1 TO number DO
	  WriteRec(stdout,persList[nameList[i]]);
    END;
    
    Sort(persList, number, isYounger, ageList);
    FwriteString(stdout, "List Sorted by Age: ");
    FwriteLn(stdout);
    FOR i := 1 TO number DO
	  WriteRec(stdout,persList[ageList[i]]);
    END;
END Phones.