sSyntax10.Scn.Fnt8FoldElemsNewaSyntax10i.Scn.Fnt 808/ 88, !8?88I #8887 8F8<8N8888; 8V8K88<88888 888g  *8#8O88q88f 8588888Syntax10b.Scn.Fnt=88a8S8E88B ZParcElemsAlloc? )&TableElemsAlloc^Syntax10.Scn.Fnt ZParcElemsAlloc;yz/table File Lines Comb Heap Sort.Mod 247 0.19 0.19 XE.Mod 628 0.62 0.53 O_2.Text 918 0.93 0.77 2*O_2.Text 1836 2.35 1.71  MODULE Sort; (**SHML 13-Nov-91, Sorts lines in a text alphabetically**) IMPORT Oberon, Texts, TextFrames, Viewers, MenuViewers(*, Out, Time*); CONST NofLines = 2000; TYPE String = ARRAY 256 OF CHAR; Array = POINTER TO ARRAY NofLines OF String; VAR W: Texts.Writer; (* sorter: PROCEDURE (array: Array; n: INTEGER); PROCEDURE ASSERT(cond: BOOLEAN); (*Ensure that cond is true*) BEGIN IF ~cond THEN HALT(100) END END ASSERT; PROCEDURE Sorted(n: INTEGER): BOOLEAN; (*Is array sorted?*) BEGIN DEC(n); WHILE n > 0 DO IF array[n] < array[n-1] THEN RETURN FALSE END; DEC(n) END; RETURN TRUE END Sorted; PROCEDURE BSortArray(n: INTEGER); (*Sort n elements of array in ascending order, BubbleSort*) VAR i, j: INTEGER; a: String; BEGIN Out.Str("Bubble sort: "); Out.Int(n, 0); Out.Ln; Time.Start; FOR i := n-1 TO 1 BY -1 DO FOR j := 1 TO i DO IF array[j-1] > array[j] THEN a := array[j]; array[j] := array[j-1]; array[j-1] := a END; END END ;Time.Stop ;ASSERT(Sorted(n)) END BSortArray;*) PROCEDURE WriteMsg(n: LONGINT; 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 = 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; (*PROCEDURE CSortArray(array: Array; n: INTEGER); (*Sort n elements of array in ascending order, CombSort*) VAR gap, j: INTEGER; a: String; swap: BOOLEAN; BEGIN (*Out.Str("Comb sort: "); Out.Int(n, 0); Out.Ln; Time.Start;*) gap := n; REPEAT gap := gap*10 DIV 13; IF gap = 0 THEN gap := 1 END; REPEAT j := gap; swap := FALSE; WHILE j < n DO IF array[j-gap] > array[j] THEN a := array[j]; array[j] := array[j-gap]; array[j-gap] := a; swap := TRUE END; INC(j) END UNTIL ~swap UNTIL (gap = 1) & ~swap (*;Time.Stop ;ASSERT(Sorted(n))*) END CSortArray; *) PROCEDURE HSortArray(array: Array; n: INTEGER); (*Sort n elements of array in ascending order, HeapSort*) VAR left, right: INTEGER; a: String; PROCEDURE Sift(left, right: INTEGER); VAR i, j: INTEGER; a: String; BEGIN i := left; j := 2*left; a := array[left]; IF (j < right) & (array[j] < array[j+1]) THEN INC(j) END; WHILE (j <= right) & (a < array[j]) DO array[i] := array[j]; i := j; j := 2*j; IF (j < right) & (array[j] < array[j+1]) THEN INC(j) END END; array[i] := a END Sift; BEGIN (*Out.Str("Heap sort: "); Out.Int(n, 0); Out.Ln; Time.Start;*) left := n DIV 2; right := n-1; WHILE left > 0 DO DEC(left); Sift(left, right) END; WHILE right > 0 DO a := array[0]; array[0] := array[right]; array[right] := a; DEC(right); Sift(left, right) END (*;Time.Stop ;ASSERT(Sorted(n))*) END HSortArray; (* PROCEDURE UseBubble*; BEGIN sorter := BSortArray END UseBubble; PROCEDURE UseComb*; BEGIN sorter := CSortArray END UseComb; PROCEDURE UseHeap*; BEGIN sorter := HSortArray END UseHeap; PROCEDURE GetNofLines(text: Texts.Text; VAR n: INTEGER); (*Count number of lines in text; terminate text with a CR if necessary*) VAR pos: LONGINT; R: Texts.Reader; ch: CHAR; BEGIN n := 0; IF text.len = 0 THEN RETURN END; Texts.OpenReader(R, text, 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); FOR pos := 0 TO text.len-1 DO Texts.Read(R, ch); IF ch = 0DX THEN INC(n) END END END GetNofLines;*) PROCEDURE FillArray(array: Array; VAR n: INTEGER; text: Texts.Text; emptyLines: BOOLEAN); (*Fill array with lines from text (including empty lines if requested); return number of lines in n*) VAR i, j: INTEGER; len, pos: LONGINT; R: Texts.Reader; ch: CHAR; white: BOOLEAN; BEGIN len := text.len; IF len = 0 THEN RETURN END; 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 := 0; pos := 0; len := text.len; IF emptyLines THEN (*include empty lines*) REPEAT j := 0; REPEAT Texts.Read(R, ch); array[n, j] := ch; INC(j) UNTIL ch = 0DX; array[n, j] := 0X; INC(pos, LONG(j)); INC(n) (* ; IF n = NofLines THEN WriteMsg(NofLines, "exceeded!"); n := 0; RETURN END*) UNTIL pos = len ELSE (*exclude empty lines*) REPEAT j := 0; white := TRUE; REPEAT Texts.Read(R, ch); IF white & ((ch > " ") OR (ch = Texts.ElemChar)) THEN white := FALSE END; array[n, j] := ch; INC(j) UNTIL ch = 0DX; array[n, j] := 0X; INC(pos, LONG(j)); IF ~white THEN INC(n) END (*keep line if not only white-space*) UNTIL pos = len END (*;FOR i := 0 TO n-1 DO j := 0; REPEAT Out.Int(ORD(array[i, j]), 4); INC(j) UNTIL array[i, j] = 0X END; Out.Ln*) END FillArray; PROCEDURE FillText(text: Texts.Text; array: Array; n: INTEGER; reverse, unique: BOOLEAN); (*Fill text with n lines from array; in reverse order if requested*) VAR i, j, delta: INTEGER; ch: CHAR; last: String; BEGIN IF reverse THEN i := n-1; delta := -1 ELSE i := 0; delta := 1 END; IF unique THEN last[0] := 0X; WHILE n > 0 DO IF array[i] # last THEN last := array[i]; ch := last[0]; j := 0; WHILE ch # 0X DO Texts.Write(W, ch); (*Out.Int(ORD(ch), 4);*) INC(j); ch := last[j] END; (*Out.Ln;*) END; INC(i, delta); DEC(n) END ELSE WHILE n > 0 DO ch := array[i, 0]; j := 0; WHILE ch # 0X DO Texts.Write(W, ch); (*Out.Int(ORD(ch), 4);*) INC(j); ch := array[i, j] END; (*Out.Ln;*) INC(i, delta); DEC(n) END END; Texts.Append(text, W.buf) END FillText; PROCEDURE Sort*; (**("^" | "*" | ) ["\" {c}] where c IN {"r", "e", "u"}**) (**Sort a marked viewer, a selection, or a file. Option /r means in reverse order; /e keep empty lines**) VAR V: Viewers.Viewer; S: Texts.Scanner; x, y, n: INTEGER; text, sel: Texts.Text; beg, end, time: LONGINT; buf: Texts.Buffer; array: Array; reverse, empty, unique: BOOLEAN; BEGIN text := TextFrames.Text(""); Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S); IF S.class = Texts.Char THEN IF S.c = "*" THEN (*text from marked viewer*) V := Oberon.MarkedViewer(); IF V.dsc.next IS TextFrames.Frame THEN text := V.dsc.next(TextFrames.Frame).text END ELSIF S.c = "^" THEN (*text from selection*) Oberon.GetSelection(sel, beg, end, time); IF time >= 0 THEN NEW(buf); Texts.OpenBuf(buf); Texts.Save(sel, beg, end, buf); text := TextFrames.Text(""); Texts.Append(text, buf) END END ELSIF S.class = Texts.Name THEN text := TextFrames.Text(S.s) END; Texts.Scan(S); reverse := FALSE; empty := FALSE; unique := FALSE; IF (S.class = Texts.Char) & (S.c = "\") THEN Texts.Scan(S); IF S.class = Texts.Name THEN reverse := (CAP(S.s[0]) = "R") OR (CAP(S.s[1]) = "R") OR (CAP(S.s[2]) = "R"); empty := (CAP(S.s[0]) = "E") OR (CAP(S.s[1]) = "E") OR (CAP(S.s[2]) = "E"); unique := (CAP(S.s[0]) = "U") OR (CAP(S.s[1]) = "U") OR (CAP(S.s[2]) = "U"); END END; (* GetNofLines(text, n); IF n = 0 THEN WriteMsg(0, ": No output."); RETURN END; NEW(array, n);*) NEW(array); FillArray(array, n, text, empty); (*WriteMsg(n, "read.");*) (*sorter(array, n);*) (*CSortArray(array, n); WriteMsg(n, "sorted.");*) HSortArray(array, n); (*WriteMsg(n, "sorted.");*) text := TextFrames.Text(""); FillText(text, array, n, reverse, unique); WriteMsg(n, "sorted."); (*WriteMsg(n, "written.");*) Oberon.AllocateUserViewer(Oberon.Mouse.X, x, y); V := MenuViewers.New( TextFrames.NewMenu("Sorted.Text", "System.Close System.Copy System.Grow Edit.Search Edit.Store"), TextFrames.NewText(text, 0), TextFrames.menuH, x, y); array := NIL; Oberon.Collect(0) END Sort; BEGIN (*sorter := HSortArray*) Texts.OpenWriter(W) END Sort. Sort.Sort * Sort marked viewer Sort.Sort ^ Sort selection Sort.Sort Test.Text Sort file 'Test.Text' Sort.Sort *\r Sort marked viewer in reverse order Sort.Sort *\e Sort marked viewer including empty lines Sort.Sort *\u Sort marked viewer keeping unique lines only