home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / cpm / modula2 / case.lbr / CASE.MZD / CASE.MOD
Encoding:
Text File  |  1987-05-05  |  9.3 KB  |  359 lines
  1. MODULE AnyCase;
  2.  
  3. (*  adapted from a program (unknown author) by Glenn Brooke
  4.     12/29/86 for Turbo Modula-2 for the Z80.  Released to
  5.     the public domain.  Last update 1/1/86
  6. *)
  7.  
  8. (* obtain all the needed procedures from standard libraries *)
  9. (* This program does use Turbo Modula-2 extensions of WRITE, WRITELN *)
  10.  
  11.    FROM Storage    IMPORT ALLOCATE, DEALLOCATE;
  12.    FROM ComLine    IMPORT commandLine;
  13.    FROM Texts      IMPORT TEXT, ReadChar, WriteChar, EOT, OpenText,
  14.                           CreateText, Closetext;
  15.    FROM Strings    IMPORT Length;
  16.  
  17. CONST
  18.      maxidlength = 80;         (* you may want to shorten this to conserve
  19.                                   memory space. *)
  20.      maxfilenamelength = 14;
  21.  
  22. TYPE
  23.     NodePtr = POINTER TO Node;
  24.     ListPtr = POINTER TO ListNode;
  25.     Node = RECORD
  26.          List : ListPtr;
  27.          Len : CARDINAL;
  28.          left, right : NodePtr;
  29.          END;
  30.     ListNode = RECORD
  31.          ch : ARRAY[0..1] OF CHAR;
  32.          next : ListPtr;
  33.          END;
  34.     idtype = ARRAY[0..maxidlength-1] OF CHAR;
  35.     leg = (LessThan, Equal, GreaterThan);
  36.     filename = ARRAY[0..maxfilenamelength-1] OF CHAR;
  37.  
  38. VAR
  39.    Root, where : NodePtr;
  40.    j,k,c,i,d : CARDINAL;
  41.    Nput, Output : TEXT;
  42.    id : idtype;
  43.    ch : CHAR;
  44.    List : ListPtr;
  45.    F : TEXT;
  46.    infilename, outfilename : filename;
  47.  
  48. PROCEDURE RelativeSize(id : idtype; anode : NodePtr; VAR RelSize : leg);
  49. VAR
  50.    cell : ListPtr;
  51.    a,b : CHAR;
  52.    c,d : CARDINAL;
  53.  
  54. BEGIN
  55.      d := 0;
  56.      cell := anode^.List;
  57.      FOR c := 0 TO anode^.Len + 1 DO
  58.          a := CAP(cell^.ch[d]);
  59.          b := CAP(id[c]);
  60.          IF a = b THEN (*keep looking*)
  61.             IF d=1 THEN
  62.                d := 0;
  63.                cell := cell^.next
  64.             ELSE d := 1
  65.             END;
  66.          ELSIF a>b THEN
  67.                RelSize := LessThan;
  68.                RETURN
  69.          ELSE
  70.              RelSize := GreaterThan;
  71.              RETURN
  72.          END;
  73.          END;
  74.          RelSize := Equal;
  75. END RelativeSize;
  76.  
  77. PROCEDURE addit(id : idtype; VAR anode : NodePtr);
  78. VAR RelSize : leg;
  79.  
  80.       PROCEDURE addstring(List : ListPtr; VAR Len : CARDINAL; id : idtype);
  81.       VAR d,c : CARDINAL;
  82.       BEGIN (*addstring*)
  83.         c := 0; d := 0;
  84.         WHILE (c<maxidlength) & (id[c]#" ") DO
  85.            List^.ch[d] := id[c];
  86.            INC(c);
  87.            IF d = 0 THEN d := 1
  88.            ELSE
  89.             d := 0;
  90.             NEW(List^.next);
  91.             List := List^.next;
  92.             List^.next := NIL;
  93.            END; (*if then *)
  94.            List^.ch[d] := " ";
  95.            IF c>maxidlength-1 THEN Len := maxidlength-1
  96.              ELSE Len := c-1
  97.            END; (* if then *)
  98.         END; (* while *)
  99.       END addstring;
  100.  
  101. BEGIN (*addit*)
  102.   IF anode = NIL THEN (*not in tree insert it *)
  103.      NEW(anode);
  104.      WITH anode^ DO
  105.         left := NIL;
  106.         right := NIL;
  107.         NEW(List);
  108.         addstring(List, Len, id);
  109.      END;
  110.   ELSE
  111.     RelativeSize(id, anode, RelSize);
  112.     IF RelSize = LessThan THEN addit(id, anode^.left)
  113.     ELSIF RelSize = GreaterThan THEN addit(id, anode^.right)
  114.     (*ELSE id is already in spelling list, simply return*)
  115.     END
  116.   END;
  117. END addit;
  118.  
  119.  
  120. PROCEDURE InTree(id :idtype; VAR anode : NodePtr) : BOOLEAN;
  121.  
  122. (* Side effect is to set anode to point to place in tree id is located *)
  123.  
  124. VAR RelSize : leg;
  125. BEGIN (*InTree*)
  126.  LOOP
  127.    IF anode=NIL THEN (* not in tree *) RETURN(FALSE)
  128.    ELSE
  129.      RelativeSize(id, anode, RelSize);
  130.      IF RelSize=LessThan THEN (*create side effect *)
  131.        anode := anode^.left;
  132.      ELSIF RelSize = GreaterThan THEN (* create side effect *)
  133.        anode := anode^.right
  134.      ELSE (*its in the tree *) RETURN(TRUE);
  135.      END
  136.    END
  137.  END;
  138. END InTree;
  139.  
  140. PROCEDURE delit(id : idtype; VAR anode : NodePtr);
  141. VAR
  142.   qnode : NodePtr;
  143.   mark, markhold : ListPtr;
  144.   RelSize : leg;
  145.  
  146.    PROCEDURE del(VAR anode : NodePtr);
  147.    BEGIN (* del *)
  148.      IF anode^.right # NIL THEN del(anode^.right)
  149.      ELSE
  150.       qnode^.Len := anode^.Len;
  151.       qnode^.List := anode^.List;
  152.       qnode := anode;
  153.       anode := anode^.left;
  154.      END
  155.    END del;
  156.  
  157. BEGIN (* delit *)
  158.   IF anode = NIL THEN
  159.      WRITELN("Can't delete ", id);
  160.      WRITELN(" not in tree ");
  161.      WRITELN;
  162.  ELSE
  163.      RelativeSize(id, anode, RelSize);
  164.      IF RelSize = LessThan THEN delit(id, anode^.left)
  165.      ELSIF RelSize = GreaterThan THEN delit(id,anode^.right)
  166.      ELSE qnode := anode;
  167.      IF qnode^.right = NIL THEN anode := qnode^.left
  168.      ELSIF qnode^.left = NIL THEN anode := qnode^.right
  169.      ELSE del(qnode^.left);  (* dispose of qnode *)
  170.        mark := qnode^.List;
  171.        WHILE mark#NIL DO
  172.          markhold := mark;
  173.          mark := mark^.next;
  174.          DISPOSE(markhold)
  175.        END;
  176.     DISPOSE(qnode)
  177.     END
  178.   END
  179.   END
  180. END delit;
  181.  
  182. PROCEDURE copy;
  183. BEGIN (* copy *)
  184.  WriteChar(Output, ch);
  185.  IF NOT EOT(Nput) THEN           (* make sure don;t read past end of file*)
  186.    ReadChar(Nput, ch);
  187.  END; (* if then *)
  188. END copy;
  189.  
  190. PROCEDURE FinishComment;
  191. (* this is a recursive procedure ! *)
  192. BEGIN
  193.  REPEAT
  194.  REPEAT
  195.    copy;
  196.    IF ch = "(" THEN
  197.       copy;
  198.       IF ch = "*" THEN FinishComment
  199.       END;
  200.    END;
  201.  UNTIL ch= "*";
  202.  copy
  203. UNTIL ch= ")";
  204. copy
  205. END FinishComment;
  206.  
  207.  
  208.  
  209. PROCEDURE GetId(Nput : TEXT; Adding, printing : BOOLEAN;
  210.                      VAR ch : CHAR);
  211. VAR j, k : CARDINAL;
  212. BEGIN
  213.   IF (CAP(ch)>="A") & (CAP(ch)<="Z") THEN
  214.     k := 0;
  215.     REPEAT
  216.       id[k] := ch;
  217.       k := k + 1;
  218.       ReadChar(Nput, ch);
  219.     UNTIL (((ch<"0") OR (ch>"9")) & ((CAP(ch)<="A") OR (CAP(ch)>"Z")))
  220.            OR (k=maxidlength);
  221.     IF k<maxidlength THEN id[k] := " "END;
  222.     IF printing THEN
  223.        FOR j := 0 to k-1 DO WriteChar(Output, id[j]) END
  224.     END;
  225.     IF Adding THEN addit(id, Root); ELSE delit(id, Root) END;
  226.  END;
  227. END GetId;
  228.  
  229. PROCEDURE ProcessFile(Nput : TEXT; Adding : BOOLEAN);
  230. VAR ch :CHAR;
  231. BEGIN
  232.   ReadChar(Nput, ch);
  233.     IF NOT EOT(Nput) THEN
  234.         REPEAT
  235.         GetId(Nput, Adding, FALSE, ch);
  236.         ReadChar(Nput, ch);
  237.         UNTIL EOT(Nput);
  238.     END;
  239. END ProcessFile;
  240.  
  241.  
  242.  
  243. (* MAIN BODY OF ANYCASE MODULE  *)
  244.  
  245. BEGIN
  246.  (* prepare for binary tree storage of keywords *)
  247.  Root := NIL;
  248.  
  249.  (* display program identification *)
  250.  WRITELN('    Turbo Modula-2 Case Converter ');
  251.  WRITELN('    Glenn Brooke 1/1/86');
  252.  WRITELN;
  253.  
  254.  (*  OK, let's open up the input and output files for the work *)
  255.  (*  First read input, output filenames from command line*)
  256.  
  257.  READ(commandLine, infilename, outfilename);
  258.  
  259.  (* if one or both names missing, display syntax and halt *)
  260.  IF (Length(infilename) = 0) OR (Length(outfilename) = 0) THEN
  261.    WRITELN("  Syntax is :  CASE infilename outfilename ");
  262.    WRITELN;
  263.    HALT;
  264.  END;  (* IF THEN *)
  265.  
  266.  (* load default spelling list from file MODULA2.KWD *)
  267.  IF OpenText(Nput, "MODULA2.KWD") THEN
  268.    (* file was found and opened properly, now process list *)
  269.    WRITE("  now storing list of keywords in memory...");
  270.    ProcessFile(Nput, TRUE);
  271.    CloseText(Nput);
  272.    WRITE("complete");
  273.    WRITELN;
  274.  ELSE
  275.    WRITELN("  Sorry, couldn't open MODULA2.KWD (keyword file). ");
  276.    WRITELN("  Case Converter terminated. ");
  277.    HALT;
  278.  END; (* if then else *)
  279.  
  280.  (* try to open input.  if can't, say so, and halt *)
  281.  IF NOT OpenText(Nput, infilename) THEN
  282.       WRITELN("  Sorry, couldn't open input file ", infilename);
  283.       WRITELN(" Case Converter terminated. ");
  284.       HALT;
  285.  END; (* IF THEN *)
  286.  (* open output file; overwrites if exists *)
  287.  CreateText(Output, outfilename);
  288.  
  289.  
  290. (* ok, now process input file char by char -- start of "state machine" *)
  291. WRITE(" Now processing ",infilename,"...");
  292.  
  293. ReadChar(Nput, ch);
  294.  IF NOT EOT(Nput) THEN
  295.    REPEAT
  296.    IF (CAP(ch)>="A") & (CAP(ch)<="Z") THEN
  297.      k := 0;
  298.      REPEAT
  299.        id[k] := ch;
  300.        k := k + 1;
  301.        ReadChar(Nput, ch);
  302.        (* do not copy to output until see if its in spelling table *)
  303.      UNTIL (((ch<"0") OR (ch>"9") & ((CAP(ch)<"A")
  304.                OR (CAP(ch)>"Z"))) OR (k=maxidlength));
  305.      IF k<maxidlength THEN id[k] := "-1 ND;
  306.      (* look for identifier *)
  307.      where := Root;
  308.      IF InTree(id, where) THEN
  309.         (* put spelling from tree to output *)
  310.         d := 0;
  311.         List := where^.List;
  312.         FOR i := 0 TO where^.Len DO
  313.            WriteChar(Output, List^.ch[d]);
  314.            IF d=1 THEN
  315.              d := 0;
  316.              List := List^.next;
  317.            ELSE d := 1
  318.            END
  319.         END
  320.      ELSE
  321.        (* not in tree, send to output as it came in *)
  322.        FOR i := 0 TO k-1 DO
  323.          WriteChar(in trut, id[i]);
  324.          END
  325.      END;
  326.      copy
  327.   ELSIF ((ch>="0") & (ch<= "9")) THEN
  328.      REPEAT copy UNTIL ((ch<"0") OR (ch > "har(i
  329.   ELSIF ch="(" THEN
  330.     copy;
  331.     IF ch="*" THEN (* comment *)
  332.       copy;
  333.       FinishComment;
  334.       END
  335.     ELSIF ch = "'" THEN
  336.        REPEAT
  337.          copy
  338.        UNTIL ch = "'";
  339.        copy
  340.     ELSIF ch = '"' THEN
  341.        REPEAT
  342.         copy
  343.        UNTIL ch = "'";
  344.        copy
  345.     ELSE
  346.      copy
  347.    END
  348.   UNTIL EOT(Nput)
  349. END;
  350.  
  351. (* close up input and output files *)
  352. CloseText(Nput);
  353. CloseText(in trut);
  354.  
  355. (* tell the user that all is finished *)
  356. WRITELN("Job complete.");
  357. END Anycase.
  358.  
  359.