Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/PASLEDIT.ZIP/STRINGS.PAS

Pascal/Delphi Source File | 1991-02-12 | 7.7 KB | 266 lines

(*

   Library of string-handling routines written in Standard (ANSI) Pascal.

   By Ilya Shlyakhter, D-block.

*)

UNIT Strings;

                              INTERFACE

   CONST MaxStrLength = 6;   (* Maximum possible string length *)

   TYPE  StrLengthType = 0..MaxStrLength;
         StrCharData = PACKED ARRAY [1..MaxStrLength] OF Char;

         StrType = RECORD
                     Length: StrLengthType;
                     Ch: StrCharData
                   END;    (* StrType *)

   PROCEDURE StrInit (VAR Target: StrType);
   FUNCTION StrLength (TheString: StrType): StrLengthType;

   PROCEDURE StrAddChar (VAR Target: StrType; CharToAdd: Char);
   PROCEDURE StrInsertChar (VAR Target: StrType; CharToInsert: Char; Position: StrLengthType);

   PROCEDURE StrDeleteCharPos (VAR Target: StrType; Position: StrLengthType);
   PROCEDURE StrDeleteCharFirst (VAR Target: StrType; Character: Char);

   PROCEDURE StrConcat (First, Second: StrType; VAR Target: StrType);

   PROCEDURE StrReplaceCharPos (VAR Target: StrType; NewChar: Char; Position: StrLengthType);
   PROCEDURE StrReplaceCharFirst (VAR Target: StrType; OldChar: Char; NewChar: Char);
   PROCEDURE StrReplaceCharAll (VAR Target: StrType; OldChar: Char; NewChar: Char);

   FUNCTION StrCharPos (SearchString: StrType; SearchChar: Char): StrLengthType;
   PROCEDURE StrDisplayString (TheString: StrType);

   FUNCTION StrEqual (First, Second: StrType):Boolean;


                            IMPLEMENTATION


   PROCEDURE StrInit (VAR Target: StrType);

   (*
       Initializes the given string (Target) by setting its length to zero.
   *)

      BEGIN  (* StrInit *)
         Target.Length := 0
      END;   (* StrInit *)

   FUNCTION StrLength (TheString: StrType): StrLengthType;

   (*
       Returns the length of a given string (TheString).
   *)

      BEGIN  (* StrLength *)
        StrLength := TheString.Length
      END;   (* StrLength *)


   FUNCTION StrCharPos (SearchString: StrType; SearchChar: Char): StrLengthType;

   (*
      Returns the first occurence of a character (SearchChar) in a string (SearchString).
      If the character is not found, returns zero.
   *)

      VAR I: StrLengthType;
          Result: StrLengthType;  (* value to be returned by the function *)

      BEGIN  (* StrCharPos *)
         I := 1;

         WHILE (SearchString.Ch [I] <> SearchChar) AND (I <= SearchString.Length) DO
            I := I + 1;

         IF SearchString.Ch [I] = SearchChar THEN
            Result := I     (* found *)
               ELSE
                  Result := 0;   (* character not found *)

         StrCharPos := Result
      END;   (* StrCharPos *)

   PROCEDURE StrAddChar (VAR Target: StrType; CharToAdd: Char);

   (*
       Appends character (CharToAdd) to the string (Target).
   *)

      BEGIN  (* StrAddChar *)
         IF Target.Length < MaxStrLength THEN
            BEGIN  (* append *)
              Target.Length := Target.Length + 1;
              Target.Ch [Target.Length] := CharToAdd
            END;   (* append *)

      END;   (* StrAddChar *)

   PROCEDURE StrInsertChar (VAR Target: StrType; CharToInsert: Char; Position: StrLengthType);

   (*
       Inserts a character (CharToInsert) into a string (Target) at the specified position (Position).
   *)

      VAR I: StrLengthType;

      BEGIN  (* StrInsertChar *)
         IF Target.Length < MaxStrLength THEN
            BEGIN  (* insert *)
               FOR I := Target.Length+1 DOWNTO Position+1 DO
                  Target.Ch [I] := Target.Ch [I-1];

               Target.Ch [Position] := CharToInsert;
               Target.Length := Target.Length + 1;
            END;   (* insert *)
      END;   (* StrInsertChar *)

   PROCEDURE StrDeleteCharPos (VAR Target: StrType; Position: StrLengthType);

   (*
       Deletes a single character from a string (Target) at the specified position (Position).
   *)

      VAR I: StrLengthType;

      BEGIN  (* StrDeleteCharPos *)
        IF Target.Length > 0 THEN
          BEGIN  (* delete *)
            FOR I := Position TO Target.Length DO
               Target.Ch [I] := Target.Ch [I+1];

            Target.Length := Target.Length - 1
          END;   (* delete *)
      END;   (* StrDeleteCharPos *)

   PROCEDURE StrDeleteCharFirst (VAR Target: StrType; Character: Char);

   (*
      Deletes the first occurence of a character (Character) in a string (Target).

   *)

      VAR CharPos: StrLengthType;

      BEGIN  (* StrDeleteCharFirst *)
         CharPos := StrCharPos (Target, Character);

         IF CharPos > 0 THEN     (* the character was found in the string *)
            StrDeleteCharPos (Target, CharPos);
      END;   (* StrDeleteCharFirst *)


   PROCEDURE StrConcat (First, Second: StrType; VAR Target: StrType);

   (*
      Concatenates (merges) two given strings (First and Second) and stores result
      in another string (Target).
   *)

      VAR I: StrLengthType;

      BEGIN  (* StrConcat *)
         IF (First.Length + Second.Length) > MaxStrLength THEN
            Second.Length := MaxStrLength - First.Length;

         Target := First;
         FOR I := 1 TO Second.Length DO
            Target.Ch [First.Length + I] := Second.Ch [I];

         Target.Length := First.Length + Second.Length
      END;   (* StrConcat *)

   PROCEDURE StrReplaceCharPos (VAR Target: StrType; NewChar: Char; Position: StrLengthType);

   (*
      Replaces a character in the string (Target) at the specified POSITION (Position)
      with a given character (NewChar).
   *)

      BEGIN  (* StrReplaceCharPos *)
         Target.Ch [Position] := NewChar
      END;   (* StrReplaceCharPos *)

   PROCEDURE StrReplaceCharFirst (VAR Target: StrType; OldChar: Char; NewChar: Char);

   (*
      Replaces the FIRST occurence of a character (OldChar) in a string (Target)
      with a given character (NewChar).
   *)

      VAR CharPos: StrLengthType;

      BEGIN  (* StrReplaceCharFirst *)

         CharPos := StrCharPos (Target, OldChar);

         IF CharPos > 0 THEN  (* character found in the string *)
            Target.Ch [CharPos] := NewChar;
      END;   (* StrReplaceCharFirst *)

   PROCEDURE StrReplaceCharAll (VAR Target: StrType; OldChar: Char; NewChar: Char);

   (*
      Replaces ALL occurences of a character (OldChar) in a string (Target)
      with a given character (NewChar).
   *)

      VAR I: StrLengthType;

      BEGIN  (* StrReplaceCharAll *)
         FOR I := 1 TO Target.Length DO
            IF Target.Ch [I] = OldChar THEN
               Target.Ch [I] := NewChar
      END;   (* StrReplaceCharAll *)

   FUNCTION StrEqual (First, Second: StrType): Boolean;

      VAR I: Integer;
          Result: Boolean;

      BEGIN  (* StrEqual *)
         IF First.Length <> Second.Length THEN
            Result := False  (* if the strings have different lengths, they can't be equal *)
               ELSE
                  BEGIN  (* the two strings have the same lengths *)
                     I := 1;

                     WHILE (I < MaxStrLength) AND (First.Ch [I] = Second.Ch [I]) DO
                        I := I+1;

                     Result := (I = MaxStrLength) AND (First.Ch [I] = Second.Ch [I])

                  END;   (* the two strings have the same lengths *)

         StrEqual := Result

      END;   (* StrEqual *)


   PROCEDURE StrDisplayString (TheString: StrType);

      VAR I: StrLengthType;

      BEGIN  (* StrDisplayString *)
         FOR I := 1 TO StrLength (TheString) DO
            Write (TheString.Ch [I]);

         WriteLn
      END;   (* StrDisplayString *)



   END.   (* of Unit Strings *)