1(*-------------------------------------------------------------
2Strings provides a set of operations on strings (i.e., on string constants and character
3arrays, both of which contain the character 0X as a terminator). All positions in
4strings start at 0.
5Strings.Length(s)
6  returns the number of characters in s up to and excluding the first 0X.
7Strings.Insert(src, pos, dst)
8  inserts the string src into the string dst at position pos (0 <= pos <= Length(dst)).
9  If pos = Length(dst), src is appended to dst. If the size of dst is not large enough
10  to hold the result of the operation, the result is truncated so that dst is always
11  terminated with a 0X.
12Strings.Append(s, dst)
13  has the same effect as Insert(s, Length(s), dst).
14Strings.Delete(s, pos, n)
15  deletes n characters from s starting at position pos (0 <= pos < Length(s)).
16  If n > Length(s) - pos, the new length of s is pos.
17Strings.Replace(src, pos, dst)
18  has the same effect as Delete(dst, pos, Length(src)) followed by an Insert(src, pos, dst).
19Strings.Extract(src, pos, n, dst)
20  extracts a substring dst with n characters from position pos (0 <= pos < Length(src)) in src.
21  If n > Length(src) - pos, dst is only the part of src from pos to Length(src) - 1. If the size of
22  dst is not large enough to hold the result of the operation, the result is truncated so that
23  dst is always terminated with a 0X.
24Strings.Pos(pat, s, pos)
25  returns the position of the first occurrence of pat in s after position pos (inclusive).
26  If pat is not found, -1 is returned.
27Strings.Cap(s)
28  replaces each lower case letter in s by its upper case equivalent.
29-------------------------------------------------------------*)
30(* added from trianus v4 *)
31MODULE Strings;  (*HM 94-06-22 /  *) (* noch 2017-06-21 *)
32IMPORT Reals;
33
34PROCEDURE Length* (s: ARRAY OF CHAR): INTEGER;
35  VAR i: LONGINT;
36BEGIN
37  i := 0; WHILE (i < LEN(s)) & (s[i] # 0X) DO INC(i) END;
38  IF i <= MAX(INTEGER) THEN RETURN SHORT(i) ELSE RETURN MAX(INTEGER) END
39END Length;
40
41
42PROCEDURE Append* (extra: ARRAY OF CHAR; VAR dest: ARRAY OF CHAR);
43  VAR n1, n2, i: INTEGER;
44BEGIN
45  n1 := Length(dest); n2 := Length(extra); i := 0;
46  WHILE (i < n2) & (i + n1 < LEN(dest)) DO dest[i + n1] := extra[i]; INC(i) END ;
47  IF i + n1 < LEN(dest) THEN dest[i + n1] := 0X END
48END Append;
49
50
51PROCEDURE Insert* (source: ARRAY OF CHAR; pos: INTEGER; VAR dest: ARRAY OF CHAR);
52  VAR n1, n2, i: INTEGER;
53BEGIN
54  n1 := Length(dest); n2 := Length(source);
55  IF pos < 0 THEN pos := 0 END ;
56  IF pos > n1 THEN Append(dest, source); RETURN END ;
57  IF pos + n2 < LEN(dest) THEN  (*make room for source*)
58    i := n1; (*move also 0X if it is there*)
59    WHILE i >= pos DO
60      IF i + n2 < LEN(dest) THEN dest[i + n2] := dest[i] END ;
61      DEC(i)
62    END
63  END ;
64  i := 0; WHILE i < n2 DO dest[pos + i] := source[i]; INC(i) END
65END Insert;
66
67
68PROCEDURE Delete* (VAR s: ARRAY OF CHAR; pos, n: INTEGER);
69  VAR len, i: INTEGER;
70BEGIN
71  len:=Length(s);
72  IF pos < 0 THEN pos:=0 ELSIF pos >= len THEN RETURN END ;
73  IF pos + n < len THEN
74    i:=pos + n; WHILE i < len DO s[i - n]:=s[i]; INC(i) END ;
75    IF i - n < LEN(s) THEN s[i - n]:=0X END
76  ELSE s[pos]:=0X
77  END
78END Delete;
79
80
81PROCEDURE Replace* (source: ARRAY OF CHAR; pos: INTEGER; VAR dest: ARRAY OF CHAR);
82BEGIN
83  Delete(dest, pos, pos + Length(source));
84  Insert(source, pos, dest)
85END Replace;
86
87
88PROCEDURE Extract* (source: ARRAY OF CHAR; pos, n: INTEGER; VAR dest: ARRAY OF CHAR);
89  VAR len, destLen, i: INTEGER;
90BEGIN
91  len := Length(source); destLen := SHORT(LEN(dest)) - 1;
92  IF pos < 0 THEN pos := 0 END ;
93  IF pos >= len THEN dest[0] := 0X; RETURN END ;
94  i := 0;
95  WHILE (pos + i <= LEN(source)) & (source[pos + i] # 0X) & (i < n) DO
96    IF i < destLen THEN dest[i] := source[pos + i] END ;
97    INC(i)
98  END ;
99  dest[i] := 0X
100END Extract;
101
102
103PROCEDURE Pos* (pattern, s: ARRAY OF CHAR; pos: INTEGER): INTEGER;
104  VAR n1, n2, i, j: INTEGER;
105BEGIN
106  n1 := Length(s); n2 := Length(pattern);
107  IF n2 = 0 THEN RETURN 0 END ;
108  i := pos;
109  WHILE i <= n1 - n2 DO
110    IF s[i] = pattern[0] THEN
111      j := 1; WHILE (j < n2) & (s[i + j] = pattern[j]) DO INC(j) END ;
112      IF j = n2 THEN RETURN i END
113    END ;
114    INC(i)
115  END ;
116  RETURN -1
117END Pos;
118
119
120PROCEDURE Cap* (VAR s: ARRAY OF CHAR);
121  VAR i: INTEGER;
122BEGIN
123  i := 0;
124  WHILE s[i] # 0X DO
125    IF ("a" <= s[i]) & (s[i] <= "z") THEN s[i] := CAP(s[i]) END ;
126    INC(i)
127  END
128END Cap;
129
130
131PROCEDURE Match* (string, pattern: ARRAY OF CHAR): BOOLEAN;
132
133  PROCEDURE M (VAR name, mask: ARRAY OF CHAR; n, m: INTEGER): BOOLEAN;
134  BEGIN
135    WHILE (n >= 0) & (m >= 0) & (mask[m] # "*") DO
136      IF name[n] # mask[m] THEN RETURN FALSE END ;
137      DEC(n); DEC(m)
138    END ;
139    (* ----- name empty | mask empty | mask ends with "*" *)
140    IF m < 0 THEN RETURN n < 0 END ;
141    (* ----- name empty | mask ends with "*" *)
142    WHILE (m >= 0) & (mask[m] = "*") DO DEC(m) END ;
143    IF m < 0 THEN RETURN TRUE END ;
144    (* ----- name empty | mask still to be matched *)
145    WHILE n >= 0 DO
146      IF M(name, mask, n, m) THEN RETURN TRUE END ;
147      DEC(n)
148    END ;
149    RETURN FALSE
150  END M;
151
152BEGIN
153  RETURN M(string, pattern, Length(string)-1, Length(pattern)-1)
154END Match;
155
156PROCEDURE StrToReal*(s: ARRAY OF CHAR; VAR r: REAL);
157VAR p, e: INTEGER; y, g: REAL; neg, negE: BOOLEAN;
158BEGIN
159	p := 0;
160	WHILE (s[p] = " ") OR (s[p] = "0") DO INC(p) END;
161	IF s[p] = "-" THEN neg := TRUE; INC(p) ELSE neg := FALSE END;
162	WHILE (s[p] = " ") OR (s[p] = "0") DO INC(p) END;
163
164	y := 0;
165	WHILE ("0" <= s[p]) & (s[p] <= "9") DO
166		y := y * 10 + (ORD(s[p]) - 30H);
167		INC(p);
168	END;
169	IF s[p] = "." THEN
170		INC(p); g := 1;
171		WHILE ("0" <= s[p]) & (s[p] <= "9") DO
172			g := g / 10; y := y + g * (ORD(s[p]) - 30H);
173			INC(p);
174		END;
175	END;
176	IF (s[p] = "D") OR (s[p] = "E") THEN
177		INC(p); e := 0;
178		IF s[p] = "-" THEN negE := TRUE; INC(p) ELSE negE := FALSE END;
179		WHILE (s[p] = "0") DO INC(p) END;
180		WHILE ("0" <= s[p]) & (s[p] <= "9") DO
181			e := e * 10 + (ORD(s[p]) - 30H);
182			INC(p);
183		END;
184		IF negE THEN y := y / Reals.Ten(e)
185		ELSE y := y * Reals.Ten(e) END;
186	END;
187	IF neg THEN y := -y END;
188	r := y;
189END StrToReal;
190
191PROCEDURE StrToLongReal*(s: ARRAY OF CHAR; VAR r: LONGREAL);
192VAR p, e: INTEGER; y, g: LONGREAL; neg, negE: BOOLEAN;
193BEGIN
194	p := 0;
195	WHILE (s[p] = " ") OR (s[p] = "0") DO INC(p) END;
196	IF s[p] = "-" THEN neg := TRUE; INC(p) ELSE neg := FALSE END;
197	WHILE (s[p] = " ") OR (s[p] = "0") DO INC(p) END;
198
199	y := 0;
200	WHILE ("0" <= s[p]) & (s[p] <= "9") DO
201		y := y * 10 + (ORD(s[p]) - 30H);
202		INC(p);
203	END;
204	IF s[p] = "." THEN
205		INC(p); g := 1;
206		WHILE ("0" <= s[p]) & (s[p] <= "9") DO
207			g := g / 10; y := y + g * (ORD(s[p]) - 30H);
208			INC(p);
209		END;
210	END;
211	IF (s[p] = "D") OR (s[p] = "E") THEN
212		INC(p); e := 0;
213		IF s[p] = "-" THEN negE := TRUE; INC(p) ELSE negE := FALSE END;
214		WHILE (s[p] = "0") DO INC(p) END;
215		WHILE ("0" <= s[p]) & (s[p] <= "9") DO
216			e := e * 10 + (ORD(s[p]) - 30H);
217			INC(p);
218		END;
219		IF negE THEN y := y / Reals.Ten(e)
220		ELSE y := y * Reals.Ten(e) END;
221	END;
222	IF neg THEN y := -y END;
223	r := y;
224END StrToLongReal;
225
226END Strings.
227