'Program : RLE File Compress & decompress
'Programer : FARZAD BADILI (FDB@bigfoot.com)
'http://www.inernettrash.com/users/fdb/
'Last Change : 1376\1\6

DECLARE SUB rlecomp (fln1$, fln2$)
DECLARE SUB rledecomp (fln1$, fln2$)
 DEFINT A-Z
 CLS

 LINE INPUT " Enter Surce File Spec.: "; fln1$
  LINE INPUT " Enter Target File Spec.: "; fln2$

 IF RTRIM$(fln1$) = "" OR RTRIM$(fln2$) = "" THEN PRINT "File Name Error": BEEP: END

 PRINT
  LINE INPUT " Enter your choice (C :compress - D :decompress):"; ans$

 IF UCASE$(ans$) = "C" THEN GOSUB part1 ELSE GOSUB part2
  SOUND 1000, 1: SOUND 500, 1: SOUND 1000, 1
   PRINT
    PRINT " All Done "
     END

part1:
REM ****************************** compress *********************************

  CALL rlecomp(fln1$, fln2$)     'This part will compress the file
                                 'fln1$ ---> fln2$
  RETURN

part2:
REM ***************************** decompress ********************************

  CALL rledecomp(fln1$, fln2$)  'This part will decompress the file
                                'fln1$ ---> fln2$
  RETURN

SUB rlecomp (fln1$, fln2$)

   OPEN fln1$ FOR BINARY AS #1
    OPEN fln2$ FOR BINARY AS #2
     size# = LOF(1)
REM ****************************** compress *********************************
     n# = 0
      t = 1
       sn# = 0

start:

  n# = n# + 1
   SEEK #1, n#
    a$ = INPUT$(1, #1)
     b$ = INPUT$(1, #1)
      c$ = INPUT$(1, #1)

 IF n# > size# THEN CLOSE #1, #2: EXIT SUB

REM *************************************************************************

 IF a$ = b$ THEN
   t = t + 1
    IF t = 129 THEN
      e$ = CHR$((t - 2) OR 128) + a$
       PUT #2, , e$
        t = 1
    END IF
       move = 1
 END IF

 IF move = 1 THEN move = 0: GOTO start

REM *************************************************************************

 IF a$ <> b$ THEN

   IF t = 1 THEN
     IF b$ = c$ THEN
       e$ = CHR$(t - 1) + a$
        PUT #2, , e$
     ELSE
         t = t + 1: sn# = n#:   move = 1
     END IF
   END IF

   IF move = 1 THEN move = 0: GOTO start
REM *************************************************************************
   IF t > 1 THEN

     IF sn# > 0 THEN

       IF b$ = c$ THEN
         e$ = CHR$(t - 1)
          PUT #2, , e$
           FOR count# = sn# TO n#
              SEEK #1, count#
               a$ = INPUT$(1, #1)
                PUT #2, , a$
           NEXT
               t = 1: sn# = 0
     ELSE
        t = t + 1

         IF t = 129 THEN
           e$ = CHR$(t - 2)
            PUT #2, , e$
             FOR count# = sn# TO n#
                SEEK #1, count#
                 a$ = INPUT$(1, #1)
                  PUT #2, , a$
             NEXT
                t = 1: sn# = 0

         END IF
    END IF

    ELSE
        SEEK #1, n#
         a$ = INPUT$(1, #1)
          e$ = CHR$((t - 1) OR 128) + a$
           PUT #2, , e$
            t = 1
    END IF
   END IF

 END IF

  GOTO start

END SUB

SUB rledecomp (fln1$, fln2$)

REM ***************************** decompress ********************************
 n# = 1
  OPEN fln1$ FOR BINARY AS #1
   OPEN fln2$ FOR BINARY AS #2
    size# = LOF(1)

start2:

 SEEK #1, n#
  a$ = INPUT$(1, #1)

 IF n# > size# THEN GOTO ep

 IF ((ASC(a$)) AND 128) = 0 THEN
   lg = ASC(a$)
    FOR t = 1 TO lg + 1
     SEEK #1, n# + t
      a$ = INPUT$(1, #1)
     PUT #2, , a$
    NEXT
        n# = n# + 2 + lg

 ELSE
  SEEK #1, n#
   a$ = INPUT$(1, #1)
    b$ = INPUT$(1, #1)
  FOR t = 1 TO ASC(a$) - 127
     PUT #2, , b$
  NEXT
      n# = n# + 2

 END IF

GOTO start2

ep:

 CLOSE #1, #2

END SUB