Fresh Fish 8/FreshFishVol8-CD1.bin/useful/dev/obero/oberon-a/source/library/strings.mod

Text File | 1994-08-08 | 12.5 KB | 465 lines

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

     $RCSfile: Strings.mod $
  Description: String manipulation

   Created by: fjc (Frank Copeland)
    $Revision: 1.5 $
      $Author: fjc $
        $Date: 1994/08/08 16:25:47 $

  Copyright © 1994, Frank Copeland.
  This file is part of the Oberon-A Library.
  See Oberon-A.doc for conditions of use and distribution.

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

MODULE Strings;

(*
** $C= CaseChk       $I- IndexChk  $L+ LongAdr   $N= NilChk
** $P= PortableCode  $R= RangeChk  $S= StackChk  $T= TypeChk
** $V= OvflChk       $Z= ZeroVars
**
** Index checking is handled explicitly by the relevant procedures.
*)

IMPORT Util, SYS := SYSTEM;

CONST
  DIGITS = "0123456789ABCDEF";

VAR
  digits : ARRAY 17 OF CHAR;

(*------------------------------------*)
(* $D- disable copying of open arrays *)
PROCEDURE Length *
  ( string : ARRAY OF CHAR ) : LONGINT;
(*
  Safely calculates the length of a string.

  This implementation checks the length of the string against the size of
  the array before returning. This is necessary to deal with over-running
  the end of the array if there is no NUL character (this happens when the
  string exactly fills the array). This does not prevent the procedure from
  merrily searching through memory well past the end of the array; it simply
  ensures that whatever result is returned is sensible.
*)

VAR length : LONGINT;

BEGIN (* Length *)
  length := SYS.STRLEN (string);
  IF length > LEN (string) THEN RETURN LEN (string) ELSE RETURN length END
END Length;


(*------------------------------------*)
(* $D- disable copying of open arrays *)
PROCEDURE Append *
  ( VAR target : ARRAY OF CHAR; source : ARRAY OF CHAR );
(*
  Appends the source string to the target string, truncating if necessary.
*)

VAR
  maxLength, targetLength, newLength : LONGINT;

BEGIN (* Append *)
  targetLength := Length (target);
  maxLength := LEN (target); DEC (maxLength);
  IF targetLength < maxLength THEN
    (* There is actually room at the end of the array. *)
    newLength :=
      Util.MinLongint( targetLength + Length (source), maxLength);
    SYS.MOVE
      ( SYS.ADR (source), SYS.ADR (target [targetLength]),
        newLength - targetLength );
    target [newLength] := 0X;
  END; (* IF *)
END Append;


(*------------------------------------*)
(* $D- disable copying of open arrays *)
PROCEDURE Insert *
  ( VAR target : ARRAY OF CHAR;
    subString  : ARRAY OF CHAR;
    position   : LONGINT );
(*
  Insert "subString" into "target" starting at "position", truncating if
  necessary.
*)

VAR maxLength, subStringLength, targetLength : LONGINT;

BEGIN (* Insert *)
  subStringLength := Length (subString);
  targetLength := Length (target);
  maxLength := LEN (target); DEC (maxLength);
  IF (position >= targetLength) THEN
    (* The start position is past the end of the target string. *)
    Append (target, subString);
  ELSIF ((subStringLength + targetLength) <= maxLength) THEN
    (*
      The result will fit into the target string. Move characters towards
      the end of the string to make room and copy the new characters into
      the space.
    *)
    SYS.MOVE
      ( SYS.ADR (target [position]),
        SYS.ADR (target [position + subStringLength]),
        targetLength - position );
    SYS.MOVE
      (SYS.ADR (subString), SYS.ADR (target [position]), subStringLength);
    target [targetLength + subStringLength] := 0X;
  ELSIF ((position + subStringLength) < maxLength) THEN
    (*
      The result will overflow the target string, but the subString will
      fit. Move characters towards the end of the string to make room and
      copy the new characters into the space.
    *)
    SYS.MOVE
      ( SYS.ADR (target [position]),
        SYS.ADR (target [position + subStringLength]),
        maxLength - subStringLength - position );
    SYS.MOVE
      ( SYS.ADR (subString), SYS.ADR (target [position]),
        subStringLength );
    target [maxLength] := 0X;
  ELSE
    (*
      The result will overflow the target string, and the subString is too
      long to fit. Just discard the end of the target string and append
      the new characters to it.
    *)
    target [position] := 0X;
    Append (target, subString);
  END; (* ELSE *)
END Insert;


(*------------------------------------*)
(* $D- disable copying of open arrays *)
PROCEDURE OverWrite *
  ( VAR target : ARRAY OF CHAR;
    source     : ARRAY OF CHAR;
    start      : LONGINT );
(*
  Overwrites the contents of "target" with "source", starting at "start".
  Truncates where necessary.
*)

VAR sourceLength : LONGINT;

