(* 	$Id: LongStrings.Mod,v 1.4 1999/11/29 09:38:49 ooc-devel Exp $	 *)
MODULE LongStrings;
(*  Facilities for manipulating strings of LONGCHAR characters.
    Copyright (C) 1996-1999  Michael van Acken

    This module is free software; you can redistribute it and/or
    modify it under the terms of the GNU Lesser General Public License
    as published by the Free Software Foundation; either version 2 of
    the License, or (at your option) any later version.

    This module 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
    Lesser General Public License for more details.

    You should have received a copy of the GNU Lesser General Public
    License along with OOC. If not, write to the Free Software Foundation,
    59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
*)
 
(*
Notes: This is the LONGCHAR version of the module `Strings'.  Imagine
all occurences of CHAR in `Strings' replaced with LONGCHAR, and you
are looking at this module.
*)


TYPE
  CompareResults* = SHORTINT;
  
CONST
  (* values returned by `Compare' *)
  less* = -1;
  equal* = 0;
  greater* = 1;
 

PROCEDURE Length* (stringVal: ARRAY OF LONGCHAR): INTEGER;
(* Returns the length of `stringVal'.  This is equal to the number of 
   characters in `stringVal' up to and excluding the first 0X.  *)
  VAR
    i: INTEGER;
  BEGIN
    i := 0;
    WHILE (stringVal[i] # 0X) DO
      INC (i)
    END;
    RETURN i
  END Length;

 
 
(* 
The following seven procedures construct a string value, and attempt to assign
it to a variable parameter.  They all have the property that if the length of 
the constructed string value exceeds the capacity of the variable parameter, a
truncated value is assigned.  The constructed string always ends with the
string terminator 0X.
*)

PROCEDURE Assign* (source: ARRAY OF LONGCHAR; VAR destination: ARRAY OF LONGCHAR);
(* Copies `source' to `destination'.  Equivalent to the predefined procedure 
   COPY.  Unlike COPY, this procedure can be assigned to a procedure 
   variable.  *)
  VAR
    i: INTEGER;
  BEGIN
    i := -1;
    REPEAT
      INC (i);
      destination[i] := source[i]
    UNTIL (destination[i] = 0X) OR (i = LEN (destination)-1);
    destination[i] := 0X
  END Assign;
  
PROCEDURE Extract* (source: ARRAY OF LONGCHAR; startPos, numberToExtract: INTEGER;
                    VAR destination: ARRAY OF LONGCHAR);
