(* 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 Strings IN Oberon; (** portable *) (* ejz, *)
(** Strings is a utility module that provides procedures to manipulate strings.
Note: All strings MUST be 0X terminated. *)
IMPORT Oberon, Texts, Dates, Reals IN A2;
CONST
CR* = 0DX; (** the Oberon end of line character *)
Tab* = 09X; (** the horizontal tab character *)
LF* = 0AX; (** the UNIX end of line character *)
VAR
isAlpha*: ARRAY 256 OF BOOLEAN; (** all letters in the oberon charset *)
ISOToOberon*, OberonToISO*: ARRAY 256 OF CHAR; (** Translation tables for iso-8859-1 to oberon ascii code. *)
CRLF*: ARRAY 4 OF CHAR; (** end of line "string" used by MS-DOS and most TCP protocols *)
sDayName: ARRAY 7, 4 OF CHAR;
lDayName: ARRAY 7, 12 OF CHAR;
sMonthName: ARRAY 12, 4 OF CHAR;
lMonthName: ARRAY 12, 12 OF CHAR;
dateform, timeform: ARRAY 32 OF CHAR;
(** Length of str. *)
PROCEDURE Length*(CONST str(** in *): ARRAY OF CHAR): LONGINT;
VAR i, l: LONGINT;
BEGIN
l := LEN(str); i := 0;
WHILE (i < l) & (str[i] # 0X) DO
INC(i)
END;
RETURN i
END Length;
(** Append this to to. *)
PROCEDURE Append*(VAR to(** in/out *): ARRAY OF CHAR; CONST this: ARRAY OF CHAR);
VAR i, j, l: LONGINT;
BEGIN
i := 0;
WHILE to[i] # 0X DO
INC(i)
END;
l := LEN(to)-1; j := 0;
WHILE (i < l) & (this[j] # 0X) DO
to[i] := this[j]; INC(i); INC(j)
END;
to[i] := 0X
END Append;
(** Append this to to. *)
PROCEDURE AppendCh*(VAR to(** in/out *): ARRAY OF CHAR; this: CHAR);
VAR i: LONGINT;
BEGIN
i := 0;
WHILE to[i] # 0X DO
INC(i)
END;
IF i < (LEN(to)-1) THEN
to[i] := this; to[i+1] := 0X
END
END AppendCh;
(** TRUE if ch is a hexadecimal digit. *)
PROCEDURE IsHexDigit*(ch: CHAR): BOOLEAN;
BEGIN
RETURN ((ch >= "0") & (ch <= "9")) OR ((CAP(ch) >= "A") & (CAP(ch) <= "F"))
END IsHexDigit;
(** TRUE if ch is a decimal digit. *)
PROCEDURE IsDigit*(ch: CHAR): BOOLEAN;
BEGIN
RETURN (ch >= "0") & (ch <= "9")
END IsDigit;
(** TRUE if ch is a letter. *)
PROCEDURE IsAlpha*(ch: CHAR): BOOLEAN;
BEGIN
RETURN isAlpha[ORD(ch)]
END IsAlpha;
(** If ch is an upper-case letter return the corresponding lower-case letter. *)
PROCEDURE LowerCh*(ch: CHAR): CHAR;
BEGIN
CASE ch OF
"A" .. "Z": ch := CHR(ORD(ch)-ORD("A")+ORD("a"))
(* |"": ch := ""
|"": ch := ""
|"": ch := "
" *)
ELSE
END;
RETURN ch
END LowerCh;
(** If ch is an lower-case letter return the corresponding upper-case letter. *)
PROCEDURE UpperCh*(ch: CHAR): CHAR;
BEGIN
CASE ch OF
"a" .. "z": ch := CAP(ch)
(* |"": ch := ""
|"": ch := ""
|"
": ch := ""
|"": ch := "A"
|"": ch := "E"
|"": ch := "I"
|"": ch := "O"
|"": ch := "U"
|"": ch := "A"
|"": ch := "E"
|"": ch := "I"
|"": ch := "O"
|"": ch := "U"
|"": ch := "E"
|"": ch := "E"
|"": ch := "I"
|"": ch := "C"
|"": ch := "A"
|"": ch := "N"
|"": ch := "S" *)
ELSE
END;
RETURN ch
END UpperCh;
(** Convert str to all lower-case letters. *)
PROCEDURE Lower*(CONST str(** in *): ARRAY OF CHAR; VAR lstr(** out *): ARRAY OF CHAR);
VAR i: LONGINT;
BEGIN
i := 0;
WHILE str[i] # 0X DO
lstr[i] := LowerCh(str[i]); INC(i)
END;
lstr[i] := 0X
END Lower;
(** Convert str to all upper-case letters. *)
PROCEDURE Upper*(CONST str(** in *): ARRAY OF CHAR; VAR ustr(** out *): ARRAY OF CHAR);
VAR i: LONGINT;
BEGIN
i := 0;
WHILE str[i] # 0X DO
ustr[i] := UpperCh(str[i]); INC(i)
END;
ustr[i] := 0X
END Upper;
(** Is str prefixed by pre? *)
PROCEDURE Prefix*(CONST pre, str(** in *): ARRAY OF CHAR): BOOLEAN;
VAR i: LONGINT;
BEGIN
i := 0;
WHILE (pre[i] # 0X) & (pre[i] = str[i]) DO
INC(i)
END;
RETURN pre[i] = 0X
END Prefix;
(** Checks if str is prefixed by pre. The case is ignored. *)
PROCEDURE CAPPrefix*(CONST pre, str(** in *): ARRAY OF CHAR): BOOLEAN;
VAR i: LONGINT;
BEGIN
i := 0;
WHILE (pre[i] # 0X) & (CAP(pre[i]) = CAP(str[i])) DO
INC(i)
END;
RETURN pre[i] = 0X
END CAPPrefix;
(** Compare str1 to str2. The case is ignored. *)
PROCEDURE CAPCompare*(CONST str1(** in *), str2(** in *): ARRAY OF CHAR): BOOLEAN;
VAR i: LONGINT;
BEGIN
i := 0;
WHILE (str1[i] # 0X) & (str2[i] # 0X) & (CAP(str1[i]) = CAP(str2[i])) DO
INC(i)
END;
RETURN str1[i] = str2[i]
END CAPCompare;
(** Get the parameter-value on line. The parameter value is started behind the first colon character. *)
PROCEDURE GetPar*(CONST line(** in *): ARRAY OF CHAR; VAR par(** out *): ARRAY OF CHAR);
VAR i, j, l: LONGINT;
BEGIN
i := 0;
WHILE (line[i] # 0X) & (line[i] # ":") DO
INC(i)
END;
IF line[i] = ":" THEN
INC(i)
END;
WHILE (line[i] # 0X) & (line[i] <= " ") DO
INC(i)
END;
l := LEN(par)-1; j := 0;
WHILE (j < l) & (line[i] # 0X) DO
par[j] := line[i]; INC(j); INC(i)
END;
par[j] := 0X
END GetPar;
(** Get the suffix of str. The suffix is started by the last dot in str. *)
PROCEDURE GetSuffix*(CONST str(** in *): ARRAY OF CHAR; VAR suf(** out *): ARRAY OF CHAR);
VAR i, j, l, dot: LONGINT;
BEGIN
dot := -1; i := 0;
WHILE str[i] # 0X DO
IF str[i] = "." THEN
dot := i
ELSIF str[i] = "/" THEN
dot := -1
END;
INC(i)
END;
j := 0;
IF dot > 0 THEN
l := LEN(suf)-1; i := dot+1;
WHILE (j < l) & (str[i] # 0X) DO
suf[j] := str[i]; INC(j); INC(i)
END
END;
suf[j] := 0X
END GetSuffix;
(** Change the suffix of str to suf. *)
PROCEDURE ChangeSuffix*(VAR str(** in/out *): ARRAY OF CHAR; CONST suf: ARRAY OF CHAR);
VAR i, j, l, dot: LONGINT;
BEGIN
dot := -1; i := 0;
WHILE str[i] # 0X DO
IF str[i] = "." THEN
dot := i
ELSIF str[i] = "/" THEN
dot := -1
END;
INC(i)
END;
IF dot > 0 THEN
l := LEN(str)-1; i := dot+1; j := 0;
WHILE (i < l) & (suf[j] # 0X) DO
str[i] := suf[j]; INC(i); INC(j)
END;
str[i] := 0X
END
END ChangeSuffix;
(** Search in src starting at pos for the next occurrence of pat. Returns pos=-1 if not found. *)
PROCEDURE Search*(CONST pat, src(** in *): ARRAY OF CHAR; VAR pos(** in/out *): LONGINT);
CONST MaxPat = 128;
VAR
buf: ARRAY MaxPat OF CHAR;
len, i, srclen: LONGINT;
PROCEDURE Find(beg: LONGINT);
VAR
i, j, b, e: LONGINT;
ch: CHAR;
ref: ARRAY MaxPat OF CHAR;
BEGIN
ch := src[pos]; INC(pos);
ref[0] := ch;
i := 0; j := 0; b := 0; e := 1;
WHILE (pos <= srclen) & (i < len) DO
IF buf[i] = ch THEN
INC(i); j := (j + 1) MOD MaxPat
ELSE
i := 0; b := (b + 1) MOD MaxPat; j := b
END;
IF j # e THEN
ch := ref[j]
ELSE
IF pos >= srclen THEN
ch := 0X
ELSE
ch := src[pos]
END;
INC(pos); ref[j] := ch; e := (e + 1) MOD MaxPat; INC(beg);
END
END;
IF i = len THEN
pos := beg-len
ELSE
pos := -1
END
END Find;
BEGIN
len := Length(pat);
IF MaxPat < len THEN
len := MaxPat
END;
IF len <= 0 THEN
pos := -1;
RETURN
END;
i := 0;
REPEAT
buf[i] := pat[i]; INC(i)
UNTIL i >= len;
srclen := Length(src);
IF pos < 0 THEN
pos := 0
ELSIF pos >= srclen THEN
pos := -1;
RETURN
END;
Find(pos)
END Search;
(** Search in src starting at pos for the next occurrence of pat. *)
PROCEDURE CAPSearch*(CONST pat, src(** in *): ARRAY OF CHAR; VAR pos(** in/out *): LONGINT);
CONST MaxPat = 128;
VAR
buf: ARRAY MaxPat OF CHAR;
len, i, srclen: LONGINT;
PROCEDURE Find(beg: LONGINT);
VAR
i, j, b, e: LONGINT;
ch: CHAR;
ref: ARRAY MaxPat OF CHAR;
BEGIN
ch := UpperCh(src[pos]); INC(pos);
ref[0] := ch;
i := 0; j := 0; b := 0; e := 1;
WHILE (pos <= srclen) & (i < len) DO
IF buf[i] = ch THEN
INC(i); j := (j + 1) MOD MaxPat
ELSE
i := 0; b := (b + 1) MOD MaxPat; j := b
END;
IF j # e THEN
ch := ref[j]
ELSE
IF pos >= srclen THEN
ch := 0X
ELSE
ch := UpperCh(src[pos])
END;
INC(pos); ref[j] := ch; e := (e + 1) MOD MaxPat; INC(beg);
END
END;
IF i = len THEN
pos := beg-len
ELSE
pos := -1
END
END Find;
BEGIN
len := Length(pat);
IF MaxPat < len THEN
len := MaxPat
END;
IF len <= 0 THEN
pos := -1;
RETURN
END;
i := 0;
REPEAT
buf[i] := UpperCh(pat[i]); INC(i)
UNTIL i >= len;
srclen := Length(src);
IF pos < 0 THEN
pos := 0
ELSIF pos >= srclen THEN
pos := -1;
RETURN
END;
Find(pos)
END CAPSearch;
(** Convert a string into an integer. Leading white space characters are ignored. *)
PROCEDURE StrToInt*(CONST str: ARRAY OF CHAR; VAR val: LONGINT);
VAR i, d: LONGINT; ch: CHAR; neg: BOOLEAN;
BEGIN
i := 0; ch := str[0];
WHILE (ch # 0X) & (ch <= " ") DO
INC(i); ch := str[i]
END;
neg := FALSE; IF ch = "+" THEN INC(i); ch := str[i] END;
IF ch = "-" THEN neg := TRUE; INC(i); ch := str[i] END;
WHILE (ch # 0X) & (ch <= " ") DO
INC(i); ch := str[i]
END;
val := 0;
WHILE (ch >= "0") & (ch <= "9") DO
d := ORD(ch)-ORD("0");
INC(i); ch := str[i];
IF val <= ((MAX(LONGINT)-d) DIV 10) THEN
val := 10*val+d
ELSIF neg & (val = 214748364) & (d = 8) & ((ch < "0") OR (ch > "9")) THEN
val := MIN(LONGINT); neg := FALSE
ELSE
HALT(99)
END
END;
IF neg THEN val := -val END
END StrToInt;
(** Convert the substring beginning at position i in str into an integer. Any leading whitespace characters are ignored.
After the conversion i pointes to the first character after the integer. *)
PROCEDURE StrToIntPos*(CONST str: ARRAY OF CHAR; VAR val: LONGINT; VAR i: INTEGER);
VAR noStr: ARRAY 16 OF CHAR;
BEGIN
WHILE (str[i] # 0X) & (str[i] <= " ") DO
INC(i)
END;
val := 0;
IF str[i] = "-" THEN
noStr[val] := str[i]; INC(val); INC(i);
WHILE (str[i] # 0X) & (str[i] <= " ") DO
INC(i)
END
END;
WHILE (str[i] >= "0") & (str[i] <= "9") DO
noStr[val] := str[i]; INC(val); INC(i)
END;
noStr[val] := 0X;
StrToInt(noStr, val)
END StrToIntPos;
(** Convert an integer into a string. *)
PROCEDURE IntToStr*(val: LONGINT; VAR str: ARRAY OF CHAR);
VAR
i, j: LONGINT;
digits: ARRAY 16 OF LONGINT;
BEGIN
IF val = MIN(LONGINT) THEN
COPY("-2147483648", str);
RETURN
END;
IF val < 0 THEN
val := -val; str[0] := "-"; j := 1
ELSE
j := 0
END;
i := 0;
REPEAT
digits[i] := val MOD 10; INC(i); val := val DIV 10
UNTIL val = 0;
DEC(i);
WHILE i >= 0 DO
str[j] := CHR(digits[i]+ORD("0")); INC(j); DEC(i)
END;
str[j] := 0X
END IntToStr;
(** Converts a real to a string. *)
PROCEDURE RealToStr*(x: LONGREAL; VAR s: ARRAY OF CHAR);
VAR e, h, l, n, len: LONGINT; i, j, pos: INTEGER; z: LONGREAL; d: ARRAY 16 OF CHAR;
PROCEDURE Wr(ch: CHAR);
BEGIN
IF ch = 0X THEN HALT(42) END;
IF pos < len THEN s[pos] := ch; INC(pos) END;
END Wr;
BEGIN
len := LEN(s)-1; pos := 0;
e:= Reals.ExpoL(x);
IF e = 2047 THEN
Wr("N"); Wr("a"); Wr("N")
ELSE
n := 14;
IF (x < 0) & (e # 0) THEN Wr("-"); x:= - x END;
IF e = 0 THEN h:= 0; l:= 0 (* no denormals *)
ELSE e:= (e - 1023) * 301029 DIV 1000000; (* ln(2)/ln(10) = 0.301029996 *)
z:= Reals.Ten(e+1);
IF x >= z THEN x:= x/z; INC(e) ELSE x:= x * Reals.Ten(-e) END;
IF x >= 10 THEN x:= x * Reals.Ten(-1) + 0.5D0 / Reals.Ten(n); INC(e)
ELSE x:= x + 0.5D0 / Reals.Ten(n);
IF x >= 10 THEN x:= x * Reals.Ten(-1); INC(e) END
END;
x:= x * Reals.Ten(7); h:= ENTIER(x); x:= (x-h) * Reals.Ten(8); l:= ENTIER(x)
END;
i := 15; WHILE i > 7 DO d[i]:= CHR(l MOD 10 + ORD("0")); l:= l DIV 10; DEC(i) END;
WHILE i >= 0 DO d[i]:= CHR(h MOD 10 + ORD("0")); h:= h DIV 10; DEC(i) END;
IF ABS(e) > 8 THEN (* scientific notation *)
j := 15; WHILE (j > 0) & (d[j] = "0") DO DEC(j) END;
Wr(d[0]); IF j # 0 THEN Wr(".") END; i := 1; WHILE i <= j DO Wr(d[i]); INC(i) END;
IF e < 0 THEN Wr("D"); Wr("-"); e:= - e ELSE Wr("D"); Wr("+") END;
Wr(CHR(e DIV 100 + ORD("0"))); e:= e MOD 100;
Wr(CHR(e DIV 10 + ORD("0"))); Wr(CHR(e MOD 10 + ORD("0")))
ELSE
IF e < 0 THEN (* leading zeros *)
j := (* !15*) 14; WHILE (j > 0) & (d[j] = "0") DO DEC(j) END;
Wr("0"); Wr("."); INC(e);
WHILE e < 0 DO Wr("0"); INC(e) END;
i := 0; WHILE i <= j DO Wr(d[i]); INC(i) END
ELSE
i := 0; WHILE (e >= 0) & (i < 16 ) DO Wr(d[i]); INC(i); DEC(e) END;
IF i < 16 THEN
Wr(".");
WHILE i < (*16*) 15 DO Wr(d[i]); INC(i); END;
WHILE s[pos - 1] = "0" DO DEC(pos) END;
IF s[pos - 1] = "." THEN DEC(pos) END;
END
END
END
END;
s[pos] := 0X
END RealToStr;
PROCEDURE RealToFixStr*(x: LONGREAL; VAR str: ARRAY OF CHAR; n, f, D: LONGINT);
VAR pos, len, e, i, h, l: LONGINT; r, z: LONGREAL; d: ARRAY 16 OF CHAR; s: CHAR;
PROCEDURE Wr(ch: CHAR);
BEGIN
IF ch = 0X THEN HALT(42) END;
IF pos < len THEN str[pos] := ch; INC(pos) END;
END Wr;
BEGIN
len := LEN(str)-1; pos := 0;
e := Reals.ExpoL(x);
IF (e = 2047) OR (ABS(D) > 308) THEN
Wr("N"); Wr("a"); Wr("N")
ELSE
IF D = 0 THEN DEC(n, 2) ELSE DEC(n, 7) END;
IF n < 2 THEN n := 2 END;
IF f < 0 THEN f := 0 END;
IF n < f + 2 THEN n := f + 2 END;
DEC(n, f);
IF (e # 0) & (x < 0) THEN s := "-"; x := - x ELSE s := " " END;
IF e = 0 THEN
h := 0; l := 0; DEC(e, D-1) (* no denormals *)
ELSE
e := (e - 1023) * 301029 DIV 1000000; (* ln(2)/ln(10) = 0.301029996 *)
z := Reals.Ten(e+1);
IF x >= z THEN x := x/z; INC(e) ELSE x:= x * Reals.Ten(-e) END;
DEC(e, D-1); i := -(e+f);
IF i <= 0 THEN r := 5 * Reals.Ten(i) ELSE r := 0 END;
IF x >= 10 THEN
x := x * Reals.Ten(-1) + r; INC(e)
ELSE
x := x + r;
IF x >= 10 THEN x := x * Reals.Ten(-1); INC(e) END
END;
x := x * Reals.Ten(7); h:= ENTIER(x); x := (x-h) * Reals.Ten(8); l := ENTIER(x)
END;
i := 15;
WHILE i > 7 DO d[i] := CHR(l MOD 10 + ORD("0")); l := l DIV 10; DEC(i) END;
WHILE i >= 0 DO d[i] := CHR(h MOD 10 + ORD("0")); h := h DIV 10; DEC(i) END;
IF n <= e THEN n := e + 1 END;
IF e > 0 THEN
WHILE n > e DO Wr(" "); DEC(n) END;
Wr(s); e:= 0;
WHILE n > 0 DO
DEC(n);
IF e < 16 THEN Wr(d[e]); INC(e) ELSE Wr("0") END
END;
Wr(".")
ELSE
WHILE n > 1 DO Wr(" "); DEC(n) END;
Wr(s); Wr("0"); Wr(".");
WHILE (0 < f) & (e < 0) DO Wr("0"); DEC(f); INC(e) END
END;
WHILE f > 0 DO
DEC(f);
IF e < 16 THEN Wr(d[e]); INC(e) ELSE Wr("0") END
END;
IF D # 0 THEN
IF D < 0 THEN Wr("D"); Wr("-"); D := - D
ELSE Wr("D"); Wr("+")
END;
Wr(CHR(D DIV 100 + ORD("0"))); D := D MOD 100;
Wr(CHR(D DIV 10 + ORD("0"))); Wr(CHR(D MOD 10 + ORD("0")))
END
END;
str[pos] := 0X
END RealToFixStr;
(** Convert a string into a real. Precondition: s has a well defined real syntax. Scientific notation with D and E to indicate exponents is allowed. *)
PROCEDURE StrToReal*(CONST s: ARRAY OF CHAR; VAR r: LONGREAL);
VAR p, e: INTEGER; y, g: LONGREAL; neg, negE: BOOLEAN;
BEGIN
p := 0;
WHILE (s[p] = " ") OR (s[p] = "0") DO INC(p) END;
IF s[p] = "-" THEN neg := TRUE; INC(p) ELSE neg := FALSE END;
WHILE (s[p] = " ") OR (s[p] = "0") DO INC(p) END;
y := 0;
WHILE ("0" <= s[p]) & (s[p] <= "9") DO
y := y * 10 + (ORD(s[p]) - 30H);
INC(p);
END;
IF s[p] = "." THEN
INC(p); g := 1;
WHILE ("0" <= s[p]) & (s[p] <= "9") DO
g := g / 10; y := y + g * (ORD(s[p]) - 30H);
INC(p);
END;
END;
IF (s[p] = "D") OR (s[p] = "E") THEN
INC(p); e := 0;
IF s[p] = "-" THEN negE := TRUE; INC(p) ELSE negE := FALSE END;
WHILE (s[p] = "0") DO INC(p) END;
WHILE ("0" <= s[p]) & (s[p] <= "9") DO
e := e * 10 + (ORD(s[p]) - 30H);
INC(p);
END;
IF negE THEN y := y / Reals.Ten(e)
ELSE y := y * Reals.Ten(e) END;
END;
IF neg THEN y := -y END;
r := y;
END StrToReal;
(** Convert a string into a boolean. "Yes", "True" and "On" are TRUE all other strings are FALSE.
Leading white space characters are ignored. *)
PROCEDURE StrToBool*(CONST str: ARRAY OF CHAR; VAR b: BOOLEAN);
VAR i: LONGINT;
BEGIN
i := 0;
WHILE (str[i] # 0X) & (str[i] <= " ") DO
INC(i)
END;
CASE CAP(str[i]) OF
"Y", "T": b := TRUE
|"O": b := CAP(str[i+1]) = "N"
ELSE
b := FALSE
END
END StrToBool;
(** Convert a boolean into "Yes" or "No". *)
PROCEDURE BoolToStr*(b: BOOLEAN; VAR str: ARRAY OF CHAR);
BEGIN
IF b THEN
COPY("Yes", str)
ELSE
COPY("No", str)
END
END BoolToStr;
(** Convert a string to a set *)
PROCEDURE StrToSet*(CONST str: ARRAY OF CHAR; VAR set: SET);
VAR i, d, d1: LONGINT; ch: CHAR; dot: BOOLEAN;
BEGIN
set := {}; dot := FALSE;
i := 0; ch := str[i];
WHILE (ch # 0X) & (ch # "}") DO
WHILE (ch # 0X) & ((ch < "0") OR (ch > "9")) DO INC(i); ch := str[i] END;
IF ch = 0X THEN RETURN END;
d := 0; WHILE (ch >= "0") & (ch <= "9") DO d := d*10 + ORD(ch) - 30H; INC(i); ch := str[i] END;
IF d <= MAX(SET) THEN INCL(set, d) END;
IF dot THEN
d1 := 0;
WHILE (d1 <= MAX(SET)) & (d1 < d) DO INCL(set, d1); INC(d1) END;
dot := FALSE
END;
WHILE ch = " " DO INC(i); ch := str[i] END;
IF ch = "." THEN d1 := d + 1; dot := TRUE END
END
END StrToSet;
(** Convert a set to a string *)
PROCEDURE SetToStr* (set: SET; VAR str: ARRAY OF CHAR);
VAR i, j, k: INTEGER; noFirst: BOOLEAN;
BEGIN
str[0] := "{"; i := 0; k := 1; noFirst := FALSE;
WHILE i <= MAX(SET) DO
IF i IN set THEN
IF noFirst THEN str[k] := ","; INC(k) ELSE noFirst := TRUE END;
IF i >= 10 THEN str[k] := CHR(i DIV 10 + 30H); INC(k) END;
str[k] := CHR(i MOD 10 + 30H); INC(k);
j := i; INC(i);
WHILE (i <= MAX(SET)) & (i IN set) DO INC(i) END;
IF i-2 > j THEN
str[k] := "."; str[k+1] := "."; INC(k, 2); j := i - 1;
IF j >= 10 THEN str[k] := CHR(j DIV 10 + 30H); INC(k) END;
str[k] := CHR(j MOD 10 + 30H); INC(k)
ELSE i := j
END
END;
INC(i)
END;
str[k] := "}"; str[k+1] := 0X
END SetToStr;
(** Convert date (Oberon.GetClock) into specified format. *)
PROCEDURE DateToStr*(date: LONGINT; VAR str: ARRAY OF CHAR);
VAR i, j, k, x: LONGINT; form, name: ARRAY 32 OF CHAR;
BEGIN
COPY(dateform, form);
IF form = "" THEN form := "DD.MM.YY" END;
i := 0; j := 0;
WHILE form[j] # 0X DO
IF CAP(form[j]) = "D" THEN (* Day *)
INC(j); x := date MOD 32;
IF CAP(form[j]) = "D" THEN
INC(j);
IF CAP(form[j]) = "D" THEN
INC(j); x := Dates.DayOfWeek(date);
IF CAP(form[j]) = "D" THEN INC(j); COPY(lDayName[x], name)
ELSE COPY(sDayName[x], name)
END;
k := 0; WHILE name[k] # 0X DO str[i] := name[k]; INC(i); INC(k) END
ELSE (* day with leading zero *)
str[i] := CHR(x DIV 10 + ORD("0"));
str[i + 1] := CHR(x MOD 10 + ORD("0"));
INC(i, 2)
END
ELSE (* no leading zero *)
IF x > 9 THEN str[i] := CHR(x DIV 10 + ORD("0")); INC(i) END;
str[i] := CHR(x MOD 10 + ORD("0")); INC(i)
END
ELSIF CAP(form[j]) = "M" THEN (* Month *)
INC(j); x := date DIV 32 MOD 16;
IF CAP(form[j]) = "M" THEN
INC(j);
IF CAP(form[j]) = "M" THEN
INC(j);
IF CAP(form[j]) = "M" THEN INC(j); COPY(lMonthName[x-1], name)
ELSE COPY(sMonthName[x-1], name)
END;
k := 0; WHILE name[k] # 0X DO str[i] := name[k]; INC(i); INC(k) END
ELSE
str[i] := CHR(x DIV 10 + ORD("0"));
str[i + 1] := CHR(x MOD 10 + ORD("0"));
INC(i, 2)
END
ELSE
IF x > 9 THEN str[i] := CHR(x DIV 10 + ORD("0")); INC(i) END;
str[i] := CHR(x MOD 10 + ORD("0")); INC(i)
END
ELSIF CAP(form[j]) = "Y" THEN (* Year *)
INC(j,2); x := date DIV 512;
IF CAP(form[j]) = "Y" THEN
INC(j, 2); INC(x, 1900);
str[i] := CHR(x DIV 1000 + ORD("0")); str[i + 1] := CHR(x DIV 100 MOD 10 + ORD("0"));
str[i + 2] := CHR(x DIV 10 MOD 10 + ORD("0")); str[i + 3] := CHR(x MOD 10 + ORD("0"));
INC(i, 4)
ELSE
str[i] := CHR(x DIV 10 MOD 10 + ORD("0")); str[i + 1] := CHR(x MOD 10 + ORD("0"));
INC(i, 2)
END
ELSE str[i] := form[j]; INC(i); INC(j)
END
END;
str[i] := 0X
END DateToStr;
(** Returns a month's name (set short to get the abbreviation) *)
PROCEDURE MonthToStr* (month: INTEGER; VAR str: ARRAY OF CHAR; short: BOOLEAN);
BEGIN
month := (month - 1) MOD 12;
IF short THEN COPY(sMonthName[month], str) ELSE COPY(lMonthName[month], str) END
END MonthToStr;
(** Returns a day's name (set short to get the abbreviation) *)
PROCEDURE DayToStr* (day: INTEGER; VAR str: ARRAY OF CHAR; short: BOOLEAN);
BEGIN
IF short THEN COPY(sDayName[day MOD 7], str) ELSE COPY(lDayName[day MOD 7], str) END
END DayToStr;
(** Convert time (Oberon.GetClock) into specified format. *)
PROCEDURE TimeToStr*(time: LONGINT; VAR str: ARRAY OF CHAR);
VAR i, j, x, h, hPos: LONGINT; form: ARRAY 32 OF CHAR; shortH, leadingH: BOOLEAN;
BEGIN
COPY(timeform, form);
IF form = "" THEN form := "HH:MM:SS" END;
i := 0; j := 0; h:= time DIV 4096 MOD 32; shortH := FALSE;
WHILE form[j] # 0X DO
IF ((CAP(form[j]) = "A") OR (CAP(form[j]) = "P")) & (CAP(form[j+1]) = "M") THEN
shortH := TRUE;
IF CAP(form[j]) = form[j] THEN x := 0 ELSE x := 32 END;
IF (h < 1) OR (h > 12) THEN str[i] := CHR(ORD("P") + x) ELSE str[i] := CHR(ORD("A") + x) END;
h := h MOD 12; IF h = 0 THEN h := 12 END;
str[i + 1] := CHR(ORD("M") + x);
INC(i, 2);
WHILE (CAP(form[j]) = "A") OR (CAP(form[j]) = "P") OR (CAP(form[j]) = "M") DO INC(j) END
ELSIF form[j] = "H" THEN
hPos := i; INC(i, 2); INC(j); leadingH := (form[j] = "H");
IF leadingH THEN INC(j) END
ELSIF form[j] = "M" THEN
INC(j); x := time DIV 64 MOD 64;
IF form[j] = "M" THEN str[i] := CHR(x DIV 10 + ORD("0")); INC(i); INC(j)
ELSIF x > 9 THEN str[i] := CHR(x DIV 10 + ORD("0")); INC(i)
END;
str[i] := CHR(x MOD 10 + ORD("0")); INC(i)
ELSIF form[j] = "S" THEN
INC(j); x := time MOD 64;
IF form[j] = "S" THEN str[i] := CHR(x DIV 10 + ORD("0")); INC(i); INC(j)
ELSIF x > 9 THEN str[i] := CHR(x DIV 10 + ORD("0")); INC(i)
END;
str[i] := CHR(x MOD 10 + ORD("0")); INC(i)
ELSE str[i] := form[j]; INC(i); INC(j)
END
END;
str[i] := 0X;
IF ~leadingH THEN
IF h > 9 THEN str[hPos] := CHR(h DIV 10 + ORD("0")); INC(hPos)
ELSE i := hPos + 1; WHILE str[i] # 0X DO str[i] := str[i + 1]; INC(i) END
END;
str[hPos] := CHR(h MOD 10 + ORD("0"))
ELSE
str[hPos] := CHR(h DIV 10 + ORD("0"));
str[hPos + 1] := CHR(h MOD 10 + ORD("0"))
END
END TimeToStr;
(** Convert a string into an time value. Leading white space characters are ignored. *)
PROCEDURE StrToTime*(CONST str: ARRAY OF CHAR; VAR time: LONGINT);
VAR
h, m, s: LONGINT;
i: INTEGER;
BEGIN
i := 0;
WHILE (str[i] # 0X) & ((str[i] < "0") OR (str[i] > "9")) DO INC(i) END;
StrToIntPos(str, h, i);
WHILE (str[i] # 0X) & ((str[i] < "0") OR (str[i] > "9")) DO INC(i) END;
StrToIntPos(str, m, i);
WHILE (str[i] # 0X) & ((str[i] < "0") OR (str[i] > "9")) DO INC(i) END;
StrToIntPos(str, s, i);
time := (h*64 + m)*64 + s
END StrToTime;
(** Convert a string into an date value. Leading white space characters are ignored. *)
PROCEDURE StrToDate*(CONST str: ARRAY OF CHAR; VAR date: LONGINT);
VAR
d, m, y: LONGINT;
i: INTEGER;
BEGIN
i := 0;
WHILE (str[i] # 0X) & ((str[i] < "0") OR (str[i] > "9")) DO INC(i) END;
StrToIntPos(str, d, i);
WHILE (str[i] # 0X) & ((str[i] < "0") OR (str[i] > "9")) DO INC(i) END;
StrToIntPos(str, m, i);
WHILE (str[i] # 0X) & ((str[i] < "0") OR (str[i] > "9")) DO INC(i) END;
StrToIntPos(str, y, i); y := y-1900;
date := (y*16 + m)*32 + d
END StrToDate;
PROCEDURE Init;
VAR i: LONGINT; s: Texts.Scanner;
BEGIN
Oberon.OpenScanner(s, "System.DateFormat");
IF s.class = Texts.String THEN COPY(s.s, dateform) ELSE dateform := "" END;
Oberon.OpenScanner(s, "System.TimeFormat");
IF s.class = Texts.String THEN COPY(s.s, timeform) ELSE timeform := "" END;
sDayName[0] := "Mon"; sDayName[1] := "Tue"; sDayName[2] := "Wed"; sDayName[3] := "Thu";
sDayName[4] := "Fri"; sDayName[5] := "Sat"; sDayName[6] := "Sun";
lDayName[0] := "Monday"; lDayName[1] := "Tuesday"; lDayName[2] := "Wednesday"; lDayName[3] := "Thursday";
lDayName[4] := "Friday"; lDayName[5] := "Saturday"; lDayName[6] := "Sunday";
sMonthName[0] := "Jan"; sMonthName[1] := "Feb"; sMonthName[2] := "Mar"; sMonthName[3] := "Apr";
sMonthName[4] := "May"; sMonthName[5] := "Jun"; sMonthName[6] := "Jul"; sMonthName[7] := "Aug";
sMonthName[8] := "Sep"; sMonthName[9] := "Oct"; sMonthName[10] := "Nov"; sMonthName[11] := "Dec";
lMonthName[0] := "January"; lMonthName[1] := "February"; lMonthName[2] := "March"; lMonthName[3] := "April";
lMonthName[4] := "May"; lMonthName[5] := "June"; lMonthName[6] := "July"; lMonthName[7] := "August";
lMonthName[8] := "September"; lMonthName[9] := "October"; lMonthName[10] := "November";
lMonthName[11] := "December";
FOR i := 0 TO 255 DO
isAlpha[i] := ((i >= ORD("A")) & (i <= ORD("Z"))) OR ((i >= ORD("a")) & (i <= ORD("z")))
END;
(* isAlpha[ORD("")] := TRUE; isAlpha[ORD("")] := TRUE; isAlpha[ORD("")] := TRUE;
isAlpha[ORD("")] := TRUE; isAlpha[ORD("")] := TRUE; isAlpha[ORD("
")] := TRUE;
isAlpha[ORD("")] := TRUE; isAlpha[ORD("")] := TRUE; isAlpha[ORD("")] := TRUE;
isAlpha[ORD("")] := TRUE; isAlpha[ORD("")] := TRUE; isAlpha[ORD("")] := TRUE;
isAlpha[ORD("")] := TRUE; isAlpha[ORD("")] := TRUE; isAlpha[ORD("")] := TRUE;
isAlpha[ORD("")] := TRUE; isAlpha[ORD("")] := TRUE; isAlpha[ORD("")] := TRUE;
isAlpha[ORD("")] := TRUE; isAlpha[ORD("")] := TRUE; isAlpha[ORD("")] := TRUE;
isAlpha[ORD("")] := TRUE; isAlpha[ORD("")] := TRUE; *)
FOR i := 0 TO 255 DO
ISOToOberon[i] := CHR(i); OberonToISO[i] := CHR(i)
END;
ISOToOberon[8] := CHR(127);
ISOToOberon[146] := CHR(39);
ISOToOberon[160] := CHR(32);
ISOToOberon[162] := CHR(99);
ISOToOberon[166] := CHR(124);
ISOToOberon[168] := CHR(34);
ISOToOberon[169] := CHR(99);
ISOToOberon[170] := CHR(97);
ISOToOberon[171] := CHR(60);
ISOToOberon[173] := CHR(45);
ISOToOberon[174] := CHR(114);
ISOToOberon[175] := CHR(45);
ISOToOberon[176] := CHR(111);
ISOToOberon[178] := CHR(50);
ISOToOberon[179] := CHR(51);
ISOToOberon[180] := CHR(39);
ISOToOberon[183] := CHR(46);
ISOToOberon[185] := CHR(49);
ISOToOberon[186] := CHR(48);
ISOToOberon[187] := CHR(62);
ISOToOberon[192] := CHR(65);
ISOToOberon[193] := CHR(65);
ISOToOberon[194] := CHR(65);
ISOToOberon[195] := CHR(65);
ISOToOberon[196] := CHR(128); OberonToISO[128] := CHR(196);
ISOToOberon[197] := CHR(65);
ISOToOberon[198] := CHR(65);
ISOToOberon[199] := CHR(67);
ISOToOberon[200] := CHR(69);
ISOToOberon[201] := CHR(69);
ISOToOberon[202] := CHR(69);
ISOToOberon[203] := CHR(69);
ISOToOberon[204] := CHR(73);
ISOToOberon[205] := CHR(73);
ISOToOberon[206] := CHR(73);
ISOToOberon[207] := CHR(73);
ISOToOberon[208] := CHR(68);
ISOToOberon[209] := CHR(78);
ISOToOberon[210] := CHR(79);
ISOToOberon[211] := CHR(79);
ISOToOberon[212] := CHR(79);
ISOToOberon[213] := CHR(79);
ISOToOberon[214] := CHR(129); OberonToISO[129] := CHR(214);
ISOToOberon[215] := CHR(42);
ISOToOberon[216] := CHR(79);
ISOToOberon[217] := CHR(85);
ISOToOberon[218] := CHR(85);
ISOToOberon[219] := CHR(85);
ISOToOberon[220] := CHR(130); OberonToISO[130] := CHR(220);
ISOToOberon[221] := CHR(89);
ISOToOberon[222] := CHR(80);
ISOToOberon[223] := CHR(150); OberonToISO[150] := CHR(223);
ISOToOberon[224] := CHR(139); OberonToISO[139] := CHR(224);
ISOToOberon[225] := CHR(148); OberonToISO[148] := CHR(225);
ISOToOberon[226] := CHR(134); OberonToISO[134] := CHR(226);
ISOToOberon[227] := CHR(97);
ISOToOberon[228] := CHR(131); OberonToISO[131] := CHR(228);
ISOToOberon[229] := CHR(97);
ISOToOberon[230] := CHR(97);
ISOToOberon[231] := CHR(147); OberonToISO[147] := CHR(231);
ISOToOberon[232] := CHR(140); OberonToISO[140] := CHR(232);
ISOToOberon[233] := CHR(144); OberonToISO[144] := CHR(233);
ISOToOberon[234] := CHR(135); OberonToISO[135] := CHR(234);
ISOToOberon[235] := CHR(145); OberonToISO[145] := CHR(235);
ISOToOberon[236] := CHR(141); OberonToISO[141] := CHR(236);
ISOToOberon[237] := CHR(105);
ISOToOberon[238] := CHR(136); OberonToISO[136] := CHR(238);
ISOToOberon[239] := CHR(146); OberonToISO[146] := CHR(239);
ISOToOberon[240] := CHR(100);
ISOToOberon[241] := CHR(149); OberonToISO[149] := CHR(241);
ISOToOberon[242] := CHR(142); OberonToISO[142] := CHR(242);
ISOToOberon[243] := CHR(111);
ISOToOberon[244] := CHR(137); OberonToISO[137] := CHR(244);
ISOToOberon[245] := CHR(111);
ISOToOberon[246] := CHR(132); OberonToISO[132] := CHR(246);
ISOToOberon[248] := CHR(111);
ISOToOberon[249] := CHR(143); OberonToISO[143] := CHR(249);
ISOToOberon[250] := CHR(117);
ISOToOberon[251] := CHR(138); OberonToISO[138] := CHR(251);
ISOToOberon[252] := CHR(133); OberonToISO[133] := CHR(252);
ISOToOberon[253] := CHR(121);
ISOToOberon[254] := CHR(112);
ISOToOberon[255] := CHR(121);
CRLF[0] := CR; CRLF[1] := LF; CRLF[2] := 0X; CRLF[3] := 0X
END Init;
BEGIN
Init()
END Strings.