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