| 1 | ------------------------------------------------------------------------------
|
|---|
| 2 | -- ZLib for Ada thick binding. --
|
|---|
| 3 | -- --
|
|---|
| 4 | -- Copyright (C) 2002-2003 Dmitriy Anisimkov --
|
|---|
| 5 | -- --
|
|---|
| 6 | -- This library is free software; you can redistribute it and/or modify --
|
|---|
| 7 | -- it under the terms of the GNU General Public License as published by --
|
|---|
| 8 | -- the Free Software Foundation; either version 2 of the License, or (at --
|
|---|
| 9 | -- your option) any later version. --
|
|---|
| 10 | -- --
|
|---|
| 11 | -- This library is distributed in the hope that it will be useful, but --
|
|---|
| 12 | -- WITHOUT ANY WARRANTY; without even the implied warranty of --
|
|---|
| 13 | -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU --
|
|---|
| 14 | -- General Public License for more details. --
|
|---|
| 15 | -- --
|
|---|
| 16 | -- You should have received a copy of the GNU General Public License --
|
|---|
| 17 | -- along with this library; if not, write to the Free Software Foundation, --
|
|---|
| 18 | -- Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. --
|
|---|
| 19 | -- --
|
|---|
| 20 | -- As a special exception, if other files instantiate generics from this --
|
|---|
| 21 | -- unit, or you link this unit with other files to produce an executable, --
|
|---|
| 22 | -- this unit does not by itself cause the resulting executable to be --
|
|---|
| 23 | -- covered by the GNU General Public License. This exception does not --
|
|---|
| 24 | -- however invalidate any other reasons why the executable file might be --
|
|---|
| 25 | -- covered by the GNU Public License. --
|
|---|
| 26 | ------------------------------------------------------------------------------
|
|---|
| 27 |
|
|---|
| 28 | -- $Id: zlib.ads,v 1.1 2004/11/15 16:42:25 bird Exp $
|
|---|
| 29 |
|
|---|
| 30 | with Ada.Streams;
|
|---|
| 31 |
|
|---|
| 32 | with Interfaces;
|
|---|
| 33 |
|
|---|
| 34 | package ZLib is
|
|---|
| 35 |
|
|---|
| 36 | ZLib_Error : exception;
|
|---|
| 37 |
|
|---|
| 38 | type Compression_Level is new Integer range -1 .. 9;
|
|---|
| 39 |
|
|---|
| 40 | type Flush_Mode is private;
|
|---|
| 41 |
|
|---|
| 42 | type Compression_Method is private;
|
|---|
| 43 |
|
|---|
| 44 | type Window_Bits_Type is new Integer range 8 .. 15;
|
|---|
| 45 |
|
|---|
| 46 | type Memory_Level_Type is new Integer range 1 .. 9;
|
|---|
| 47 |
|
|---|
| 48 | type Unsigned_32 is new Interfaces.Unsigned_32;
|
|---|
| 49 |
|
|---|
| 50 | type Strategy_Type is private;
|
|---|
| 51 |
|
|---|
| 52 | type Header_Type is (None, Auto, Default, GZip);
|
|---|
| 53 | -- Header type usage have a some limitation for inflate.
|
|---|
| 54 | -- See comment for Inflate_Init.
|
|---|
| 55 |
|
|---|
| 56 | subtype Count is Ada.Streams.Stream_Element_Count;
|
|---|
| 57 |
|
|---|
| 58 | ----------------------------------
|
|---|
| 59 | -- Compression method constants --
|
|---|
| 60 | ----------------------------------
|
|---|
| 61 |
|
|---|
| 62 | Deflated : constant Compression_Method;
|
|---|
| 63 | -- Only one method allowed in this ZLib version.
|
|---|
| 64 |
|
|---|
| 65 | ---------------------------------
|
|---|
| 66 | -- Compression level constants --
|
|---|
| 67 | ---------------------------------
|
|---|
| 68 |
|
|---|
| 69 | No_Compression : constant Compression_Level := 0;
|
|---|
| 70 | Best_Speed : constant Compression_Level := 1;
|
|---|
| 71 | Best_Compression : constant Compression_Level := 9;
|
|---|
| 72 | Default_Compression : constant Compression_Level := -1;
|
|---|
| 73 |
|
|---|
| 74 | --------------------------
|
|---|
| 75 | -- Flush mode constants --
|
|---|
| 76 | --------------------------
|
|---|
| 77 |
|
|---|
| 78 | No_Flush : constant Flush_Mode;
|
|---|
| 79 | -- Regular way for compression, no flush
|
|---|
| 80 |
|
|---|
| 81 | Partial_Flush : constant Flush_Mode;
|
|---|
| 82 | -- will be removed, use Z_SYNC_FLUSH instead
|
|---|
| 83 |
|
|---|
| 84 | Sync_Flush : constant Flush_Mode;
|
|---|
| 85 | -- all pending output is flushed to the output buffer and the output
|
|---|
| 86 | -- is aligned on a byte boundary, so that the decompressor can get all
|
|---|
| 87 | -- input data available so far. (In particular avail_in is zero after the
|
|---|
| 88 | -- call if enough output space has been provided before the call.)
|
|---|
| 89 | -- Flushing may degrade compression for some compression algorithms and so
|
|---|
| 90 | -- it should be used only when necessary.
|
|---|
| 91 |
|
|---|
| 92 | Full_Flush : constant Flush_Mode;
|
|---|
| 93 | -- all output is flushed as with SYNC_FLUSH, and the compression state
|
|---|
| 94 | -- is reset so that decompression can restart from this point if previous
|
|---|
| 95 | -- compressed data has been damaged or if random access is desired. Using
|
|---|
| 96 | -- FULL_FLUSH too often can seriously degrade the compression.
|
|---|
| 97 |
|
|---|
| 98 | Finish : constant Flush_Mode;
|
|---|
| 99 | -- Just for tell the compressor that input data is complete.
|
|---|
| 100 |
|
|---|
| 101 | ------------------------------------
|
|---|
| 102 | -- Compression strategy constants --
|
|---|
| 103 | ------------------------------------
|
|---|
| 104 |
|
|---|
| 105 | -- RLE stategy could be used only in version 1.2.0 and later.
|
|---|
| 106 |
|
|---|
| 107 | Filtered : constant Strategy_Type;
|
|---|
| 108 | Huffman_Only : constant Strategy_Type;
|
|---|
| 109 | RLE : constant Strategy_Type;
|
|---|
| 110 | Default_Strategy : constant Strategy_Type;
|
|---|
| 111 |
|
|---|
| 112 | Default_Buffer_Size : constant := 4096;
|
|---|
| 113 |
|
|---|
| 114 | type Filter_Type is limited private;
|
|---|
| 115 | -- The filter is for compression and for decompression.
|
|---|
| 116 | -- The usage of the type is depend of its initialization.
|
|---|
| 117 |
|
|---|
| 118 | function Version return String;
|
|---|
| 119 | pragma Inline (Version);
|
|---|
| 120 | -- Return string representation of the ZLib version.
|
|---|
| 121 |
|
|---|
| 122 | procedure Deflate_Init
|
|---|
| 123 | (Filter : in out Filter_Type;
|
|---|
| 124 | Level : in Compression_Level := Default_Compression;
|
|---|
| 125 | Strategy : in Strategy_Type := Default_Strategy;
|
|---|
| 126 | Method : in Compression_Method := Deflated;
|
|---|
| 127 | Window_Bits : in Window_Bits_Type := 15;
|
|---|
| 128 | Memory_Level : in Memory_Level_Type := 8;
|
|---|
| 129 | Header : in Header_Type := Default);
|
|---|
| 130 | -- Compressor initialization.
|
|---|
| 131 | -- When Header parameter is Auto or Default, then default zlib header
|
|---|
| 132 | -- would be provided for compressed data.
|
|---|
| 133 | -- When Header is GZip, then gzip header would be set instead of
|
|---|
| 134 | -- default header.
|
|---|
| 135 | -- When Header is None, no header would be set for compressed data.
|
|---|
| 136 |
|
|---|
| 137 | procedure Inflate_Init
|
|---|
| 138 | (Filter : in out Filter_Type;
|
|---|
| 139 | Window_Bits : in Window_Bits_Type := 15;
|
|---|
| 140 | Header : in Header_Type := Default);
|
|---|
| 141 | -- Decompressor initialization.
|
|---|
| 142 | -- Default header type mean that ZLib default header is expecting in the
|
|---|
| 143 | -- input compressed stream.
|
|---|
| 144 | -- Header type None mean that no header is expecting in the input stream.
|
|---|
| 145 | -- GZip header type mean that GZip header is expecting in the
|
|---|
| 146 | -- input compressed stream.
|
|---|
| 147 | -- Auto header type mean that header type (GZip or Native) would be
|
|---|
| 148 | -- detected automatically in the input stream.
|
|---|
| 149 | -- Note that header types parameter values None, GZip and Auto is
|
|---|
| 150 | -- supporting for inflate routine only in ZLib versions 1.2.0.2 and later.
|
|---|
| 151 | -- Deflate_Init is supporting all header types.
|
|---|
| 152 |
|
|---|
| 153 | procedure Close
|
|---|
| 154 | (Filter : in out Filter_Type;
|
|---|
| 155 | Ignore_Error : in Boolean := False);
|
|---|
| 156 | -- Closing the compression or decompressor.
|
|---|
| 157 | -- If stream is closing before the complete and Ignore_Error is False,
|
|---|
| 158 | -- The exception would be raised.
|
|---|
| 159 |
|
|---|
| 160 | generic
|
|---|
| 161 | with procedure Data_In
|
|---|
| 162 | (Item : out Ada.Streams.Stream_Element_Array;
|
|---|
| 163 | Last : out Ada.Streams.Stream_Element_Offset);
|
|---|
| 164 | with procedure Data_Out
|
|---|
| 165 | (Item : in Ada.Streams.Stream_Element_Array);
|
|---|
| 166 | procedure Generic_Translate
|
|---|
| 167 | (Filter : in out Filter_Type;
|
|---|
| 168 | In_Buffer_Size : in Integer := Default_Buffer_Size;
|
|---|
| 169 | Out_Buffer_Size : in Integer := Default_Buffer_Size);
|
|---|
| 170 | -- Compressing/decompressing data arrived from Data_In routine
|
|---|
| 171 | -- to the Data_Out routine. User should provide Data_In and Data_Out
|
|---|
| 172 | -- for compression/decompression data flow.
|
|---|
| 173 | -- Compression or decompression depend on initialization of Filter.
|
|---|
| 174 |
|
|---|
| 175 | function Total_In (Filter : in Filter_Type) return Count;
|
|---|
| 176 | pragma Inline (Total_In);
|
|---|
| 177 | -- Return total number of input bytes read so far.
|
|---|
| 178 |
|
|---|
| 179 | function Total_Out (Filter : in Filter_Type) return Count;
|
|---|
| 180 | pragma Inline (Total_Out);
|
|---|
| 181 | -- Return total number of bytes output so far.
|
|---|
| 182 |
|
|---|
| 183 | function CRC32
|
|---|
| 184 | (CRC : in Unsigned_32;
|
|---|
| 185 | Data : in Ada.Streams.Stream_Element_Array)
|
|---|
| 186 | return Unsigned_32;
|
|---|
| 187 | pragma Inline (CRC32);
|
|---|
| 188 | -- Calculate CRC32, it could be necessary for make gzip format.
|
|---|
| 189 |
|
|---|
| 190 | procedure CRC32
|
|---|
| 191 | (CRC : in out Unsigned_32;
|
|---|
| 192 | Data : in Ada.Streams.Stream_Element_Array);
|
|---|
| 193 | pragma Inline (CRC32);
|
|---|
| 194 | -- Calculate CRC32, it could be necessary for make gzip format.
|
|---|
| 195 |
|
|---|
| 196 | -------------------------------------------------
|
|---|
| 197 | -- Below is more complex low level routines. --
|
|---|
| 198 | -------------------------------------------------
|
|---|
| 199 |
|
|---|
| 200 | procedure Translate
|
|---|
| 201 | (Filter : in out Filter_Type;
|
|---|
| 202 | In_Data : in Ada.Streams.Stream_Element_Array;
|
|---|
| 203 | In_Last : out Ada.Streams.Stream_Element_Offset;
|
|---|
| 204 | Out_Data : out Ada.Streams.Stream_Element_Array;
|
|---|
| 205 | Out_Last : out Ada.Streams.Stream_Element_Offset;
|
|---|
| 206 | Flush : in Flush_Mode);
|
|---|
| 207 | -- Compressing/decompressing the datas from In_Data buffer to the
|
|---|
| 208 | -- Out_Data buffer.
|
|---|
| 209 | -- In_Data is incoming data portion,
|
|---|
| 210 | -- In_Last is the index of last element from In_Data accepted by the
|
|---|
| 211 | -- Filter.
|
|---|
| 212 | -- Out_Data is the buffer for output data from the filter.
|
|---|
| 213 | -- Out_Last is the last element of the received data from Filter.
|
|---|
| 214 | -- To tell the filter that incoming data is complete put the
|
|---|
| 215 | -- Flush parameter to FINISH.
|
|---|
| 216 |
|
|---|
| 217 | function Stream_End (Filter : in Filter_Type) return Boolean;
|
|---|
| 218 | pragma Inline (Stream_End);
|
|---|
| 219 | -- Return the true when the stream is complete.
|
|---|
| 220 |
|
|---|
| 221 | procedure Flush
|
|---|
| 222 | (Filter : in out Filter_Type;
|
|---|
| 223 | Out_Data : out Ada.Streams.Stream_Element_Array;
|
|---|
| 224 | Out_Last : out Ada.Streams.Stream_Element_Offset;
|
|---|
| 225 | Flush : in Flush_Mode);
|
|---|
| 226 | pragma Inline (Flush);
|
|---|
| 227 | -- Flushing the data from the compressor.
|
|---|
| 228 |
|
|---|
| 229 | generic
|
|---|
| 230 | with procedure Write
|
|---|
| 231 | (Item : in Ada.Streams.Stream_Element_Array);
|
|---|
| 232 | -- User should provide this routine for accept
|
|---|
| 233 | -- compressed/decompressed data.
|
|---|
| 234 |
|
|---|
| 235 | Buffer_Size : in Ada.Streams.Stream_Element_Offset
|
|---|
| 236 | := Default_Buffer_Size;
|
|---|
| 237 | -- Buffer size for Write user routine.
|
|---|
| 238 |
|
|---|
| 239 | procedure Write
|
|---|
| 240 | (Filter : in out Filter_Type;
|
|---|
| 241 | Item : in Ada.Streams.Stream_Element_Array;
|
|---|
| 242 | Flush : in Flush_Mode);
|
|---|
| 243 | -- Compressing/Decompressing data from Item to the
|
|---|
| 244 | -- generic parameter procedure Write.
|
|---|
| 245 | -- Output buffer size could be set in Buffer_Size generic parameter.
|
|---|
| 246 |
|
|---|
| 247 | generic
|
|---|
| 248 | with procedure Read
|
|---|
| 249 | (Item : out Ada.Streams.Stream_Element_Array;
|
|---|
| 250 | Last : out Ada.Streams.Stream_Element_Offset);
|
|---|
| 251 | -- User should provide data for compression/decompression
|
|---|
| 252 | -- thru this routine.
|
|---|
| 253 |
|
|---|
| 254 | Buffer : in out Ada.Streams.Stream_Element_Array;
|
|---|
| 255 | -- Buffer for keep remaining data from the previous
|
|---|
| 256 | -- back read.
|
|---|
| 257 |
|
|---|
| 258 | Rest_First, Rest_Last : in out Ada.Streams.Stream_Element_Offset;
|
|---|
| 259 | -- Rest_First have to be initialized to Buffer'Last + 1
|
|---|
| 260 | -- before usage.
|
|---|
| 261 |
|
|---|
| 262 | procedure Read
|
|---|
| 263 | (Filter : in out Filter_Type;
|
|---|
| 264 | Item : out Ada.Streams.Stream_Element_Array;
|
|---|
| 265 | Last : out Ada.Streams.Stream_Element_Offset);
|
|---|
| 266 | -- Compressing/Decompressing data from generic parameter
|
|---|
| 267 | -- procedure Read to the Item.
|
|---|
| 268 | -- User should provide Buffer for the operation
|
|---|
| 269 | -- and Rest_First variable first time initialized to the Buffer'Last + 1.
|
|---|
| 270 |
|
|---|
| 271 | private
|
|---|
| 272 |
|
|---|
| 273 | use Ada.Streams;
|
|---|
| 274 |
|
|---|
| 275 | type Flush_Mode is new Integer range 0 .. 4;
|
|---|
| 276 |
|
|---|
| 277 | type Compression_Method is new Integer range 8 .. 8;
|
|---|
| 278 |
|
|---|
| 279 | type Strategy_Type is new Integer range 0 .. 3;
|
|---|
| 280 |
|
|---|
| 281 | No_Flush : constant Flush_Mode := 0;
|
|---|
| 282 | Sync_Flush : constant Flush_Mode := 2;
|
|---|
| 283 | Full_Flush : constant Flush_Mode := 3;
|
|---|
| 284 | Finish : constant Flush_Mode := 4;
|
|---|
| 285 | Partial_Flush : constant Flush_Mode := 1;
|
|---|
| 286 | -- will be removed, use Z_SYNC_FLUSH instead
|
|---|
| 287 |
|
|---|
| 288 | Filtered : constant Strategy_Type := 1;
|
|---|
| 289 | Huffman_Only : constant Strategy_Type := 2;
|
|---|
| 290 | RLE : constant Strategy_Type := 3;
|
|---|
| 291 | Default_Strategy : constant Strategy_Type := 0;
|
|---|
| 292 |
|
|---|
| 293 | Deflated : constant Compression_Method := 8;
|
|---|
| 294 |
|
|---|
| 295 | type Z_Stream;
|
|---|
| 296 |
|
|---|
| 297 | type Z_Stream_Access is access all Z_Stream;
|
|---|
| 298 |
|
|---|
| 299 | type Filter_Type is record
|
|---|
| 300 | Strm : Z_Stream_Access;
|
|---|
| 301 | Compression : Boolean;
|
|---|
| 302 | Stream_End : Boolean;
|
|---|
| 303 | Header : Header_Type;
|
|---|
| 304 | CRC : Unsigned_32;
|
|---|
| 305 | Offset : Stream_Element_Offset;
|
|---|
| 306 | -- Offset for gzip header/footer output.
|
|---|
| 307 |
|
|---|
| 308 | Opened : Boolean := False;
|
|---|
| 309 | end record;
|
|---|
| 310 |
|
|---|
| 311 | end ZLib;
|
|---|
