Programmer 7500/MAX_PROGRAMMERS.iso/INFO/MODULA2/SORT_MD2.ZIP/EDITSORT.MD2

Text File | 1987-02-14 | 5.5 KB | 183 lines

EDITSORT.MD2


MODULE EditSort;

(* --------------------------------------------------------------- *)
(* This module is the capsule editor for the procedure QuickSort.  *)
(* This editor will perform the following:               *)
(*                                   *)
(* (1) Customize the procedure name.                   *)
(* (2) Customize the Record type declaration.               *)
(* (3) Customize the keys for sorting.                   *)
(* --------------------------------------------------------------- *)

FROM Strlib1 IMPORT Stringls, StringAdd, StringRemove, StringReplace,
        ShowString, StringLeft, InputString, Len,
        StringPos, eos;
FROM FileSystem IMPORT File, Response, Lookup, Close, ReadChar,
        WriteChar;
FROM InOut IMPORT ReadCard, WriteCard;
FROM Terminal IMPORT WriteLn;

CONST MAXKEY = 10;
      MAXSTRING = 80;
      EOL = 36C ;

TYPE String = ARRAY [1..MAXSTRING] OF CHAR;

VAR i, j, k, n : CARDINAL;
    ch : CHAR;
    Line, Str, Sortname, Recname, YourFile, Fldname : String;
    Subkey : ARRAY [1..MAXKEY] OF String;
    f1, f2 : File;

PROCEDURE GetLine;
(* Procedure to read the next text line from QWKSORT.CAP file.       *)
(* Insert an End Of String (eos) if string is not full.        *)

BEGIN
    i := 0;
    REPEAT
      ReadChar(f1,ch);
      INC(i);
      Line[i] := ch
    UNTIL ch = CHAR(EOL) ;
    IF i < MAXSTRING THEN Line[i + 1] := eos END;
END GetLine;

PROCEDURE PutLine;
(* Procedure to write a text line in the user specified output       *)
(* file.  If the line is generated by this program, append an       *)
(* End-Of-Line (EOL) character to the text line.           *)

BEGIN
    i := Len(Line);
    IF i>0 THEN
      FOR j := 1 TO i DO
    ch := Line[j];
    WriteChar(f2,ch)
      END;
      IF ch <> CHAR(EOL) THEN
      WriteChar(f2,CHAR(EOL)) END;
    END;
END PutLine;

PROCEDURE ScanSkip(Match : ARRAY OF CHAR);
(* Procedure will read a text line from file QWKSORT.CAP and       *)
(* attempt to locate string 'Match' in it.  If no match is       *)
(* found, the line is written to output text file.           *)

VAR Pos : CARDINAL;

BEGIN
    Pos := 0;
    WHILE Pos = 0 DO
      GetLine;
      Pos := StringPos(Line,Match,1);
      IF Pos = 0 THEN PutLine END;
    END;
END ScanSkip;

PROCEDURE OneSort;
(* Procedure to customize the dummy key field               *)

BEGIN
    (* Edit record type. *)
    ScanSkip("Item");
    StringReplace(Line,"Item",Recname); PutLine;
    (* Enter sort key and edit the 'dummy' key. *)
    ShowString("Enter fieldname ? "); InputString(Fldname);
    FOR k := 1 TO 2 DO
      ScanSkip("key"); StringReplace(Line,"key",Fldname);
      PutLine
    END;
END OneSort;

PROCEDURE MultiSort;
(* Procedure to establish multikey sorting. *)

BEGIN
    (* Enter the number of sort fields and their names. *)
    ShowString("Enter number of fields used ? ");
      ReadCard(n);
    WriteLn;
    FOR k := 1 TO n DO
      ShowString("Enter name for subkey # ");
    WriteCard(k,2);
      ShowString(" "); InputString(Subkey[k]);
      WriteLn
    END;
    (* Edit the arguments in the procedure call, changing them       *)
    (* from arrays of character to the user specified record type. *)
    ScanSkip("S1, S2 :");
    Stringls(Str,"R1, R2 : ");
    StringAdd(Str,Recname); StringReplace(Line,"S1, S2 :
      ARRAY OF CHAR",Str);
    PutLine;
    ScanSkip("i : CARDINAL;"); PutLine;
    (* Insert the declaration for the strings used in the       *)
    (* comparison.                           *)
    Stringls(Line,"  S1, S2 : ARRAY [1.YourMaxString] OF CHAR;");
    PutLine;
    ScanSkip("i := 0"); PutLine;
    (* Build the text line that represents the code for the       *)
    (* build-up of the multifield sort string.               *)
    Stringls(Line,"Stringls(S1,R1."); StringAdd(Line,Subkey[1]);
    StringAdd(Line,") ; Stringls(S2,R2.");
      StringAdd(Line,Subkey[1]);
    StringAdd(Line,") ;") ; PutLine;
    IF n > 1 THEN
      FOR k := 2 TO n DO
    Stringls(Line,"  StringAdd(S1,R1.");
    StringAdd(Line,Subkey[k]);
    StringAdd(Line,") ; StringAdd(S2,R2.");
    StringAdd(Line,Subkey[k]);
    StringAdd(Line,") ;") ; PutLine
      END;
    END;

    (* Edit record type for the locally declared records.       *)
    ScanSkip("Item");
    StringReplace(Line,"Item",Recname); PutLine;
    (* Edit the call to the Compare procedure.               *)
    FOR k := 1 TO 2 DO
      ScanSkip(".key") ; StringRemove(Line,".key"); PutLine
    END;
END MultiSort;

BEGIN (* Main module *)
    ShowString("Enter the output filename ? ");
    InputString(YourFile); WriteLn;
    Lookup(f1,"c:qwksort.cap,"FALSE);
    Lookup(f2,YourFile,TRUE);
    (* Check if both files are opened correctly.           *)
    IF (f1.res = done) AND (f2.res = done) THEN
      ShowString("Enter new procedure name ? ");
    InputString(Sortname);
      WriteLn;
      GetLine ; StringReplace(Line,"QuickSort,"Sortname);
      ShowString("Enter record type name ? ");
    InputString(Recname);
      WriteLn;
      StringReplace(Line,"Item",Recname); PutLine;
      GetLine ; GetLine; (* Skip the two comment lines *)
      ShowString("Is the sort based on one field ? ");
      InputString(Str); WriteLn;
      StringLeft(Str,Str,1); (* Extract the leftmost character *)
      IF CAP(Str[1]) = "Y" THEN OneSort ELSE MultiSort
    END;
      ScanSkip("QuickSort") ; StringReplace(Line,"QuickSort",
    Sortname);
      PutLine;
    ELSE
      ShowString("Error in locating file QWKSORT.CAP")
    END;
    IF (f1.res = done) THEN Close(f1) END;
    IF (f2.res = done) THEN Close(f2) END;
END EditSort.

SORT.CAP")
    END;
    IF (f1.res = done)