BEGIN (* OverWrite *)
  sourceLength :=
    Util.MinLongint (Length (source), Length (target) - start);
  IF sourceLength > 0 THEN
    SYS.MOVE (SYS.ADR (source), SYS.ADR (target [start]), sourceLength)
  END; (* IF *)
END OverWrite;


(*------------------------------------*)
(* $D- disable copying of open arrays *)
PROCEDURE OverWriteSubString *
  ( VAR target : ARRAY OF CHAR;
    start      : LONGINT;
    source     : ARRAY OF CHAR;
    subStart,
    subLength  : LONGINT );
(*
  Overwrites the contents of target [start ...] with source [subStart ..
  (subStart + subLength - 1)]. Truncates or extends where necessary.
*)

VAR sourceLength : LONGINT;

BEGIN (* OverWriteSubString *)
  sourceLength :=
    Util.MinLongint
      ( Util.MinLongint (subLength, Length (source) - subStart),
        Length (target) - start );
  IF sourceLength > 0 THEN
    SYS.MOVE (SYS.ADR (source), SYS.ADR (target [start]), sourceLength)
  END; (* IF *)
END OverWriteSubString;


(*------------------------------------*)
(* $D- disable copying of open arrays *)
PROCEDURE CopySubString *
  ( VAR target : ARRAY OF CHAR;
    source     : ARRAY OF CHAR;
    start,
    length     : LONGINT );
(*
  Assigns a copy of a sub-string of "source" to "target". The sub-string
  starts at "start" and is "length" characters long. If an invalid substring
  is specified, the target is set to an empty string.
*)

VAR sourceLength, targetLength : LONGINT;

BEGIN (* CopySubString *)
  targetLength := 0;
  IF length > 0 THEN
    sourceLength := Length (source);
    IF (start < sourceLength) THEN
      targetLength :=
        Util.MinLongint (
          Util.MinLongint (length, LEN (target) - 1), sourceLength - start);
      SYS.MOVE (SYS.ADR (source [start]), SYS.ADR (target), targetLength);
    END; (* IF *)
  END; (* IF *)
  target [targetLength] := 0X;
END CopySubString;


(*------------------------------------*)
PROCEDURE DeleteSubString *
  ( VAR string    : ARRAY OF CHAR;
    start, length : LONGINT );
(*
  Deletes the sub-string of "string" starting at "start" that is "length"
  characters long.
*)

VAR stringLength : LONGINT;

BEGIN (* DeleteSubString *)
  IF length > 0 THEN
    stringLength := Length (string);
    IF start < stringLength THEN
      IF (start + length) < stringLength THEN
        (*
          Move characters towards the front of the array into the space
          deleted.
        *)
        SYS.MOVE
          ( SYS.ADR (string [start + length]), SYS.ADR (string [start]),
            stringLength - (start + length) );
        string [stringLength - length] := 0X;
      ELSE
        (* Delete to the end of the string. *)
        string [start] := 0X;
      END; (* ELSE *)
    END; (* IF *)
  END; (* IF *)
END DeleteSubString;


(*------------------------------------*)
PROCEDURE FindChar *
  ( char       : CHAR;
    VAR target : ARRAY OF CHAR;
    start      : LONGINT )
  : LONGINT;
(*
  Searches "target" for the first occurrence of "char", starting at "start"
  and returns its position if found, otherwise it returns the length of the
  string.
*)

VAR limit, position : LONGINT;

