Back to...

   1  --  Legal licensing note:
   2  
   3  --  Copyright (c) 2006 .. 2023 Gautier de Montmollin
   4  --  SWITZERLAND
   5  
   6  --  Permission is hereby granted, free of charge, to any person obtaining a copy
   7  --  of this software and associated documentation files (the "Software"), to deal
   8  --  in the Software without restriction, including without limitation the rights
   9  --  to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
  10  --  copies of the Software, and to permit persons to whom the Software is
  11  --  furnished to do so, subject to the following conditions:
  12  
  13  --  The above copyright notice and this permission notice shall be included in
  14  --  all copies or substantial portions of the Software.
  15  
  16  --  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
  17  --  IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
  18  --  FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
  19  --  AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
  20  --  LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
  21  --  OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
  22  --  THE SOFTWARE.
  23  
  24  --  NB: this is the MIT License, as found on the site
  25  --  http://www.opensource.org/licenses/mit-license.php
  26  --
  27  --  Translated by P2Ada (v. 15-Nov-2006)
  28  --  from R. P. Byrne's Shrink.Pas (v. 1.2, 1989) in Turbo Pascal
  29  --  and 16-bit assembler, then reworked by G. de Montmollin
  30  --
  31  --  Note about the LZW patent: as on 10-Dec-2007, one could read on
  32  --  http://www.unisys.com/about__unisys/lzw :
  33  --
  34  --  Unisys U.S. LZW Patent No. 4,558,302 expired on June 20, 2003,
  35  --  the counterpart patents in the United Kingdom, France, Germany
  36  --  and Italy expired on June 18, 2004,
  37  --  the Japanese counterpart patents expired on June 20, 2004
  38  --  and the counterpart Canadian patent expired on July 7, 2004.
  39  --
  40  
  41  with Zip.CRC_Crypto;
  42  
  43  private procedure Zip.Compress.Shrink
  44    (input,
  45     output           : in out Zip_Streams.Root_Zipstream_Type'Class;
  46     input_size_known :        Boolean;
  47     input_size       :        Zip_64_Data_Size_Type;  --  ignored if unknown
  48     feedback         :        Feedback_Proc;
  49     CRC              : in out Interfaces.Unsigned_32;  --  only updated here
  50     crypto           : in out CRC_Crypto.Crypto_pack;
  51     output_size      :    out Zip_64_Data_Size_Type;
  52     compression_ok   :    out Boolean);  --  indicates compressed <= uncompressed