home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / Pascal / Snippets / PNL Libraries / lzrw1kh.p < prev    next >
Encoding:
Text File  |  1996-06-01  |  5.8 KB  |  192 lines  |  [TEXT/CWIE]
  1.  
  2. {    ###################################################################   }
  3. {    ##                                                               ##   }
  4. {    ##      ##    ##### #####  ##   ##  ##      ## ##  ## ##  ##     ##   }
  5. {    ##      ##      ### ##  ## ## # ## ###     ##  ## ##  ##  ##     ##   }
  6. {    ##      ##     ###  #####  #######  ##    ##   ####   ######     ##   }
  7. {    ##      ##    ###   ##  ## ### ###  ##   ##    ## ##  ##  ##     ##   }
  8. {    ##      ##### ##### ##  ## ##   ## #### ##     ##  ## ##  ##     ##   }
  9. {    ##                                                               ##   }
  10. {    ##   EXTREMELY FAST AND EASY TO UNDERSTAND COMPRESSION ALGORITM  ##   }
  11. {    ##                                                               ##   }
  12. {    ###################################################################   }
  13. {    ##                                                               ##   }
  14. {    ##   This unit implements the updated LZRW1/KH algoritm which    ##   }
  15. {    ##   also implements  some RLE coding  which is usefull  when    ##   }
  16. {    ##   compress files  containing  a lot  of consecutive  bytes    ##   }
  17. {    ##   having the same value.   The algoritm is not as good  as    ##   }
  18. {    ##   LZH, but can compete with Lempel-Ziff.   It's the fasted    ##   }
  19. {    ##   one I've encountered upto now.                              ##   }
  20. {    ##                                                               ##   }
  21. {    ##                                                               ##   }
  22. {    ##                                                               ##   }
  23. {    ##                                                Kurt HAENEN    ##   }
  24. {    ##                                                               ##   }
  25. {    ###################################################################   }
  26.  
  27. unit LZRW1KH;
  28.  
  29. interface
  30.  
  31. {$IFC undefined THINK_Pascal}
  32.     uses
  33.         Types;
  34. {$ENDC}
  35.  
  36.     const
  37.         BufferMaxSize = 32768;
  38.         BufferMax = BufferMaxSize - 1;
  39.         FLAG_Copied = $80;
  40.         FLAG_Compress = $40;
  41.  
  42.     type
  43.         BufferIndex = 0..BufferMax;
  44.         BufferSize = 0..BufferMaxSize;
  45.         BufferArray = packed array[BufferIndex] of BYTE;
  46.         BufferPtr = ^BufferArray;
  47.  
  48.     function LZRW1KHCompress (Source, Dest: BufferPtr; SourceSize: BufferSize): BufferSize;
  49.     function LZRW1KHDecompress (Source, Dest: BufferPtr; SourceSize: BufferSize): BufferSize;
  50.  
  51. implementation
  52.  
  53. {$IFC undefined THINK_Pascal}
  54.     uses
  55.         Memory;
  56. {$ENDC}
  57.  
  58.     type
  59.         HashTable = array[0..4095] of INTEGER;
  60.         WORD = longint;
  61.  
  62.     function LZRW1KHCompress (Source, Dest: BufferPtr; SourceSize: BufferSize): BufferSize;
  63.         var
  64.             Hash: HashTable;
  65.  
  66.         function GetMatch (X: BufferIndex; var Size: WORD; var Pos: BufferIndex): BOOLEAN;
  67.             var
  68.                 HashValue: WORD;
  69.         begin
  70.             HashValue := BAND(BSR(40543 * BXOR(BSL(BXOR(BSL(Source^[X], 4), Source^[X + 1]), 4), Source^[X + 2]), 4), $0FFF);
  71.  
  72.             GetMatch := FALSE;
  73.             if (Hash[HashValue] <> -1) and (X - Hash[HashValue] < 4096) then begin
  74.                 Pos := Hash[HashValue];
  75.                 Size := 0;
  76.                 while ((Size < 18) & (Source^[X + Size] = Source^[Pos + Size]) & (X + Size < SourceSize)) do
  77.                     Size := Size + 1;
  78.                 GetMatch := (Size >= 3)
  79.             end;
  80.             Hash[HashValue] := X
  81.         end;
  82.  
  83.         var
  84.             Key, Bit, Command, Size: WORD;
  85.             X, Y, Z, Pos: BufferIndex;
  86.     begin
  87.         for Key := 0 to 4095 do
  88.             Hash[Key] := -1;
  89.         Dest^[0] := FLAG_Compress;
  90.         X := 0;
  91.         Y := 3;
  92.         Z := 1;
  93.         Bit := 0;
  94.         Command := 0;
  95.         while (X < SourceSize) & (Y <= SourceSize) do begin
  96.             if (Bit > 15) then begin
  97.                 Dest^[Z] := BAND(BSR(Command, 8), $FF);
  98.                 Dest^[Z + 1] := BAND(Command, $FF);
  99.                 Z := Y;
  100.                 Bit := 0;
  101.                 Y := Y + 2;
  102.             end;
  103.             Size := 1;
  104.             while ((Source^[X] = Source^[X + Size]) & (Size < $FFF) & (X + Size < SourceSize)) do
  105.                 Size := Size + 1;
  106.             if (Size >= 16) then begin
  107.                 Dest^[Y] := 0;
  108.                 Dest^[Y + 1] := BAND(BSR(Size - 16, 8), $FF);
  109.                 Dest^[Y + 2] := BAND(Size - 16, $FF);
  110.                 Dest^[Y + 3] := Source^[X];
  111.                 Y := Y + 4;
  112.                 X := X + Size;
  113.                 Command := BSL(Command, 1) + 1;
  114.             end
  115.             else if (GetMatch(X, Size, Pos)) then begin
  116.                 Key := BSL(X - Pos, 4) + (Size - 3);
  117.                 Dest^[Y] := BAND(BSR(Key, 8), $FF);
  118.                 Dest^[Y + 1] := BAND(Key, $FF);
  119.                 Y := Y + 2;
  120.                 X := X + Size;
  121.                 Command := BSL(Command, 1) + 1;
  122.             end
  123.             else begin
  124.                 Dest^[Y] := Source^[X];
  125.                 Y := Y + 1;
  126.                 X := X + 1;
  127.                 Command := BSL(Command, 1);
  128.             end;
  129.             Bit := Bit + 1;
  130.         end;
  131.         Command := BSL(Command, 16 - Bit);
  132.         Dest^[Z] := BAND(BSR(Command, 8), $FF);
  133.         Dest^[Z + 1] := BAND(Command, $FF);
  134.         if (Y > SourceSize) then begin
  135.             BlockMove(@Source^[0], @Dest^[1], SourceSize);
  136.             Dest^[0] := FLAG_Copied;
  137.             Y := SourceSize + 1;
  138.         end;
  139.         LZRW1KHCompress := Y
  140.     end;
  141.  
  142.     function LZRW1KHDecompress (Source, Dest: BufferPtr; SourceSize: BufferSize): BufferSize;
  143.         var
  144.             X, Y, Pos: BufferIndex;
  145.             Command, Size, K: WORD;
  146.             Bit: BYTE;
  147.     begin
  148.         if (Source^[0] = FLAG_Copied) then begin
  149.             BlockMove(@Source^[1], @Dest^[0], SourceSize - 1);
  150.             Y := SourceSize - 1;
  151.         end
  152.         else begin
  153.             Y := 0;
  154.             X := 3;
  155.             Command := BSL(Source^[1], 8) + Source^[2];
  156.             Bit := 16;
  157.             while (X < SourceSize) do begin
  158.                 if (Bit = 0) then begin
  159.                     Command := BSL(Source^[X], 8) + Source^[X + 1];
  160.                     Bit := 16;
  161.                     X := X + 2;
  162.                 end;
  163.                 if (BAND(Command, $8000) = 0) then begin
  164.                     Dest^[Y] := Source^[X];
  165.                     Y := Y + 1;
  166.                     X := X + 1;
  167.                 end
  168.                 else begin
  169.                     Pos := BSL(Source^[X], 4) + BSR(Source^[X + 1], 4);
  170.                     if (Pos = 0) then begin
  171.                         Size := BSL(Source^[X + 1], 8) + Source^[X + 2] + 15;
  172.                         for K := 0 to Size do
  173.                             Dest^[Y + K] := Source^[X + 3];
  174.                         X := X + 4;
  175.                         Y := Y + Size + 1;
  176.                     end
  177.                     else begin
  178.                         Size := BAND(Source^[X + 1], $0F) + 2;
  179.                         for K := 0 to Size do
  180.                             Dest^[Y + K] := Dest^[Y - Pos + K];
  181.                         X := X + 2;
  182.                         Y := Y + Size + 1;
  183.                     end;
  184.                 end;
  185.                 Command := BSL(Command, 1);
  186.                 Bit := Bit - 1;
  187.             end
  188.         end;
  189.         LZRW1KHDecompress := Y
  190.     end;
  191.  
  192. end.