BEGIN (* FindChar *)
  position := start;
  limit := Length (target);
  WHILE (position < limit) & (target [position] # char) DO
    INC(position);
  END; (* WHILE *)
  IF position = limit THEN RETURN -1 ELSE RETURN position END
END FindChar;


(*------------------------------------*)
(* $D- disable copying of open arrays *)
PROCEDURE CompareCAP *
  ( string1, string2 : ARRAY OF CHAR )
  : SHORTINT;
(*
  Returns the result of the lexical comparison of the two strings. Returns
  -1 if (string1 < string2), 0 if (string1 = string2) and 1 if
  (string1 > string2). The case of the strings is ignored.
*)

VAR
  length1, length2, index, limit : LONGINT;
  result : SHORTINT; ch1, ch2 : CHAR;

BEGIN (* CompareCAP *)
  length1 := Length (string1);
  length2 := Length (string2);
  limit := Util.MinLongint (length1, length2);
  index := 0;
  LOOP
    IF (index = limit) THEN
      IF (length1 < length2) THEN
        result := -1;
      ELSIF (length1 > length2) THEN
        result := 1;
      ELSE
        result := 0;
      END; (* ELSE *)
      EXIT;
    END; (* IF *)
    ch1 := CAP (string1 [index]); ch2 := CAP (string2 [index]);
    IF ch1 < ch2 THEN
      result := -1;
      EXIT;
    ELSIF ch1 > ch2 THEN
      result := 1;
      EXIT;
    END; (* IF *)
    INC (index);
  END; (* LOOP *)
  RETURN result;
END CompareCAP;


(*------------------------------------*)
PROCEDURE TrimLeft *
  (VAR string : ARRAY OF CHAR; char : CHAR );
(*
  Deletes any instances of "char" from the start of "string".
*)

VAR length : LONGINT;

BEGIN (* TrimLeft *)
  length := 0;
  WHILE (string [length] = char) DO
    INC (length);
  END; (* WHILE *)
  IF length > 0 THEN DeleteSubString (string, 0, length) END
END TrimLeft;


(*------------------------------------*)
PROCEDURE TrimRight *
  ( VAR string : ARRAY OF CHAR; char : CHAR );
(*
  Deletes any instances of "char" from the end of "string".
*)

VAR start : LONGINT;

BEGIN (* TrimRight *)
  start := Length (string);
  WHILE (string [start] = char) DO DEC (start) END;
  string [start] := 0X;
END TrimRight;


(*------------------------------------*)
PROCEDURE Fill *
  ( VAR string : ARRAY OF CHAR;
    char       : CHAR;
    start, length : LONGINT );
(*
  Fills string with char, beginning at start character for length
  characters.
*)

VAR newLength : LONGINT;

BEGIN (* Fill *)
  IF start < (LEN (string) - 1) THEN
    length := Util.MinLongint (length, LEN (string) - start - 1);
    newLength := Util.MaxLongint (Length (string), start + length);
    WHILE length > 0 DO
      string [start] := char; INC (start); DEC (length)
    END; (* WHILE *)
    string [newLength] := 0X;
  END; (* IF *)
END Fill;


(*------------------------------------*)
PROCEDURE ToUpper *
  (VAR string : ARRAY OF CHAR);

  VAR index : LONGINT; ch : CHAR;

BEGIN (* ToUpper *)
  index := 0; ch := string [0];
  WHILE ch # 0X DO
    string [index] := CAP (ch); INC (index); ch := string [index]
  END; (* WHILE *)
END ToUpper;


(*------------------------------------*)
PROCEDURE ToLower *
  (VAR string : ARRAY OF CHAR);

  VAR index : LONGINT; ch : CHAR;

BEGIN (* ToLower *)
  index := 0; ch := string [0];
  WHILE ch # 0X DO
    IF ((ch >= "A") & (ch <= "Z")) OR ((ch >= "À") & (ch <= "ß")) THEN
      ch := CHR (ORD (ch) + 32); string [index] := ch
    END; (* IF *)
    INC (index); ch := string [index]
  END; (* WHILE *)
END ToLower;


(*------------------------------------*)
PROCEDURE IntToString *
  ( int : LONGINT; base, field : INTEGER;
    padChar : CHAR; VAR str : ARRAY OF CHAR );

  VAR i, j, k : INTEGER; temp : ARRAY 33 OF CHAR; neg : BOOLEAN;

BEGIN (* IntToString *)
  IF (base < 2) OR (base > 16) THEN HALT (30) END;
  i := 0; neg := (int < 0); int := ABS (int);
  REPEAT
    temp [i] := digits [SHORT (int MOD base)]; INC (i); int := int DIV base
  UNTIL int = 0;
  IF neg THEN temp [i] := "-"; INC (i) END;
  j := i; k := 0;
  WHILE j < field DO str [k] := padChar; INC (j); INC (k) END;
  WHILE i > 0 DO DEC (i); str [k] := temp [i]; INC (k) END;
  str [k] := 0X
END IntToString;

(*------------------------------------*)
(*$D-*)
PROCEDURE StringToInt *
  ( str : ARRAY OF CHAR; base : INTEGER; VAR int : LONGINT )
  : BOOLEAN;

  VAR i, d, temp, limit : LONGINT; ch : CHAR; neg : BOOLEAN;

BEGIN (* StringToInt *)
  IF (base < 2) OR (base > 16) THEN RETURN FALSE END;
  limit := MAX (LONGINT) DIV base; i := 0; ch := str [i];
  WHILE (ch # 0X) & (ch <= " ") DO INC (i); ch := str [i] END;
  IF ch = "-" THEN neg := TRUE; INC (i); ch := str [i]
  ELSE neg := FALSE
  END;
  temp := 0;
  WHILE ch > " " DO
    IF (ch >= "0") & (ch <= "9") THEN d := ORD (ch) - ORD ("0")
    ELSIF (ch >= "A") & (ch <= "F") THEN d := ORD (ch) - (ORD ("A") - 10)
    ELSE RETURN FALSE
    END;
    IF d >= base THEN RETURN FALSE END;
    IF (limit - d) < temp THEN RETURN FALSE END;
    temp := temp * base + d;
    INC (i); ch := str [i]
  END;
  IF neg THEN int := -temp ELSE int := temp END;
  RETURN TRUE
END StringToInt;

BEGIN
  digits := DIGITS
END Strings.