Oberon/V4.Sort.Mod

(* ETH Oberon, Copyright (c) 1990-2017 Computer Systems Institute, ETH Zurich, CH-8092 Zurich. All rights reserved.  License at ftp : //ftp.ethoberon.ethz.ch/ETHOberon/license.txt . *) MODULE V4Sort; (** portable *) (*SHML 13.11.91 / mf 13.10.94 / tk adapted for System3 1.6.95*) &#9;IMPORT Oberon, Texts, Documents, TextFrames, Viewers, MenuViewers; &#9;CONST &#9;&#9;NofLines &#61; 4000; &#9;&#9;suffix &#61; ".Srt"; &#9;&#9;Menu &#61; "System.Close System.Copy System.Grow EditTools.StoreAscii "; &#9;TYPE &#9;&#9;Integer &#61; LONGINT; (* LONGINT in EO context, INTEGER in GA context. *) &#9;&#9;String &#61; ARRAY 256 OF CHAR; &#9;&#9;Array &#61; POINTER TO ARRAY NofLines OF String; &#9;VAR W : Texts.Writer; (* Add suffix to name without overrunning the new array. *) PROCEDURE AddSuffix(name, suffix : ARRAY OF CHAR; VAR new : ARRAY OF CHAR); &#9;VAR i, si : Integer; &#9;BEGIN &#9;&#9;(* Locate upper bound of the first character of suffix. *) &#9;&#9;i : &#61; 0; si : &#61; LEN(new) - 1; &#9;&#9;WHILE (suffix&#91;i&#93; # 0X) &#38; (0 &#60; si) DO INC(i); DEC(si) END; &#9;&#9;IF suffix&#91;i&#93; # 0X THEN &#9;&#9;&#9;Texts.WriteString(W, "Long suffix truncated to fit in new array."); Texts.WriteLn(W); &#9;&#9;&#9;Texts.Append(Oberon.Log, W.buf) &#9;&#9;END; &#9;&#9;(* Retain or copy as much of the original name as suffix allows. *) &#9;&#9;i : &#61; 0; IF name # new THEN &#9;&#9;&#9;WHILE (i &#60; si) &#38; (name&#91;i&#93; # 0X) DO new&#91;i&#93; : &#61; name&#91;i&#93;; INC(i) END &#9;&#9;ELSE &#9;&#9;&#9;WHILE (i &#60; si) &#38; (name&#91;i&#93; # 0X) DO INC(i) END &#9;&#9;END; &#9;&#9;IF name&#91;i&#93; # 0X THEN &#9;&#9;&#9;Texts.WriteString(W, "Name truncated to fit suffix."); Texts.WriteLn(W); &#9;&#9;&#9;Texts.Append(Oberon.Log, W.buf) &#9;&#9;END; &#9;&#9;(* Add suffix. *) &#9;&#9;si : &#61; 0; &#9;&#9;WHILE (suffix&#91;si&#93; # 0X) &#38; (i +1 &#60; LEN(new)) DO &#9;&#9;&#9;new&#91;i&#93; : &#61; suffix&#91;si&#93;; INC(i); INC(si) &#9;&#9;END; &#9;&#9;new&#91;i&#93; : &#61; 0X &#9;END AddSuffix; (* Write number n followed by str followed by a newline to the Log *) PROCEDURE WriteMsg(n : (* LONGINT *) Integer; str : ARRAY OF CHAR); &#9;BEGIN &#9;&#9;Texts.WriteInt(W, n, 0); &#9;&#9;IF n&#61;1 THEN Texts.WriteString(W, " line ") &#9;&#9;ELSE Texts.WriteString(W, " lines ") &#9;&#9;END; &#9;&#9;Texts.WriteString(W, str); Texts.WriteLn(W); &#9;&#9;Texts.Append(Oberon.Log, W.buf) &#9;END WriteMsg; (* Sort n elements of array in ascending order, HeapSort *) PROCEDURE HSortArray(array : Array; n : (* INTEGER *) Integer); &#9;VAR &#9;&#9;left, right : (* INTEGER *) Integer; &#9;&#9;a : String; &#9;PROCEDURE Sift(left, right : (* INTEGER *) Integer); &#9;&#9;VAR &#9;&#9;&#9;i, j : (* INTEGER *) Integer; &#9;&#9;&#9;a : String; &#9;&#9;BEGIN &#9;&#9;&#9;i : &#61;left; j : &#61;2*left; a : &#61;array&#91;left&#93;; &#9;&#9;&#9;IF (j &#60; right) &#38; (array&#91;j&#93; &#60; array&#91;j+1&#93;) THEN INC(j) END; &#9;&#9;&#9;WHILE (j &#60;&#61; right) &#38; (a &#60; array&#91;j&#93;) DO &#9;&#9;&#9;&#9;array&#91;i&#93; : &#61;array&#91;j&#93;; i : &#61;j; j : &#61;2*j; &#9;&#9;&#9;&#9;IF (j &#60; right) &#38; (array&#91;j&#93; &#60; array&#91;j+1&#93;) THEN INC(j) END &#9;&#9;&#9;END; &#9;&#9;&#9;array&#91;i&#93; : &#61;a &#9;&#9;END Sift; &#9;BEGIN &#9;&#9;left : &#61;n DIV 2+1; right : &#61;n-1; &#9;&#9;WHILE left &#62; 0 DO DEC(left); Sift(left, right) END; &#9;&#9;WHILE right &#62; 0 DO &#9;&#9;&#9;a : &#61;array&#91;0&#93;; array&#91;0&#93; : &#61;array&#91;right&#93;; array&#91;right&#93; : &#61;a; &#9;&#9;&#9;DEC(right); Sift(left, right) &#9;&#9;END &#9;END HSortArray; (* Fill array with lines from text (including empty lines if requested); return number of lines in n *) PROCEDURE FillArray(array : Array; VAR n : (* INTEGER *) Integer; text : Texts.Text; emptyLines : BOOLEAN); &#9;VAR &#9;&#9;j : (* INTEGER *) Integer; &#9;&#9;len, pos : (* LONGINT *) Integer; &#9;&#9;R : Texts.Reader; &#9;&#9;ch : CHAR; &#9;&#9;white : BOOLEAN; &#9;BEGIN &#9;&#9;len : &#61;text.len; &#9;&#9;(* IF len&#61;0 THEN RETURN END; *) &#9;&#9;IF len # 0 THEN &#9;&#9;&#9;Texts.OpenReader(R, text, len-1); Texts.Read(R, ch); &#9;&#9;&#9;IF ch # 0DX THEN Texts.Write(W, 0DX); Texts.Append(text, W.buf) END; (* terminate text with a CR *) &#9;&#9;&#9;Texts.OpenReader(R, text, 0); &#9;&#9;&#9;n : &#61;0; pos : &#61;0; len : &#61;text.len; &#9;&#9;&#9;IF emptyLines THEN (* include empty lines *) &#9;&#9;&#9;&#9;REPEAT j : &#61;0; &#9;&#9;&#9;&#9;&#9;REPEAT Texts.Read(R, ch); array&#91;n, j&#93; : &#61;ch; INC(j) UNTIL ch&#61;0DX; &#9;&#9;&#9;&#9;&#9;array&#91;n, j&#93; : &#61;0X; INC(pos, (* LONG(j) *) j); &#9;&#9;&#9;&#9;&#9;INC(n) &#9;&#9;&#9;&#9;UNTIL pos&#61;len &#9;&#9;&#9;ELSE (* exclude empty lines *) &#9;&#9;&#9;&#9;REPEAT j : &#61;0; white : &#61;TRUE; &#9;&#9;&#9;&#9;&#9;REPEAT Texts.Read(R, ch); &#9;&#9;&#9;&#9;&#9;&#9;IF white &#38; (ch &#62; " ") THEN white : &#61;FALSE END; &#9;&#9;&#9;&#9;&#9;&#9;array&#91;n, j&#93; : &#61;ch; INC(j) &#9;&#9;&#9;&#9;&#9;UNTIL ch&#61;0DX; &#9;&#9;&#9;&#9;&#9;array&#91;n, j&#93; : &#61;0X; INC(pos, (* LONG(j) *) j); &#9;&#9;&#9;&#9;&#9;IF &#126;white THEN INC(n) END (* keep line if not only white-space *) &#9;&#9;&#9;&#9;UNTIL pos&#61;len &#9;&#9;&#9;END &#9;&#9;END &#9;END FillArray; (* Fill text with n lines from array; in reverse order if requested *) PROCEDURE FillText(text : Texts.Text; array : Array; n : (* INTEGER *) Integer; reverse, unique : BOOLEAN); &#9;VAR &#9;&#9;i, j, delta : (* INTEGER *) Integer; &#9;&#9;ch : CHAR; &#9;&#9;last : String; &#9;BEGIN &#9;&#9;IF reverse THEN i : &#61;n-1; delta : &#61;-1 ELSE i : &#61;0; delta : &#61;1 END; &#9;&#9;IF unique THEN last&#91;0&#93; : &#61;0X; &#9;&#9;&#9;WHILE n &#62; 0 DO &#9;&#9;&#9;&#9;IF array&#91;i&#93; # last THEN last : &#61;array&#91;i&#93;; &#9;&#9;&#9;&#9;&#9;ch : &#61;last&#91;0&#93;; j : &#61;0; &#9;&#9;&#9;&#9;&#9;WHILE ch # 0X DO Texts.Write(W, ch); INC(j); ch : &#61;last&#91;j&#93; END; &#9;&#9;&#9;&#9;END; &#9;&#9;&#9;&#9;INC(i, delta); DEC(n) &#9;&#9;&#9;END &#9;&#9;ELSE &#9;&#9;&#9;WHILE n &#62; 0 DO ch : &#61;array&#91;i, 0&#93;; j : &#61;0; &#9;&#9;&#9;&#9;WHILE ch # 0X DO Texts.Write(W, ch); INC(j); ch : &#61;array&#91;i, j&#93; END; &#9;&#9;&#9;&#9;INC(i, delta); DEC(n) &#9;&#9;&#9;END &#9;&#9;END; &#9;&#9;Texts.Append(text, W.buf) &#9;END FillText; (** Sort a marked viewer, a selection, or a file. &#9;Option /r means in reverse order; /e keep empty lines **) PROCEDURE Sort*; (** ("^" &#124; "*" &#124; &#60;name&#62;) &#91;"/" &#123;c&#125;&#93; where c IN &#123;"r", "e", "u"&#125; **) &#9;VAR &#9;&#9;S, nameS : Texts.Scanner; &#9;&#9;n : Integer; &#9;&#9;text, sel : Texts.Text; &#9;&#9;beg, end, time : (* LONGINT *) Integer; &#9;&#9;buf : Texts.Buffer; &#9;&#9;array : Array; &#9;&#9;reverse, empty, unique : BOOLEAN; &#9;&#9;V : Viewers.Viewer; &#9;&#9;name : ARRAY 16 OF CHAR; &#9;&#9;X, Y : INTEGER; &#9;BEGIN &#9;&#9;Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S); &#9;&#9;IF S.class&#61;Texts.Char THEN &#9;&#9;&#9;IF S.c&#61;"*" THEN &#9;&#9;&#9;&#9;V : &#61; Oberon.MarkedViewer; &#9;&#9;&#9;&#9;IF &#126;(V IS MenuViewers.Viewer) THEN HALT(30) END; (* normal Viewers don&#39;t have a menu where I can scan for a name and don&#39;t have a text to sort *) &#9;&#9;&#9;&#9;Texts.OpenScanner(nameS, V.dsc(TextFrames.Frame).text, 0); &#9;&#9;&#9;&#9;Texts.Scan(nameS); &#9;&#9;&#9;&#9;COPY(nameS.s, name); &#9;&#9;&#9;&#9;text : &#61; V.dsc.next(TextFrames.Frame).text; &#9;&#9;&#9;ELSIF S.c&#61;"^" THEN Oberon.GetSelection(sel, beg, end, time); &#9;&#9;&#9;&#9;IF time &#62;&#61; 0 THEN &#9;&#9;&#9;&#9;&#9;name : &#61; "Selection"; NEW(text); Texts.Open(text, name); &#9;&#9;&#9;&#9;&#9;NEW(buf); Texts.OpenBuf(buf); &#9;&#9;&#9;&#9;&#9;Texts.Save(sel, beg, end, buf); &#9;&#9;&#9;&#9;&#9;Texts.Append(text, buf) &#9;&#9;&#9;&#9;END &#9;&#9;&#9;END &#9;&#9;ELSIF S.class&#61;Texts.Name THEN COPY(S.s, name); NEW(text); Texts.Open(text, name) &#9;&#9;END; &#9;&#9;Texts.Scan(S); &#9;&#9;reverse : &#61;FALSE; empty : &#61;FALSE; unique : &#61;FALSE; &#9;&#9;IF (S.class&#61;Texts.Char) &#38; (S.c&#61;"/") THEN &#9;&#9;&#9;Texts.Scan(S); &#9;&#9;&#9;IF S.class&#61;Texts.Name THEN &#9;&#9;&#9;&#9;reverse : &#61;(CAP(S.s&#91;0&#93;)&#61;"R") OR (CAP(S.s&#91;1&#93;)&#61;"R") OR (CAP(S.s&#91;2&#93;)&#61;"R"); &#9;&#9;&#9;&#9;empty : &#61;(CAP(S.s&#91;0&#93;)&#61;"E") OR (CAP(S.s&#91;1&#93;)&#61;"E") OR (CAP(S.s&#91;2&#93;)&#61;"E"); &#9;&#9;&#9;&#9;unique : &#61;(CAP(S.s&#91;0&#93;)&#61;"U") OR (CAP(S.s&#91;1&#93;)&#61;"U") OR (CAP(S.s&#91;2&#93;)&#61;"U") &#9;&#9;&#9;END &#9;&#9;END; &#9;&#9;NEW(array); &#9;&#9;FillArray(array, n, text, empty); &#9;&#9;HSortArray(array, n); &#9;&#9;NEW(text); Texts.Open(text, ""); &#9;&#9;FillText(text, array, n, reverse, unique); WriteMsg(n, "sorted."); &#9;&#9;AddSuffix(name, suffix, name); &#9;&#9;Oberon.AllocateUserViewer(Oberon.Par.vwr.X, X, Y); &#9;&#9;V : &#61; MenuViewers.New( &#9;&#9;&#9;TextFrames.NewMenu(name, Menu), &#9;&#9;&#9;TextFrames.NewText(text, 0), &#9;&#9;&#9;TextFrames.menuH, &#9;&#9;&#9;X, Y); &#9;&#9;array : &#61;NIL; &#9;&#9;Oberon.Collect(0) &#9;END V4Sort; &#9;BEGIN &#9;&#9;Texts.OpenWriter(W) &#9;END V4Sort.