kolibrios-fun/programs/other/fb2reader/SRC/Strings.ob07

(*
    Copyright 2016, 2019, 2022 Anton Krotov

    This file is part of fb2read.

    fb2read 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.

    fb2read 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 fb2read. If not, see <http://www.gnu.org/licenses/>.
*)

MODULE Strings;

IMPORT sys := SYSTEM, KOSAPI;


TYPE

  STRING* = ARRAY 1024 OF CHAR;

  UTF8*   = ARRAY 8 OF CHAR;

  CHARS*  = RECORD first*, last* : INTEGER END;


VAR

  CS: BOOLEAN;


PROCEDURE [ccall,   "base64.obj",      ""] base64_decode (inp, outp: INTEGER; Len: INTEGER): INTEGER; END;
PROCEDURE [stdcall, "rasterworks.obj", ""] countUTF8Z (string, byteQuantity: INTEGER): INTEGER; END;

PROCEDURE DelLeft(VAR s: STRING; count: INTEGER);
VAR i, max: INTEGER;
BEGIN
  max := LENGTH(s) - count - 1;
  IF max >= 0 THEN
    FOR i := 0 TO max DO
      s[i] := s[i + count]
    END
  END
END DelLeft;


PROCEDURE Trim*(VAR s: STRING; ch: CHAR);
VAR i, n: INTEGER;
BEGIN
  i := 0;
  WHILE s[i] = ch DO
    INC(i)
  END;
  DelLeft(s, i);
  n := LENGTH(s) - 1;
  IF n >= 0 THEN
    i := n;
    WHILE s[i] = ch DO
      DEC(i)
    END;
    IF n # i THEN
      s[i + 1] := 0X
    END
  END
END Trim;


PROCEDURE GetChar*(chars: CHARS; i: INTEGER): CHAR;
VAR c: CHAR;
BEGIN
  ASSERT(chars.first + i <= chars.last);
  sys.GET(chars.first + i, c)
  RETURN c
END GetChar;


PROCEDURE Reverse*(VAR s: ARRAY OF CHAR);
VAR i, j: INTEGER; c: CHAR;
BEGIN
  i := 0;
  j := LENGTH(s) - 1;
  WHILE i < j DO
    c := s[i];
    s[i] := s[j];
    s[j] := c;
    INC(i);
    DEC(j)
  END
END Reverse;


PROCEDURE IntToString*(x: INTEGER; VAR s: STRING);
VAR n, i: INTEGER;
BEGIN
  i := 0;
  REPEAT
    n := x MOD 10;
    x := x DIV 10;
    s[i] := CHR(ORD("0") + n);
    INC(i)
  UNTIL x = 0;
  s[i] := 0X;
  Reverse(s)
END IntToString;


PROCEDURE isdigit(c: CHAR): BOOLEAN;
  RETURN ("0" <= c) & (c <= "9")
END isdigit;


PROCEDURE CharsToInt*(s: CHARS; VAR err: BOOLEAN): INTEGER;
VAR n, i, res, len: INTEGER; c: CHAR;
BEGIN
  res := 0;
  len := s.last - s.first + 1;
  err := len <= 0;
  FOR i := 0 TO s.last - s.first DO
    c := GetChar(s, i);
    IF isdigit(c) THEN
      n := ORD(c) - ORD("0");
      res := res * 10 + n
    ELSE
      err := TRUE
    END
  END
  RETURN res
END CharsToInt;


PROCEDURE Append*(VAR str1: STRING; str2: STRING);
VAR
  len1, len2 : INTEGER;
  i, j       : INTEGER;
BEGIN
  len1 := LENGTH(str1);
  len2 := LENGTH(str2);
  ASSERT(len1 + len2 < LEN(str1));
  j := len1;
  FOR i := 0 TO len2 - 1 DO
    str1[j] := str2[i];
    INC(j)
  END;
  str1[j] := 0X
END Append;


PROCEDURE GetPath*(VAR S: STRING);
VAR i, j: INTEGER;
BEGIN
  j := 0;
  i := LENGTH(S) - 1;
  WHILE i >= 0 DO
    IF S[i] = "/" THEN
      j := i;
      i := 0
    END;
    DEC(i)
  END;
  S[j] := 0X
END GetPath;


PROCEDURE PutChar*(chars: CHARS; i: INTEGER; c: CHAR);
BEGIN
  ASSERT(chars.first + i <= chars.last);
  sys.PUT(chars.first + i, c)
END PutChar;


