(**********************************************************************

    :Program.    StringOps.mod
    :Contents.   string operations, replaces the standard module "Strings".
    :Author.     Nicolas Benezan [bne]
    :Address.    Postwiesenstr. 2, D7000 Stuttgart 60
    :Phone.      711/333679
    :Copyright.  Public Domain
    :Language.   OBERON
    :Translator. OBERON v1.01
    :History.    V1.0 [bne] 18-Apr-89
    :History.    V1.1 [bne] 18-Apr-89 (bug in DeleteSubString fixed)
    :History.    V2.0 [kai] 25-Apr-90 ported to OBERON
    :History.    V2.1 [kai] 17-Aug-90 + StringConv, StringForm

**********************************************************************)

MODULE StringOps;

IMPORT s: SYSTEM;

CONST
  nul   = 00X;
  space = " ";

(*нннннннннннннннннннннннннннннннннннннннннннннннннннннннннннннннннннннн*)
(* basic string operations                                              *)
(*нннннннннннннннннннннннннннннннннннннннннннннннннннннннннннннннннннннн*)
PROCEDURE Length* (String: ARRAY OF CHAR): INTEGER;
(* $EntryExitCode- *)
  BEGIN
    s.INLINE (02C5FH,          (*    move.l  (sp)+,a6  *)
              0301FH,          (*    move.w  (sp)+,d0  *)
              0205FH,          (*    move.l  (sp)+,a0  *)
              05340H,          (*    subq    #1,d0     *)
              03200H,          (*    move.w  d0,d1     *)
              04A18H,          (* l: tst.b   (a0)+     *)
              057C9H, 0FFFCH,  (*    dbeq    d1,l      *)
              09041H,          (*    sub.w   d1,d0     *)
              04ED6H);         (*    jmp     (a6)      *)
  END Length;

PROCEDURE Append* (VAR String: ARRAY OF CHAR;
                       Tail: ARRAY OF CHAR);
  VAR
    PosStr, PosTail: INTEGER;
  BEGIN
    PosTail:= 0;
    PosStr:= Length (String);
    LOOP
      IF PosStr > LEN (String) THEN
        EXIT
      ELSIF (PosTail > LEN (Tail)) OR (Tail[PosTail] = nul) THEN
        String[PosStr]:= nul;
        EXIT
      END;
      String[PosStr]:= Tail[PosTail];
      INC (PosStr);
      INC (PosTail);
    END;
  END Append;

PROCEDURE AppendChar* (VAR String: ARRAY OF CHAR;
                           Char: CHAR);
  VAR
    Len:INTEGER;
  BEGIN
    Len:= Length (String);
    IF Len <= LEN (String) THEN
      String[Len]:= Char;
      IF Len < LEN (String) THEN
        String[Len + 1]:= nul;
      END;
    END;
  END AppendChar;

PROCEDURE Assign* (    Source: ARRAY OF CHAR;
                   VAR Destination: ARRAY OF CHAR);
  VAR
    Pos, Max: INTEGER;
  BEGIN
    Max:= LEN (Source);
    IF LEN (Destination) < Max THEN
      Max:= LEN (Destination);
    END;
    Pos:= 0;
    LOOP
      Destination[Pos]:= Source[Pos];
      INC (Pos);
      IF (Pos > Max) OR (Source[Pos] = nul) THEN
        IF Pos <= LEN (Destination) THEN
          Destination[Pos]:= nul;
        END;
        EXIT
      END;
    END;
  END Assign;

PROCEDURE CapChar* (VAR Char: CHAR);
  BEGIN
    CASE Char OF
     "a".."z", "р".."Ў", "°".."■":
      DEC (Char, 32);
    ELSE
    END;
  END CapChar;

PROCEDURE CapString* (VAR String: ARRAY OF CHAR);
  VAR
    Pos: INTEGER;
  BEGIN
    Pos:= 0;
    WHILE (Pos <= LEN(String)) AND (String[Pos] # nul) DO
      CapChar (String[Pos]);
      INC (Pos);
    END;
  END CapString;

PROCEDURE FindChar* (String: ARRAY OF CHAR;
                     Char: CHAR;
                     Start: INTEGER): INTEGER;
  VAR
    Step: INTEGER;
  BEGIN
    IF Start < 0 THEN
      Start:= -Start;
      Step:= -1;
    ELSE
      Step:= 1;
    END;
    WHILE (Start <= LEN (String)) AND (Start >= 0) AND
          (String[Start] # nul) DO
      IF String[Start] = Char THEN
        RETURN Start
      END;
      INC (Start, Step);
    END;
    RETURN -1
  END FindChar;

PROCEDURE Concat* (    Head: ARRAY OF CHAR;
                       Tail: ARRAY OF CHAR;
                   VAR String: ARRAY OF CHAR);
  BEGIN
    Assign (Head,String);
    Append (String, Tail);
  END Concat;

PROCEDURE DeleteSubString* (VAR String: ARRAY OF CHAR;
                                Start, Len: INTEGER);
  BEGIN
    INC (Len, Start);
    IF Len >= Length (String) THEN
      String[Start]:= nul;
      RETURN
    END;
    WHILE Len <= LEN (String) DO
      String[Start]:= String[Len];
      IF String[Len] = nul THEN
        RETURN
      END;
      INC (Start);
      INC (Len);
    END;
    IF Start <= LEN (String) THEN
      String[Start]:= nul;
    END;
  END DeleteSubString;

PROCEDURE FindSubString* (String: ARRAY OF CHAR;
                          SubString: ARRAY OF CHAR;
                          Start: INTEGER): INTEGER;
  VAR
    Pos, Max: INTEGER;
  BEGIN
    Pos:= 0;
    Max:= LEN(String) - Length (SubString) + 1;
    WHILE (String[Start] # nul) AND (Start <= Max) DO
      LOOP
        IF (Pos > LEN(SubString)) OR (SubString[Pos] = nul) THEN
          RETURN Start
        END;
        IF String[Start + Pos] # SubString[Pos] THEN
          Pos:= 0;
          EXIT
        END;
        INC (Pos);
      END;
      INC (Start);
    END;
    RETURN -1
  END FindSubString;

PROCEDURE ShiftRight* (VAR String: ARRAY OF CHAR;
                           Position, Distance: INTEGER);
  VAR
    Start, End: INTEGER;
  BEGIN
    End:= Length (String) + Distance;
    IF End > LEN (String) THEN
      End:= LEN (String);
    END;
    Start:= End - Distance;
    WHILE Start >= Position DO
      String[End]:= String[Start];
      DEC (End);
      DEC (Start);
    END;
  END ShiftRight;

PROCEDURE OverWrite* (VAR String: ARRAY OF CHAR;
                          Overlay: ARRAY OF CHAR;
                          Position: INTEGER);
  VAR
    Pos, Len: INTEGER;
  BEGIN
    Len:= Length (Overlay);
    DEC (Len);
    IF Position + Len > LEN (String) THEN
      Len:= LEN(String) - Position;
    END;
    Pos:= 0;
    WHILE Pos <= Len DO
      String[Position]:= Overlay[Pos];
      INC(Position);
      INC (Pos);
    END;
  END OverWrite;

PROCEDURE InsertSubString* (VAR String: ARRAY OF CHAR;
                                SubString: ARRAY OF CHAR;
                                Position: INTEGER);
  BEGIN
    ShiftRight (String, Position, Length (SubString));
    OverWrite (String, SubString, Position);
  END InsertSubString;

PROCEDURE InsertChar* (VAR String: ARRAY OF CHAR;
                           Char: CHAR;
                           Position: INTEGER);
  BEGIN
    ShiftRight (String, Position, 1);
    String[Position]:= Char;
  END InsertChar;

PROCEDURE SubString* (    Source: ARRAY OF CHAR;
                      VAR Destination: ARRAY OF CHAR;
                          Position, Len: INTEGER);
  VAR
    SrcLen, Pos: INTEGER;
  BEGIN
    SrcLen:= Length(Source);
    IF Position + Len > SrcLen THEN
      Len:= SrcLen - Position;
    END;
    Pos:= 0;
    WHILE Pos <= Len - 1 DO
      Destination[Pos]:= Source[Position];
      INC(Position);
      INC(Pos);
    END;
    IF Len <= LEN (Destination) THEN
      Destination[Len]:= nul;
    END;
  END SubString;

PROCEDURE Compare* (String1, String2: ARRAY OF CHAR): INTEGER;
  VAR
    Max, Max1, Max2, Res, Pos, Diff: INTEGER;
  BEGIN
    Max1:= LEN (String1);
    Max2:= LEN (String2);
    Res:= Max1 - Max2;
    IF Res < 0 THEN
      Max:= Max1;
    ELSE
      Max:= Max2;
    END;
    Pos:= 0;
    WHILE Pos <= Max DO
      Diff:= ORD (String1[Pos]) - ORD (String2[Pos]);
      IF (Diff # 0) OR (String1[Pos] = nul) THEN
        RETURN Diff
      END;
      INC (Pos);
    END;
    INC (Max);
    IF (Res < 0) AND (String2[Max] # nul) THEN
    ELSIF (Res > 0) AND (String1[Max] # nul) THEN
    ELSE
      RETURN 0;
    END;
    RETURN Res;
  END Compare;

(*нннннннннннннннннннннннннннннннннннннннннннннннннннннннннннннннннннннн*)
(* string formatting                                                    *)
(*нннннннннннннннннннннннннннннннннннннннннннннннннннннннннннннннннннннн*)
PROCEDURE AppendBlanks* (VAR String: ARRAY OF CHAR;
                             Width: INTEGER);
  VAR
    Pos, Max: INTEGER;
  BEGIN
    IF Width <= LEN (String) THEN
      Max:= Width - 1;
    ELSE
      Max:= LEN (String);
    END;
    Pos:= Length (String);
    WHILE Pos <= Max DO
      String[Pos]:= space;
      INC (Pos);
    END;
    IF Pos <= LEN (String) THEN
      String[Pos]:= nul;
    END;
  END AppendBlanks;

PROCEDURE LeftInsertChar (VAR String: ARRAY OF CHAR;
                              Char: CHAR;
                              Num: INTEGER);
  VAR
    Pos, Max: INTEGER;
  BEGIN
    IF Num <= LEN (String) THEN
      Max:= Length (String) + Num;
      IF Max > LEN (String) THEN
        Max:= LEN (String);
      END;
      Pos:= Max - Num;
      WHILE Pos >= 0 DO
        String[Max]:= String[Pos];
        DEC (Max);
        DEC (Pos);
      END;
      DEC (Num);
    ELSE
      Num:= LEN (String);
    END;
    Pos := 0;
    WHILE Pos <= Num DO
      String[Pos]:= Char;
      INC (Pos);
    END;
  END LeftInsertChar;

PROCEDURE Indent* (VAR String: ARRAY OF CHAR;
                       Margin: INTEGER);
  BEGIN
    LeftInsertChar (String, space, Margin);
  END Indent;

PROCEDURE CenterAdjust* (VAR String: ARRAY OF CHAR;
                             Width: INTEGER);
  VAR
    Len: INTEGER;
  BEGIN
    Len:= Length(String);
    IF Len < Width THEN
      Indent (String, (Width - Length (String)) DIV 2);
      AppendBlanks (String,Width);
    END;
  END CenterAdjust;

PROCEDURE CutBlanks* (VAR String: ARRAY OF CHAR);
  VAR
    Pos: INTEGER;
  BEGIN
    Pos:= 0;
    WHILE (Pos <= LEN (String)) AND (String[Pos] = space) DO
      INC (Pos);
    END;
    DeleteSubString (String, 0, Pos);
    Pos:= Length (String) - 1;
    WHILE (Pos >= 0) AND (String[Pos] = space) DO
      DEC (Pos);
    END;
    INC (Pos);
    IF Pos <= LEN (String) THEN
      String[Pos]:= nul;
    END;
  END CutBlanks;

PROCEDURE RightAdjust* (VAR String: ARRAY OF CHAR;
                            Width: INTEGER);
  VAR
    Len: INTEGER;
  BEGIN
    CutBlanks (String);
    Len:= Length (String);
    IF Len < Width THEN
      Indent (String, Width - Len);
    END;
  END RightAdjust;

PROCEDURE EmptyString* (String: ARRAY OF CHAR): BOOLEAN;
  VAR
    Pos: INTEGER;
  BEGIN
    Pos:= 0;
    WHILE Pos <= LEN (String) DO
      IF String[Pos] = nul THEN
        RETURN TRUE;
      ELSIF String[Pos] # space THEN
        RETURN FALSE;
      END;
      INC (Pos);
    END;
    RETURN TRUE;
  END EmptyString;

PROCEDURE LeftInsertZeroes* (VAR String: ARRAY OF CHAR;
                                 Width: INTEGER);
  VAR
    Len: INTEGER;
  BEGIN
    CutBlanks (String);
    Len:= Length (String);
    IF Len < Width THEN
      LeftInsertChar (String, "0", Width - Len);
    END;
  END LeftInsertZeroes;

(*нннннннннннннннннннннннннннннннннннннннннннннннннннннннннннннннннннннн*)
(* string / numeric conversions                                         *)
(*нннннннннннннннннннннннннннннннннннннннннннннннннннннннннннннннннннннн*)
PROCEDURE NumToStr* {"StringOps.NumToStrOk"} (    Int, Base: LONGINT;
                                              VAR String: ARRAY OF CHAR);

PROCEDURE NumToStrOk* (    Int, Base: LONGINT;
                       VAR String: ARRAY OF CHAR): BOOLEAN;
  TYPE
    Array = ARRAY 16 OF CHAR;
  CONST
    DigitArray = Array ("0123456789ABCDEF");
  VAR
    Pos: INTEGER;
    Ok : BOOLEAN;

  PROCEDURE NextDigit;
    VAR
      Digit: CHAR;
    BEGIN
      IF (Pos <= LEN (String)) THEN
        Digit:= DigitArray[Int MOD Base];
        Int:= Int DIV Base;
        IF (Int # 0) THEN
          NextDigit;
        END;
        String[Pos]:= Digit;
        INC (Pos);
      ELSE
        Ok:= FALSE;
      END;
    END NextDigit;

  BEGIN
    Ok:= TRUE;
    IF Int # 0 THEN
      Pos:= 0;
      NextDigit;
    ELSE
      String[0]:= "0";
      Pos:= 1;
    END;
    IF Pos <= LEN (String) THEN
      String[Pos]:= nul;
    END;
    RETURN Ok
  END NumToStrOk;

PROCEDURE IntToStr* {"StringOps.IntToStrOk"} (    Int: LONGINT;
                                              VAR String: ARRAY OF CHAR);

PROCEDURE IntToStrOk* (    Int: LONGINT;
                       VAR String: ARRAY OF CHAR): BOOLEAN;
  BEGIN
    RETURN NumToStrOk (Int, 10, String);
  END IntToStrOk;

PROCEDURE IntToHex* {"StringOps.IntToHexOk"} (    Int: LONGINT;
                                              VAR String: ARRAY OF CHAR);

PROCEDURE IntToHexOk* (    Int: LONGINT;
                       VAR String: ARRAY OF CHAR): BOOLEAN;
  BEGIN
    RETURN NumToStrOk (Int, 16, String);
  END IntToHexOk;

PROCEDURE StrToIntOk* (    String: ARRAY OF CHAR;
                       VAR Int: LONGINT): BOOLEAN;
  (* $CopyArrays- *)
  CONST
    Base = 10;
    MaxDivBase = MAX (LONGINT) DIV Base;
  VAR
    Pos: INTEGER;
    Digit: CHAR;
    Neg, Ok: BOOLEAN;
  BEGIN
    Int:= 0;
    Ok:= TRUE;
    IF String[0] # "-" THEN
      Pos:= 0;
      Neg:= FALSE;
    ELSE
      Pos:= 1;
      Neg:= TRUE;
    END;
    LOOP
      IF Pos > LEN(String) THEN
        EXIT
      END;
      Digit:= String[Pos];
      IF (Digit < "0") OR (Digit > "9") THEN
        IF Digit # nul THEN
          Ok:= FALSE;
        END;
        EXIT
      END;
      DEC (Digit, ORD ("0"));
      IF Int <= MaxDivBase THEN
        Int:= Int * Base;
        IF Int <= MAX (LONGINT) - ORD (Digit) THEN
          INC (Int, ORD (Digit));
        ELSE (* overflow *)
          Ok:= FALSE;
          EXIT
        END;
      ELSE (* overflow *)
        Ok:= FALSE;
        EXIT
      END;
      INC (Pos);
    END;
    IF Neg THEN
      Int:= -Int
    END;
    RETURN Ok
  END StrToIntOk;

PROCEDURE StrToInt* (String: ARRAY OF CHAR): LONGINT;
  (* $CopyArrays- *)
  VAR
    Int: LONGINT;
  BEGIN
    IF StrToIntOk (String, Int) THEN
    END;
    RETURN Int
  END StrToInt;

PROCEDURE HexToIntOk* (    String: ARRAY OF CHAR;
                       VAR Int: LONGINT): BOOLEAN;
  (* $CopyArrays- *)
  CONST
    Base = 16;
    MaxDivBase = MAX (LONGINT) DIV Base;
  VAR
    Pos: INTEGER;
    Digit: CHAR;
    Ok: BOOLEAN;
  BEGIN
    Pos:= 0;
    Int:= 0;
    Ok:= TRUE;
    LOOP
      Digit:= String[Pos];
      IF Digit = nul THEN
        IF Pos = 0 THEN
          Ok:= FALSE;
        END;
        EXIT
      END;
      IF Int > MaxDivBase THEN
        Ok:= FALSE;
        EXIT
      END;
      IF (Digit >= "0") AND (Digit <= "9") THEN
        DEC (Digit, ORD ("0"));
      ELSIF (Digit >= "A") AND (Digit <= "F") THEN
        DEC (Digit, ORD ("A") - 10);
      ELSE
        Ok:= FALSE;
        EXIT
      END;
      Int:= Int * Base + ORD (Digit);
      INC (Pos);
      IF Pos = LEN (String) THEN
        EXIT
      END;
    END;
    RETURN Ok
  END HexToIntOk;

PROCEDURE HexToInt* (String: ARRAY OF CHAR): LONGINT;
  (* $CopyArrays- *)
  VAR
    Int: LONGINT;
  BEGIN
    IF HexToIntOk (String, Int) THEN
    END;
    RETURN Int
  END HexToInt;

END StringOps.