home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 15 / CDACTUAL15.iso / cdactual / program / basic / QB_RLE.ZIP / RLE.BAS next >
Encoding:
BASIC Source File  |  1991-03-07  |  2.2 KB  |  61 lines
  1. '************************************************************
  2. '*      Program Name    RLE.BAS                             *
  3. '*      Author          Kenneth G. White                    *
  4. '*      Date            9/3/90                              *
  5. '*      Language        QuickBasic 4.x / PDS 7.x            *
  6. '*      Purpose         RLE Data Compression Functions      *
  7. '************************************************************
  8. DECLARE FUNCTION compr$ (source$)
  9. DECLARE FUNCTION uncompr$ (source$)
  10. DEFINT A-Z
  11.  
  12. END
  13.  
  14. FUNCTION compr$ (source$)
  15.  
  16. slen = LEN(source$)
  17. size$ = CHR$(slen \ 255)
  18. size$ = size$ + CHR$(slen MOD 255)  'uncompressed buffer length
  19.  
  20. IF slen < 2 THEN
  21.    compr$ = size$ + source$ 'if input 1-2 chars process and bail out
  22.    EXIT FUNCTION
  23. END IF
  24.  
  25. tcomp$ = size$ + SPACE$(slen * 2)  'set buffer length for worst case
  26. count = 1                          'sequential char count
  27. cspot = 1                          'input string read position
  28. ncspot = 3                         'location of first buffer write
  29. newchr = ASC(MID$(source$, cspot, 1)) 'get starting character
  30. cspot = cspot + 1
  31.  
  32. DO
  33.    DO
  34.       nxtchr = ASC(MID$(source$, cspot, 1)) 'next char for comparison
  35.       IF nxtchr = newchr THEN
  36.          count = count + 1
  37.          cspot = cspot + 1 'loop until char transition, end of input
  38.       END IF               'or sequential char count of 255
  39.    LOOP UNTIL nxtchr <> newchr OR cspot > slen OR count = 255
  40.    SELECT CASE count
  41.    CASE 1, 2                  'not enough chars to compress
  42.       IF newchr <> 2 THEN
  43.          MID$(tcomp$, ncspot, count) = STRING$(count, newchr)
  44.          ncspot = ncspot + count
  45.       ELSE            'process compression marker char as special case
  46.          MID$(tcomp$, ncspot, 3) = CHR$(2)+CHR$(count)+CHR$(newchr)
  47.          ncspot = ncspot + 3
  48.       END IF
  49.    CASE IS > 2             'encode sequential chars
  50.       MID$(tcomp$, ncspot, 3) = CHR$(2) + CHR$(count) + CHR$(newchr)
  51.       ncspot = ncspot + 3
  52.    CASE ELSE               'don't process if char count = 0
  53.    END SELECT
  54.    count = 0
  55.    newchr = nxtchr         'set up new comparison char
  56. LOOP UNTIL cspot > slen
  57.  
  58. compr$ = LEFT$(tcomp$, ncspot - 1)
  59. END FUNCTION
  60.  
  61.