PROCEDURE StrToChars*(str: ARRAY OF CHAR; VAR chars: CHARS);
BEGIN
  ASSERT(str # "");
  chars.first := sys.ADR(str[0]);
  chars.last  := sys.ADR(str[LENGTH(str) - 1])
END StrToChars;


PROCEDURE PtrToString*(ptr: INTEGER; VAR S: STRING);
VAR i: INTEGER; c: CHAR;
BEGIN
  i := 0;
  REPEAT
    sys.GET(ptr, c);
    S[i] := c;
    INC(i);
    INC(ptr)
  UNTIL (c = 0X) OR (i = LEN(S));
  S[i - 1] := 0X
END PtrToString;


PROCEDURE CharsEq*(chars1, chars2: CHARS): BOOLEAN;
VAR
  pos, len2  : INTEGER;
  c1, c2     : CHAR;
  Result     : BOOLEAN;

  PROCEDURE CAP(VAR c: CHAR);
  BEGIN
    IF ~CS & ("a" <= c) & (c <= "z") THEN
      c := CHR(ORD(c) - 32)
    END
  END CAP;

BEGIN
  pos  := chars1.last - chars1.first;
  len2 := chars2.last - chars2.first;
  IF pos = len2 THEN
    REPEAT
      c1 := GetChar(chars1, pos);
      c2 := GetChar(chars2, pos);
      CAP(c1);
      CAP(c2);
      DEC(pos)
    UNTIL (c1 # c2) OR (pos = -1);
    Result := c1 = c2
  ELSE
    Result := FALSE
  END
  RETURN Result
END CharsEq;


PROCEDURE CharsEqStr*(chars: CHARS; str: STRING): BOOLEAN;
VAR
  chars2: CHARS;
BEGIN
  StrToChars(str, chars2)
  RETURN CharsEq(chars, chars2)
END CharsEqStr;


PROCEDURE SetCS*(value: BOOLEAN);
BEGIN
  CS := value
END SetCS;


PROCEDURE Utf8Length*(chars: CHARS): INTEGER;
  RETURN countUTF8Z(chars.first, chars.last - chars.first + 1)
END Utf8Length;


PROCEDURE Replace*(VAR chars: CHARS; str1, str2: ARRAY OF CHAR);
VAR
  temp: CHARS;
  s   : CHARS;
  len1: INTEGER;
  len2: INTEGER;
  diff: INTEGER;

  PROCEDURE Put(first, last, len1, len2, diff: INTEGER; str2: ARRAY OF CHAR);
  VAR i: INTEGER; c: CHAR;
  BEGIN
    sys.MOVE(sys.ADR(str2[0]), first, len2);
    FOR i := first + len1 TO last DO
      sys.GET(i, c);
      sys.PUT(i - diff, c);
    END
  END Put;

BEGIN
  len1 := LENGTH(str1);
  len2 := LENGTH(str2);
  diff := len1 - len2;
  ASSERT(diff >= 0);
  ASSERT(len1 > 0);
  StrToChars(str1, s);
  temp := chars;
  temp.last := temp.first + len1 - 1;
  WHILE temp.last <= chars.last DO
    IF CharsEq(temp, s) THEN
      Put(temp.first, chars.last, len1, len2, diff, str2);
      chars.last := chars.last - diff;
      temp.first := temp.first + len2;
      temp.last  := temp.first + len1 - 1
    ELSE
      INC(temp.first);
      INC(temp.last)
    END
  END
END Replace;


PROCEDURE utf8*(code: INTEGER; VAR uchar: UTF8);
BEGIN
  uchar[0] := 0X;
  IF code < 80H THEN
    uchar[0] := CHR(code);
    uchar[1] := 0X
  ELSIF code < 800H THEN
    uchar[1] := CHR(ORD(BITS(code) * {0..5}) + 80H);
    uchar[0] := CHR(ASR(code, 6) + 0C0H);
    uchar[2] := 0X
  ELSIF code < 10000H THEN
    uchar[2] := CHR(ORD(BITS(code) * {0..5}) + 80H);
    code := ASR(code, 6);
    uchar[1] := CHR(ORD(BITS(code) * {0..5}) + 80H);
    uchar[0] := CHR(ASR(code, 6) + 0E0H);
    uchar[3] := 0X
(*
  ELSIF code < 200000H THEN
  ELSIF code < 4000000H THEN
  ELSE  *)
  END
END utf8;


PROCEDURE EntOct*(VAR chars: CHARS): BOOLEAN;
VAR
  i     : INTEGER;
  c     : CHAR;
  amp   : BOOLEAN;
  oct   : BOOLEAN;
  val   : INTEGER;
  exit  : BOOLEAN;
  str   : STRING;
  str2  : STRING;
  uchar : UTF8;
  res   : BOOLEAN;

BEGIN
  i := 0;
  amp := FALSE;
  oct := FALSE;
  res := FALSE;
  WHILE i <= chars.last - chars.first DO
    c := GetChar(chars, i);
    CASE c OF
    |"&":
      amp := TRUE;
      oct := FALSE
    |"#":
      oct := amp;
      amp := FALSE
    |"0".."9":
      IF oct THEN
        val := 0;
        str := "&#";
        str2[1] := 0X;
        exit := FALSE;
        REPEAT
          val := val * 10 + ORD(c) - ORD("0");
          str2[0] := c;
          Append(str, str2);
          INC(i);
          IF i <= chars.last - chars.first THEN
            c := GetChar(chars, i)
          ELSE
            exit := TRUE
          END
        UNTIL ~isdigit(c) OR exit;
        IF c = ";" THEN
          str2[0] := c;
          Append(str, str2);
          utf8(val, uchar);
          Replace(chars, str, uchar);
          res := TRUE;
          i := chars.last - chars.first
        ELSE
          IF ~exit THEN
            DEC(i);
            amp := FALSE;
            oct := FALSE
          END
        END
      ELSE
        amp := FALSE
      END
    ELSE
      amp := FALSE;
      oct := FALSE
    END;
    INC(i)
  END
  RETURN res
END EntOct;


PROCEDURE UCase*(VAR s: STRING);
VAR i, n: INTEGER; c: CHAR;
BEGIN
  n := LENGTH(s) - 1;
  FOR i := 0 TO n DO
    c := s[i];
    IF ("a" <= c) & (c <= "z") OR (0A0X <= c) & (c <= 0AFX) THEN
      c := CHR(ORD(c) - 32)
    ELSIF (0E0X <= c) & (c <= 0EFX) THEN
      c := CHR(ORD(c) - 50H)
    ELSIF (c = 0F1X) OR (c = 0F3X) OR (c = 0F5X) OR (c = 0F7X) THEN
      c := CHR(ORD(c) - 1)
    END;
    s[i] := c
  END
END UCase;


PROCEDURE Base64* (VAR chars: CHARS);
BEGIN
	chars.last := chars.first + base64_decode(chars.first, chars.first, chars.last - chars.first + 1) - 1
END Base64;


BEGIN
  CS := TRUE
END Strings.