home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1987 / 10 / sort_mod / sortdemo.mod < prev    next >
Encoding:
Text File  |  1987-04-14  |  4.5 KB  |  162 lines
  1.  
  2. MODULE SortDemo;                  (* demonstriert den Gebrauch von "Sorting" *)
  3.  
  4.  
  5.   FROM DOSCALL IMPORT InputReady,                             (* Importliste *)
  6.                       ReadConsoleNoEcho;
  7.   FROM InOut   IMPORT CloseInput,
  8.                       Done,
  9.                       OpenInput,
  10.                       Read,
  11.                       ReadCard,
  12.                       ReadString,
  13.                       WriteCard,
  14.                       WriteLn,
  15.                       WriteString;
  16.   FROM Sorting IMPORT ShellSort,
  17.                       SortType;
  18.   FROM String  IMPORT Compare,
  19.                       Substr;
  20.   FROM SYSTEM  IMPORT STRING;
  21.  
  22.  
  23.   VAR first,last : CARDINAL;
  24.       Choice     : CHAR;
  25.       Ascending,
  26.       Quit       : BOOLEAN;
  27.       Data       : ARRAY [0..1000] OF SortType;  (* das  zu sortierende Feld *)
  28.       FileName   : STRING[80];                   (* Name der Datei mit Daten *)
  29.  
  30.  
  31. (* --  hier folgen die in "Lower" zu übergebenden Vergleichsoperationen  --- *)
  32.  
  33.  
  34.   PROCEDURE LowerName (VAR a,b : SortType) : BOOLEAN;
  35.  
  36.    (* Sortierung nach Namen *)
  37.  
  38.     BEGIN
  39.       RETURN (Compare(b.Name,a.Name) > 0);
  40.     END LowerName;
  41.  
  42.  
  43.   PROCEDURE LowerAge (VAR a,b : SortType) : BOOLEAN;
  44.  
  45.    (* Sortierung nach Alter *)
  46.  
  47.     VAR aYear,bYear   : STRING[4];
  48.         aMonth,bMonth,
  49.         aDay,bDay     : STRING[2];
  50.  
  51.     BEGIN
  52.       Substr (a.Birthday,1,2,aDay);                (* Datum entschlüsseln... *)
  53.       Substr (a.Birthday,4,2,aMonth);
  54.       Substr (a.Birthday,7,4,aYear);
  55.       Substr (b.Birthday,1,2,bDay);
  56.       Substr (b.Birthday,4,2,bMonth);
  57.       Substr (b.Birthday,7,4,bYear);
  58.       IF Compare(aYear,bYear)=0 THEN                  (* ... und vergleichen *)
  59.         IF Compare(aMonth,bMonth)=0 THEN
  60.           RETURN (Compare(aDay,bDay) > 0);
  61.         ELSE
  62.           RETURN (Compare(aMonth,bMonth) > 0);
  63.         END;
  64.       ELSE
  65.         RETURN (Compare(aYear,bYear) > 0);
  66.       END;
  67.       RETURN TRUE;
  68.     END LowerAge;
  69.  
  70.  
  71.   PROCEDURE LowerSalary (VAR a,b : SortType) : BOOLEAN;
  72.  
  73.    (* Sortierung nach Einkommen *)
  74.  
  75.     BEGIN
  76.       RETURN (a.Salary < b.Salary);
  77.     END LowerSalary;
  78.  
  79.  
  80.  
  81. (* -------  Einlesen der zu sortierenden Daten aus einer Textdatei  -------- *)
  82.  
  83.   PROCEDURE ReadData ();
  84.  
  85.     VAR EOL : CHAR;
  86.  
  87.     BEGIN
  88.       WriteLn ();
  89.       WriteString ("Name der Datei mit Daten: ");
  90.       ReadString (FileName);
  91.       WriteLn ();
  92.       OpenInput (FileName);            (* Textdatei als Eingabestream öffnen *)
  93.       IF NOT Done THEN
  94.         WriteLn ();
  95.         WriteString ("Fehler:  Datei nicht gefunden!");
  96.         WriteLn ();
  97.         HALT ();
  98.       END;
  99.       first := 1;
  100.       last := 0;
  101.       REPEAT
  102.         INC (last);
  103.         WITH Data[last] DO                           (* Elemente einlesen... *)
  104.           ReadString (Name);
  105.           ReadString (Birthday);
  106.           ReadCard (Salary);
  107.           Read (EOL);                                       (* nächste Zeile *)
  108.         END;
  109.       UNTIL NOT Done;                          (* ... bis Dateiende erreicht *)
  110.       CloseInput ();                (* Textdatei als Eingabestream schließen *)
  111.     END ReadData;
  112.  
  113.  
  114.   PROCEDURE DisplayData ();
  115.  
  116.     VAR Count : CARDINAL;
  117.  
  118.     BEGIN
  119.       WriteLn ();
  120.       WriteLn ();
  121.       WriteString ("      Name               ");
  122.       WriteString ("      Geburtstag    ");
  123.       WriteString ("Einkommen");
  124.       WriteLn ();
  125.       WriteLn ();
  126.       FOR Count := first TO last DO      (* Ausgabe der Liste auf Bildschirm *)
  127.         WITH Data[Count] DO
  128.           WriteCard (Count,3);
  129.           WriteString (".  ");
  130.           WriteString (Name);
  131.           WriteString (Birthday);
  132.           WriteCard (Salary,6);
  133.           WriteLn ();
  134.         END;
  135.       END;
  136.       WriteLn ();
  137.       WriteLn ();
  138.     END DisplayData;
  139.  
  140.  
  141.   BEGIN
  142.     Quit := FALSE;
  143.     ReadData ();
  144.     REPEAT
  145.       DisplayData ();
  146.       WriteString ("Sortieren nach (A)lter,(E)inkommen oder (N)amen ? ");
  147.       WriteLn ();
  148.       WriteString ("Kleinbuchstabe=aufsteigende,");
  149.       WriteString ("Grossbuchstabe=absteigende Reihenfolge: ");
  150.       Read (Choice);
  151.       Ascending := (ORD(Choice) >= 96);                  (* Kleinbuchstabe ? *)
  152.       CASE Choice OF
  153.         "N","n" : ShellSort (Data,first,last,LowerName,Ascending);
  154.       | "A","a" : ShellSort (Data,first,last,LowerAge,Ascending);
  155.       | "E","e" : ShellSort (Data,first,last,LowerSalary,Ascending);
  156.       ELSE
  157.         Quit := TRUE;
  158.       END;
  159.     UNTIL Quit;
  160.     WriteLn ();
  161.   END SortDemo.
  162.