Oberon/ETH Oberon/2.3.7/Sort.Mod

(* ETH Oberon, Copyright 1990-2003 Computer Systems Institute, ETH Zurich, CH-8092 Zurich. Refer to the license.txt file provided with this distribution. *) MODULE Sort;	(** portable *)	(*SHML 13.11.91 / mf 13.10.94 / tk adapted for System3 1.6.95*) &#9;IMPORT Oberon, Texts, Objects, Gadgets, TextGadgets, Documents, Desktops; &#9;CONST NofLines&#61;4000; &#9;TYPE &#9;&#9;String&#61;ARRAY 256 OF CHAR; &#9;&#9;Array&#61;POINTER TO ARRAY NofLines OF String; &#9;VAR W&#58; Texts.Writer; &#9;PROCEDURE WriteMsg(n&#58; LONGINT; str&#58; ARRAY OF CHAR); &#9;&#9;(*Write number n followed by str followed by a newline to the Log*) &#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); Texts.Append(Oberon.Log, W.buf) &#9;END WriteMsg; &#9;PROCEDURE HSortArray(array&#58; Array; n&#58; INTEGER);	(*Sort n elements of array in ascending order, HeapSort*) &#9;&#9;VAR left, right&#58; INTEGER; a&#58; String; &#9;&#9;PROCEDURE Sift(left, right&#58; INTEGER); &#9;&#9;&#9;VAR i, j&#58; INTEGER; a&#58; String; &#9;&#9;BEGIN	i&#58;&#61;left; j&#58;&#61;2*left; a&#58;&#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;&#58;&#61;array&#91;j&#93;; i&#58;&#61;j; j&#58;&#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;&#58;&#61;a &#9;&#9;END Sift; &#9;&#9; &#9;BEGIN	left&#58;&#61;n DIV 2+1; right&#58;&#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&#58;&#61;array&#91;0&#93;; array&#91;0&#93;&#58;&#61;array&#91;right&#93;; array&#91;right&#93;&#58;&#61;a; &#9;&#9;&#9;DEC(right); Sift(left, right) &#9;&#9;END &#9;END HSortArray; &#9;PROCEDURE FillArray(array&#58; Array; VAR n&#58; INTEGER; text&#58; Texts.Text; emptyLines&#58; BOOLEAN); &#9;&#9;(*Fill array with lines from text (including empty lines if requested); return number of lines in n *) &#9;&#9;VAR j&#58; INTEGER; len, pos&#58; LONGINT; R&#58; Texts.Reader; ch&#58; CHAR; white&#58; BOOLEAN; &#9;BEGIN	len&#58;&#61;text.len; IF len&#61;0 THEN RETURN END; &#9;&#9;Texts.OpenReader(R, text, len-1); Texts.Read(R, ch); &#9;&#9;IF ch # 0DX THEN Texts.Write(W, 0DX); Texts.Append(text, W.buf) END;	(*terminate text with a CR*) &#9;&#9;Texts.OpenReader(R, text, 0); &#9;&#9;n&#58;&#61;0; pos&#58;&#61;0; len&#58;&#61;text.len; &#9;&#9;IF emptyLines THEN	(*include empty lines*) &#9;&#9;&#9;REPEAT	j&#58;&#61;0; &#9;&#9;&#9;&#9;REPEAT Texts.Read(R, ch); array&#91;n, j&#93;&#58;&#61;ch; INC(j) UNTIL ch&#61;0DX; &#9;&#9;&#9;&#9;array&#91;n, j&#93;&#58;&#61;0X; INC(pos, LONG(j)); &#9;&#9;&#9;&#9;INC(n) &#9;&#9;&#9;UNTIL pos&#61;len &#9;&#9;ELSE	(*exclude empty lines*) &#9;&#9;&#9;REPEAT	j&#58;&#61;0; white&#58;&#61;TRUE; &#9;&#9;&#9;&#9;REPEAT	Texts.Read(R, ch); &#9;&#9;&#9;&#9;&#9;IF white &#38; (ch &#62; " ") THEN white&#58;&#61;FALSE END; &#9;&#9;&#9;&#9;&#9;array&#91;n, j&#93;&#58;&#61;ch; INC(j) &#9;&#9;&#9;&#9;UNTIL ch&#61;0DX; &#9;&#9;&#9;&#9;array&#91;n, j&#93;&#58;&#61;0X; INC(pos, LONG(j)); &#9;&#9;&#9;&#9;IF &#126;white THEN INC(n) END	(*keep line if not only white-space*) &#9;&#9;&#9;UNTIL pos&#61;len &#9;&#9;END &#9;END FillArray; &#9; &#9;PROCEDURE FillText(text&#58; Texts.Text; array&#58; Array; n&#58; INTEGER; reverse, unique&#58; BOOLEAN); &#9;&#9;(*Fill text with n lines from array ; in reverse order if requested*) &#9;&#9;VAR i, j, delta&#58; INTEGER; ch&#58; CHAR; last&#58; String; &#9;BEGIN &#9;&#9;IF reverse THEN i&#58;&#61;n-1; delta&#58;&#61;-1	ELSE i&#58;&#61;0; delta&#58;&#61;1	END; &#9;&#9;IF unique THEN	last&#91;0&#93;&#58;&#61;0X; &#9;&#9;&#9;WHILE n &#62; 0 DO &#9;&#9;&#9;&#9;IF array&#91;i&#93; # last THEN	last&#58;&#61;array&#91;i&#93;; &#9;&#9;&#9;&#9;&#9;ch&#58;&#61;last&#91;0&#93;; j&#58;&#61;0; &#9;&#9;&#9;&#9;&#9;WHILE ch # 0X DO Texts.Write(W, ch); INC(j); ch&#58;&#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&#58;&#61;array&#91;i, 0&#93;; j&#58;&#61;0; &#9;&#9;&#9;&#9;WHILE ch # 0X DO Texts.Write(W, ch); INC(j); ch&#58;&#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; &#9; &#9;PROCEDURE Sort *;	(** ("^" &#124; "*" &#124; &#60;name&#62;) &#91;"/" &#123;c&#125;&#93;	 where c IN &#123;"r", "e", "u"&#125; **) &#9;&#9;(**Sort a marked viewer, a selection, or a file. Option /r means in reverse order; /e keep empty lines**) &#9;&#9;VAR S&#58; Texts.Scanner; n&#58; INTEGER; text, sel&#58; Texts.Text; beg, end, time&#58; LONGINT; &#9;&#9;&#9;buf&#58; Texts.Buffer; array&#58; Array; reverse, empty, unique&#58; BOOLEAN; TF&#58; TextGadgets.Frame; D&#58; Objects.Object; &#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	text&#58;&#61;Oberon.MarkedText &#9;&#9;&#9;ELSIF S.c&#61;"^" THEN	Oberon.GetSelection(sel, beg, end, time); &#9;&#9;&#9;&#9;IF time &#62;&#61; 0 THEN	NEW(buf); Texts.OpenBuf(buf); Texts.Save(sel, beg, end, buf); &#9;&#9;&#9;&#9;&#9;NEW(text); Texts.Open(text, ""); Texts.Append(text, buf) &#9;&#9;&#9;&#9;END &#9;&#9;&#9;END &#9;&#9;ELSIF S.class&#61;Texts.Name THEN NEW(text); Texts.Open(text, S.s) &#9;&#9;END; &#9;&#9;Texts.Scan(S); &#9;&#9;reverse&#58;&#61;FALSE; empty&#58;&#61;FALSE; unique&#58;&#61;FALSE; &#9;&#9;IF (S.class&#61;Texts.Char) &#38; (S.c&#61;Oberon.OptionChar) THEN	Texts.Scan(S); &#9;&#9;&#9;IF S.class&#61;Texts.Name THEN &#9;&#9;&#9;&#9;reverse&#58;&#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&#58;&#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&#58;&#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); HSortArray(array, n); &#9;&#9;NEW(text); Texts.Open(text, ""); &#9;&#9;FillText(text, array, n, reverse, unique); WriteMsg(n, "sorted."); &#9;&#9;D&#58;&#61;Gadgets.CreateObject("TextDocs.NewDoc"); &#9;&#9;IF	D#NIL	THEN &#9;&#9;&#9;WITH	D&#58; Documents.Document	DO &#9;&#9;&#9;&#9;NEW(TF); TextGadgets.Init(TF, text, FALSE); D.W&#58;&#61;300; D.name&#58;&#61;"Sorted.Text"; &#9;&#9;&#9;&#9;Documents.Init(D, TF); &#9;&#9;&#9;&#9;Desktops.ShowDoc(D) &#9;&#9;&#9;END &#9;&#9;END; &#9;&#9;array&#58;&#61;NIL; &#9;&#9;Oberon.Collect; &#9;END Sort; BEGIN	Texts.OpenWriter(W) END Sort.