Topspeed_JPI/TS/MODBASE/STREDIT.MOD

IMPLEMENTATION MODULE StrEdit;
(*
 *  REPERTOIRE
 *  Release 1.6
 *  By Charles Bradford and Cole Brecheen
 *  (c) Copyright 1985-1992 PMI
 *  Green Bay, Wisconsin
 *  All rights reserved
 *  (414) 468-6040
 *
 *  $Header:   D:/logfiles/mods/stredit.mov   1.7   17 Mar 1991 17:58:52   coleb  $
 *
 *)

IMPORT LowLevel;
IMPORT M2Strings;
IMPORT Numbers;
IMPORT ScanUtils;
IMPORT SYSTEM;

VAR
  Initialized : BOOLEAN;

  PROCEDURE Init();
    BEGIN
      IF Initialized THEN
        RETURN;
      ELSE
        Initialized := TRUE;
      END;
      LowLevel.Init();
      M2Strings.Init();
      Numbers.Init();
      ScanUtils.Init();
    END Init;


  CONST
    BLANK = ' ';
    TAB = 11C;

  PROCEDURE AssignStr(instr : ARRAY OF CHAR; VAR outstr : ARRAY OF CHAR);
    (*Allows assignment of constants to strings; Logitech's Assign has
      two VAR parameters.  Changed 24 May 87 to use HIGH instead
      of SYSTEM.SIZE because M2SDS's SIZE returns incorrect results.*)
    VAR
      insize, outsize : CARDINAL;
    BEGIN
      insize := 1+HIGH(instr);
      outsize := 1+HIGH(outstr);
      IF insize>outsize THEN
        LowLevel.Move(SYSTEM.ADR(instr), SYSTEM.ADR(outstr), outsize);
      ELSE
        LowLevel.Move(SYSTEM.ADR(instr), SYSTEM.ADR(outstr), insize);
        SetLength(outstr, M2Strings.Length(instr));
      END;
    END AssignStr;

  PROCEDURE Append( VAR TheStr: ARRAY OF CHAR; AppStr: ARRAY OF CHAR);
    VAR
      HighAppStr, leng, leng2: CARDINAL;
    BEGIN
      HighAppStr := HIGH(AppStr);
        (* Exposes a nasty bug in Stony Brook M2. *)
      leng := M2Strings.Length(TheStr);
      leng2 := Numbers.Min(M2Strings.Length(AppStr), (HIGH(TheStr)+1-leng));
      IF leng2 > 0  THEN
        LowLevel.Move(SYSTEM.ADR(AppStr), SYSTEM.ADR(TheStr[leng]), leng2);
        INC(leng, leng2);
        IF leng <= HIGH(TheStr) THEN
          TheStr[leng] := 0C;
        END;
      END;
    END Append;

  PROCEDURE ReplaceTabs(VAR TheStr : ARRAY OF CHAR; tabInterval: CARDINAL);
    VAR
      cnt, tabspot, offsetToNextTabStop : CARDINAL;
      tabstr : ARRAY [0..15] OF CHAR;
    BEGIN
      tabspot := M2Strings.Pos(TAB, TheStr);
      WHILE (tabspot<=HIGH(TheStr)) DO
        M2Strings.Delete(TheStr, tabspot, 1);
        LowLevel.Fill( SYSTEM.ADR(tabstr), 16, BLANK );
        offsetToNextTabStop := tabInterval - (tabspot MOD tabInterval);
        tabstr[offsetToNextTabStop] := 0C;
        M2Strings.Insert(tabstr, TheStr, tabspot);
        tabspot := M2Strings.Pos(TAB, TheStr);
      END;
    END ReplaceTabs;

  PROCEDURE tabStop(thespot : CARDINAL; tabInterval: CARDINAL) : BOOLEAN;
    BEGIN
      RETURN (((thespot MOD tabInterval) = 0) AND (thespot # 0));
    END tabStop;

  PROCEDURE InsertTabs(VAR TheStr : ARRAY OF CHAR; tabInterval: CARDINAL;
      leadingOnly: BOOLEAN);
    VAR
      index, leng, spaceStrLngth, tabStrLngth : CARDINAL;
      spacestr : ARRAY [0..79] OF CHAR;
      tabstr   : ARRAY [0..15] OF CHAR;
      newstr   : ARRAY [0..255] OF CHAR;
      nonBlankFound: BOOLEAN;

    BEGIN
      (*InsertTabs*)
      ReplaceTabs(TheStr, tabInterval);
        (* We don't want to have to deal with the complication of tabs
         * already in TheStr, so we start by expanding them to blanks.
         *)
      leng := M2Strings.Length(TheStr);
      IF leng = 0 THEN
        RETURN;
      END;
      DEC(leng);
      spacestr := '';
      spaceStrLngth := 0;
      tabstr := '';
      tabStrLngth := 0;
      newstr := '';
      nonBlankFound := FALSE;

      FOR index := 0 TO leng DO
        IF NOT (leadingOnly AND nonBlankFound) THEN
          IF tabStop(index, tabInterval) AND (spaceStrLngth > 1) THEN
            Append(tabstr, TAB);
            INC(tabStrLngth);
            IF (spaceStrLngth > tabInterval) THEN
              (*  What's happened here is that we had a single space
               *  immediately preceding a tab stop before this last
               *  run of spaces.  We refused to replace it with a
               *  tab because we had only one space to replace it
               *  with.  Now, however, we see that something has to
               *  go there -- could either be a space or a tab.  We
               *  choose a tab.
               *)
              Append(tabstr, TAB);
              INC(tabStrLngth);
            END;
            spacestr := '';
            spaceStrLngth := 0;
          END;
          IF TheStr[index]=BLANK THEN
            Append(spacestr, BLANK);
            INC(spaceStrLngth);
          END;
          IF tabStrLngth > 0 THEN
            Append(newstr, tabstr);
            tabstr := '';
            tabStrLngth := 0;
          END;
          IF (spaceStrLngth > 0) AND (TheStr[index] # BLANK) THEN
            (*  We've hit a nonblank and we're not at a tabstop, so we're
             *  not going to get to replace this last sequence of blanks
             *  with a tab.
             *)
            Append(newstr, spacestr);
            spacestr := '';
            spaceStrLngth := 0;
          END;
        END;
        IF (TheStr[index] # BLANK) OR (leadingOnly AND nonBlankFound) THEN
          Append(newstr, TheStr[index]);
          nonBlankFound := TRUE;
        END;
      END;
      AssignStr(newstr, TheStr);
    END InsertTabs;

  PROCEDURE InsertTimes(Ch : CHAR; VAR TheStr : ARRAY OF CHAR; indx,
      times : CARDINAL);
    VAR
      cnt : CARDINAL;
    BEGIN
      IF times = 0 THEN RETURN END;
      LowLevel.ShiftArrayRight( SYSTEM.ADR(TheStr[indx]), (HIGH(TheStr) + 1) -
          indx, times );
      FOR cnt := 1 TO times DO
        TheStr[ indx + cnt - 1 ] := Ch;
      END;
    END InsertTimes;


  PROCEDURE InsertSubstr(str1 : ARRAY OF CHAR; start, lnth :
      CARDINAL; VAR str2 : ARRAY OF CHAR; ndx : CARDINAL);
    VAR
      tmpstr : ARRAY [0..255] OF CHAR;
    BEGIN
      M2Strings.Copy(str1, start, lnth, tmpstr);
      M2Strings.Insert(tmpstr, str2, ndx);
    END InsertSubstr;

  PROCEDURE OverWrite(obj : ARRAY OF CHAR; VAR targ : ARRAY OF
      CHAR; pos : CARDINAL);
(*Unconditionally writes obj into targ beginning at pos, and for the length of
  obj, wipes out anything that may have been in targ at that position.*)
    VAR
      max, i : CARDINAL;
    BEGIN
      max := M2Strings.Length(obj);
      IF max = 0 THEN RETURN END;
        (* bug fix submitted by Henk Hofmans, 8 Feb 87 *)
      IF (max>15) OR ((max+pos) > M2Strings.Length(targ)) THEN
      (*This test is only for optimization purposes.*)
        M2Strings.Delete(targ, pos, M2Strings.Length(obj));
        M2Strings.Insert(obj, targ, pos);
      ELSE
        FOR i := 0 TO (max-1) DO
          targ[pos+i] := obj[i];
        END;
      END;
    END OverWrite;


  PROCEDURE ReplaceStr(
      searchstr, replacstr : ARRAY OF CHAR;
      VAR TheStr : ARRAY OF CHAR);
    VAR
      spot, lngth1, lngth2 : CARDINAL;
      repeating: BOOLEAN;
    BEGIN
      lngth1 := M2Strings.Length( searchstr );
      lngth2 := M2Strings.Length( replacstr );
      spot := ScanUtils.Positn( searchstr, replacstr, 0, ScanUtils.CaseSens );
      repeating := spot > HIGH(replacstr);
        (* If repeating = FALSE, then the old string is embedded
           in the new string, and we'll get hung in an infinite
           loop if we try to replace all instances of the old
           string. *)
      spot := ScanUtils.Positn( searchstr, TheStr, 0, ScanUtils.CaseSens );
      WHILE spot<=HIGH(TheStr) DO
        M2Strings.Delete(TheStr, spot, lngth1);
        M2Strings.Insert(replacstr, TheStr, spot);
        IF repeating THEN
          spot := ScanUtils.Positn( searchstr, TheStr, 0,
              ScanUtils.CaseSens );
        ELSE
          spot := ScanUtils.Positn( searchstr, TheStr, spot + lngth2,
              ScanUtils.CaseSens );
        END;
      END;
    END ReplaceStr;


  PROCEDURE ReplaceStrInsens(
      searchstr, replacstr : ARRAY OF CHAR;
      VAR TheStr : ARRAY OF CHAR);
    VAR
      spot, lngth1, lngth2 : CARDINAL;
      repeating: BOOLEAN;
    BEGIN
      lngth1 := M2Strings.Length( searchstr );
      lngth2 := M2Strings.Length( replacstr );
      spot := ScanUtils.Positn( searchstr, replacstr, 0,
          ScanUtils.CaseInsens );
      repeating := spot > HIGH(replacstr);
        (* If repeating = FALSE, then the old string is embedded
           in the new string, and we'll get hung in an infinite
           loop if we try to replace all instances of the old
           string. *)
      spot := ScanUtils.Positn( searchstr, TheStr, 0,
          ScanUtils.CaseInsens );
      WHILE spot<=HIGH(TheStr) DO
        M2Strings.Delete(TheStr, spot, lngth1);
        M2Strings.Insert(replacstr, TheStr, spot);
        IF repeating THEN
          spot := ScanUtils.Positn( searchstr, TheStr, 0,
              ScanUtils.CaseInsens );
        ELSE
          spot := ScanUtils.Positn( searchstr, TheStr, spot + lngth2,
              ScanUtils.CaseInsens );
        END;
      END;
    END ReplaceStrInsens;


  PROCEDURE CrunchBlanks(VAR line : ARRAY OF CHAR);
    VAR
      LastNotBlank : BOOLEAN;
      LengthOfLine, ResultIndex, index, LeftOvers : CARDINAL;
    BEGIN
      ReplaceTabs(line, 8);
      LastNotBlank := FALSE;
      LengthOfLine := M2Strings.Length(line);
      IF LengthOfLine = 0 THEN
        RETURN;
      END;
      ResultIndex := 0;
      FOR index := 0 TO (LengthOfLine-1) DO
        IF line[index]<>BLANK THEN
          LastNotBlank := TRUE;
          line[ResultIndex] := line[index];
          INC(ResultIndex);
        ELSIF LastNotBlank THEN
          LastNotBlank := FALSE;
          line[ResultIndex] := line[index];
          INC(ResultIndex);
        END;
      END;
      IF (ResultIndex>0) AND (line[ResultIndex-1]=BLANK) THEN
        DEC(ResultIndex);
      END;
      LeftOvers := LengthOfLine-ResultIndex;
      IF LeftOvers>0 THEN
        M2Strings.Delete(line, ResultIndex, LeftOvers);
      END;
    END CrunchBlanks;

  PROCEDURE CutLeadingChars(TheChar : CHAR; VAR TheStr : ARRAY OF
      CHAR);
  (*deletes any TheChar's at the start of TheStr*)
    VAR
      NonMatchFound : BOOLEAN;
      ndx, StrLen : CARDINAL;
    BEGIN
      StrLen := M2Strings.Length(TheStr);
      IF StrLen=0 THEN
        RETURN;
      END;
      ndx := 0;
      IF (TheStr[ndx]=TheChar) THEN
        NonMatchFound := FALSE;
        WHILE ((ndx + 1) < StrLen) AND (NOT NonMatchFound) DO
          INC(ndx);
          NonMatchFound := TheStr[ndx]#TheChar;
        END;
        IF NOT NonMatchFound THEN
          INC(ndx);
        END;
        M2Strings.Delete(TheStr, 0, ndx);
      END;
    END CutLeadingChars;

  PROCEDURE CutTrailingChars(TheChar : CHAR; VAR TheStr : ARRAY
      OF CHAR);
  (*deletes any TheChar's at the end of TheStr*)
    VAR
      index : CARDINAL;
    BEGIN
      index := M2Strings.Length(TheStr);
      IF index > 0 THEN
        LOOP
          IF TheStr[ index - 1] = TheChar THEN
            DEC(index);
            IF index = 0 THEN
              TheStr[0] := 0C;
              RETURN;
            END;
          ELSIF index <= HIGH(TheStr) THEN
            TheStr[index] := 0C;
            RETURN;
          ELSE
            RETURN;
          END;
        END;
      END;
    END CutTrailingChars;

  PROCEDURE LowerStr(VAR TheStr : ARRAY OF CHAR);
    VAR
      pointer, leng : CARDINAL;
    CONST
      shiftdown = 32;
    BEGIN
      leng := M2Strings.Length(TheStr);
      IF leng = 0 THEN
        RETURN;
      END;
      DEC( leng);
      FOR pointer := 0 TO leng DO
        IF (TheStr[pointer]>='A') AND (TheStr[pointer]<='Z') THEN
          TheStr[pointer] := CHR( ORD(TheStr[pointer]) + shiftdown);
        END;
      END;
    END LowerStr;

  PROCEDURE CAPstr(VAR TheStr : ARRAY OF CHAR);
    VAR
      pointer, leng : CARDINAL;
    CONST
      shiftdown = 32;
    BEGIN
      leng := M2Strings.Length(TheStr);
      IF leng = 0 THEN
        RETURN;
      END;
      DEC( leng);
      FOR pointer := 0 TO leng DO
        TheStr[pointer] := CAP(TheStr[pointer]);
      END;
    END CAPstr;

  PROCEDURE DeleteChar(TheChar : CHAR; VAR x : ARRAY OF CHAR);
    VAR
      spot : CARDINAL;
    BEGIN
      spot := M2Strings.Pos(TheChar, x);
      WHILE spot<=HIGH(x) DO
        M2Strings.Delete(x, spot, 1);
        spot := M2Strings.Pos(TheChar, x);
      END;
    END DeleteChar;

  PROCEDURE SetLength( VAR TheStr : ARRAY OF CHAR; NewLength :
      CARDINAL);
    VAR
      OldLength, MaxLength: CARDINAL;
    BEGIN
      OldLength := M2Strings.Length( TheStr);
      IF NewLength # OldLength THEN
        MaxLength := HIGH(TheStr) + 1;
        IF OldLength < MaxLength THEN
          (* if a null exists that must be filled *)
          IF OldLength > 0 THEN
            TheStr[ OldLength] := TheStr[ OldLength - 1 ];
            (* the current last character in the string *)
          ELSIF MaxLength > 1 THEN
            TheStr[ OldLength] := TheStr[ 1 ];
          ELSE
            TheStr[ OldLength] := BLANK;
          END;
        END;
        IF NewLength < MaxLength THEN
          (* set the new length *)
          TheStr[ NewLength] := 0C;
        END;
      END;
    END SetLength;

  PROCEDURE RightJustify( VAR TheStr: ARRAY OF CHAR;
      RequiredLength: CARDINAL );
    VAR strlength: CARDINAL;
    BEGIN
      IF NOT ScanUtils.IsBlank( TheStr ) THEN
        CutTrailingChars( BLANK, TheStr );
      END;
      strlength := M2Strings.Length( TheStr );
      WHILE strlength > RequiredLength DO
        M2Strings.Delete( TheStr, 0, 1 );
        DEC( strlength );
      END;
      WHILE strlength < RequiredLength DO
        M2Strings.Insert( BLANK, TheStr, 0 );
        INC( strlength );
      END;
    END RightJustify;

  PROCEDURE LeftJustify( VAR TheStr: ARRAY OF CHAR;
      RequiredLength: CARDINAL );
    VAR strlength: CARDINAL;
    BEGIN
      IF NOT ScanUtils.IsBlank( TheStr ) THEN
        CutLeadingChars( BLANK, TheStr );
      END;
      strlength := M2Strings.Length( TheStr );
      IF strlength > RequiredLength THEN
        SetLength( TheStr, RequiredLength );
      ELSE
        WHILE strlength < RequiredLength DO
          Append( TheStr, BLANK );
          INC( strlength );
        END;
      END;
    END LeftJustify;


  PROCEDURE MakeCurrency( CurrencySymbol: ARRAY OF CHAR;
      VAR TheStr: ARRAY OF CHAR );
    VAR
      spot, lngth: CARDINAL;
    BEGIN
      DeleteChar( ' ', TheStr );
      IF NOT ScanUtils.Present( CurrencySymbol, TheStr,
          ScanUtils.CaseSens ) THEN
        M2Strings.Insert( CurrencySymbol, TheStr, 0 );
      END;
      lngth := M2Strings.Length(TheStr);
      IF lngth < 3 THEN
        RightJustify( TheStr, 3 );
        lngth := 3;
      END;
      IF NOT ScanUtils.PresentPos( '.', TheStr, spot,
          ScanUtils.CaseSens ) THEN
        Append( TheStr, '.' );
        INC( lngth );
      ELSIF spot < (lngth - 3) THEN
        M2Strings.Delete( TheStr, spot + 3, lngth - (spot + 3) );
        RETURN;
      END;
      WHILE (TheStr[ lngth - 3 ] # '.') AND (lngth < (HIGH(TheStr) + 1)) DO
        Append( TheStr, '0' );
        INC( lngth );
      END;
    END MakeCurrency;


  PROCEDURE Center( VAR TheStr: ARRAY OF CHAR;
      RequiredLength: CARDINAL );
    VAR
      PadLength, strlength: CARDINAL;
    BEGIN
      IF NOT ScanUtils.IsBlank( TheStr ) THEN
        CutLeadingChars( BLANK, TheStr );
        CutTrailingChars( BLANK, TheStr );
      END;
      strlength := M2Strings.Length( TheStr );
      IF strlength > RequiredLength THEN
        SetLength( TheStr, RequiredLength );
      ELSIF strlength < RequiredLength THEN
        PadLength := (RequiredLength - strlength) DIV 2;
        InsertTimes( ' ', TheStr, 0, PadLength );
        strlength := strlength + PadLength;
        PadLength := RequiredLength - strlength;
        InsertTimes( ' ', TheStr, strlength, PadLength );
      END;
    END Center;


  PROCEDURE InsertRightJustified( str1: ARRAY OF CHAR; VAR
      str2: ARRAY OF CHAR; spot: CARDINAL );

      (* Inserts str1 into str2 without changing the length of
         str2.  Deletes characters from the beginning of str2 to
         make room for str1.  Truncates str1 if necessary. *)

    VAR
      str1length, str2length: CARDINAL;
      tmpstr: ARRAY [0..255] OF CHAR;
    BEGIN
      str1length := M2Strings.Length( str1 );
      str2length := M2Strings.Length( str2 );
      IF str1length > str2length THEN
        SetLength( str1, str2length );
        str1length := str2length;
      END;
      LowLevel.Move( SYSTEM.ADR(str2), SYSTEM.ADR(tmpstr), Numbers.Min( HIGH(str2), HIGH(tmpstr)) + 1 );
        (* We assign str2 to a tmpstr to avoid complications
           associated with possible overflow of str2, and we do
           it with a Move to avoid overhead of an AssignStr. *)
      SetLength( tmpstr, str2length );
      IF spot >= str2length THEN
        (* Means insertions beyond length of str2 will be
           appended. *)
        Append( str2, str1 );
      ELSE
        M2Strings.Insert( str1, str2, spot );
      END;
      M2Strings.Delete( str2, 0, str1length );
    END InsertRightJustified;

  PROCEDURE DeleteRightJustified( VAR TheStr: ARRAY OF CHAR;
      spot, HowMany: CARDINAL );
      (* Deletes HowMany characters from TheStr beginning with
         spot, and fills in with blanks at the beginning of
         TheStr to preserve its former length. *)
    VAR
      cnt: CARDINAL;
    BEGIN
      M2Strings.Delete( TheStr, spot, HowMany );
      FOR cnt := 1 TO HowMany DO
        M2Strings.Insert( BLANK, TheStr, 0 );
      END;
    END DeleteRightJustified;


BEGIN
  Initialized := FALSE;
  Init();
END StrEdit.