IMPLEMENTATION MODULE Strings;

(** ------------------------------------------------------------------

                Commodore Amiga string manipulation module

      (c) Copyright 1986 Modula-2 Software Ltd.  All Rights Reserved
      (c) Copyright 1986 TDI Software, Inc.      All Rights Reserved

    ------------------------------------------------------------------ **)


(* VERSION FOR COMMODORE AMIGA

     Original Author : Paul Curtis, Modula-2 Software Ltd.  20-Jul-86

     Version         : 2.01a  20-Jul-86  Paul Curtis, Modula-2 Software Ltd.
                         Upgraded for 2.20a compiler.
                       2.00a  17-Mar-86  Phil Camp, Modula-2 Software Ltd.
                         Corrected name confusion between 'String'
                         and 'Strings'.

*)

(*$S-,$T-,$Q+*)

VAR Terminator: CHAR;
    (* the character used to terminate any string.
       On initialisation of the module is set to NUL
       and should not normally be changed.           *)

(*$T- Range checking off *)

PROCEDURE InitStringModule;
BEGIN
  Terminator := 0C;
END InitStringModule;


PROCEDURE Assign((* TO *) VAR Dest   : ARRAY OF CHAR;
                          VAR Source : ARRAY OF CHAR);

  (* Equivalent to  Dest := Source  *)

VAR LenSource : CARDINAL;
    I         : INTEGER;

BEGIN
  LenSource := Length(Source);
  IF LenSource > (HIGH(Dest) + 1) THEN
    LenSource := HIGH(Dest) + 1;
  END (* IF *);
  FOR I := 0 TO (LenSource - 1) DO
    Dest[I] := Source[I];
  END (* FOR *);
  IF LenSource <= HIGH(Dest) THEN
    Dest[LenSource] := Terminator;
  END (* IF *);
END Assign;



PROCEDURE Insert((* String   *) VAR SubStr : ARRAY OF CHAR;
                 (* Into     *) VAR Str    : ARRAY OF CHAR;
                 (* At point *)     Index  : CARDINAL     );

  (* starting at point Index in string Str inserts SubStr *)

VAR LenSub, LenStr, I : CARDINAL;

BEGIN
  LenSub := Length(SubStr);
  LenStr := Length(Str);
  IF ((LenStr + LenSub) < HIGH(Str)) AND (Index < LenStr) THEN
    (* make room *)
    FOR I := (LenStr + LenSub) TO (Index + LenSub) BY -1 DO
      Str[I] := Str[I - LenSub];
    END (* FOR *);
    (* copy in *)
    FOR I := 0 TO (LenSub - 1) DO
      Str[I + Index] := SubStr[I];
    END (* FOR *);
  END (* IF *);
END Insert;


PROCEDURE Delete((* From        *) VAR Str   : ARRAY OF CHAR;
                 (* starting at *)     Index : CARDINAL;
                 (* No of chars *)     Len   : CARDINAL     );

  (* removes Len characters from Str starting at point Index *)

VAR LenStr, I : CARDINAL;

BEGIN
  LenStr := Length(Str);
  IF Index < LenStr THEN
    (* copy over deleted chars. also copies 0C character *)
    FOR I := Index TO (LenStr - Len) DO
      Str[I] := Str[I + Len]
    END (* FOR *);
  END (* IF *);
END Delete;


PROCEDURE Copy((* origin      *) VAR Str    : ARRAY OF CHAR;
               (* from point  *)     Index  : CARDINAL;
               (* No of chars *)     Len    : CARDINAL;
               (* into        *) VAR Result : ARRAY OF CHAR);

  (* Copies Len characters starting at Index in Str into Result *)

VAR LenStr, I : CARDINAL;

BEGIN
  LenStr := Length(Str);
  IF (Index < LenStr) AND (Len < HIGH(Result)) THEN
    (* test they will not copy past end of Str *)
    IF (Index + Len) > LenStr THEN
      Len := LenStr - Index - 1;
    END (* IF *);
    (* copy chars into Result *)
    I := 0;
    WHILE I <= (Len - 1) DO
      Result[I] := Str[I + Index];  
      INC(I);
    END (* WHILE *);
    Result[I] := Terminator;
  END (* IF *);
END Copy;