(* Copies at most `numberToExtract' characters from `source' to `destination',
   starting at position `startPos' in `source'.  An empty string value will be
   extracted if `startPos' is greater than or equal to `Length(source)'.  
   pre: `startPos' and `numberToExtract' are not negative.  *)
  VAR
    sourceLength, i: INTEGER;
  BEGIN
    (* make sure that we get an empty string if `startPos' refers to an array
       index beyond `Length (source)'  *)
    sourceLength := Length (source);
    IF (startPos > sourceLength) THEN
      startPos := sourceLength
    END;
    
    (* make sure that `numberToExtract' doesn't exceed the capacity 
       of `destination' *)
    IF (numberToExtract >= LEN (destination)) THEN
      numberToExtract := SHORT (LEN (destination))-1
    END;
    
    (* copy up to `numberToExtract' characters to `destination' *)
    i := 0;
    WHILE (i < numberToExtract) & (source[startPos+i] # 0X) DO
      destination[i] := source[startPos+i];
      INC (i)
    END;
    destination[i] := 0X
  END Extract;
  
PROCEDURE Delete* (VAR stringVar: ARRAY OF LONGCHAR; 
                  startPos, numberToDelete: INTEGER);
(* Deletes at most `numberToDelete' characters from `stringVar', starting at 
   position `startPos'.  The string value in `stringVar' is not altered if
   `startPos' is greater than or equal to `Length(stringVar)'.
   pre: `startPos' and `numberToDelete' are not negative.  *)
  VAR
    stringLength, i: INTEGER;
  BEGIN
    stringLength := Length (stringVar);
    IF (startPos+numberToDelete < stringLength) THEN
      (* `stringVar' has remaining characters beyond the deleted section;
         these have to be moved forward by `numberToDelete' characters *)
      FOR i := startPos TO stringLength-numberToDelete DO
        stringVar[i] := stringVar[i+numberToDelete]
      END
    ELSIF (startPos < stringLength) THEN
      stringVar[startPos] := 0X
    END
  END Delete;
 
PROCEDURE Insert* (source: ARRAY OF LONGCHAR; startPos: INTEGER;
                   VAR destination: ARRAY OF LONGCHAR);
(* Inserts `source' into `destination' at position `startPos'.  After the call
   `destination' contains the string that is contructed by first splitting 
   `destination' at the position `startPos' and then concatenating the first 
   half, `source', and the second half.  The string value in `destination' is 
   not altered if `startPos' is greater than `Length(source)'.  If `startPos =
   Length(source)', then `source' is appended to `destination'.
   pre: `startPos' is not negative.  *)
  VAR
    sourceLength, destLength, destMax, i: INTEGER;
  BEGIN
    destLength := Length (destination);
    sourceLength := Length (source);
    destMax := SHORT (LEN (destination))-1;
    IF (startPos+sourceLength < destMax) THEN
      (* `source' is inserted inside of `destination' *)
      IF (destLength+sourceLength > destMax) THEN
        (* `destination' too long, truncate it *)
        destLength := destMax-sourceLength;
        destination[destLength] := 0X
      END;
      
      (* move tail section of `destination' *)
      FOR i := destLength TO startPos BY -1 DO
        destination[i+sourceLength] := destination[i]
      END
    ELSIF (startPos <= destLength) THEN
      (* `source' replaces `destination' from `startPos' on *)
      destination[destMax] := 0X;        (* set string terminator *)
      sourceLength := destMax-startPos   (* truncate `source' *)
    ELSE  (* startPos > destLength: no change in `destination' *)
      sourceLength := 0
    END;
    (* copy characters from `source' to `destination' *)
    FOR i := 0 TO sourceLength-1 DO
      destination[startPos+i] := source[i]
    END
  END Insert;
  
PROCEDURE Replace* (source: ARRAY OF LONGCHAR; startPos: INTEGER;
                    VAR destination: ARRAY OF LONGCHAR);
(* Copies `source' into `destination', starting at position `startPos'. Copying
   stops when all of `source' has been copied, or when the last character of 
   the string value in `destination' has been replaced.   The string value in 
   `destination' is not altered if `startPos' is greater than or equal to 
   `Length(source)'. 
   pre: `startPos' is not negative.  *)
  VAR
    destLength, i: INTEGER;
  BEGIN
    destLength := Length (destination);
    IF (startPos < destLength) THEN
      (* if `startPos' is inside `destination', then replace characters until
         the end of `source' or `destination' is reached *)
      i := 0;
      WHILE (startPos # destLength) & (source[i] # 0X) DO
        destination[startPos] := source[i];
        INC (startPos);
        INC (i)
      END
    END
  END Replace;
 
PROCEDURE Append* (source: ARRAY OF LONGCHAR; VAR destination: ARRAY OF LONGCHAR);
(* Appends source to destination. *)
  VAR
    destLength, i: INTEGER;
  BEGIN
    destLength := Length (destination);
    i := 0;
    WHILE (destLength < LEN (destination)-1) & (source[i] # 0X) DO
      destination[destLength] := source[i];
      INC (destLength);
      INC (i)
    END;
    destination[destLength] := 0X
  END Append;
  
PROCEDURE Concat* (source1, source2: ARRAY OF LONGCHAR; 
                   VAR destination: ARRAY OF LONGCHAR);
(* Concatenates `source2' onto `source1' and copies the result into 
   `destination'. *)
  VAR
    i, j: INTEGER;
  BEGIN
    (* copy `source1' into `destination' *)
    i := 0;
    WHILE (source1[i] # 0X) & (i < LEN(destination)-1) DO
      destination[i] := source1[i];
      INC (i)
    END;
    
    (* append `source2' to `destination' *)
    j := 0;
    WHILE (source2[j] # 0X) & (i < LEN (destination)-1) DO
      destination[i] := source2[j];
      INC (j); INC (i)
    END;
    destination[i] := 0X
  END Concat;



(*
The following predicates provide for pre-testing of the operation-completion
conditions for the procedures above.
*)
 
PROCEDURE CanAssignAll* (sourceLength: INTEGER; VAR destination: ARRAY OF LONGCHAR): BOOLEAN;
(* Returns TRUE if a number of characters, indicated by `sourceLength', will 
   fit into `destination'; otherwise returns FALSE.  
   pre: `sourceLength' is not negative.  *)
  BEGIN
    RETURN (sourceLength < LEN (destination))
  END CanAssignAll;
 
PROCEDURE CanExtractAll* (sourceLength, startPos, numberToExtract: INTEGER;
                          VAR destination: ARRAY OF LONGCHAR): BOOLEAN;
(* Returns TRUE if there are `numberToExtract' characters starting at 
  `startPos' and within the `sourceLength' of some string, and if the capacity
   of `destination' is sufficient to hold `numberToExtract' characters;
   otherwise returns FALSE. 
   pre: `sourceLength', `startPos', and `numberToExtract' are not negative.  *)
  BEGIN
    RETURN (startPos+numberToExtract <= sourceLength) &
           (numberToExtract < LEN (destination))
  END CanExtractAll;
  
PROCEDURE CanDeleteAll* (stringLength, startPos, 
                        numberToDelete: INTEGER): BOOLEAN;
(* Returns TRUE if there are `numberToDelete' characters starting at `startPos'
   and within the `stringLength' of some string; otherwise returns FALSE.
   pre: `stringLength', `startPos' and `numberToDelete' are not negative.  *)
  BEGIN
    RETURN (startPos+numberToDelete <= stringLength)
  END CanDeleteAll;
  
PROCEDURE CanInsertAll* (sourceLength, startPos: INTEGER;
                         VAR destination: ARRAY OF LONGCHAR): BOOLEAN;
(* Returns TRUE if there is room for the insertion of `sourceLength'
   characters from some string into `destination' starting at `startPos'; 
   otherwise returns FALSE.
   pre: `sourceLength' and `startPos' are not negative.  *)
  VAR
    lenDestination: INTEGER;
  BEGIN
    lenDestination := Length (destination);
    RETURN (startPos <= lenDestination) &
           (sourceLength+lenDestination < LEN (destination))
  END CanInsertAll;
 
PROCEDURE CanReplaceAll* (sourceLength, startPos: INTEGER;
                          VAR destination: ARRAY OF LONGCHAR): BOOLEAN;
(* Returns TRUE if there is room for the replacement of `sourceLength'
   characters in `destination' starting at `startPos'; otherwise returns FALSE.
   pre: `sourceLength' and `startPos' are not negative.  *)
  BEGIN
    RETURN (sourceLength+startPos <= Length(destination))
  END CanReplaceAll;
 
PROCEDURE CanAppendAll* (sourceLength: INTEGER; 
                         VAR destination: ARRAY OF LONGCHAR): BOOLEAN;
(* Returns TRUE if there is sufficient room in `destination' to append a string
   of length `sourceLength' to the string in `destination'; otherwise returns 
   FALSE.
   pre: `sourceLength' is not negative.  *)
  BEGIN
    RETURN (Length (destination)+sourceLength < LEN (destination))
  END CanAppendAll;
 
PROCEDURE CanConcatAll* (source1Length, source2Length: INTEGER;
                         VAR destination: ARRAY OF LONGCHAR): BOOLEAN;
(* Returns TRUE if there is sufficient room in `destination' for a two strings
   of lengths `source1Length' and `source2Length'; otherwise returns FALSE.
   pre: `source1Length' and `source2Length' are not negative.  *)
  BEGIN
    RETURN (source1Length+source2Length < LEN (destination))
  END CanConcatAll;
  


(* 
The following type and procedures provide for the comparison of string values,
and for the location of substrings within strings.  
*)
 
PROCEDURE Compare* (stringVal1, stringVal2: ARRAY OF LONGCHAR): CompareResults;
(* Returns `less', `equal', or `greater', according as `stringVal1' is 
   lexically less than, equal to, or greater than `stringVal2'.
   Note that Oberon-2 already contains predefined comparison operators on 
   strings.  *)
  VAR
    i: INTEGER;
  BEGIN
    i := 0;
    WHILE (stringVal1[i] # 0X) & (stringVal1[i] = stringVal2[i]) DO
      INC (i)
    END;
    IF (stringVal1[i] < stringVal2[i]) THEN
      RETURN less 
    ELSIF (stringVal1[i] > stringVal2[i]) THEN
      RETURN greater
    ELSE
      RETURN equal
    END
  END Compare;
 
PROCEDURE Equal* (stringVal1, stringVal2: ARRAY OF LONGCHAR): BOOLEAN;
(* Returns `stringVal1 = stringVal2'.  Unlike the predefined operator `=', this
   procedure can be assigned to a procedure variable. *)
  VAR
    i: INTEGER;
  BEGIN
    i := 0;
    WHILE (stringVal1[i] # 0X) & (stringVal1[i] = stringVal2[i]) DO
      INC (i)
    END;
    RETURN (stringVal1[i] = 0X) & (stringVal2[i] = 0X)
  END Equal;
 
PROCEDURE FindNext* (pattern, stringToSearch: ARRAY OF LONGCHAR; startPos: INTEGER;
                     VAR patternFound: BOOLEAN; VAR posOfPattern: INTEGER);
(* Looks forward for next occurrence of `pattern' in `stringToSearch', starting
   the search at position `startPos'.  If `startPos < Length(stringToSearch)' 
   and `pattern' is found, `patternFound' is returned as TRUE, and 
   `posOfPattern' contains the start position in `stringToSearch' of `pattern',
   a value in the range [startPos..Length(stringToSearch)-1].  Otherwise 
   `patternFound' is returned as FALSE, and `posOfPattern' is unchanged.  
   If `startPos > Length(stringToSearch)-Length(Pattern)' then `patternFound'
   is returned as FALSE.
   pre: `startPos' is not negative.  *)
  VAR
    patternPos: INTEGER;
  BEGIN
    IF (startPos < Length (stringToSearch)) THEN
      patternPos := 0;
      LOOP
        IF (pattern[patternPos] = 0X) THEN     
          (* reached end of pattern *)
          patternFound := TRUE;
          posOfPattern := startPos-patternPos;
          EXIT
        ELSIF (stringToSearch[startPos] = 0X) THEN 
          (* end of string (but not of pattern) *)
          patternFound := FALSE;
          EXIT
        ELSIF (stringToSearch[startPos] = pattern[patternPos]) THEN  
          (* characters identic, compare next one *)
          INC (startPos); 
          INC (patternPos)
        ELSE                               
          (* difference found: reset indices and restart *)
          startPos := startPos-patternPos+1; 
          patternPos := 0
        END
      END
    ELSE
      patternFound := FALSE
    END
  END FindNext;
  
PROCEDURE FindPrev* (pattern, stringToSearch: ARRAY OF LONGCHAR; startPos: INTEGER;
                     VAR patternFound: BOOLEAN; VAR posOfPattern: INTEGER);
(* Looks backward for the previous occurrence of `pattern' in `stringToSearch'
   and returns the position of the first character of the `pattern' if found. 
   The search for the pattern begins at `startPos'. If `pattern' is found, 
   `patternFound' is returned as TRUE, and `posOfPattern' contains the start 
   position in `stringToSearch' of pattern in the range [0..startPos]. 
   Otherwise `patternFound' is returned as FALSE, and `posOfPattern' is 
   unchanged.  
   The pattern might be found at the given value of `startPos'.  The search 
   will fail if `startPos' is negative.
   If `startPos > Length(stringToSearch)-Length(pattern)' the whole string 
   value is searched.  *)
  VAR
    patternPos, stringLength, patternLength: INTEGER;
  BEGIN
    (* correct `startPos' if it is larger than the possible searching range *)
    stringLength := Length (stringToSearch);
    patternLength := Length (pattern);
    IF (startPos > stringLength-patternLength) THEN
      startPos := stringLength-patternLength
    END;
    
    IF (startPos >= 0) THEN
      patternPos := 0;
      LOOP
        IF (pattern[patternPos] = 0X) THEN     
          (* reached end of pattern *)
          patternFound := TRUE;
          posOfPattern := startPos-patternPos;
          EXIT
        ELSIF (stringToSearch[startPos] # pattern[patternPos]) THEN
          (* characters differ: reset indices and restart *)
          IF (startPos > patternPos) THEN
            startPos := startPos-patternPos-1;
            patternPos := 0
          ELSE
            (* reached beginning of `stringToSearch' without finding a match *)
            patternFound := FALSE;
            EXIT
          END
        ELSE  (* characters identic, compare next one *)
          INC (startPos); 
          INC (patternPos)
        END
      END
    ELSE
      patternFound := FALSE
    END
  END FindPrev;
 
PROCEDURE FindDiff* (stringVal1, stringVal2: ARRAY OF LONGCHAR;
                     VAR differenceFound: BOOLEAN; 
                     VAR posOfDifference: INTEGER);
(* Compares the string values in `stringVal1' and `stringVal2' for differences.
   If they are equal, `differenceFound' is returned as FALSE, and TRUE 
   otherwise. If `differenceFound' is TRUE, `posOfDifference' is set to the 
   position of the first difference; otherwise `posOfDifference' is unchanged.
*)
  VAR
    i: INTEGER;
  BEGIN
    i := 0;
    WHILE (stringVal1[i] # 0X) & (stringVal1[i] = stringVal2[i]) DO
      INC (i)
    END;
    differenceFound := (stringVal1[i] # 0X) OR (stringVal2[i] # 0X);
    IF differenceFound THEN
      posOfDifference := i
    END
  END FindDiff;

  
PROCEDURE Capitalize* (VAR stringVar: ARRAY OF LONGCHAR);
(* Applies the function CAP to each character of the string value in 
   `stringVar'.  *)
  VAR
    i: INTEGER;
  BEGIN
    i := 0;
    WHILE (stringVar[i] # 0X) DO
      stringVar[i] := CAP (stringVar[i]);
      INC (i)
    END
  END Capitalize;
 

PROCEDURE Long* (source: ARRAY OF CHAR; VAR destination: ARRAY OF LONGCHAR);
(* Copies `source' to `destination', extending CHAR values to LONGCHAR on the
   way.  Equivalent to the predefined procedure COPY.  Unlike COPY, this 
   procedure can be assigned to a procedure variable.  *)
  BEGIN
    COPY (source, destination)
  END Long;

PROCEDURE Short* (source: ARRAY OF LONGCHAR; repl: CHAR; VAR destination: ARRAY OF CHAR);
(* Copies `source' to `destination', converting LONGCHAR values to CHAR on the
   way.  LONGCHAR characters outside the range [MIN(CHAR)..MAX(CHAR)] are
   replaced by the character `repl'.  *)
  VAR
    i, len: INTEGER;
  BEGIN
    len := SHORT (LEN (destination)-1);
    i := 0;
    WHILE (source[i] # 0X) & (i # len) DO
      IF (source[i] <= MAX (CHAR)) THEN
        destination[i] := SHORT (source[i])
      ELSE
        destination[i] := repl
      END;
      INC (i)
    END;
    destination[i] := 0X
  END Short;

END LongStrings.