diff options
Diffstat (limited to 'Build/source/utils/xml2pmx/xml2pmx-src/obsrc/Strings1.m')
-rw-r--r-- | Build/source/utils/xml2pmx/xml2pmx-src/obsrc/Strings1.m | 421 |
1 files changed, 0 insertions, 421 deletions
diff --git a/Build/source/utils/xml2pmx/xml2pmx-src/obsrc/Strings1.m b/Build/source/utils/xml2pmx/xml2pmx-src/obsrc/Strings1.m deleted file mode 100644 index 42da388c552..00000000000 --- a/Build/source/utils/xml2pmx/xml2pmx-src/obsrc/Strings1.m +++ /dev/null @@ -1,421 +0,0 @@ -MODULE Strings1; (** portable *) (* ejz, *) - -(***************************************************************************) -(**************** Copyright 2015--2021 Dieter Gloetzel ********************) -(************************ Version016 multi platform ***********************) -(***************************************************************************) -(* This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see <http://www.gnu.org/licenses/>. *) - -TYPE LONGINT = INTEGER; - -(** Strings is a utility module that provides procedures to manipulate strings. - Note: All strings MUST be 0X terminated. *) - 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. *) - -(** Length of str. *) - PROCEDURE Length*(VAR 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; 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 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")) - |80X: ch := 83X - |81X: ch := 84X - |82X: ch := 85X - 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) - |83X: ch := 80X - |84X: ch := 81X - |85X: ch := 82X - |86X: ch := "A" - |87X: ch := "E" - |88X: ch := "I" - |89X: ch := "O" - |8AX: ch := "U" - |8BX: ch := "A" - |8CX: ch := "E" - |8DX: ch := "I" - |8EX: ch := "O" - |8FX: ch := "U" - |90X: ch := "E" - |91X: ch := "E" - |92X: ch := "I" - |93X: ch := "C" - |94X: ch := "A" - |95X: ch := "N" - |96X: ch := "S" - ELSE - END; - RETURN ch - END UpperCh; - -(** Convert str to all lower-case letters. *) - PROCEDURE Lower*(VAR str(** in *), 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*(VAR str(** in *), 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; - -(** Change the suffix of str to suf. *) - PROCEDURE ChangeSuffix*(VAR str(** in/out *): ARRAY OF CHAR; 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*(pat: ARRAY OF CHAR; VAR 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; - -(** Convert a string into an integer. Leading white space characters are ignored. *) - PROCEDURE StrToInt*(VAR 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 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; - - PROCEDURE RealToStr*(x: LONGREAL; VAR s: ARRAY OF CHAR); - VAR n, m, k, pos: INTEGER; tmp: ARRAY 16 OF CHAR; - - PROCEDURE W(ch: CHAR); - BEGIN - IF pos < LEN(s)-1 THEN - s[pos] := ch; pos := pos+1 - END - END W; - - BEGIN - pos := 0; - IF x < 0 THEN W('-'); x := -x END; - ASSERT (x < 1.0E9); - - n := ENTIER(x); - m := ENTIER(1.0E6 * (x - n) + 0.5); - IF m = 1000000 THEN n := n+1; m := 0 END; - - IntToStr(n, tmp); - FOR k := 0 TO Length(tmp)-1 DO W(tmp[k]) END; - - IF m > 0 THEN - W('.'); - k := 100000; - WHILE m > 0 DO - W(CHR(m DIV k + ORD('0'))); - m := m MOD k; k := k DIV 10 - END - END; - - s[pos] := 0X - END RealToStr; - - PROCEDURE Init(); - VAR i: LONGINT; - BEGIN - - FOR i := 0 TO 255 DO - isAlpha[i] := ((i >= ORD("A")) & (i <= ORD("Z"))) OR ((i >= ORD("a")) & (i <= ORD("z"))) - END; - isAlpha[ORD(80X)] := TRUE; isAlpha[ORD(81X)] := TRUE; isAlpha[ORD(82X)] := TRUE; - isAlpha[ORD(83X)] := TRUE; isAlpha[ORD(84X)] := TRUE; isAlpha[ORD(85X)] := TRUE; - isAlpha[ORD(86X)] := TRUE; isAlpha[ORD(87X)] := TRUE; isAlpha[ORD(88X)] := TRUE; - isAlpha[ORD(89X)] := TRUE; isAlpha[ORD(8AX)] := TRUE; isAlpha[ORD(8BX)] := TRUE; - isAlpha[ORD(8CX)] := TRUE; isAlpha[ORD(8DX)] := TRUE; isAlpha[ORD(8EX)] := TRUE; - isAlpha[ORD(8FX)] := TRUE; isAlpha[ORD(90X)] := TRUE; isAlpha[ORD(91X)] := TRUE; - isAlpha[ORD(92X)] := TRUE; isAlpha[ORD(93X)] := TRUE; isAlpha[ORD(94X)] := TRUE; - isAlpha[ORD(95X)] := TRUE; isAlpha[ORD(96X)] := TRUE; - FOR i := 0 TO 255 DO - ISOToOberon[i] := CHR(i); OberonToISO[i] := CHR(i) - END; - ISOToOberon[8] := 7FX; - ISOToOberon[146] := 27X; - ISOToOberon[160] := 20X; - ISOToOberon[162] := 63X; - ISOToOberon[166] := 7CX; - ISOToOberon[168] := 22X; - ISOToOberon[169] := 63X; - ISOToOberon[170] := 61X; - ISOToOberon[171] := 3CX; - ISOToOberon[173] := 2DX; - ISOToOberon[174] := 72X; - ISOToOberon[175] := 2DX; - ISOToOberon[176] := 6FX; - ISOToOberon[178] := 32X; - ISOToOberon[179] := 33X; - ISOToOberon[180] := 27X; - ISOToOberon[183] := 2EX; - ISOToOberon[185] := 31X; - ISOToOberon[186] := 30X; - ISOToOberon[187] := 3EX; - ISOToOberon[192] := 41X; - ISOToOberon[193] := 41X; - ISOToOberon[194] := 41X; - ISOToOberon[195] := 41X; - ISOToOberon[196] := 80X; OberonToISO[128] := 0C4X; - ISOToOberon[197] := 41X; - ISOToOberon[198] := 41X; - ISOToOberon[199] := 43X; - ISOToOberon[200] := 45X; - ISOToOberon[201] := 45X; - ISOToOberon[202] := 45X; - ISOToOberon[203] := 45X; - ISOToOberon[204] := 49X; - ISOToOberon[205] := 49X; - ISOToOberon[206] := 49X; - ISOToOberon[207] := 49X; - ISOToOberon[208] := 44X; - ISOToOberon[209] := 4EX; - ISOToOberon[210] := 4FX; - ISOToOberon[211] := 4FX; - ISOToOberon[212] := 4FX; - ISOToOberon[213] := 4FX; - ISOToOberon[214] := 81X; OberonToISO[129] := 0D6X; - ISOToOberon[215] := 2AX; - ISOToOberon[216] := 4FX; - ISOToOberon[217] := 55X; - ISOToOberon[218] := 55X; - ISOToOberon[219] := 55X; - ISOToOberon[220] := 82X; OberonToISO[130] := 0DCX; - ISOToOberon[221] := 59X; - ISOToOberon[222] := 50X; - ISOToOberon[223] := 96X; OberonToISO[150] := 0DFX; - ISOToOberon[224] := 8BX; OberonToISO[139] := 0E0X; - ISOToOberon[225] := 94X; OberonToISO[148] := 0E1X; - ISOToOberon[226] := 86X; OberonToISO[134] := 0E2X; - ISOToOberon[227] := 61X; - ISOToOberon[228] := 83X; OberonToISO[131] := 0E4X; - ISOToOberon[229] := 61X; - ISOToOberon[230] := 61X; - ISOToOberon[231] := 93X; OberonToISO[147] := 0E7X; - ISOToOberon[232] := 8CX; OberonToISO[140] := 0E8X; - ISOToOberon[233] := 90X; OberonToISO[144] := 0E9X; - ISOToOberon[234] := 87X; OberonToISO[135] := 0EAX; - ISOToOberon[235] := 91X; OberonToISO[145] := 0EBX; - ISOToOberon[236] := 8DX; OberonToISO[141] := 0ECX; - ISOToOberon[237] := 69X; - ISOToOberon[238] := 88X; OberonToISO[136] := 0EEX; - ISOToOberon[239] := 92X; OberonToISO[146] := 0EFX; - ISOToOberon[240] := 64X; - ISOToOberon[241] := 95X; OberonToISO[149] := 0F1X; - ISOToOberon[242] := 8EX; OberonToISO[142] := 0F2X; - ISOToOberon[243] := 6FX; - ISOToOberon[244] := 89X; OberonToISO[137] := 0F4X; - ISOToOberon[245] := 6FX; - ISOToOberon[246] := 84X; OberonToISO[132] := 0F6X; - ISOToOberon[248] := 6FX; - ISOToOberon[249] := 8FX; OberonToISO[143] := 0F9X; - ISOToOberon[250] := 75X; - ISOToOberon[251] := 8AX; OberonToISO[138] := 0FBX; - ISOToOberon[252] := 85X; OberonToISO[133] := 0FCX; - ISOToOberon[253] := 79X; - ISOToOberon[254] := 70X; - ISOToOberon[255] := 79X; - END Init; - -BEGIN - Init() -END Strings1. - |