796 lines
18 KiB
Plaintext
796 lines
18 KiB
Plaintext
(* ImageEn Build 7.0.0.06.2637 @ 7-4-17 14:58:42.679 *)
|
|
(*
|
|
File version 1001
|
|
*)
|
|
|
|
unit tiflzw;
|
|
|
|
{$R-}
|
|
{$Q-}
|
|
|
|
// Example of TIFF-LZW decompression plug-in for ImageEn
|
|
|
|
{$I ie.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
Windows, classes, sysutils;
|
|
|
|
|
|
function TIFFLZWDecompress(CompBuf: pbyte; LineSize: integer; var Id: pointer; FillOrder: integer): pbyte;
|
|
procedure TIFFLZWCompress(indata: pbyte; inputlen: integer; outstream: TStream; var id: pointer);
|
|
|
|
|
|
implementation
|
|
|
|
uses
|
|
hyieutils;
|
|
|
|
{$R-}
|
|
|
|
const
|
|
EOICODE = 257;
|
|
CLEARCODE = 256;
|
|
MAXPREALLOC = 32; // preallocated byte (min 3) (great is more quick)
|
|
DECOMPBLOCKSIZE = 1024;
|
|
|
|
type
|
|
|
|
// string table
|
|
TSItem = record
|
|
Data: pbyte;
|
|
Dim: integer;
|
|
PreAlloc: array[0..MAXPREALLOC - 1] of byte; // preallocated bytes
|
|
end;
|
|
PSItem = ^TSItem;
|
|
|
|
// LZW decompressor record
|
|
TTIFLZWDec = record
|
|
// single row decompressed (in-class allocated)
|
|
fDecomp: pbyte;
|
|
fDecompAllocated: integer;
|
|
// compressed buffer (out-class allocated)
|
|
fComp: pbyte;
|
|
// row length in bytes. fComp is decompressed in blocks of fLineSize
|
|
fLineSize: integer;
|
|
// Position (in bit) of next code to read
|
|
fNextCode: integer;
|
|
// Length of current code
|
|
fDimCode: integer;
|
|
// position of next byte to write in fDecomp
|
|
fWPos: integer;
|
|
fWByte: pbyte;
|
|
//
|
|
fOldCode: integer;
|
|
// String table
|
|
STableSize: integer; // number of elements in STable
|
|
STable: array[0..4096] of TSItem; // max 12 bit
|
|
//
|
|
Aborting: boolean;
|
|
fFillOrder: integer; // the same as TIFF specifications
|
|
end;
|
|
PTIFLZWDec = ^TTIFLZWDec;
|
|
|
|
|
|
|
|
// return next code from fComp (based on fNextCode and fDimCode)
|
|
// Note: fDimCode is from 9 to 12
|
|
function GetNextCode(plzw: PTIFLZWDec): integer;
|
|
begin
|
|
|
|
with plzw^ do
|
|
begin
|
|
result := pinteger(@pbytearray(fComp)[ fNextCode shr 3 ])^;
|
|
|
|
// 3.0.1, to support FillOrder=2 reading TIFF-LZW files (1/8/2008, 21:17)
|
|
if fFillOrder=2 then
|
|
begin
|
|
ReverseBitsB(pbytearray(@result)[0]);
|
|
ReverseBitsB(pbytearray(@result)[1]);
|
|
ReverseBitsB(pbytearray(@result)[2]);
|
|
ReverseBitsB(pbytearray(@result)[3]);
|
|
end;
|
|
|
|
// invert bytes of the double word result
|
|
{$ifdef IEUSEASM}
|
|
asm
|
|
mov EAX, @result
|
|
bswap EAX
|
|
mov @result, EAX
|
|
end;
|
|
{$else}
|
|
result := IESwapDWord(result);
|
|
{$endif}
|
|
|
|
result := (result shl (fNextCode and 7)) shr (32 - fDimCode);
|
|
|
|
inc(fNextCode, fDimCode);
|
|
end;
|
|
end;
|
|
|
|
|
|
// Free table memory
|
|
procedure FreeTable(plzw: PTIFLZWDec);
|
|
var
|
|
q: integer;
|
|
begin
|
|
with plzw^ do
|
|
begin
|
|
for q := 256 to STableSize - 1 do
|
|
if STable[q].Dim > MAXPREALLOC then
|
|
freemem(STable[q].Data);
|
|
STableSize := 0;
|
|
end;
|
|
end;
|
|
|
|
|
|
// Init table
|
|
procedure InitializeTable(plzw: PTIFLZWDec);
|
|
begin
|
|
FreeTable(plzw); // free table if allocated
|
|
plzw^.STableSize := 258;
|
|
plzw^.fDimCode := 9;
|
|
end;
|
|
|
|
|
|
procedure PutCode(plzw: PTIFLZWDec; code: integer);
|
|
var
|
|
ps: pbyte;
|
|
cdim: integer;
|
|
begin
|
|
with plzw^ do
|
|
begin
|
|
cdim := STable[code].Dim;
|
|
while fWPos + cdim > fDecompAllocated do
|
|
begin
|
|
// can happen when decompressed block exceed line size (goes at next line)
|
|
inc(fDecompAllocated, DECOMPBLOCKSIZE);
|
|
ReallocMem(fDecomp, fDecompAllocated);
|
|
fWByte := @(pbytearray(fDecomp)[fWPos]);
|
|
end;
|
|
|
|
if code < 256 then
|
|
begin
|
|
fWByte^ := code; inc(fWByte);
|
|
inc(fWPos);
|
|
end
|
|
else
|
|
begin
|
|
with STable[code] do
|
|
begin
|
|
case cdim of
|
|
1:
|
|
begin
|
|
fWByte^ := Data^;
|
|
inc(fWByte);
|
|
end;
|
|
2:
|
|
begin
|
|
ps := pbyte(Data);
|
|
fWByte^ := ps^; inc(ps); inc(fWByte);
|
|
fWByte^ := ps^; inc(fWByte);
|
|
end;
|
|
3:
|
|
begin
|
|
ps := pbyte(Data);
|
|
fWByte^ := ps^; inc(ps); inc(fWByte);
|
|
fWByte^ := ps^; inc(ps); inc(fWByte);
|
|
fWByte^ := ps^; inc(fWByte);
|
|
end;
|
|
4:
|
|
begin
|
|
ps := pbyte(Data);
|
|
fWByte^ := ps^; inc(ps); inc(fWByte);
|
|
fWByte^ := ps^; inc(ps); inc(fWByte);
|
|
fWByte^ := ps^; inc(ps); inc(fWByte);
|
|
fWByte^ := ps^; inc(fWByte);
|
|
end
|
|
else
|
|
begin
|
|
CopyMemory(fWByte, Data, cdim);
|
|
inc(fWByte, cdim);
|
|
end;
|
|
end;
|
|
inc(fWPos, cdim);
|
|
end;
|
|
end;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
// Adds to table OldCode + the first char in Code
|
|
// 3.0.3
|
|
function AddConcatToTable(plzw: PTIFLZWDec; Code, OldCode: integer): boolean;
|
|
var
|
|
sz: integer;
|
|
ps, pd: pbyte;
|
|
begin
|
|
with plzw^ do
|
|
begin
|
|
|
|
with STable[STableSize] do
|
|
begin
|
|
// copy the whole OldCode data
|
|
if OldCode < 256 then
|
|
begin
|
|
sz := 1;
|
|
Dim := 2;
|
|
Data := @PreAlloc;
|
|
Data^ := OldCode;
|
|
end
|
|
else
|
|
begin
|
|
sz := STable[OldCode].Dim;
|
|
Dim := sz + 1;
|
|
if Dim > MAXPREALLOC then
|
|
getmem(Data, Dim)
|
|
else
|
|
Data := @PreAlloc;
|
|
|
|
if sz=1 then
|
|
Data^ := STable[OldCode].Data^
|
|
else
|
|
if sz=2 then
|
|
begin
|
|
ps := STable[OldCode].Data;
|
|
pd := Data;
|
|
pd^ := ps^; inc(pd); inc(ps);
|
|
pd^ := ps^;
|
|
end
|
|
else
|
|
if sz=3 then
|
|
begin
|
|
ps := STable[OldCode].Data;
|
|
pd := Data;
|
|
pd^ := ps^; inc(pd); inc(ps);
|
|
pd^ := ps^; inc(pd); inc(ps);
|
|
pd^ := ps^;
|
|
end
|
|
else
|
|
CopyMemory(Data, STable[OldCode].Data, sz);
|
|
end;
|
|
|
|
// copy first byte of Code data
|
|
pbytearray(Data)[sz] := STable[Code].Data^; // first char
|
|
end;
|
|
|
|
inc(STableSize);
|
|
case STableSize of
|
|
511: fDimCode := 10;
|
|
1023: fDimCode := 11;
|
|
2047: fDimCode := 12;
|
|
end;
|
|
|
|
if STableSize > high(STable) then
|
|
Aborting := True; // table overflow
|
|
|
|
result := not Aborting;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
// decompress fLineSize bytes
|
|
// 3.0.3
|
|
function GetNextline(plzw: PTIFLZWDec): pbyte;
|
|
var
|
|
Code: integer;
|
|
OldCode: integer;
|
|
begin
|
|
|
|
result := nil;
|
|
|
|
with plzw^ do
|
|
begin
|
|
|
|
OldCode := fOldCode;
|
|
|
|
if fWPos > fLineSize then
|
|
begin
|
|
// copy the rest of previous row
|
|
move(pbytearray(fDecomp)[fLineSize], fDecomp^, fWPos - fLineSize);
|
|
fWPos := fWPos - fLineSize;
|
|
fWByte := @(pbytearray(fDecomp)[fWPos]);
|
|
end
|
|
else
|
|
begin
|
|
fWPos := 0;
|
|
fWByte := pbyte(fDecomp);
|
|
end;
|
|
|
|
while fWPos < fLineSize do
|
|
begin
|
|
|
|
Code := GetNextCode(plzw);
|
|
|
|
if OldCode = -1 then
|
|
OldCode := Code;
|
|
|
|
if Code = CLEARCODE then
|
|
begin
|
|
InitializeTable(plzw);
|
|
Code := GetNextCode(plzw);
|
|
if Code = EOICODE then
|
|
break;
|
|
if Code >= STableSize then
|
|
begin
|
|
// invalid code, must be < STableSize (because we haven't OldCode now)
|
|
Aborting := true;
|
|
exit;
|
|
end;
|
|
PutCode(plzw, Code);
|
|
OldCode := Code;
|
|
end
|
|
|
|
else
|
|
if Code = EOICODE then
|
|
break
|
|
|
|
else
|
|
if Code < 256 then // just an optimization
|
|
begin
|
|
fWByte^ := code; inc(fWByte); inc(fWPos);
|
|
if not AddConcatToTable(plzw, Code, OldCode) then
|
|
exit; // aborting=true implicit (table overflow)
|
|
OldCode := Code;
|
|
end
|
|
|
|
else
|
|
if Code < STableSize then
|
|
begin
|
|
PutCode(plzw, Code);
|
|
if not AddConcatToTable(plzw, Code, OldCode) then
|
|
exit; // aborting=true implicit (table overflow)
|
|
OldCode := Code;
|
|
end
|
|
|
|
else
|
|
if Code = STableSize then
|
|
begin
|
|
if not AddConcatToTable(plzw, OldCode, OldCode) then
|
|
exit; // aborting=true implicit (table overflow)
|
|
PutCode(plzw, STableSize - 1);
|
|
OldCode := Code;
|
|
end
|
|
|
|
else
|
|
begin
|
|
// invalid Code (do not Abort, sometime images can be successfully loaded also with this error)
|
|
break;
|
|
end;
|
|
|
|
end;
|
|
|
|
fOldCode := OldCode;
|
|
|
|
result := fDecomp;
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
// buf = compressed buffer data
|
|
// LineSize = length of one line in buf (in bytes)
|
|
// 3.0.3
|
|
function CreateLzw(buf: pbyte; LineSize: integer; FillOrder: integer): PTIFLZWDec;
|
|
var
|
|
i: integer;
|
|
begin
|
|
result := allocmem(sizeof(TTIFLZWDec)); // zero filled
|
|
with result^ do
|
|
begin
|
|
fDecompAllocated := LineSize + 1;
|
|
getmem(fDecomp, fDecompAllocated);
|
|
|
|
fComp := buf;
|
|
fLineSize := LineSize;
|
|
fNextCode := 0;
|
|
InitializeTable(result);
|
|
fOldCode := -1;
|
|
fWPos := 0;
|
|
fWByte := pbyte(fDecomp);
|
|
Aborting := false;
|
|
fFillOrder := FillOrder;
|
|
for i := 0 to 255 do
|
|
begin
|
|
STable[i].Data := @STable[i].PreAlloc;
|
|
STable[i].Data^ := i;
|
|
STable[i].Dim := 1;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure DestroyLzw(plzw: PTIFLZWDec);
|
|
begin
|
|
FreeTable(plzw);
|
|
freemem(plzw^.fDecomp);
|
|
freemem(plzw);
|
|
end;
|
|
|
|
|
|
///////////////////////////////////////////////////////////////////////////////////////
|
|
///////////////////////////////////////////////////////////////////////////////////////
|
|
///////////////////////////////////////////////////////////////////////////////////////
|
|
// CompBuf: compressed buf (of full image)
|
|
// LineSize: row size in bytes (this isn't the size of the image)
|
|
// Id: is a reference variable (where I store the pointer to TTIFLZWDec object)
|
|
// IMPORTANT:
|
|
// - In the first call "Id" is ZERO.
|
|
// - In the nexts call "Id" will be the some returned in the first call
|
|
// - In the last call "CompBuf" will be NIL (you will free your allocated objects)
|
|
// rest: the decompressed row (you have not to free it) or nil if error detected
|
|
|
|
function TIFFLZWDecompress(CompBuf: pbyte; LineSize: integer; var Id: pointer; FillOrder: integer): pbyte;
|
|
var
|
|
plzw: PTIFLZWDec;
|
|
begin
|
|
result := nil;
|
|
|
|
if Id <> nil then
|
|
begin
|
|
plzw := PTIFLZWDec(Id);
|
|
if CompBuf = nil then
|
|
begin
|
|
DestroyLzw(plzw);
|
|
exit; // EXIT POINT
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
plzw := CreateLzw(CompBuf, LineSize, FillOrder);
|
|
Id := pointer(plzw);
|
|
end;
|
|
|
|
if assigned(plzw) then
|
|
result := GetNextLine(plzw);
|
|
|
|
end;
|
|
|
|
|
|
/////////////////////////////////////////////////////////////////////////////////////////////
|
|
/////////////////////////////////////////////////////////////////////////////////////////////
|
|
/////////////////////////////////////////////////////////////////////////////////////////////
|
|
|
|
// Original C code:
|
|
// ppmtogif.c - read a portable pixmap and produce a GIF file
|
|
//
|
|
// Based on GIFENCOD by David Rowley <mgardi@watdscu.waterloo.edu>.A
|
|
// Lempel-Zim compression based on "compress".
|
|
//
|
|
// Modified by Marcel Wijkstra <wijkstra@fwi.uva.nl>
|
|
//
|
|
//
|
|
// Copyright (C) 1989 by Jef Poskanzer.
|
|
//
|
|
|
|
const
|
|
BITS = 12;
|
|
maxbits = 12;
|
|
maxmaxcode = 1 shl BITS - 1;
|
|
HSIZE = 5003;
|
|
XEOF = -1;
|
|
|
|
type
|
|
TLZWCompRecord = record
|
|
inpos: integer;
|
|
oStream: TStream;
|
|
CountDown: integer;
|
|
indata: pbyte;
|
|
init_bits: integer;
|
|
n_bits: integer;
|
|
maxcode: integer;
|
|
ClearCode: integer;
|
|
EOFCode: integer;
|
|
free_ent: integer;
|
|
clear_flg: integer;
|
|
a_count: integer;
|
|
htab: array[0..HSIZE - 1] of integer;
|
|
codetab: array[0..HSIZE - 1] of word;
|
|
cur_accum: dword;
|
|
cur_bits: integer;
|
|
accum: array[0..255] of AnsiChar;
|
|
g_init_bits: integer;
|
|
_fcode: integer;
|
|
_i: integer;
|
|
_c: integer;
|
|
_ent: integer;
|
|
_disp: integer;
|
|
_hsize_reg: integer;
|
|
_hshift: integer;
|
|
end;
|
|
PLZWCompRecord = ^TLZWCompRecord;
|
|
|
|
function NextPixel(var lzwr: TLZWCompRecord): integer;
|
|
var
|
|
pb: pbyte;
|
|
begin
|
|
with lzwr do
|
|
begin
|
|
if (CountDown = 0) then
|
|
begin
|
|
result := XEOF;
|
|
exit;
|
|
end;
|
|
dec(CountDown);
|
|
|
|
pb := indata;
|
|
inc(pb, inpos);
|
|
result := pb^;
|
|
|
|
inc(inpos);
|
|
end;
|
|
end;
|
|
|
|
procedure cl_hash(var lzwr: TLZWCompRecord; hsize: integer);
|
|
var
|
|
htab_p: pinteger;
|
|
i, m1: integer;
|
|
begin
|
|
htab_p := @(lzwr.htab[0]);
|
|
inc(htab_p, hsize);
|
|
m1 := -1;
|
|
i := hsize - 16;
|
|
repeat
|
|
pinteger(uint64(htab_p) - 4 * 16)^ := m1;
|
|
pinteger(uint64(htab_p) - 4 * 15)^ := m1;
|
|
pinteger(uint64(htab_p) - 4 * 14)^ := m1;
|
|
pinteger(uint64(htab_p) - 4 * 13)^ := m1;
|
|
pinteger(uint64(htab_p) - 4 * 12)^ := m1;
|
|
pinteger(uint64(htab_p) - 4 * 11)^ := m1;
|
|
pinteger(uint64(htab_p) - 4 * 10)^ := m1;
|
|
pinteger(uint64(htab_p) - 4 * 9)^ := m1;
|
|
pinteger(uint64(htab_p) - 4 * 8)^ := m1;
|
|
pinteger(uint64(htab_p) - 4 * 7)^ := m1;
|
|
pinteger(uint64(htab_p) - 4 * 6)^ := m1;
|
|
pinteger(uint64(htab_p) - 4 * 5)^ := m1;
|
|
pinteger(uint64(htab_p) - 4 * 4)^ := m1;
|
|
pinteger(uint64(htab_p) - 4 * 3)^ := m1;
|
|
pinteger(uint64(htab_p) - 4 * 2)^ := m1;
|
|
pinteger(uint64(htab_p) - 4 * 1)^ := m1;
|
|
dec(htab_p, 16);
|
|
dec(i, 16);
|
|
until not (i >= 0);
|
|
inc(i, 16);
|
|
while i > 0 do
|
|
begin
|
|
dec(htab_p);
|
|
htab_p^ := m1;
|
|
dec(i);
|
|
end;
|
|
end;
|
|
|
|
procedure flush_char(var lzwr: TLZWCompRecord);
|
|
begin
|
|
with lzwr do
|
|
begin
|
|
if (a_count > 0) then
|
|
begin
|
|
oStream.Write(accum[0], a_count);
|
|
a_count := 0;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure char_out(var lzwr: TLZWCompRecord; c: integer);
|
|
begin
|
|
with lzwr do
|
|
begin
|
|
accum[a_count] := AnsiChar(c);
|
|
inc(a_count);
|
|
if (a_count >= 254) then
|
|
flush_char(lzwr);
|
|
end;
|
|
end;
|
|
|
|
procedure output(var lzwr: TLZWCompRecord; code: integer);
|
|
const
|
|
masks: array[0..16] of integer =
|
|
($0000, $8000, $C000, $E000, $F000,
|
|
$F800, $FC00, $FE00, $FF00, $FF80,
|
|
$FFC0, $FFE0, $FFF0, $FFF8, $FFFC,
|
|
$FFFE, $FFFF);
|
|
begin
|
|
with lzwr do
|
|
begin
|
|
cur_accum := cur_accum and (((1 shl cur_bits) - 1) shl (32 - cur_bits));
|
|
if (cur_bits > 0) then
|
|
cur_accum := cur_accum or dword(code shl (32 - n_bits - cur_bits))
|
|
else
|
|
cur_accum := code shl dword(32 - n_bits);
|
|
inc(cur_bits, n_bits);
|
|
while (cur_bits >= 8) do
|
|
begin
|
|
char_out(lzwr, dword(cur_accum and $FF000000) shr 24);
|
|
cur_accum := cur_accum shl 8;
|
|
dec(cur_bits, 8);
|
|
end;
|
|
if (free_ent > maxcode - 1) or (clear_flg <> 0) then
|
|
begin
|
|
if (clear_flg <> 0) then
|
|
begin
|
|
n_bits := g_init_bits;
|
|
maxcode := 1 shl n_bits - 1;
|
|
clear_flg := 0;
|
|
end
|
|
else
|
|
begin
|
|
inc(n_bits);
|
|
if (n_bits = maxbits) then
|
|
maxcode := maxmaxcode
|
|
else
|
|
maxcode := 1 shl n_bits - 1;
|
|
end;
|
|
end;
|
|
if (code = EOFCode) then
|
|
begin
|
|
while (cur_bits > 0) do
|
|
begin
|
|
char_out(lzwr, dword(cur_accum and $FF000000) shr 24);
|
|
cur_accum := cur_accum shl 8;
|
|
dec(cur_bits, 8);
|
|
end;
|
|
flush_char(lzwr);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure cl_block(var lzwr: TLZWCompRecord);
|
|
begin
|
|
with lzwr do
|
|
begin
|
|
cl_hash(lzwr, integer(hsize));
|
|
free_ent := ClearCode + 2;
|
|
clear_flg := 1;
|
|
output(lzwr, integer(ClearCode));
|
|
end;
|
|
end;
|
|
|
|
// op=0 initialize/encode
|
|
// op=1 encode
|
|
// op=2 finalize
|
|
|
|
procedure lzwcompress(var lzwr: TLZWCompRecord; op: integer);
|
|
label
|
|
probe, nomatch;
|
|
begin
|
|
with lzwr do
|
|
begin
|
|
if op = 0 then
|
|
begin
|
|
// initialize
|
|
g_init_bits := init_bits;
|
|
clear_flg := 0;
|
|
n_bits := init_bits;
|
|
maxcode := 1 shl n_bits - 1;
|
|
ClearCode := (1 shl (lzwr.init_bits - 1));
|
|
EOFCode := ClearCode + 1;
|
|
free_ent := ClearCode + 2;
|
|
a_count := 0;
|
|
_ent := NextPixel(lzwr);
|
|
_hshift := 0;
|
|
_fcode := hsize;
|
|
while _fcode < 65536 do
|
|
begin
|
|
inc(_hshift);
|
|
_fcode := _fcode * 2;
|
|
end;
|
|
_hshift := 8 - _hshift;
|
|
_hsize_reg := hsize;
|
|
cl_hash(lzwr, _hsize_reg);
|
|
output(lzwr, ClearCode);
|
|
end;
|
|
if (op = 0) or (op = 1) then
|
|
begin
|
|
// encoding
|
|
while (true) do
|
|
begin
|
|
_c := NextPixel(lzwr);
|
|
if _c = XEOF then
|
|
break;
|
|
_fcode := integer(((integer(_c) shl maxbits) + _ent));
|
|
_i := ((integer(_c) shl _hshift) xor _ent);
|
|
if (lzwr.htab[_i] = _fcode) then
|
|
begin
|
|
_ent := codetab[_i];
|
|
continue;
|
|
end
|
|
else
|
|
if (integer(htab[_i]) < 0) then
|
|
goto nomatch;
|
|
_disp := _hsize_reg - _i;
|
|
if (_i = 0) then
|
|
_disp := 1;
|
|
probe:
|
|
dec(_i, _disp);
|
|
if (_i < 0) then
|
|
inc(_i, _hsize_reg);
|
|
if (htab[_i] = _fcode) then
|
|
begin
|
|
_ent := codetab[_i];
|
|
continue;
|
|
end;
|
|
if (integer(htab[_i]) > 0) then
|
|
goto probe;
|
|
nomatch:
|
|
output(lzwr, integer(_ent));
|
|
_ent := _c;
|
|
if (free_ent < maxmaxcode - 1) then
|
|
begin
|
|
codetab[_i] := free_ent;
|
|
inc(free_ent);
|
|
htab[_i] := _fcode;
|
|
end
|
|
else
|
|
cl_block(lzwr);
|
|
end;
|
|
end
|
|
else
|
|
if op = 2 then
|
|
begin
|
|
// finalize
|
|
output(lzwr, integer(_ent));
|
|
output(lzwr, integer(EOFCode));
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
// indata: decompressed data
|
|
// inputlen: indata length (in bytes)
|
|
// outstream: compressed data
|
|
// Id: is a reference variable (where I store the pointer to TLZWCompRecord object)
|
|
// IMPORTANT:
|
|
// - In the first call "Id" is ZERO.
|
|
// - In the nexts call "Id" will be the some returned in the first call
|
|
// - In the last call "indata" will be NIL (you will free your allocated objects)
|
|
|
|
procedure TIFFLZWCompress(indata: pbyte; inputlen: integer; outstream: TStream; var id: pointer);
|
|
var
|
|
lzwr: PLZWCompRecord;
|
|
begin
|
|
if id = nil then
|
|
begin
|
|
// initialize/encode
|
|
new(lzwr);
|
|
lzwr^.indata := pbyte(indata);
|
|
lzwr^.oStream := outstream;
|
|
lzwr^.cur_accum := 0;
|
|
lzwr^.cur_bits := 0;
|
|
lzwr^.CountDown := inputlen;
|
|
lzwr^.free_ent := 0;
|
|
lzwr^.inpos := 0;
|
|
lzwr^.init_bits := 8 + 1;
|
|
lzwcompress(lzwr^, 0);
|
|
id := pointer(lzwr);
|
|
end
|
|
else
|
|
if id <> nil then
|
|
begin
|
|
lzwr := PLZWCompRecord(id);
|
|
if indata = nil then
|
|
begin
|
|
// finalize
|
|
lzwcompress(lzwr^, 2);
|
|
dispose(lzwr)
|
|
end
|
|
else
|
|
begin
|
|
// continue encoding
|
|
lzwr^.CountDown := inputlen;
|
|
lzwr^.indata := pbyte(indata);
|
|
lzwr^.inpos := 0;
|
|
lzwcompress(lzwr^, 1);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
end.
|
|
|