DEADSOFTWARE

hopefully no more windows
[d2df-editor.git] / src / lib / vampimg / ZLib / impaszlib.pas
1 Unit impaszlib;
4 { Original:
5 zlib.h -- interface of the 'zlib' general purpose compression library
6 version 1.1.0, Feb 24th, 1998
8 Copyright (C) 1995-1998 Jean-loup Gailly and Mark Adler
10 This software is provided 'as-is', without any express or implied
11 warranty. In no event will the authors be held liable for any damages
12 arising from the use of this software.
14 Permission is granted to anyone to use this software for any purpose,
15 including commercial applications, and to alter it and redistribute it
16 freely, subject to the following restrictions:
18 1. The origin of this software must not be misrepresented; you must not
19 claim that you wrote the original software. If you use this software
20 in a product, an acknowledgment in the product documentation would be
21 appreciated but is not required.
22 2. Altered source versions must be plainly marked as such, and must not be
23 misrepresented as being the original software.
24 3. This notice may not be removed or altered from any source distribution.
26 Jean-loup Gailly Mark Adler
27 jloup@gzip.org madler@alumni.caltech.edu
30 The data format used by the zlib library is described by RFCs (Request for
31 Comments) 1950 to 1952 in the files ftp://ds.internic.net/rfc/rfc1950.txt
32 (zlib format), rfc1951.txt (deflate format) and rfc1952.txt (gzip format).
35 Pascal tranlastion
36 Copyright (C) 1998 by Jacques Nomssi Nzali
37 For conditions of distribution and use, see copyright notice in readme.txt
38 }
40 interface
42 {$I imzconf.inc}
44 uses
45 imzutil;
47 { zconf.h -- configuration of the zlib compression library }
48 { zutil.c -- target dependent utility functions for the compression library }
50 { The 'zlib' compression library provides in-memory compression and
51 decompression functions, including integrity checks of the uncompressed
52 data. This version of the library supports only one compression method
53 (deflation) but other algorithms will be added later and will have the same
54 stream interface.
56 Compression can be done in a single step if the buffers are large
57 enough (for example if an input file is mmap'ed), or can be done by
58 repeated calls of the compression function. In the latter case, the
59 application must provide more input and/or consume the output
60 (providing more output space) before each call.
62 The library also supports reading and writing files in gzip (.gz) format
63 with an interface similar to that of stdio.
65 The library does not install any signal handler. The decoder checks
66 the consistency of the compressed data, so the library should never
67 crash even in case of corrupted input. }
71 { Compile with -DMAXSEG_64K if the alloc function cannot allocate more
72 than 64k bytes at a time (needed on systems with 16-bit int). }
74 { Maximum value for memLevel in deflateInit2 }
75 const
76 MAX_MEM_LEVEL = 9;
77 DEF_MEM_LEVEL = 8; { if MAX_MEM_LEVEL > 8 }
79 { Maximum value for windowBits in deflateInit2 and inflateInit2 }
80 const
81 MAX_WBITS = 15; { 32K LZ77 window }
83 { default windowBits for decompression. MAX_WBITS is for compression only }
84 const
85 DEF_WBITS = MAX_WBITS;
87 { The memory requirements for deflate are (in bytes):
88 1 shl (windowBits+2) + 1 shl (memLevel+9)
89 that is: 128K for windowBits=15 + 128K for memLevel = 8 (default values)
90 plus a few kilobytes for small objects. For example, if you want to reduce
91 the default memory requirements from 256K to 128K, compile with
92 DMAX_WBITS=14 DMAX_MEM_LEVEL=7
93 Of course this will generally degrade compression (there's no free lunch).
95 The memory requirements for inflate are (in bytes) 1 shl windowBits
96 that is, 32K for windowBits=15 (default value) plus a few kilobytes
97 for small objects. }
100 { Huffman code lookup table entry--this entry is four bytes for machines
101 that have 16-bit pointers (e.g. PC's in the small or medium model). }
103 type
104 pInflate_huft = ^inflate_huft;
105 inflate_huft = Record
106 Exop, { number of extra bits or operation }
107 bits : Byte; { number of bits in this code or subcode }
108 {pad : uInt;} { pad structure to a power of 2 (4 bytes for }
109 { 16-bit, 8 bytes for 32-bit int's) }
110 base : uInt; { literal, length base, or distance base }
111 { or table offset }
112 End;
114 type
115 huft_field = Array[0..(MaxInt div SizeOf(inflate_huft))-1] of inflate_huft;
116 huft_ptr = ^huft_field;
117 type
118 ppInflate_huft = ^pInflate_huft;
120 type
121 inflate_codes_mode = ( { waiting for "i:"=input, "o:"=output, "x:"=nothing }
122 START, { x: set up for LEN }
123 LEN, { i: get length/literal/eob next }
124 LENEXT, { i: getting length extra (have base) }
125 DIST, { i: get distance next }
126 DISTEXT, { i: getting distance extra }
127 COPY, { o: copying bytes in window, waiting for space }
128 LIT, { o: got literal, waiting for output space }
129 WASH, { o: got eob, possibly still output waiting }
130 ZEND, { x: got eob and all data flushed }
131 BADCODE); { x: got error }
133 { inflate codes private state }
134 type
135 pInflate_codes_state = ^inflate_codes_state;
136 inflate_codes_state = record
138 mode : inflate_codes_mode; { current inflate_codes mode }
140 { mode dependent information }
141 len : uInt;
142 sub : record { submode }
143 Case Byte of
144 0:(code : record { if LEN or DIST, where in tree }
145 tree : pInflate_huft; { pointer into tree }
146 need : uInt; { bits needed }
147 end);
148 1:(lit : uInt); { if LIT, literal }
149 2:(copy: record { if EXT or COPY, where and how much }
150 get : uInt; { bits to get for extra }
151 dist : uInt; { distance back to copy from }
152 end);
153 end;
155 { mode independent information }
156 lbits : Byte; { ltree bits decoded per branch }
157 dbits : Byte; { dtree bits decoder per branch }
158 ltree : pInflate_huft; { literal/length/eob tree }
159 dtree : pInflate_huft; { distance tree }
160 end;
162 type
163 check_func = function(check : uLong;
164 buf : pBytef;
165 {const buf : array of byte;}
166 len : uInt) : uLong;
167 type
168 inflate_block_mode =
169 (ZTYPE, { get type bits (3, including end bit) }
170 LENS, { get lengths for stored }
171 STORED, { processing stored block }
172 TABLE, { get table lengths }
173 BTREE, { get bit lengths tree for a dynamic block }
174 DTREE, { get length, distance trees for a dynamic block }
175 CODES, { processing fixed or dynamic block }
176 DRY, { output remaining window bytes }
177 BLKDONE, { finished last block, done }
178 BLKBAD); { got a data error--stuck here }
180 type
181 pInflate_blocks_state = ^inflate_blocks_state;
183 { inflate blocks semi-private state }
184 inflate_blocks_state = record
186 mode : inflate_block_mode; { current inflate_block mode }
188 { mode dependent information }
189 sub : record { submode }
190 case Byte of
191 0:(left : uInt); { if STORED, bytes left to copy }
192 1:(trees : record { if DTREE, decoding info for trees }
193 table : uInt; { table lengths (14 bits) }
194 index : uInt; { index into blens (or border) }
195 blens : PuIntArray; { bit lengths of codes }
196 bb : uInt; { bit length tree depth }
197 tb : pInflate_huft; { bit length decoding tree }
198 end);
199 2:(decode : record { if CODES, current state }
200 tl : pInflate_huft;
201 td : pInflate_huft; { trees to free }
202 codes : pInflate_codes_state;
203 end);
204 end;
205 last : boolean; { true if this block is the last block }
207 { mode independent information }
208 bitk : uInt; { bits in bit buffer }
209 bitb : uLong; { bit buffer }
210 hufts : huft_ptr; {pInflate_huft;} { single malloc for tree space }
211 window : pBytef; { sliding window }
212 zend : pBytef; { one byte after sliding window }
213 read : pBytef; { window read pointer }
214 write : pBytef; { window write pointer }
215 checkfn : check_func; { check function }
216 check : uLong; { check on output }
217 end;
219 type
220 inflate_mode = (
221 METHOD, { waiting for method byte }
222 FLAG, { waiting for flag byte }
223 DICT4, { four dictionary check bytes to go }
224 DICT3, { three dictionary check bytes to go }
225 DICT2, { two dictionary check bytes to go }
226 DICT1, { one dictionary check byte to go }
227 DICT0, { waiting for inflateSetDictionary }
228 BLOCKS, { decompressing blocks }
229 CHECK4, { four check bytes to go }
230 CHECK3, { three check bytes to go }
231 CHECK2, { two check bytes to go }
232 CHECK1, { one check byte to go }
233 DONE, { finished check, done }
234 BAD); { got an error--stay here }
236 { inflate private state }
237 type
238 pInternal_state = ^internal_state; { or point to a deflate_state record }
239 internal_state = record
241 mode : inflate_mode; { current inflate mode }
243 { mode dependent information }
244 sub : record { submode }
245 case byte of
246 0:(method : uInt); { if FLAGS, method byte }
247 1:(check : record { if CHECK, check values to compare }
248 was : uLong; { computed check value }
249 need : uLong; { stream check value }
250 end);
251 2:(marker : uInt); { if BAD, inflateSync's marker bytes count }
252 end;
254 { mode independent information }
255 nowrap : boolean; { flag for no wrapper }
256 wbits : uInt; { log2(window size) (8..15, defaults to 15) }
257 blocks : pInflate_blocks_state; { current inflate_blocks state }
258 end;
260 type
261 alloc_func = function(opaque : voidpf; items : uInt; size : uInt) : voidpf;
262 free_func = procedure(opaque : voidpf; address : voidpf);
264 type
265 z_streamp = ^z_stream;
266 z_stream = record
267 next_in : pBytef; { next input byte }
268 avail_in : uInt; { number of bytes available at next_in }
269 total_in : uLong; { total nb of input bytes read so far }
271 next_out : pBytef; { next output byte should be put there }
272 avail_out : uInt; { remaining free space at next_out }
273 total_out : uLong; { total nb of bytes output so far }
275 msg : string[255]; { last error message, '' if no error }
276 state : pInternal_state; { not visible by applications }
278 zalloc : alloc_func; { used to allocate the internal state }
279 zfree : free_func; { used to free the internal state }
280 opaque : voidpf; { private data object passed to zalloc and zfree }
282 data_type : int; { best guess about the data type: ascii or binary }
283 adler : uLong; { adler32 value of the uncompressed data }
284 reserved : uLong; { reserved for future use }
285 end;
288 { The application must update next_in and avail_in when avail_in has
289 dropped to zero. It must update next_out and avail_out when avail_out
290 has dropped to zero. The application must initialize zalloc, zfree and
291 opaque before calling the init function. All other fields are set by the
292 compression library and must not be updated by the application.
294 The opaque value provided by the application will be passed as the first
295 parameter for calls of zalloc and zfree. This can be useful for custom
296 memory management. The compression library attaches no meaning to the
297 opaque value.
299 zalloc must return Z_NULL if there is not enough memory for the object.
300 On 16-bit systems, the functions zalloc and zfree must be able to allocate
301 exactly 65536 bytes, but will not be required to allocate more than this
302 if the symbol MAXSEG_64K is defined (see zconf.h). WARNING: On MSDOS,
303 pointers returned by zalloc for objects of exactly 65536 bytes *must*
304 have their offset normalized to zero. The default allocation function
305 provided by this library ensures this (see zutil.c). To reduce memory
306 requirements and avoid any allocation of 64K objects, at the expense of
307 compression ratio, compile the library with -DMAX_WBITS=14 (see zconf.h).
309 The fields total_in and total_out can be used for statistics or
310 progress reports. After compression, total_in holds the total size of
311 the uncompressed data and may be saved for use in the decompressor
312 (particularly if the decompressor wants to decompress everything in
313 a single step). }
315 const { constants }
316 Z_NO_FLUSH = 0;
317 Z_PARTIAL_FLUSH = 1;
318 Z_SYNC_FLUSH = 2;
319 Z_FULL_FLUSH = 3;
320 Z_FINISH = 4;
321 { Allowed flush values; see deflate() below for details }
323 Z_OK = 0;
324 Z_STREAM_END = 1;
325 Z_NEED_DICT = 2;
326 Z_ERRNO = (-1);
327 Z_STREAM_ERROR = (-2);
328 Z_DATA_ERROR = (-3);
329 Z_MEM_ERROR = (-4);
330 Z_BUF_ERROR = (-5);
331 Z_VERSION_ERROR = (-6);
332 { Return codes for the compression/decompression functions. Negative
333 values are errors, positive values are used for special but normal events.}
335 Z_NO_COMPRESSION = 0;
336 Z_BEST_SPEED = 1;
337 Z_BEST_COMPRESSION = 9;
338 Z_DEFAULT_COMPRESSION = (-1);
339 { compression levels }
341 Z_FILTERED = 1;
342 Z_HUFFMAN_ONLY = 2;
343 Z_DEFAULT_STRATEGY = 0;
344 { compression strategy; see deflateInit2() below for details }
346 Z_BINARY = 0;
347 Z_ASCII = 1;
348 Z_UNKNOWN = 2;
349 { Possible values of the data_type field }
351 Z_DEFLATED = 8;
352 { The deflate compression method (the only one supported in this version) }
354 Z_NULL = NIL; { for initializing zalloc, zfree, opaque }
356 {$IFDEF GZIO}
357 var
358 errno : int;
359 {$ENDIF}
361 { common constants }
364 { The three kinds of block type }
365 const
366 STORED_BLOCK = 0;
367 STATIC_TREES = 1;
368 DYN_TREES = 2;
369 { The minimum and maximum match lengths }
370 const
371 MIN_MATCH = 3;
372 MAX_MATCH = 258;
374 const
375 PRESET_DICT = $20; { preset dictionary flag in zlib header }
378 {$IFDEF DEBUG}
379 procedure Assert(cond : boolean; msg : AnsiString);
380 {$ENDIF}
382 procedure Trace(x : AnsiString);
383 procedure Tracev(x : AnsiString);
384 procedure Tracevv(x : AnsiString);
385 procedure Tracevvv(x : AnsiString);
386 procedure Tracec(c : boolean; x : AnsiString);
387 procedure Tracecv(c : boolean; x : AnsiString);
389 function zlibVersion : AnsiString;
390 { The application can compare zlibVersion and ZLIB_VERSION for consistency.
391 If the first character differs, the library code actually used is
392 not compatible with the zlib.h header file used by the application.
393 This check is automatically made by deflateInit and inflateInit. }
395 function zError(err : int) : AnsiString;
396 function ZALLOC (var strm : z_stream; items : uInt; size : uInt) : voidpf;
397 procedure ZFREE (var strm : z_stream; ptr : voidpf);
398 procedure TRY_FREE (var strm : z_stream; ptr : voidpf);
400 const
401 ZLIB_VERSION : string[10] = '1.1.2';
403 const
404 z_errbase = Z_NEED_DICT;
405 z_errmsg : Array[0..9] of string[21] = { indexed by 2-zlib_error }
406 ('need dictionary', { Z_NEED_DICT 2 }
407 'stream end', { Z_STREAM_END 1 }
408 '', { Z_OK 0 }
409 'file error', { Z_ERRNO (-1) }
410 'stream error', { Z_STREAM_ERROR (-2) }
411 'data error', { Z_DATA_ERROR (-3) }
412 'insufficient memory', { Z_MEM_ERROR (-4) }
413 'buffer error', { Z_BUF_ERROR (-5) }
414 'incompatible version',{ Z_VERSION_ERROR (-6) }
415 '');
416 const
417 z_verbose : int = 1;
419 function deflateInit_(var Stream: z_stream; Level: LongInt; const Version: AnsiString;
420 Stream_size: LongInt): LongInt;
421 function inflateInit_(var Stream: z_stream; const Version: AnsiString;
422 Stream_size: Longint): LongInt;
424 {$IFDEF DEBUG}
425 procedure z_error (m : string);
426 {$ENDIF}
428 implementation
430 uses
431 imzdeflate, imzinflate;
433 function deflateInit_(var Stream: z_stream; Level: LongInt; const Version: AnsiString;
434 Stream_size: LongInt): LongInt;
435 begin
436 Result := imzdeflate.deflateInit_(@Stream, Level, Version, Stream_size);
437 end;
439 function inflateInit_(var Stream: z_stream; const Version: AnsiString;
440 Stream_size: Longint): LongInt;
441 begin
442 Result := imzinflate.inflateInit_(@Stream, Version, Stream_size);
443 end;
445 function zError(err : int) : AnsiString;
446 begin
447 zError := z_errmsg[Z_NEED_DICT-err];
448 end;
450 function zlibVersion : AnsiString;
451 begin
452 zlibVersion := ZLIB_VERSION;
453 end;
455 procedure z_error (m : AnsiString);
456 begin
457 WriteLn(output, m);
458 Write('Zlib - Halt...');
459 ReadLn;
460 Halt(1);
461 end;
463 procedure Assert(cond : boolean; msg : AnsiString);
464 begin
465 if not cond then
466 z_error(msg);
467 end;
469 procedure Trace(x : AnsiString);
470 begin
471 WriteLn(x);
472 end;
474 procedure Tracev(x : AnsiString);
475 begin
476 if (z_verbose>0) then
477 WriteLn(x);
478 end;
480 procedure Tracevv(x : AnsiString);
481 begin
482 if (z_verbose>1) then
483 WriteLn(x);
484 end;
486 procedure Tracevvv(x : AnsiString);
487 begin
488 if (z_verbose>2) then
489 WriteLn(x);
490 end;
492 procedure Tracec(c : boolean; x : AnsiString);
493 begin
494 if (z_verbose>0) and (c) then
495 WriteLn(x);
496 end;
498 procedure Tracecv(c : boolean; x : AnsiString);
499 begin
500 if (z_verbose>1) and c then
501 WriteLn(x);
502 end;
504 function ZALLOC (var strm : z_stream; items : uInt; size : uInt) : voidpf;
505 begin
506 ZALLOC := strm.zalloc(strm.opaque, items, size);
507 end;
509 procedure ZFREE (var strm : z_stream; ptr : voidpf);
510 begin
511 strm.zfree(strm.opaque, ptr);
512 end;
514 procedure TRY_FREE (var strm : z_stream; ptr : voidpf);
515 begin
516 {if @strm <> Z_NULL then}
517 strm.zfree(strm.opaque, ptr);
518 end;
520 end.