PROCEDURE Concat(             VAR S1,
                 (* With   *)     S2     : ARRAY OF CHAR;
                 (* giving *) VAR Result : ARRAY OF CHAR);

  (* equivalent to   Result := S1 + S2    *)

VAR LenS1, LenS2, I : CARDINAL;

BEGIN
  LenS1 := Length(S1);
  LenS2 := Length(S2);
  IF (LenS1 + LenS2) = 0 THEN
    Result[0] := Terminator;
  ELSIF (LenS1 + LenS2) < (HIGH(Result) + 2) THEN
    Assign(Result,S1);
    (* add S2 onto end of S1 *)
    FOR I := LenS1 TO (LenS1 + LenS2 - 1) DO
      Result[I] := S2[I - LenS1]; 
    END (* FOR *);
    Result[LenS1 + LenS2] := Terminator;
  END (* IF *);
END Concat;


PROCEDURE Length(VAR Str : ARRAY OF CHAR) : CARDINAL;

  (* function giving the length of the passed string. *)

VAR I : CARDINAL;

BEGIN
  FOR I := 0 TO HIGH(Str) DO
    IF Str[I] = Terminator THEN
      RETURN I;
    END (* IF *);
  END (* FOR *);
  RETURN HIGH(Str) + 1;
END Length;


PROCEDURE Compare(VAR S1 : ARRAY OF CHAR;
                  VAR S2 : ARRAY OF CHAR) : CompareResults;

  (* compares two strings and returns Greater/Equal/Less 
     Result is :  Equal   - if strings are same length with same
                            content (possibly empty);
               
                  Greater - if identical upto the end of one (possibly
                            empty) string but other is longer;
               
                  Less    - if on char by char compare one string has a char
                            less than the char at the same position in the 
                            other string (in ASCII code value).             *) 

VAR L1, L2, Imax, Index : CARDINAL;

BEGIN
  L1 := Length (S1);
  L2 := Length (S2);
  IF (L1 # 0) AND (L2 # 0) THEN (* Both strings have some content *)
    IF L1 < L2 THEN 
      Imax := L1 - 1 
    ELSE 
      Imax := L2 - 1 
    END; (* IF *)
    FOR Index := 0 TO Imax DO
      IF S1[Index] # S2[Index] THEN
        IF S1[Index] < S2[Index] THEN 
          RETURN Less 
        ELSE 
          RETURN Greater 
        END; (* IF *)
      END; (* IF *)
    END; (* FOR *)
  END;
  (* Either or both strings might be empty *) 
  IF L1 < L2 THEN 
    RETURN Less
  ELSE
    IF L1 > L2 THEN 
      RETURN Greater
    ELSE 
      RETURN Equal 
    END; (* IF *)
  END; (* IF *)
END Compare;


PROCEDURE Pos ( VAR Source : ARRAY OF CHAR;
                VAR Match  : ARRAY OF CHAR;
                    Start  : CARDINAL;
                VAR Where  : CARDINAL ) : BOOLEAN;

VAR SourceLen, MatchLen, MatchPos, MaxCheckPos : CARDINAL;

BEGIN
  SourceLen := Length (Source);
  MatchLen := Length (Match);
  IF ((SourceLen=0) OR (MatchLen=0))
     OR (Start + MatchLen > SourceLen) THEN
    Where := SourceLen;
    RETURN FALSE 
  END;
  MaxCheckPos := SourceLen - MatchLen;
  LOOP (* for each possible matching position *)
    MatchPos := 0;
    LOOP (* try match against source at MatchPos *)
      IF Match[MatchPos] # Source[Start+MatchPos] THEN 
        EXIT
      END;
      INC (MatchPos);
      IF MatchPos=MatchLen THEN 
        Where := Start;
        RETURN TRUE 
      END
    END; (* LOOP *)
    INC (Start);
    IF Start > MaxCheckPos THEN 
      Where := SourceLen;
      RETURN FALSE 
    END
  END (* LOOP *)
END Pos;


PROCEDURE SetTerminator(Ch : CHAR);
BEGIN
  Terminator := Ch;
END SetTerminator;


PROCEDURE GetTerminator() : CHAR;
BEGIN
  RETURN Terminator;
END GetTerminator;


BEGIN
  InitStringModule;
END Strings.