home *** CD-ROM | disk | FTP | other *** search
/ Programmer Power Tools / Programmer Power Tools.iso / microcrn / issue_48.arc / RLEDCOMP.ARC / RLEDCOMP.MOD < prev    next >
Encoding:
Modula Implementation  |  1989-05-19  |  3.4 KB  |  133 lines
  1. IMPLEMENTATION MODULE RleDComp;
  2.  
  3. (*
  4.    Michael S. Hunt   April 4, 1989
  5.    released into the public domain
  6.  
  7.    Support code from Micro Cornucopia Magazine Issue #48
  8.  
  9.    Micro Cornucopia
  10.    PO Box 223
  11.    Bend, OR 97709
  12.  
  13. *)
  14.  
  15. IMPORT FileSystem;
  16.  
  17. TYPE    ShortCard = [0..255];
  18.  
  19. PROCEDURE RleCompBuff (src : ARRAY OF CHAR;
  20.               VAR dest : ARRAY OF CHAR;
  21.                       repeatCode : CHAR;
  22.               srcSize : CARDINAL;
  23.                       VAR destSize : CARDINAL);
  24. VAR     k, sPos, dPos : CARDINAL;
  25.     repeatCount : ShortCard;
  26. BEGIN
  27.   repeatCount := 1;
  28.   sPos := 0;
  29.   dPos := 2;
  30.   dest[0] := repeatCode;
  31.   REPEAT
  32.     sPos := sPos + 1;
  33.     IF (sPos < srcSize) AND (src[sPos] = src[sPos+1] )
  34.                     AND (ORD(repeatCount) < 255) THEN
  35.       INC(repeatCount)
  36.     ELSE
  37.       IF repeatCount > 3 THEN
  38.         dest[dPos] := repeatCode;
  39.         dest[dPos+1] := src[sPos];
  40.         dest[dPos+2] := CHR(repeatCount);
  41.         INC(dPos,3);
  42.         repeatCount := 1
  43.       ELSE
  44.         FOR k := 1 TO repeatCount DO
  45.           dest[dPos+k-1] := src[sPos]
  46.     END;  
  47.         INC(dPos, repeatCount);
  48.         repeatCount := 1
  49.       END
  50.     END
  51.   UNTIL sPos = srcSize;
  52.   destSize := dPos - 1
  53. END RleCompBuff;
  54.  
  55. PROCEDURE RleDecompBuff (src : ARRAY OF CHAR;
  56.             srcSize : CARDINAL;
  57.             VAR dest : ARRAY OF CHAR);
  58. VAR   dPos, sPos : CARDINAL;
  59.       j : ShortCard;
  60. BEGIN
  61.   sPos := 2;
  62.   dPos :=1;
  63.   WHILE sPos <= srcSize DO
  64.     IF src[sPos] = src[1] THEN
  65.       FOR j := 1 TO ORD(src[sPos+2]) DO
  66.         dest[dPos+j-1] := src[sPos+1]
  67.       END;
  68.       dPos := dPos + ORD(src[sPos+2]);
  69.       INC(sPos, 3)
  70.     ELSE
  71.       dest[dPos] := src[sPos];
  72.       INC(dPos);
  73.       INC(sPos)
  74.     END
  75.   END
  76. END RleDecompBuff;
  77.  
  78. PROCEDURE RleCompFile (VAR sFil, dFil : FileSystem.File; repeatCode : CHAR);
  79. VAR       k, repeatCount : ShortCard;
  80.     curByte, repeatByte, nextByte : CHAR;
  81. BEGIN
  82.   repeatCount := 1;
  83.   FileSystem.ReadBlock (sFil, curByte);
  84.   IF sFil.count > 0 THEN
  85.     FileSystem.WriteBlock (dFil, repeatCode);
  86.     REPEAT
  87.       FileSystem.ReadBlock (sFil, nextByte);
  88.       IF (curByte = nextByte) AND (ORD(repeatCount) < 255)
  89.                               AND (sFil.count = 1) THEN
  90.         INC(repeatCount);
  91.       ELSE
  92.         IF repeatCount > 3 THEN
  93.             FileSystem.WriteBlock(dFil, repeatCode);
  94.             FileSystem.WriteBlock(dFil, curByte);
  95.             FileSystem.WriteBlock(dFil, repeatCount);
  96.             repeatCount := 1
  97.         ELSE
  98.           FOR k := 1 TO repeatCount DO
  99.             FileSystem.WriteBlock(dFil, curByte)
  100.           END;  
  101.           repeatCount := 1
  102.         END
  103.       END;
  104.       curByte := nextByte
  105.     UNTIL sFil.count = 0
  106.   END
  107. END RleCompFile;
  108.  
  109. PROCEDURE RleDecompFile (VAR sFil, dFil: FileSystem.File);
  110. VAR    repeatCount, i : ShortCard;
  111.     repeatByte, repeatCode, curByte : CHAR;
  112. BEGIN
  113.   FileSystem.ReadBlock (sFil, repeatCode);
  114.   IF sFil.count > 0 THEN
  115.     FileSystem.ReadBlock (sFil, curByte);
  116.     WHILE sFil.count > 0 DO
  117.       IF curByte = repeatCode THEN
  118.         FileSystem.ReadBlock (sFil, repeatByte);
  119.         FileSystem.ReadBlock (sFil, repeatCount);
  120.         FOR i := 1 TO repeatCount DO
  121.           FileSystem.WriteBlock(dFil, repeatByte)
  122.         END
  123.       ELSE
  124.         FileSystem.WriteBlock(dFil, curByte)
  125.       END;
  126.       FileSystem.ReadBlock(sFil, curByte);
  127.     END
  128.   END
  129. END RleDecompFile;
  130.  
  131. BEGIN
  132. END RleDComp.
  133.