Oberon/A2/Oberon.Sort.Mod

(* ETH Oberon, Copyright 2001 ETH Zuerich Institut fuer Computersysteme, ETH Zentrum, CH-8092 Zuerich. Refer to the "General ETH Oberon System Source License" contract available at: http://www.oberon.ethz.ch/ *) MODULE Sort IN Oberon;	(** portable *)	(*SHML 13.11.91 / mf 13.10.94 / tk adapted for System3 1.6.95*)
 * IMPORT Oberon, Texts, Objects, Gadgets, TextGadgets, Desktops, Documents,
 * TextFrames, Viewers, MenuViewers;


 * CONST NofLines &#61; 4000;
 * suffix &#61; ".Srt";
 * Menu &#61; "System.Close System.Copy System.Grow ET.Move ET.Search ET.Replace ET.StoreAscii ";


 * TYPE
 * Integer &#61; LONGINT; (* LONGINT in S3 context, INTEGER in V5 context. *)
 * String &#61; ARRAY 256 OF CHAR;
 * Array &#61; POINTER TO ARRAY NofLines OF String;


 * VAR W: Texts.Writer;
 * suffixArray: ARRAY 32 OF CHAR;


 * (* Add suffix to name without overrunning the new array. *)
 * PROCEDURE AddSuffix(VAR name, suffix, new: ARRAY OF CHAR);
 * VAR i, si: Integer;
 * BEGIN
 * (* Locate upper bound of the first character of suffix. *)
 * i :&#61; 0; si :&#61; LEN(new) - 1;
 * WHILE (suffix&#91;i&#93; # 0X) &#38; (0 &#60; si) DO INC(i); DEC(si) END;
 * IF suffix&#91;i&#93; # 0X THEN
 * Texts.WriteString(W, "Long suffix truncated to fit in new array."); Texts.WriteLn(W);
 * Texts.Append(Oberon.Log, W.buf)
 * END;
 * (* Retain or copy as much of the original name as suffix allows. *)
 * i :&#61; 0; IF name &#61; new THEN
 * WHILE (i &#60; si) &#38; (name&#91;i&#93; # 0X) DO INC(i) END
 * ELSE
 * WHILE (i &#60; si) &#38; (name&#91;i&#93; # 0X) DO new&#91;i&#93; :&#61; name&#91;i&#93;; INC(i) END
 * END;
 * IF name&#91;i&#93; # 0X THEN
 * Texts.WriteString(W, "Name truncated to fit suffix."); Texts.WriteLn(W);
 * Texts.Append(Oberon.Log, W.buf)
 * END;
 * (* Add suffix. *)
 * si :&#61; 0;
 * WHILE (suffix&#91;si&#93; # 0X) &#38; (i +1 &#60; LEN(new)) DO
 * new&#91;i&#93; :&#61; suffix&#91;si&#93;; INC(i); INC(si)
 * END;
 * new&#91;i&#93; :&#61; 0X
 * END AddSuffix;
 * PROCEDURE WriteMsg(n: (* LONGINT *) Integer; str: ARRAY OF CHAR);
 * (* Write number n followed by str followed by a newline to the Log *)
 * BEGIN
 * Texts.WriteInt(W, n, 0);
 * IF n&#61;1 THEN Texts.WriteString(W, " line ")
 * ELSE Texts.WriteString(W, " lines ")
 * END;
 * Texts.WriteString(W, str); Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
 * END WriteMsg;
 * END WriteMsg;


 * (* Sort n elements of array in ascending order, HeapSort *)
 * PROCEDURE HSortArray(array: Array; n: (* INTEGER *) Integer);
 * VAR left, right: (* INTEGER *) Integer; a: String;


 * PROCEDURE Sift(left, right: (* INTEGER *) Integer);
 * VAR i, j: (* INTEGER *) Integer; a: String;
 * BEGIN	i:&#61;left; j:&#61;2*left; a:&#61;array&#91;left&#93;;
 * IF (j &#60; right) &#38; (array&#91;j&#93; &#60; array&#91;j+1&#93;) THEN INC(j) END;
 * WHILE (j &#60;&#61; right) &#38; (a &#60; array&#91;j&#93;) DO
 * array&#91;i&#93;:&#61;array&#91;j&#93;; i:&#61;j; j:&#61;2*j;
 * IF (j &#60; right) &#38; (array&#91;j&#93; &#60; array&#91;j+1&#93;) THEN INC(j) END
 * END;
 * array&#91;i&#93;:&#61;a
 * END Sift;


 * BEGIN	left:&#61;n DIV 2+1; right:&#61;n-1;
 * WHILE left &#62; 0 DO DEC(left); Sift(left, right) END;
 * WHILE right &#62; 0 DO
 * a:&#61;array&#91;0&#93;; array&#91;0&#93;:&#61;array&#91;right&#93;; array&#91;right&#93;:&#61;a;
 * DEC(right); Sift(left, right)
 * END
 * END HSortArray;


 * PROCEDURE FillArray(array: Array; VAR n: (* INTEGER *) Integer; text: Texts.Text; emptyLines: BOOLEAN);
 * (* Fill array with lines from text (including empty lines if requested); return number of lines in n *)
 * VAR j: (* INTEGER *) Integer; len, pos: (* LONGINT *) Integer; R: Texts.Reader; ch: CHAR; white: BOOLEAN;
 * BEGIN
 * len:&#61;text.len;
 * (* IF len&#61;0 THEN RETURN END; *)
 * IF len#0 THEN
 * Texts.OpenReader(R, text, len-1); Texts.Read(R, ch);
 * IF ch # 0DX THEN Texts.Write(W, 0DX); Texts.Append(text, W.buf) END;	(* terminate text with a CR *)
 * Texts.OpenReader(R, text, 0);
 * n:&#61;0; pos:&#61;0; len:&#61;text.len;
 * IF emptyLines THEN	(* include empty lines *)
 * REPEAT	j:&#61;0;
 * REPEAT Texts.Read(R, ch); array&#91;n, j&#93;:&#61;ch; INC(j) UNTIL ch&#61;0DX;
 * array&#91;n, j&#93;:&#61;0X; INC(pos, (* LONG(j) *) j);
 * INC(n)
 * UNTIL pos&#61;len
 * ELSE	(* exclude empty lines *)
 * REPEAT	j:&#61;0; white:&#61;TRUE;
 * REPEAT	Texts.Read(R, ch);
 * IF white &#38; (ch &#62; " ") THEN white:&#61;FALSE END;
 * array&#91;n, j&#93;:&#61;ch; INC(j)
 * UNTIL ch&#61;0DX;
 * array&#91;n, j&#93;:&#61;0X; INC(pos, (* LONG(j) *) j);
 * IF &#126;white THEN INC(n) END	(* keep line if not only white-space *)
 * UNTIL pos&#61;len
 * END
 * END
 * END FillArray;


 * PROCEDURE FillText(text: Texts.Text; array: Array; n: (* INTEGER *) Integer; reverse, unique: BOOLEAN);
 * (* Fill text with n lines from array; in reverse order if requested *)
 * VAR i, j, delta: (* INTEGER *) Integer; ch: CHAR; last: String;
 * BEGIN
 * IF reverse THEN i:&#61;n-1; delta:&#61;-1	ELSE i:&#61;0; delta:&#61;1	END;
 * IF unique THEN	last&#91;0&#93;:&#61;0X;
 * WHILE n &#62; 0 DO
 * IF array&#91;i&#93; # last THEN	last:&#61;array&#91;i&#93;;
 * ch:&#61;last&#91;0&#93;; j:&#61;0;
 * WHILE ch # 0X DO Texts.Write(W, ch); INC(j); ch:&#61;last&#91;j&#93; END;
 * END;
 * INC(i, delta); DEC(n)
 * END
 * ELSE
 * WHILE n &#62; 0 DO	ch:&#61;array&#91;i, 0&#93;; j:&#61;0;
 * WHILE ch # 0X DO Texts.Write(W, ch); INC(j); ch:&#61;array&#91;i, j&#93; END;
 * INC(i, delta); DEC(n)
 * END
 * END;
 * Texts.Append(text, W.buf)
 * END FillText;


 * PROCEDURE Sort*; (** ("^" | "*" | &#60;name&#62;) &#91;"/" &#123;c&#125;&#93;	where c IN &#123;"r", "e", "u"&#125; **)
 * (** Sort a marked viewer, a selection, or a file. Option /r means in reverse order; /e keep empty lines **)
 * VAR
 * S, nameS: Texts.Scanner;
 * n: Integer;
 * text, sel: Texts.Text;
 * beg, end, time: (* LONGINT *) Integer;
 * buf: Texts.Buffer;
 * array: Array;
 * reverse, empty, unique: BOOLEAN;
 * TF: TextGadgets.Frame;
 * D: Objects.Object;
 * V: Viewers.Viewer;
 * name: ARRAY 16 OF CHAR;
 * X, Y: INTEGER;
 * BEGIN
 * Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
 * IF S.class&#61;Texts.Char THEN
 * IF S.c&#61;"*" THEN
 * text:&#61;Oberon.MarkedText;
 * (* Also get the name of the viewer. *)
 * D :&#61; Documents.MarkedDoc;
 * IF D &#61; NIL THEN (* Plain old Text viewer. *)
 * Texts.OpenScanner(nameS, Oberon.MarkedViewer.dsc(TextFrames.Frame).text, 0);
 * Texts.Scan(nameS);
 * AddSuffix(nameS.s, suffixArray, name)
 * ELSE
 * AddSuffix(Documents.MarkedDoc.name, suffixArray, name)
 * END
 * ELSIF S.c&#61;"^" THEN	Oberon.GetSelection(sel, beg, end, time);
 * IF time &#62;&#61; 0 THEN	NEW(buf); Texts.OpenBuf(buf); Texts.Save(sel, beg, end, buf);
 * NEW(text); Texts.Open(text, ""); Texts.Append(text, buf)
 * END
 * END
 * ELSIF S.class&#61;Texts.Name THEN NEW(text); Texts.Open(text, S.s)
 * END;
 * Texts.Scan(S);
 * reverse:&#61;FALSE; empty:&#61;FALSE; unique:&#61;FALSE;
 * IF (S.class&#61;Texts.Char) &#38; (S.c&#61;Oberon.OptionChar) THEN	Texts.Scan(S);
 * IF S.class&#61;Texts.Name THEN
 * 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");
 * 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");
 * 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");
 * END
 * END;
 * NEW(array);
 * FillArray(array, n, text, empty); HSortArray(array, n);
 * NEW(text); Texts.Open(text, "");
 * FillText(text, array, n, reverse, unique); WriteMsg(n, "sorted.");
 * IF D &#61; NIL THEN (* Text viewer. *)
 * Oberon.AllocateUserViewer(Oberon.Par.vwr.X, X, Y);
 * V :&#61; MenuViewers.New(
 * TextFrames.NewMenu(name, Menu),
 * TextFrames.NewText(text, 0),
 * TextFrames.menuH,
 * X, Y);
 * ELSE
 * D:&#61;Gadgets.CreateObject("TextDocs.NewDoc");
 * NEW(TF); TextGadgets.Init(TF, text, FALSE); D(Documents.Document).W:&#61;300;(* D.name :&#61; "Sorted.Text"; *)
 * COPY(name, D(Documents.Document).name);
 * Documents.Init(D(Documents.Document), TF);
 * Desktops.ShowDoc(D(Documents.Document))
 * END;
 * array:&#61;NIL;
 * Oberon.Collect
 * END Sort;
 * END Sort;

BEGIN
 * suffixArray :&#61; suffix;
 * Texts.OpenWriter(W)

END Sort.