UNSAFE MODULE TextCat EXPORTS RTHooks, TextCat;

IMPORT TextClass;

REVEAL
  T = Public BRANDED "TextCat.T" OBJECT OVERRIDES
    get_info       := MyGetInfo;
    get_char       := MyGetChar;
    get_wide_char  := MyGetWideChar;
    get_chars      := MyGetChars;
    get_wide_chars := MyGetWideChars;
  END;

PROCEDURE New (t, u: TEXT): TEXT =
  BEGIN
    RETURN Concat (t, u);
  END New;

PROCEDURE Concat (t, u: TEXT): TEXT =
  VAR ti, ui: TextClass.Info;
  BEGIN
    t.get_info (ti);  IF (ti.length <= 0) THEN RETURN u; END;
    u.get_info (ui);  IF (ui.length <= 0) THEN RETURN t; END;
    RETURN NEW (T, a := t, b := u,
                a_len := ti.length, b_len := ui.length,
                a_or_b_wide := ti.wide OR ui.wide);
  END Concat;

PROCEDURE NewMulti (READONLY x: ARRAY OF TEXT): TEXT =
  BEGIN
    RETURN MultiCat (x);
  END NewMulti;

PROCEDURE MultiCat (READONLY x: ARRAY OF TEXT): TEXT =
  VAR result: TEXT;
  VAR r_info, xi_info: TextClass.Info;
  BEGIN
    IF NUMBER (x) <= 0 THEN RETURN "";   END;
    IF NUMBER (x) = 1  THEN RETURN x[0]; END;

    result := x[LAST(x)];
    result.get_info (r_info);
    FOR i := LAST(x) - 1 TO 0 BY -1 DO
      WITH xi = x[i] DO
        xi.get_info(xi_info);
        r_info.wide := r_info.wide OR xi_info.wide;
        result := NEW (T, a := xi, a_len := xi_info.length,
                          b := result, b_len := r_info.length,
                          a_or_b_wide := r_info.wide);
        INC(r_info.length, xi_info.length);
      END;
    END;
    RETURN result;
  END MultiCat;

PROCEDURE MyGetInfo (t: T;  VAR info: TextClass.Info) =
  BEGIN
    info.start  := NIL;
    info.length := t.a_len + t.b_len;
    info.wide   := t.a_or_b_wide;
  END MyGetInfo;

PROCEDURE MyGetChar (t: T;  index: CARDINAL): CHAR =
  BEGIN
    IF (index < t.a_len) THEN RETURN t.a.get_char (index); END;
    DEC (index, t.a_len);

    IF (index < t.b_len) THEN RETURN t.b.get_char (index); END;
    DEC (index, t.b_len);

    index := -1;  (* force a range fault *) <*NOWARN*>
  END MyGetChar;

PROCEDURE MyGetWideChar (t: T;  index: CARDINAL): WIDECHAR =
  BEGIN
    IF (index < t.a_len) THEN RETURN t.a.get_wide_char (index); END;
    DEC (index, t.a_len);

    IF (index < t.b_len) THEN RETURN t.b.get_wide_char (index); END;
    DEC (index, t.b_len);

    index := -1;  (* force a range fault *) <*NOWARN*>
  END MyGetWideChar;

PROCEDURE MyGetChars (t: T;  VAR a: ARRAY OF CHAR;  start: CARDINAL) =
  VAR u: TEXT;  a_offset, t_offset, u_offset: CARDINAL := 0;
  BEGIN
    u := t.a;
    IF (t_offset + t.a_len > start) THEN
      u_offset := MAX (start - t_offset, 0);
      u.get_chars (SUBARRAY (a, a_offset, NUMBER (a) - a_offset), u_offset);
      INC (a_offset, t.a_len - u_offset);
      IF (a_offset >= NUMBER (a)) THEN RETURN; END;
    END;
    INC (t_offset, t.a_len);

    u := t.b;
    IF (t_offset + t.b_len > start) THEN
      u_offset := MAX (start - t_offset, 0);
      u.get_chars (SUBARRAY (a, a_offset, NUMBER (a) - a_offset), u_offset);
      INC (a_offset, t.b_len - u_offset);
      IF (a_offset >= NUMBER (a)) THEN RETURN; END;
    END;
    INC (t_offset, t.b_len);
  END MyGetChars;

PROCEDURE MyGetWideChars (t: T;  VAR a: ARRAY OF WIDECHAR;  start: CARDINAL) =
  VAR u: TEXT;  a_offset, t_offset, u_offset: CARDINAL := 0;
  BEGIN
    u := t.a;
    IF (t_offset + t.a_len > start) THEN
      u_offset := MAX (start - t_offset, 0);
      u.get_wide_chars (SUBARRAY (a, a_offset, NUMBER (a) - a_offset), u_offset);
      INC (a_offset, t.a_len - u_offset);
      IF (a_offset >= NUMBER (a)) THEN RETURN; END;
    END;
    INC (t_offset, t.a_len);

    u := t.b;
    IF (t_offset + t.b_len > start) THEN
      u_offset := MAX (start - t_offset, 0);
      u.get_wide_chars (SUBARRAY (a, a_offset, NUMBER (a) - a_offset), u_offset);
      INC (a_offset, t.b_len - u_offset);
      IF (a_offset >= NUMBER (a)) THEN RETURN; END;
    END;
    INC (t_offset, t.b_len);
  END MyGetWideChars;

BEGIN
END TextCat.