Back to...

   1  --   ________  ___   ______       ______      ___
   2  --  /___..._/  |.|   |.___.\     /. __ .\   __|.|   ____
   3  --     /../    |.|   |.____/     |.|__|.|  /....|  __\..\
   4  --   _/../___  |.|   |.|    ===  |..__..| |. = .| | = ..|
   5  --  /_______/  |_|  /__|        /__|  |_|  \__\_|  \__\_|
   6  
   7  --  Zip.Compress
   8  ----------------
   9  --
  10  --  Created 9-Dec-2007
  11  --
  12  --  This package facilitates the storage or compression of data.
  13  --
  14  --  Note that unlike decompression where the decoding is unique,
  15  --  there is a quasi indefinite number of ways of compressing data into
  16  --  most Zip-supported formats, including LZW (Shrink), Reduce, Deflate, or LZMA.
  17  --  As a result, you may want to use your own way for compressing data.
  18  --  This package is a portable one and doesn't claim to be the "best".
  19  --  The term "best" is relative to the needs, since there are at least
  20  --  two criteria that usually go in opposite directions: speed and
  21  --  compression ratio, a bit like risk and return in finance.
  22  
  23  --  Legal licensing note:
  24  
  25  --  Copyright (c) 2007 .. 2024 Gautier de Montmollin
  26  --  SWITZERLAND
  27  
  28  --  Permission is hereby granted, free of charge, to any person obtaining a copy
  29  --  of this software and associated documentation files (the "Software"), to deal
  30  --  in the Software without restriction, including without limitation the rights
  31  --  to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
  32  --  copies of the Software, and to permit persons to whom the Software is
  33  --  furnished to do so, subject to the following conditions:
  34  
  35  --  The above copyright notice and this permission notice shall be included in
  36  --  all copies or substantial portions of the Software.
  37  
  38  --  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
  39  --  IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
  40  --  FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
  41  --  AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
  42  --  LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
  43  --  OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
  44  --  THE SOFTWARE.
  45  
  46  --  NB: this is the MIT License, as found on the site
  47  --  http://www.opensource.org/licenses/mit-license.php
  48  
  49  ---------------------------------------------------------------------------------
  50  
  51  with Zip.CRC_Crypto;
  52  
  53  package Zip.Compress is
  54  
  55    --  Compression_Method is actually reflecting the way of compressing
  56    --  data, not only the final compression format called "method" in
  57    --  Zip specifications.
  58  
  59    type Compression_Method is
  60      (Store,  --  No compression
  61  
  62       --------------------------------------------------
  63       --  Shrink = LZW algorithm, as in GIF pictures  --
  64       --------------------------------------------------
  65       Shrink,
  66  
  67       --------------------------------------------------------------------------
  68       --  Reduce - combines LZ and a Markov predictor; 4 strengths available  --
  69       --------------------------------------------------------------------------
  70       Reduce_1,
  71       Reduce_2,
  72       Reduce_3,
  73       Reduce_4,
  74  
  75       --------------------------------------------------
  76       --  Deflate - combines LZ and Huffman encoding  --
  77       --------------------------------------------------
  78       Deflate_Fixed,
  79       Deflate_0,        --  0: No LZ77, only Huffman.
  80       Deflate_1,
  81       Deflate_2,
  82       Deflate_3,
  83       Deflate_R,
  84  
  85       -------------
  86       --  BZip2  --
  87       -------------
  88       BZip2_1,
  89       BZip2_2,
  90       BZip2_3,
  91  
  92       ------------
  93       --  LZMA  --
  94       ------------
  95       LZMA_0,           --  0: No LZ77, only "MA" part.
  96       LZMA_1,
  97       LZMA_2,
  98       LZMA_3,           --  NB: LZMA_3 can be very slow on large data
  99  
 100       --  LZMA with non-default parameters, targeted for specific data types:
 101       LZMA_2_for_Zip_in_Zip,
 102       LZMA_3_for_Zip_in_Zip,
 103       LZMA_2_for_Source,
 104       LZMA_3_for_Source,
 105       LZMA_for_JPEG,
 106       LZMA_for_ARW,   --  Raw camera picture
 107       LZMA_for_ORF,   --  Raw camera picture
 108       LZMA_for_MP3,
 109       LZMA_for_MP4,
 110       LZMA_for_PGM,  --  TBD: photo vs drawing (expect much LZ redundancy in the latter)
 111       LZMA_for_PPM,  --  TBD: photo vs drawing (expect much LZ redundancy in the latter)
 112       LZMA_for_PNG,
 113       LZMA_for_GIF,
 114       LZMA_for_WAV,
 115       LZMA_for_AU,
 116  
 117       --------------------
 118       --  Multi-method  --
 119       --------------------
 120       --    Preselection: select a method depending on hints (type and uncompressed size)
 121       Preselection_1,   --  Not too slow; selects Deflate_3 or LZMA_2*
 122       Preselection_2);  --  Can be very slow on large data; selects Deflate_3, LZMA_2*, LZMA_3* or BZip2.
 123  
 124    type Method_to_Format_Type is array (Compression_Method) of PKZip_method;
 125    Method_to_Format : constant Method_to_Format_Type;
 126  
 127    subtype Reduction_Method is Compression_Method range Reduce_1 .. Reduce_4;
 128  
 129    --  Deflate_Fixed compresses the data into a single block and with predefined
 130    --  ("fixed") compression structures. The data are basically LZ-compressed
 131    --  only, since the Huffman code sets are flat and not tailored for the data.
 132    subtype Deflation_Method is Compression_Method range Deflate_Fixed .. Deflate_R;
 133  
 134    --  The multi-block Deflate methods use refined techniques to decide when to
 135    --  start a new block and what sort of block to put next.
 136    subtype Taillaule_Deflation_Method is Compression_Method range Deflate_0 .. Deflation_Method'Last;
 137  
 138    subtype BZip2_Method is Compression_Method range BZip2_1 .. BZip2_3;
 139  
 140    subtype LZMA_Method is Compression_Method range LZMA_0 .. LZMA_for_AU;
 141  
 142    subtype Multi_Method is Compression_Method range Preselection_1 .. Preselection_2;
 143  
 144    subtype Preselection_Method is Compression_Method range Preselection_1 .. Preselection_2;
 145  
 146    subtype Single_Method is Compression_Method
 147      range Compression_Method'First .. Compression_Method'Pred (Multi_Method'First);
 148  
 149    User_abort : exception;
 150  
 151    type Data_Content_Type is
 152      (neutral,     --  No clue about what kind of data
 153       source_code,
 154       text_formatted_text_or_dna,
 155       text_data,
 156       JPEG,
 157       ARW_RW2,     --  Raw digital camera image
 158       ORF_CR2,     --  Raw digital camera image
 159       Zip_in_Zip,
 160       GIF, PNG, PGM, PPM,
 161       WAV,
 162       AU,          --  Audacity .au raw sound file
 163       MP3, MP4);
 164  
 165    --  Compress data from an input stream to an output stream until
 166    --  End_Of_File(input) = True, or number of input bytes = input_size .
 167    --  If password /= "", an encryption header is written.
 168  
 169    procedure Compress_Data
 170      (input,
 171       output           : in out Zip_Streams.Root_Zipstream_Type'Class;
 172       input_size_known : in     Boolean;
 173       input_size       : in     Zip_64_Data_Size_Type;  --  ignored if input_size_known = False
 174       method           : in     Compression_Method;
 175       feedback         : in     Feedback_Proc;
 176       password         : in     String;
 177       content_hint     : in     Data_Content_Type;
 178       CRC              :    out Interfaces.Unsigned_32;
 179       output_size      :    out Zip_64_Data_Size_Type;
 180       zip_type         :    out Interfaces.Unsigned_16);
 181       --  ^ code corresponding to the compression method actually used
 182  
 183    function Guess_Type_from_Name (name : String) return Data_Content_Type;
 184  
 185  private
 186  
 187    feedback_steps : constant := 100;
 188  
 189    Method_to_Format : constant Method_to_Format_Type :=
 190      (Store            => store,
 191       Shrink           => shrink,
 192       Reduce_1         => reduce_1,
 193       Reduce_2         => reduce_2,
 194       Reduce_3         => reduce_3,
 195       Reduce_4         => reduce_4,
 196       Deflation_Method => deflate,
 197       BZip2_Method     => bzip2_meth,
 198       LZMA_Method      => lzma_meth,
 199       Multi_Method     => unknown);
 200  
 201    -----------------------------------
 202    --  I/O buffers for compression  --
 203    -----------------------------------
 204  
 205    type IO_Buffers_Type is record
 206      InBuf  : p_Byte_Buffer := null;  --  I/O buffers
 207      OutBuf : p_Byte_Buffer := null;
 208      --
 209      InBufIdx  : Positive;       --  Points to next char in buffer to be read
 210      OutBufIdx : Positive := 1;  --  Points to next free space in output buffer
 211      --
 212      MaxInBufIdx : Natural;      --  Count of valid chars in input buffer
 213      InputEoF    : Boolean;      --  End of file indicator
 214    end record;
 215  
 216    procedure Allocate_Buffers
 217      (b                : in out IO_Buffers_Type;
 218       input_size_known : in     Boolean;
 219       input_size       : in     Zip_64_Data_Size_Type);
 220  
 221    procedure Deallocate_Buffers (b : in out IO_Buffers_Type);
 222  
 223    procedure Read_Block
 224      (b     : in out IO_Buffers_Type;
 225       input : in out Zip_Streams.Root_Zipstream_Type'Class);
 226  
 227    procedure Write_Block
 228      (b                : in out IO_Buffers_Type;
 229       input_size_known : in     Boolean;
 230       input_size       : in     Zip_64_Data_Size_Type;
 231       output           : in out Zip_Streams.Root_Zipstream_Type'Class;
 232       output_size      : in out Zip_64_Data_Size_Type;
 233       crypto           : in out Zip.CRC_Crypto.Crypto_pack);
 234  
 235    --  Exception for the case where compression works but produces
 236    --  a bigger file than the file to be compressed (data is too "random").
 237    Compression_inefficient : exception;
 238  
 239  end Zip.Compress;