' COMPRES$(0.0)  Compress Character String             12/22/1988-05/30/1997
      ' --------------------------------------------------------------------------
      ' Copyright (C) 1988-1997 by Vladimir Veytsel                  www.davar.net

      ' Type ---------------------------------------------------------------------

      '    Function

      ' Description --------------------------------------------------------------

      '    COMPRES$ function returns its first parameter with all successive
      '    occurrences of characters specified by the second parameter being
      '    compressed to the single occurrence.

      ' Declaration --------------------------------------------------------------

      '    DECLARE FUNCTION COMPRES$(Strng$,Chars$)

      ' Parameters ---------------------------------------------------------------

      '    Strng$  - Character string to be compressed
      '    Chars$  - Characters, all successive occurrences of which
      '              should to be compressed to single occurrence

      ' Value --------------------------------------------------------------------

      '    Character string compressed as specified by Chars$ parameter

      ' Note ---------------------------------------------------------------------

      '    Empty Chars$ parameter specifies compression of ALL successive
      '    duplicate characters of the string.

      ' Examples -----------------------------------------------------------------

      '    COMPRES$(""      ,""   )=""
      '    COMPRES$("ABBCCC",""   )="ABC"
      '    COMPRES$("ABBCCC","A"  )="ABBCCC"
      '    COMPRES$("ABBCCC","B"  )="ABCCC"
      '    COMPRES$("ABBCCC","C"  )="ABBC"
      '    COMPRES$("ABBCCC","ABC")="ABC"

      ' Start Function -----------------------------------------------------------

           DEFINT A-Z  ' All defaulted variables are integer

           FUNCTION COMPRES$(Strng$,Chars$) PUBLIC

      ' Check Special Case (Compression Is Impossible) ---------------------------

           IF (LEN(Strng$)<2) THEN
              COMPRES$=Strng$
              EXIT FUNCTION
           END IF

      ' Form Compressed String (with the Exception of Last Symbol) ---------------

           Chars.Lngth=LEN(Chars$)
           FOR I=1 TO LEN(Strng$)-1
               Curr.Str.Symb$=MID$(Strng$,I  ,1)
               Next.Str.Symb$=MID$(Strng$,I+1,1)
               IF (( Curr.Str.Symb$<>Next.Str.Symb$)OR  _
                   ((Curr.Str.Symb$= Next.Str.Symb$)AND _
                    (Chars.Lngth>0)                 AND _
                    (INSTR(Chars$,Curr.Str.Symb$)=0))) THEN
                  Work.Str$=Work.Str$+Curr.Str.Symb$
               END IF
           NEXT I

      ' Return Function Value to the Point of Invocation -------------------------

           COMPRES$=Work.Str$+RIGHT$(Strng$,1)

      ' Finish Function ----------------------------------------------------------

           END FUNCTION
  

      ' COMPRES$(0.0)  Compress Character String             05/29/1997-05/30/1997
      ' --------------------------------------------------------------------------

        $INCLUDE "COMPRES"

        DECLARE FUNCTION COMPRES$(Strng$,Chars$)

        CLS
        PRINT "COMPRES$(0.0)  Compress Character String  ";DATE$;
        PRINT "  ";LEFT$(TIME$,5)
        PRINT STRING$(59,"-")
        PRINT

        PRINT "COMPRES$(''      ,''   )='"; _
               COMPRES$(""      ,""   ); "'"
        PRINT "COMPRES$('ABBCCC',''   )='"; _
               COMPRES$("ABBCCC",""   ); "'"
        PRINT "COMPRES$('ABBCCC','A'  )='"; _
               COMPRES$("ABBCCC","A"  ); "'"
        PRINT "COMPRES$('ABBCCC','B'  )='"; _
               COMPRES$("ABBCCC","B"  ); "'"
        PRINT "COMPRES$('ABBCCC','C'  )='"; _
               COMPRES$("ABBCCC","C"  ); "'"
        PRINT "COMPRES$('ABBCCC','ABC')='"; _
               COMPRES$("ABBCCC","ABC"); "'"

        PRINT
        PRINT "Execution completed - hit [Enter] to continue..."