home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 15 / CDACTUAL15.iso / cdactual / program / pascal / LZRW.ZIP / COMPRESS.PAS next >
Encoding:
Pascal/Delphi Source File  |  1992-01-19  |  12.6 KB  |  351 lines
  1. {    ###################################################################    }
  2. {    ##                                                    ##    }
  3. {    ##       ##    ##### #####  ##   ##  ##      ## ##  ## ##  ##    ##    }
  4. {    ##       ##      ### ##  ## ## # ## ###     ##  ## ##  ##  ##    ##    }
  5. {    ##       ##     ###  #####  #######  ##    ##   ####   ######    ##    }
  6. {    ##       ##    ###   ##  ## ### ###  ##   ##    ## ##  ##  ##    ##    }
  7. {    ##       ##### ##### ##  ## ##   ## #### ##     ##  ## ##  ##    ##    }
  8. {    ##                                                    ##    }
  9. {    ##    EXTREMELY FAST AND EASY TO UNDERSTAND COMPRESSION ALGORITM    ##    }
  10. {    ##                                                    ##    }
  11. {    ###################################################################    }
  12. {    ##                                                    ##    }
  13. {    ##    In an earlier posting I've already presented a 680x0        ##    }
  14. {    ##    assembler routine to implement optimized LZRW1 compression.    ##    }
  15. {    ##    I've chosen then name LZRW1/KH for this optimized            ##    }
  16. {    ##    algoritm, to distinguish it from the original one.  The    ##    }
  17. {    ##    changes can be found in the maximum length for a match,    ##    }
  18. {    ##    which is 16 in the original algoritm, but 18 in the        ##    }
  19. {    ##    optimized one.  This is not a big change, but nevertheless    ##    }
  20. {    ##    it can increase the compression by 1/8.  Another thing        ##    }
  21. {    ##    I've tried to do is to make this program easy to            ##    }
  22. {    ##    understand.  Although I have some knowledge of C, I always    ##    }
  23. {    ##    find it difficult to understand someone else his programs.    ##    }
  24. {    ##    Especially if they depend on the SHORT CIRCUIT BOOLEAN        ##    }
  25. {    ##    evaluation of C : Test || Test || Test will only be         ##    }
  26. {    ##    executed fully if Test was TRUE the first three times ...    ##    }
  27. {    ##    Took me awhile to figure it out, although it seems quite    ##    }
  28. {    ##    natural now ... Enough of this, let's see some code ...    ##    }
  29. {    ##                                                    ##    }
  30. {    ##    Sorry, no list of people to thank this time ... It hasn't    ##    }
  31. {    ##    changed since my last posting.                        ##    }
  32. {    ##                                        Kurt Haenen    ##    }
  33. {    ##                                                    ##    }
  34. {    ###################################################################    }
  35.  
  36. PROGRAM    CompressionDemo(input,output);
  37.  
  38. CONST    BufferMaxSize    = 32768;
  39.         BufferMax        = BufferMaxSize-1;
  40.         FLAG_Copied    = $F0;
  41.         FLAG_Compress    = $0F;
  42.  
  43. TYPE    BufferIndex    = 0..BufferMax;
  44.     BufferSize    = 0..BufferMaxSize;
  45.     BufferArray    = ARRAY [BufferIndex] OF BYTE;
  46.     BufferPtr        = ^BufferArray;
  47.     HashTable        = ARRAY [0..4095] OF INTEGER;
  48.  
  49. FUNCTION    GetMatch        (    Source        : BufferPtr;
  50.                         X            : BufferIndex;
  51.                      VAR    Hash            : HashTable;
  52.                      VAR    Size            : BYTE;
  53.                      VAR    Pos            : BufferIndex    )    : BOOLEAN;
  54. VAR    HashValue        : WORD;
  55. BEGIN
  56.     HashValue := (40543*((((Source^[X] SHL 4) XOR Source^[X+1]) SHL 4) XOR Source^[X+2]) SHR 4) AND $0FFF;
  57.     GetMatch := FALSE;
  58.     IF (Hash[HashValue] <> -1) THEN
  59.         BEGIN
  60.             Pos := Hash[HashValue];
  61.             Size := 0;
  62.             WHILE ((Size < 18) AND (Source^[X+Size] = Source^[Pos+Size])) DO
  63.                 INC(Size);
  64.             IF (Size >= 3) THEN
  65.                 GetMatch := (X-Pos < 4096);
  66.         END;
  67.     Hash[HashValue] := X
  68. END;
  69.  
  70.  
  71. FUNCTION    Compression    (    Source,Dest    : BufferPtr;
  72.                         SourceSize    : BufferSize    )    : BufferSize;
  73. VAR    Hash                    : HashTable;
  74.     Key,Bit,Command        : WORD;
  75.     Size                    : BYTE;
  76.     X,Y,Z,Pos                : BufferIndex;
  77. BEGIN
  78.     FOR Key := 0 TO 4095 DO Hash[Key] := -1;
  79.     Dest^[0] := FLAG_Compress;
  80.     X := 0;
  81.     Y := 3;
  82.     Z := 1;
  83.     Bit := 0;
  84.     Command := 0;
  85.     WHILE (X < SourceSize) AND (Y <= SourceSize) DO
  86.         BEGIN
  87.             IF (Bit > 15) THEN
  88.                 BEGIN
  89.                     Dest^[Z] := HI(Command);
  90.                     Dest^[Z+1] := LO(Command);
  91.                     Z := Y;
  92.                     Bit := 0;
  93.                     INC(Y,2)
  94.                 END;
  95.             IF (GetMatch(Source,X,Hash,Size,Pos))
  96.                 THEN    BEGIN
  97.                         Key := ((X-Pos) SHL 4) + (Size-3);
  98.                         Dest^[Y] := HI(Key);
  99.                         Dest^[Y+1] := LO(Key);
  100.                         INC(Y,2);
  101.                         INC(X,Size);
  102.                         Command := (Command SHL 1) + 1
  103.                     END
  104.                 ELSE    BEGIN
  105.                         Dest^[Y] := Source^[X];
  106.                         INC(Y);
  107.                         INC(X);
  108.                         Command := Command SHL 1
  109.                     END;
  110.             INC(Bit);
  111.         END;
  112.      Command := Command SHL (16-Bit);
  113.      Dest^[Z] := HI(Command);
  114.      Dest^[Z+1] := LO(Command);
  115.     IF (Y > SourceSize) THEN
  116.         BEGIN
  117.             MOVE(Source^[0],Dest^[1],SourceSize);
  118.             Dest^[0] := FLAG_Copied;
  119.             Y := SUCC(SourceSize)
  120.         END;
  121.     Compression := Y
  122. END;
  123.  
  124. FUNCTION    Decompression    (    Source,Dest    : BufferPtr;
  125.                         SourceSize    : BufferSize    )    : BufferSize;
  126. VAR    X,Y,Pos                : BufferIndex;
  127.     Command                : WORD;
  128.     Bit,Size,K            : BYTE;
  129. BEGIN
  130.     IF (Source^[0] = FLAG_Copied)
  131.         THEN    FOR Y := 1 TO PRED(SourceSize) DO
  132.                 Dest^[PRED(Y)] := Source^[Y]
  133.         ELSE    BEGIN
  134.                 Y := 0;
  135.                 X := 3;
  136.                 Command := (Source^[1] SHL 8)+Source^[2];
  137.                 Bit := 16;
  138.                 WHILE (X < SourceSize) DO
  139.                     BEGIN
  140.                         IF (Bit = 0) THEN
  141.                             BEGIN
  142.                                 Command := (Source^[X] SHL 8)+Source^[X+1];
  143.                                 Bit := 16;
  144.                                 INC(X,2)
  145.                             END;
  146.                         IF ((Command AND $8000) = 0)
  147.                             THEN    BEGIN
  148.                                     Dest^[Y] := Source^[X];
  149.                                     INC(X);
  150.                                     INC(Y)
  151.                                 END
  152.                             ELSE    BEGIN
  153.                                     Size := (Source^[X+1] AND $0F)+2;
  154.                                     Pos := Y-((Source^[X] SHL 4)+(Source^[X+1] SHR 4));
  155.                                     FOR K := 0 TO Size DO
  156.                                         Dest^[Y+K] := Dest^[Pos+K];
  157.                                     INC(X,2);
  158.                                     INC(Y,Size+1)
  159.                                 END;
  160.                         Command := Command SHL 1;
  161.                         DEC(Bit)
  162.                     END
  163.             END;
  164.     Decompression := Y
  165. END;
  166.  
  167. CONST    CompIdentifier    : LONGINT        = (((((((ORD('L') SHL 8)+ORD('Z')) SHL 8)+ORD('R')) SHL 8)+ORD('W')) SHL 8);
  168.  
  169. VAR    SRCFP,DSTFP        : FILE;
  170.     SRCBuf,DSTBuf        : ARRAY [0..16390] OF BYTE;
  171.      SRCSize,DSTSize    : WORD;
  172.      Tmp                : WORD;
  173.      Identifier        : LONGINT;
  174.     InSize,OutSize        : LONGINT;
  175.  
  176. BEGIN
  177.     IF ((PARAMCOUNT <> 2) AND ((PARAMCOUNT <> 3) OR (PARAMSTR(1) <> '-D'))) THEN
  178.          BEGIN
  179.               WRITELN;
  180.                WRITELN('USAGE : COMPRESS [-D] <Source File> <Dest File>');
  181.                WRITELN('        (The -D option is case sensitive !)');
  182.                WRITELN;
  183.                HALT
  184.           END;
  185.      IF (PARAMCOUNT = 2)
  186.          THEN    BEGIN
  187.                  WRITELN('TRYING TO COMPRESS ',PARAMSTR(1),' TO ',PARAMSTR(2),'.');
  188.                 ASSIGN(SRCFP,PARAMSTR(1));
  189.                  ASSIGN(DSTFP,PARAMSTR(2));
  190.                  RESET(SRCFP,1);
  191.                  IF (IOResult <> 0) THEN
  192.                      BEGIN
  193.                              WRITELN;
  194.                           WRITELN('FILE ',PARAMSTR(1),' NOT FOUND !');
  195.                            WRITELN;
  196.                            HALT
  197.                       END;
  198.                  REWRITE(DSTFP,1);
  199.                  IF (IOResult <> 0) THEN
  200.                      BEGIN
  201.                           CLOSE(SRCFP);
  202.                           WRITELN;
  203.                            WRITELN('FILE ',PARAMSTR(2),' COULD NOT BE OPENED !');
  204.                            WRITELN;
  205.                            HALT
  206.                       END;
  207.                     BLOCKWRITE(DSTFP,CompIdentifier,SIZEOF(LONGINT),Tmp);
  208.                     IF (Tmp <> SIZEOF(LONGINT)) THEN
  209.                         BEGIN
  210.                              CLOSE(SRCFP);
  211.                               CLOSE(DSTFP);
  212.                               ERASE(DSTFP);
  213.                               WRITELN;
  214.                               WRITELN('ERROR WRITING TO ',PARAMSTR(2),' !');
  215.                               WRITELN;
  216.                               HALT
  217.                          END;
  218.                     SRCSize := 16384;
  219.                     InSize := 0;
  220.                     OutSize := 0;
  221.                  WHILE (SRCSize = 16384) DO
  222.                      BEGIN
  223.                              BLOCKREAD(SRCFP,SRCBuf[0],16384,SRCSize);
  224.                               INC(InSize,SRCSize);
  225.                               WRITE('READ : ',InSize,'  WRITTEN : ',OutSize,#13);
  226.                               DSTSize := Compression(ADDR(SRCBuf[0]),ADDR(DstBuf[0]),SRCSize);
  227.                               BLOCKWRITE(DSTFP,DSTSize,SIZEOF(WORD),Tmp);
  228.                               INC(OutSize,Tmp);
  229.                               WRITE('READ : ',InSize,'  WRITTEN : ',OutSize,#13);
  230.                               IF (Tmp <> SIZEOF(WORD)) THEN
  231.                                 BEGIN
  232.                                      CLOSE(SRCFP);
  233.                                       CLOSE(DSTFP);
  234.                                       ERASE(DSTFP);
  235.                                       WRITELN;
  236.                                       WRITELN('ERROR WRITING TO ',PARAMSTR(2),' !');
  237.                                       WRITELN;
  238.                                       HALT
  239.                                  END;
  240.                               BLOCKWRITE(DSTFP,DSTBuf[0],DSTSize,Tmp);
  241.                               INC(OutSize,Tmp+SIZEOF(WORD));
  242.                               WRITE('READ : ',InSize,'  WRITTEN : ',OutSize,#13);
  243.                               IF (Tmp <> DSTSize) THEN
  244.                                 BEGIN
  245.                                      CLOSE(SRCFP);
  246.                                       CLOSE(DSTFP);
  247.                                       ERASE(DSTFP);
  248.                                       WRITELN;
  249.                                       WRITELN('ERROR WRITING TO ',PARAMSTR(2),' !');
  250.                                       WRITELN;
  251.                                       HALT
  252.                                  END;
  253.                       END;
  254.                     WRITELN;
  255.                     WRITELN('FILE SUCCESFULLY COMPRESSED !');
  256.                     CLOSE(SRCFP);
  257.                     CLOSE(DSTFP)
  258.               END
  259.           ELSE    BEGIN
  260.                   WRITELN('TRYING TO DECOMPRESS ',PARAMSTR(2),' TO ',PARAMSTR(3),'.');
  261.                     ASSIGN(SRCFP,PARAMSTR(2));
  262.                     ASSIGN(DSTFP,PARAMSTR(3));
  263.                     RESET(SRCFP,1);
  264.                     IF (IOResult <> 0) THEN
  265.                         BEGIN
  266.                              WRITELN;
  267.                               WRITELN('FILE ',PARAMSTR(2),' NOT FOUND !');
  268.                               WRITELN;
  269.                               HALT
  270.                          END;
  271.                     REWRITE(DSTFP,1);
  272.                     IF (IOResult <> 0) THEN
  273.                         BEGIN
  274.                              CLOSE(SRCFP);
  275.                               WRITELN;
  276.                               WRITELN('FILE ',PARAMSTR(3),' COULD NOT BE OPENED !');
  277.                               WRITELN;
  278.                               HALT
  279.                          END;
  280.                     BLOCKREAD(SRCFP,Identifier,SIZEOF(LONGINT),Tmp);
  281.                     IF (Tmp <> SIZEOF(LONGINT)) THEN
  282.                         BEGIN
  283.                              CLOSE(SRCFP);
  284.                               CLOSE(DSTFP);
  285.                               ERASE(DSTFP);
  286.                               WRITELN;
  287.                               WRITELN('ERROR READING FROM ',PARAMSTR(2),' !');
  288.                               WRITELN;
  289.                               HALT
  290.                          END;
  291.                     IF (Identifier <> CompIdentifier) THEN
  292.                         BEGIN
  293.                              CLOSE(SRCFP);
  294.                               CLOSE(DSTFP);
  295.                               ERASE(DSTFP);
  296.                               WRITELN;
  297.                               WRITELN('FILE ',PARAMSTR(2),' IS NOT A COMPRESSED FILE !');
  298.                               WRITELN;
  299.                               HALT
  300.                          END;
  301.                     DSTSize := 16384;
  302.                     InSize := 0;
  303.                     OutSize := 0;
  304.                  WHILE (DSTSize = 16384) DO
  305.                      BEGIN
  306.                              BLOCKREAD(SRCFP,SRCSize,SIZEOF(WORD),Tmp);
  307.                               IF (Tmp <> SIZEOF(WORD)) THEN
  308.                                 BEGIN
  309.                                      CLOSE(SRCFP);
  310.                                       CLOSE(DSTFP);
  311.                                       ERASE(DSTFP);
  312.                                       WRITELN;
  313.                                       WRITELN('ERROR READING FROM ',PARAMSTR(2),' !');
  314.                                       WRITELN;
  315.                                       HALT
  316.                                  END;
  317.                              BLOCKREAD(SRCFP,SRCBuf[0],SRCSize,Tmp);
  318.                               INC(InSize,Tmp+SIZEOF(WORD));
  319.                               WRITE('READ : ',InSize,'  WRITTEN : ',OutSize,#13);
  320.                               IF (Tmp <> SRCSize) THEN
  321.                                 BEGIN
  322.                                      CLOSE(SRCFP);
  323.                                       CLOSE(DSTFP);
  324.                                       ERASE(DSTFP);
  325.                                       WRITELN;
  326.                                       WRITELN('ERROR READING FROM ',PARAMSTR(2),' !');
  327.                                       WRITELN;
  328.                                       HALT
  329.                                  END;
  330.                               DSTSize := Decompression(ADDR(SRCBuf[0]),ADDR(DstBuf[0]),SRCSize);
  331.                               BLOCKWRITE(DSTFP,DSTBuf[0],DSTSize,Tmp);
  332.                               INC(OutSize,Tmp);
  333.                               WRITE('READ : ',InSize,'  WRITTEN : ',OutSize,#13);
  334.                               IF (Tmp <> DSTSize) THEN
  335.                                 BEGIN
  336.                                      CLOSE(SRCFP);
  337.                                       CLOSE(DSTFP);
  338.                                       ERASE(DSTFP);
  339.                                       WRITELN;
  340.                                       WRITELN('ERROR WRITING TO ',PARAMSTR(3),' !');
  341.                                       WRITELN;
  342.                                       HALT
  343.                                  END;
  344.                       END;
  345.                     WRITELN;
  346.                     WRITELN('FILE SUCCESFULLY DECOMPRESSED !');
  347.                     CLOSE(SRCFP);
  348.                     CLOSE(DSTFP)
  349.               END
  350. END.
  351.