跳转到内容

Oberon/A2/Oberon.Sort.Mod

Add links
来自维基教科书，开放的书籍，开放的世界

(* ETH Oberon，版权所有 2001 ETH 苏黎世计算机系统研究所，ETH 中心，CH-8092 苏黎世。
请参阅 "General ETH Oberon System Source License" 协议，该协议可在以下网址获取：http://www.oberon.ethz.ch/ *)

MODULE Sort IN Oberon; (** 可移植的 *) (*SHML 13.11.91 / mf 13.10.94 / tk 为 System3 1.6.95 适配*)

IMPORT Oberon, Texts, Objects, Gadgets, TextGadgets, Desktops, Documents,
TextFrames, Viewers, MenuViewers;


CONST NofLines = 4000;
suffix = ".Srt";
Menu = "System.Close System.Copy System.Grow ET.Move ET.Search ET.Replace ET.StoreAscii ";


TYPE
Integer = LONGINT; (* 在 S3 上下文中为 LONGINT，在 V5 上下文中为 INTEGER. *)
String = ARRAY 256 OF CHAR;
Array = POINTER TO ARRAY NofLines OF String;


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


(* 在不超过新数组的情况下，将后缀添加到名称。 *)
PROCEDURE AddSuffix(VAR name, suffix, new: ARRAY OF CHAR);
VAR i, si: Integer;
BEGIN
(* 定位后缀第一个字符的上界。 *)
i := 0; si := LEN(new) - 1;
WHILE (suffix[i] # 0X) & (0 < si) DO INC(i); DEC(si) END;
IF suffix[i] # 0X THEN
Texts.WriteString(W, "长后缀被截断以适应新数组。"); Texts.WriteLn(W);
Texts.Append(Oberon.Log, W.buf)
END;
(* 保留或复制尽可能多的原始名称，以使后缀允许。 *)
i := 0; IF name = new THEN
WHILE (i < si) & (name[i] # 0X) DO INC(i) END
ELSE
WHILE (i < si) & (name[i] # 0X) DO new[i] := name[i]; INC(i) END
END;
IF name[i] # 0X THEN
Texts.WriteString(W, "名称被截断以适应后缀。"); Texts.WriteLn(W);
Texts.Append(Oberon.Log, W.buf)
END;
(* 添加后缀。 *)
si := 0;
WHILE (suffix[si] # 0X) & (i +1 < LEN(new)) DO
new[i] := suffix[si]; INC(i); INC(si)
END;
new[i] := 0X
END AddSuffix;

PROCEDURE WriteMsg(n: (* LONGINT *) Integer; str: ARRAY OF CHAR);
(* 将数字 n 后跟 str 后跟换行符写入日志 *)
BEGIN
Texts.WriteInt(W, n, 0);
IF n=1 THEN Texts.WriteString(W, " 行 ")
ELSE Texts.WriteString(W, " 行 ")
END;
Texts.WriteString(W, str); Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
END WriteMsg;


(* 按升序对数组的 n 个元素进行排序，堆排序 *)
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:=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 left:=n DIV 2+1; 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
END HSortArray;


PROCEDURE FillArray(array: Array; VAR n: (* INTEGER *) Integer; text: Texts.Text; emptyLines: BOOLEAN);
(* 使用文本中的行填充数组（如果需要，包括空行）；在 n 中返回行数 *)
VAR j: (* INTEGER *) Integer; len, pos: (* LONGINT *) Integer; R: Texts.Reader; ch: CHAR; white: BOOLEAN;
BEGIN
len:=text.len;
(* IF len=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; (* 使用 CR 终止文本 *)
Texts.OpenReader(R, text, 0);
n:=0; pos:=0; len:=text.len;
IF emptyLines THEN (* 包含空行 *)
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) *) j);
INC(n)
UNTIL pos=len
ELSE (* 排除空行 *)
REPEAT j:=0; white:=TRUE;
REPEAT Texts.Read(R, ch);
IF white & (ch > " ") THEN white:=FALSE END;
array[n, j]:=ch; INC(j)
UNTIL ch=0DX;
array[n, j]:=0X; INC(pos, (* LONG(j) *) j);
IF ~white THEN INC(n) END (* 如果不仅仅是空白，则保留行 *)
UNTIL pos=len
END
END
END FillArray;


PROCEDURE FillText(text: Texts.Text; array: Array; n: (* INTEGER *) Integer; reverse, unique: BOOLEAN);
(* 使用数组中的 n 行填充文本；如果需要，则反转顺序 *)
VAR i, j, delta: (* INTEGER *) 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); INC(j); ch:=last[j] END;
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); INC(j); ch:=array[i, j] END;
INC(i, delta); DEC(n)
END
END;
Texts.Append(text, W.buf)
END FillText;


PROCEDURE Sort*; (** ("^" | "*" | <name>) ["/" {c}] 其中 c IN {"r", "e", "u"} **)
(** 对标记的查看器、选择或文件进行排序。选项 /r 表示反转顺序；/e 保留空行 **)
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=Texts.Char THEN
IF S.c="*" THEN
text:=Oberon.MarkedText();
(* 同时获取查看器的名称。 *)
D := Documents.MarkedDoc();
IF D = NIL THEN (* 普通的 Text 查看器。 *)
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="^" THEN Oberon.GetSelection(sel, beg, end, time);
IF time >= 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=Texts.Name THEN NEW(text); Texts.Open(text, S.s)
END;
Texts.Scan(S);
reverse:=FALSE; empty:=FALSE; unique:=FALSE;
IF (S.class=Texts.Char) & (S.c=Oberon.OptionChar) 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;
NEW(array);
FillArray(array, n, text, empty); HSortArray(array, n);
NEW(text); Texts.Open(text, "");
FillText(text, array, n, reverse, unique); WriteMsg(n, "已排序。");
IF D = NIL THEN (* Text 查看器。 *)
Oberon.AllocateUserViewer(Oberon.Par.vwr.X, X, Y);
V := MenuViewers.New(
TextFrames.NewMenu(name, Menu),
TextFrames.NewText(text, 0),
TextFrames.menuH,
X, Y);
ELSE
D:=Gadgets.CreateObject("TextDocs.NewDoc");
NEW(TF); TextGadgets.Init(TF, text, FALSE); D(Documents.Document).W:=300; (* D.name := "Sorted.Text"; *)
COPY(name, D(Documents.Document).name);
Documents.Init(D(Documents.Document), TF);
Desktops.ShowDoc(D(Documents.Document))
END;
array:=NIL;
Oberon.Collect
END Sort;


BEGIN

suffixArray := suffix;
Texts.OpenWriter(W)

END Sort.

检索自 "https://wikibooks.cn/w/index.php?title=Oberon/A2/Oberon.Sort.Mod&oldid=3836687"
华夏公益教科书