1331 lines
42 KiB
Plaintext
1331 lines
42 KiB
Plaintext
(* ImageEn Build 7.0.0.06.2637 @ 7-4-17 14:58:42.679 *)
|
|
(*
|
|
Copyright (c) 1998-2017 by Carlotta Calandra. All rights reserved.
|
|
Copyright (c) 2011-2017 by Xequte Software.
|
|
|
|
This software comes without express or implied warranty.
|
|
In no case shall the author be liable for any damage or unwanted behavior of any
|
|
computer hardware and/or software.
|
|
|
|
Author grants you the right to include the component
|
|
in your application, whether COMMERCIAL, SHAREWARE, or FREEWARE.
|
|
|
|
ImageEn, IEvolution and ImageEn ActiveX may not be included in any
|
|
commercial, shareware or freeware libraries or components.
|
|
|
|
www.ImageEn.com
|
|
*)
|
|
|
|
(*
|
|
File version 1008
|
|
*)
|
|
|
|
unit tifccitt;
|
|
|
|
{$R-}
|
|
{$Q-}
|
|
|
|
{$I ie.inc}
|
|
|
|
interface
|
|
|
|
uses Windows, sysutils, classes, hyiedefs;
|
|
|
|
procedure IEInitialize_tifccitt();
|
|
procedure IEFinalize_tifccitt();
|
|
|
|
function CCITTHuffmanGetLine(dstbuf, srcbuf: pbyte; srcbufLen: integer; Width: integer; FillOrder: integer): integer;
|
|
function _CCITTHuffmanGetLine(dstbuf, srcbuf: pbyte; srcbufLen: integer; Width: integer; posb: integer; FillOrder: integer): integer;
|
|
function CCITT3_2D_GetLine(dstbuf, srcbuf: pbyte; srcbuflen: integer; Width: integer; predbuf: pbyte; posb: integer; FillOrder: integer; AlignEOL: boolean): integer;
|
|
procedure CCITTHuffmanPutLine(rdata: pbyte; wb: integer; fs: TStream; var Aborting: boolean; FillOrder: integer);
|
|
procedure CCITTHuffmanPutLineG3(rdata: pbyte; wb: integer; fs: TStream; var bwr: byte; var bwrl: integer; var Aborting: boolean; FillOrder: integer);
|
|
procedure CCITTHuffmanPutLineG32D(rdata: pbyte; wb: integer; fs: TStream; var bwr: byte; var bwrl: integer; var predline: pbyte; var Aborting: boolean; FillOrder: integer);
|
|
procedure _CCITTHuffmanPutLine(rdata: pbyte; wb: integer; wbuf: pbyte; var wpos: integer; FillOrder: integer);
|
|
procedure CCITTHuffmanPutLineG4(rdata: pbyte; wb: integer; fs: TStream; var bwr: byte; var bwrl: integer; var predline: pbyte; var Aborting: boolean; FillOrder: integer);
|
|
|
|
implementation
|
|
|
|
uses
|
|
hyieutils, ImageEnProc;
|
|
|
|
{$R-}
|
|
|
|
type
|
|
|
|
ppbyte = ^pbyte;
|
|
|
|
TT4Entry = record
|
|
dim: integer; // code bit count
|
|
code: word; // code (max 14 bit)
|
|
rl: integer; // run length
|
|
end;
|
|
PT4Entry = ^TT4Entry;
|
|
|
|
const
|
|
G3CODE_INVALID = -1;
|
|
G3CODE_INCOMP = -2;
|
|
G3CODE_EOL = -3;
|
|
G3CODE_EOF = -4;
|
|
bitmask: array [0..7] of byte = ($80, $40, $20, $10, $08, $04, $02, $01);
|
|
bitclearmask: array [0..7] of byte = ($80, $C0, $E0, $F0, $F8, $FC, $FE, $FF);
|
|
|
|
|
|
const
|
|
T4_2DC: array [0..12] of TT4Entry = (
|
|
(dim: 12; code: 0), // 000000000000 (12 zeri) - 0:INVALID
|
|
(dim: 4; code: 1), // 0001 - 1:pass
|
|
(dim: 3; code: 1), // 001 - 2:horizzontal
|
|
(dim: 7; code: 2), // 0000010 - 3:vertical Vl(3)
|
|
(dim: 6; code: 2), // 000010 - 4:vertical Vl(2)
|
|
(dim: 3; code: 2), // 010 - 5:vertical Vl(1)
|
|
(dim: 1; code: 1), // 1 - 6:vertical V(0)
|
|
(dim: 3; code: 3), // 011 - 7:vertical Vr(1)
|
|
(dim: 6; code: 3), // 000011 - 8:vertical Vr(2)
|
|
(dim: 7; code: 3), // 0000011 - 9:vertical Vr(3)
|
|
(dim: 10; code: 15), // 0000001111 - 10:extension 2-D (enter in uncompressed mode)
|
|
(dim: 12; code: 15), // 000000001111 - 11:extension 1-D (enter in uncompressed mode)
|
|
(dim: 12; code: 1) // 0000 00000001 - 12:EOL
|
|
);
|
|
|
|
type
|
|
PT4Tree = ^TT4Tree;
|
|
TT4Tree = record
|
|
code: integer;
|
|
childs: array [0..1] of PT4Tree; // if 0 and 1 is nil this is a terminal node
|
|
end;
|
|
|
|
var
|
|
T4Tree: array [0..1] of TT4Tree;
|
|
|
|
const
|
|
NUMCODES = 116 + 12;
|
|
T4Codes: array [0..1, 0..NUMCODES - 1] of TT4Entry = ((
|
|
// WHITE CODES
|
|
(dim: 8; code: $35; rl: 0), // 0011 0101
|
|
(dim: 6; code: $7; rl: 1), // 0001 11
|
|
(dim: 4; code: $7; rl: 2), // 0111
|
|
(dim: 4; code: $8; rl: 3), // 1000
|
|
(dim: 4; code: $B; rl: 4), // 1011
|
|
(dim: 4; code: $C; rl: 5), // 1100
|
|
(dim: 4; code: $E; rl: 6), // 1110
|
|
(dim: 4; code: $F; rl: 7), // 1111
|
|
(dim: 5; code: $13; rl: 8), // 1001 1
|
|
(dim: 5; code: $14; rl: 9), // 1010 0
|
|
(dim: 5; code: $7; rl: 10), // 0011 1
|
|
(dim: 5; code: $8; rl: 11), // 0100 0
|
|
(dim: 6; code: $8; rl: 12), // 0010 00
|
|
(dim: 6; code: $3; rl: 13), // 0000 11
|
|
(dim: 6; code: $34; rl: 14), // 1101 00
|
|
(dim: 6; code: $35; rl: 15), // 1101 01
|
|
(dim: 6; code: $2A; rl: 16), // 1010 10
|
|
(dim: 6; code: $2B; rl: 17), // 1010 11
|
|
(dim: 7; code: $27; rl: 18), // 0100 111
|
|
(dim: 7; code: $C; rl: 19), // 0001 100
|
|
(dim: 7; code: $8; rl: 20), // 0001 000
|
|
(dim: 7; code: $17; rl: 21), // 0010 111
|
|
(dim: 7; code: $3; rl: 22), // 0000 011
|
|
(dim: 7; code: $4; rl: 23), // 0000 100
|
|
(dim: 7; code: $28; rl: 24), // 0101 000
|
|
(dim: 7; code: $2B; rl: 25), // 0101 011
|
|
(dim: 7; code: $13; rl: 26), // 0010 011
|
|
(dim: 7; code: $24; rl: 27), // 0100 100
|
|
(dim: 7; code: $18; rl: 28), // 0011 000
|
|
(dim: 8; code: $2; rl: 29), // 0000 0010
|
|
(dim: 8; code: $3; rl: 30), // 0000 0011
|
|
(dim: 8; code: $1A; rl: 31), // 0001 1010
|
|
(dim: 8; code: $1B; rl: 32), // 0001 1011
|
|
(dim: 8; code: $12; rl: 33), // 0001 0010
|
|
(dim: 8; code: $13; rl: 34), // 0001 0011
|
|
(dim: 8; code: $14; rl: 35), // 0001 0100
|
|
(dim: 8; code: $15; rl: 36), // 0001 0101
|
|
(dim: 8; code: $16; rl: 37), // 0001 0110
|
|
(dim: 8; code: $17; rl: 38), // 0001 0111
|
|
(dim: 8; code: $28; rl: 39), // 0010 1000
|
|
(dim: 8; code: $29; rl: 40), // 0010 1001
|
|
(dim: 8; code: $2A; rl: 41), // 0010 1010
|
|
(dim: 8; code: $2B; rl: 42), // 0010 1011
|
|
(dim: 8; code: $2C; rl: 43), // 0010 1100
|
|
(dim: 8; code: $2D; rl: 44), // 0010 1101
|
|
(dim: 8; code: $4; rl: 45), // 0000 0100
|
|
(dim: 8; code: $5; rl: 46), // 0000 0101
|
|
(dim: 8; code: $A; rl: 47), // 0000 1010
|
|
(dim: 8; code: $B; rl: 48), // 0000 1011
|
|
(dim: 8; code: $52; rl: 49), // 0101 0010
|
|
(dim: 8; code: $53; rl: 50), // 0101 0011
|
|
(dim: 8; code: $54; rl: 51), // 0101 0100
|
|
(dim: 8; code: $55; rl: 52), // 0101 0101
|
|
(dim: 8; code: $24; rl: 53), // 0010 0100
|
|
(dim: 8; code: $25; rl: 54), // 0010 0101
|
|
(dim: 8; code: $58; rl: 55), // 0101 1000
|
|
(dim: 8; code: $59; rl: 56), // 0101 1001
|
|
(dim: 8; code: $5A; rl: 57), // 0101 1010
|
|
(dim: 8; code: $5B; rl: 58), // 0101 1011
|
|
(dim: 8; code: $4A; rl: 59), // 0100 1010
|
|
(dim: 8; code: $4B; rl: 60), // 0100 1011
|
|
(dim: 8; code: $32; rl: 61), // 0011 0010
|
|
(dim: 8; code: $33; rl: 62), // 0011 0011
|
|
(dim: 8; code: $34; rl: 63), // 0011 0100
|
|
(dim: 5; code: $1B; rl: 64), // 1101 1
|
|
(dim: 5; code: $12; rl: 128), // 1001 0
|
|
(dim: 6; code: $17; rl: 192), // 0101 11
|
|
(dim: 7; code: $37; rl: 256), // 0110 111
|
|
(dim: 8; code: $36; rl: 320), // 0011 0110
|
|
(dim: 8; code: $37; rl: 384), // 0011 0111
|
|
(dim: 8; code: $64; rl: 448), // 0110 0100
|
|
(dim: 8; code: $65; rl: 512), // 0110 0101
|
|
(dim: 8; code: $68; rl: 576), // 0110 1000
|
|
(dim: 8; code: $67; rl: 640), // 0110 0111
|
|
(dim: 9; code: $CC; rl: 704), // 0110 0110 0
|
|
(dim: 9; code: $CD; rl: 768), // 0110 0110 1
|
|
(dim: 9; code: $D2; rl: 832), // 0110 1001 0
|
|
(dim: 9; code: $D3; rl: 896), // 0110 1001 1
|
|
(dim: 9; code: $D4; rl: 960), // 0110 1010 0
|
|
(dim: 9; code: $D5; rl: 1024), // 0110 1010 1
|
|
(dim: 9; code: $D6; rl: 1088), // 0110 1011 0
|
|
(dim: 9; code: $D7; rl: 1152), // 0110 1011 1
|
|
(dim: 9; code: $D8; rl: 1216), // 0110 1100 0
|
|
(dim: 9; code: $D9; rl: 1280), // 0110 1100 1
|
|
(dim: 9; code: $DA; rl: 1344), // 0110 1101 0
|
|
(dim: 9; code: $DB; rl: 1408), // 0110 1101 1
|
|
(dim: 9; code: $98; rl: 1472), // 0100 1100 0
|
|
(dim: 9; code: $99; rl: 1536), // 0100 1100 1
|
|
(dim: 9; code: $9A; rl: 1600), // 0100 1101 0
|
|
(dim: 6; code: $18; rl: 1664), // 0110 00
|
|
(dim: 9; code: $9B; rl: 1728), // 0100 1101 1
|
|
(dim: 11; code: $8; rl: 1792), // 0000 0001 000
|
|
(dim: 11; code: $C; rl: 1856), // 0000 0001 100
|
|
(dim: 11; code: $D; rl: 1920), // 0000 0001 101
|
|
(dim: 12; code: $12; rl: 1984), // 0000 0001 0010
|
|
(dim: 12; code: $13; rl: 2048), // 0000 0001 0011
|
|
(dim: 12; code: $14; rl: 2112), // 0000 0001 0100
|
|
(dim: 12; code: $15; rl: 2176), // 0000 0001 0101
|
|
(dim: 12; code: $16; rl: 2240), // 0000 0001 0110
|
|
(dim: 12; code: $17; rl: 2304), // 0000 0001 0111
|
|
(dim: 12; code: $1C; rl: 2368), // 0000 0001 1100
|
|
(dim: 12; code: $1D; rl: 2432), // 0000 0001 1101
|
|
(dim: 12; code: $1E; rl: 2496), // 0000 0001 1110
|
|
(dim: 12; code: $1F; rl: 2560), // 0000 0001 1111
|
|
(dim: 12; code: $1; rl: G3CODE_EOL), // 0000 0000 0001
|
|
(dim: 9; code: $1; rl: G3CODE_INVALID), // 0000 0000 1
|
|
(dim: 10; code: $1; rl: G3CODE_INVALID), // 0000 0000 01
|
|
(dim: 11; code: $1; rl: G3CODE_INVALID), // 0000 0000 001
|
|
(dim: 13; code: $1; rl: G3CODE_EOL), // 0000000000001
|
|
(dim: 14; code: $1; rl: G3CODE_EOL), // 00000000000001
|
|
(dim: 15; code: $1; rl: G3CODE_EOL), // 000000000000001
|
|
(dim: 16; code: $1; rl: G3CODE_EOL), // 0000000000000001
|
|
(dim: 17; code: $1; rl: G3CODE_EOL), // 00000000000000001
|
|
(dim: 18; code: $1; rl: G3CODE_EOL), // 000000000000000001
|
|
(dim: 19; code: $1; rl: G3CODE_EOL), // 0000000000000000001
|
|
(dim: 20; code: $1; rl: G3CODE_EOL), // 00000000000000000001
|
|
//
|
|
(dim: 21; code: $1; rl: G3CODE_EOL), // 000000000000000000001
|
|
(dim: 22; code: $1; rl: G3CODE_EOL), // 0000000000000000000001
|
|
(dim: 23; code: $1; rl: G3CODE_EOL), // 00000000000000000000001
|
|
(dim: 24; code: $1; rl: G3CODE_EOL), // 000000000000000000000001
|
|
(dim: 25; code: $1; rl: G3CODE_EOL), // 0000000000000000000000001
|
|
(dim: 26; code: $1; rl: G3CODE_EOL), // 00000000000000000000000001
|
|
(dim: 27; code: $1; rl: G3CODE_EOL), // 000000000000000000000000001
|
|
(dim: 28; code: $1; rl: G3CODE_EOL), // 0000000000000000000000000001
|
|
(dim: 29; code: $1; rl: G3CODE_EOL), // 00000000000000000000000000001
|
|
(dim: 30; code: $1; rl: G3CODE_EOL), // 000000000000000000000000000001
|
|
(dim: 31; code: $1; rl: G3CODE_EOL), // 0000000000000000000000000000001
|
|
(dim: 32; code: $1; rl: G3CODE_EOL) // 00000000000000000000000000000001
|
|
), (
|
|
|
|
// BLACK CODES
|
|
(dim: 10; code: $37; rl: 0), // 0000 1101 11
|
|
(dim: 3; code: $2; rl: 1), // 010
|
|
(dim: 2; code: $3; rl: 2), // 11
|
|
(dim: 2; code: $2; rl: 3), // 10
|
|
(dim: 3; code: $3; rl: 4), // 011
|
|
(dim: 4; code: $3; rl: 5), // 0011
|
|
(dim: 4; code: $2; rl: 6), // 0010
|
|
(dim: 5; code: $3; rl: 7), // 0001 1
|
|
(dim: 6; code: $5; rl: 8), // 0001 01
|
|
(dim: 6; code: $4; rl: 9), // 0001 00
|
|
(dim: 7; code: $4; rl: 10), // 0000 100
|
|
(dim: 7; code: $5; rl: 11), // 0000 101
|
|
(dim: 7; code: $7; rl: 12), // 0000 111
|
|
(dim: 8; code: $4; rl: 13), // 0000 0100
|
|
(dim: 8; code: $7; rl: 14), // 0000 0111
|
|
(dim: 9; code: $18; rl: 15), // 0000 1100 0
|
|
(dim: 10; code: $17; rl: 16), // 0000 0101 11
|
|
(dim: 10; code: $18; rl: 17), // 0000 0110 00
|
|
(dim: 10; code: $8; rl: 18), // 0000 0010 00
|
|
(dim: 11; code: $67; rl: 19), // 0000 1100 111
|
|
(dim: 11; code: $68; rl: 20), // 0000 1101 000
|
|
(dim: 11; code: $6C; rl: 21), // 0000 1101 100
|
|
(dim: 11; code: $37; rl: 22), // 0000 0110 111
|
|
(dim: 11; code: $28; rl: 23), // 0000 0101 000
|
|
(dim: 11; code: $17; rl: 24), // 0000 0010 111
|
|
(dim: 11; code: $18; rl: 25), // 0000 0011 000
|
|
(dim: 12; code: $CA; rl: 26), // 0000 1100 1010
|
|
(dim: 12; code: $CB; rl: 27), // 0000 1100 1011
|
|
(dim: 12; code: $CC; rl: 28), // 0000 1100 1100
|
|
(dim: 12; code: $CD; rl: 29), // 0000 1100 1101
|
|
(dim: 12; code: $68; rl: 30), // 0000 0110 1000
|
|
(dim: 12; code: $69; rl: 31), // 0000 0110 1001
|
|
(dim: 12; code: $6A; rl: 32), // 0000 0110 1010
|
|
(dim: 12; code: $6B; rl: 33), // 0000 0110 1011
|
|
(dim: 12; code: $D2; rl: 34), // 0000 1101 0010
|
|
(dim: 12; code: $D3; rl: 35), // 0000 1101 0011
|
|
(dim: 12; code: $D4; rl: 36), // 0000 1101 0100
|
|
(dim: 12; code: $D5; rl: 37), // 0000 1101 0101
|
|
(dim: 12; code: $D6; rl: 38), // 0000 1101 0110
|
|
(dim: 12; code: $D7; rl: 39), // 0000 1101 0111
|
|
(dim: 12; code: $6C; rl: 40), // 0000 0110 1100
|
|
(dim: 12; code: $6D; rl: 41), // 0000 0110 1101
|
|
(dim: 12; code: $DA; rl: 42), // 0000 1101 1010
|
|
(dim: 12; code: $DB; rl: 43), // 0000 1101 1011
|
|
(dim: 12; code: $54; rl: 44), // 0000 0101 0100
|
|
(dim: 12; code: $55; rl: 45), // 0000 0101 0101
|
|
(dim: 12; code: $56; rl: 46), // 0000 0101 0110
|
|
(dim: 12; code: $57; rl: 47), // 0000 0101 0111
|
|
(dim: 12; code: $64; rl: 48), // 0000 0110 0100
|
|
(dim: 12; code: $65; rl: 49), // 0000 0110 0101
|
|
(dim: 12; code: $52; rl: 50), // 0000 0101 0010
|
|
(dim: 12; code: $53; rl: 51), // 0000 0101 0011
|
|
(dim: 12; code: $24; rl: 52), // 0000 0010 0100
|
|
(dim: 12; code: $37; rl: 53), // 0000 0011 0111
|
|
(dim: 12; code: $38; rl: 54), // 0000 0011 1000
|
|
(dim: 12; code: $27; rl: 55), // 0000 0010 0111
|
|
(dim: 12; code: $28; rl: 56), // 0000 0010 1000
|
|
(dim: 12; code: $58; rl: 57), // 0000 0101 1000
|
|
(dim: 12; code: $59; rl: 58), // 0000 0101 1001
|
|
(dim: 12; code: $2B; rl: 59), // 0000 0010 1011
|
|
(dim: 12; code: $2C; rl: 60), // 0000 0010 1100
|
|
(dim: 12; code: $5A; rl: 61), // 0000 0101 1010
|
|
(dim: 12; code: $66; rl: 62), // 0000 0110 0110
|
|
(dim: 12; code: $67; rl: 63), // 0000 0110 0111
|
|
(dim: 10; code: $F; rl: 64), // 0000 0011 11
|
|
(dim: 12; code: $C8; rl: 128), // 0000 1100 1000
|
|
(dim: 12; code: $C9; rl: 192), // 0000 1100 1001
|
|
(dim: 12; code: $5B; rl: 256), // 0000 0101 1011
|
|
(dim: 12; code: $33; rl: 320), // 0000 0011 0011
|
|
(dim: 12; code: $34; rl: 384), // 0000 0011 0100
|
|
(dim: 12; code: $35; rl: 448), // 0000 0011 0101
|
|
(dim: 13; code: $6C; rl: 512), // 0000 0011 0110 0
|
|
(dim: 13; code: $6D; rl: 576), // 0000 0011 0110 1
|
|
(dim: 13; code: $4A; rl: 640), // 0000 0010 0101 0
|
|
(dim: 13; code: $4B; rl: 704), // 0000 0010 0101 1
|
|
(dim: 13; code: $4C; rl: 768), // 0000 0010 0110 0
|
|
(dim: 13; code: $4D; rl: 832), // 0000 0010 0110 1
|
|
(dim: 13; code: $72; rl: 896), // 0000 0011 1001 0
|
|
(dim: 13; code: $73; rl: 960), // 0000 0011 1001 1
|
|
(dim: 13; code: $74; rl: 1024), // 0000 0011 1010 0
|
|
(dim: 13; code: $75; rl: 1088), // 0000 0011 1010 1
|
|
(dim: 13; code: $76; rl: 1152), // 0000 0011 1011 0
|
|
(dim: 13; code: $77; rl: 1216), // 0000 0011 1011 1
|
|
(dim: 13; code: $52; rl: 1280), // 0000 0010 1001 0
|
|
(dim: 13; code: $53; rl: 1344), // 0000 0010 1001 1
|
|
(dim: 13; code: $54; rl: 1408), // 0000 0010 1010 0
|
|
(dim: 13; code: $55; rl: 1472), // 0000 0010 1010 1
|
|
(dim: 13; code: $5A; rl: 1536), // 0000 0010 1101 0
|
|
(dim: 13; code: $5B; rl: 1600), // 0000 0010 1101 1
|
|
(dim: 13; code: $64; rl: 1664), // 0000 0011 0010 0
|
|
(dim: 13; code: $65; rl: 1728), // 0000 0011 0010 1
|
|
(dim: 11; code: $8; rl: 1792), // 0000 0001 000
|
|
(dim: 11; code: $C; rl: 1856), // 0000 0001 100
|
|
(dim: 11; code: $D; rl: 1920), // 0000 0001 101
|
|
(dim: 12; code: $12; rl: 1984), // 0000 0001 0010
|
|
(dim: 12; code: $13; rl: 2048), // 0000 0001 0011
|
|
(dim: 12; code: $14; rl: 2112), // 0000 0001 0100
|
|
(dim: 12; code: $15; rl: 2176), // 0000 0001 0101
|
|
(dim: 12; code: $16; rl: 2240), // 0000 0001 0110
|
|
(dim: 12; code: $17; rl: 2304), // 0000 0001 0111
|
|
(dim: 12; code: $1C; rl: 2368), // 0000 0001 1100
|
|
(dim: 12; code: $1D; rl: 2432), // 0000 0001 1101
|
|
(dim: 12; code: $1E; rl: 2496), // 0000 0001 1110
|
|
(dim: 12; code: $1F; rl: 2560), // 0000 0001 1111
|
|
(dim: 12; code: $1; rl: G3CODE_EOL), // 0000 0000 0001
|
|
(dim: 9; code: $1; rl: G3CODE_INVALID), // 0000 0000 1
|
|
(dim: 10; code: $1; rl: G3CODE_INVALID), // 0000 0000 01
|
|
(dim: 11; code: $1; rl: G3CODE_INVALID), // 0000 0000 001
|
|
(dim: 13; code: $1; rl: G3CODE_EOL), // 0000000000001
|
|
(dim: 14; code: $1; rl: G3CODE_EOL), // 00000000000001
|
|
(dim: 15; code: $1; rl: G3CODE_EOL), // 000000000000001
|
|
(dim: 16; code: $1; rl: G3CODE_EOL), // 0000000000000001
|
|
(dim: 17; code: $1; rl: G3CODE_EOL), // 00000000000000001
|
|
(dim: 18; code: $1; rl: G3CODE_EOL), // 000000000000000001
|
|
(dim: 19; code: $1; rl: G3CODE_EOL), // 0000000000000000001
|
|
(dim: 20; code: $1; rl: G3CODE_EOL), // 00000000000000000001
|
|
|
|
(dim: 21; code: $1; rl: G3CODE_EOL), // 000000000000000000001
|
|
(dim: 22; code: $1; rl: G3CODE_EOL), // 0000000000000000000001
|
|
(dim: 23; code: $1; rl: G3CODE_EOL), // 00000000000000000000001
|
|
(dim: 24; code: $1; rl: G3CODE_EOL), // 000000000000000000000001
|
|
(dim: 25; code: $1; rl: G3CODE_EOL), // 0000000000000000000000001
|
|
(dim: 26; code: $1; rl: G3CODE_EOL), // 00000000000000000000000001
|
|
(dim: 27; code: $1; rl: G3CODE_EOL), // 000000000000000000000000001
|
|
(dim: 28; code: $1; rl: G3CODE_EOL), // 0000000000000000000000000001
|
|
(dim: 29; code: $1; rl: G3CODE_EOL), // 00000000000000000000000000001
|
|
(dim: 30; code: $1; rl: G3CODE_EOL), // 000000000000000000000000000001
|
|
(dim: 31; code: $1; rl: G3CODE_EOL), // 0000000000000000000000000000001
|
|
(dim: 32; code: $1; rl: G3CODE_EOL) // 00000000000000000000000000000001
|
|
));
|
|
|
|
horizcode: TT4Entry = (dim: 3; code: $1); // 001
|
|
passcode: TT4Entry = (dim: 4; code: $1); // 0001
|
|
vcodes: array [0..6] of TT4Entry = ((dim: 7; code: $3), // 0000 011
|
|
(dim: 6; code: $3), // 0000 11
|
|
(dim: 3; code: $3), // 011
|
|
(dim: 1; code: $1), // 1
|
|
(dim: 3; code: $2), // 010
|
|
(dim: 6; code: $2), // 0000 10
|
|
(dim: 7; code: $2)); // 0000 010
|
|
|
|
|
|
function AdjustWithFillOrder(dwo: dword; posb: integer; FillOrder: integer): dword;
|
|
begin
|
|
if FillOrder = 1 then
|
|
begin
|
|
// swap "dwo" dword
|
|
{$ifdef IEUSEASM}
|
|
asm
|
|
mov EAX,dwo
|
|
bswap EAX
|
|
mov dwo,EAX
|
|
end;
|
|
{$else}
|
|
dwo := IESwapDWord(dwo);
|
|
{$endif}
|
|
dwo := (dwo shl (posb and 7));
|
|
end
|
|
else
|
|
begin
|
|
// FillOrder=2
|
|
dwo := (dwo shr (posb and 7));
|
|
ReverseBits(dwo);
|
|
end;
|
|
result := dwo;
|
|
end;
|
|
|
|
|
|
// find code indexed by posb
|
|
// srcbuf: pointer to initial bits
|
|
// posb: bit to read from srcbuf (start of code)
|
|
// WB: 0=use white code 1=use black code
|
|
function FindCode(srcbuf: pbyte; srcbufLen: integer; posb, WB: integer; FillOrder: integer): integer;
|
|
var
|
|
ibi: integer;
|
|
dwo: dword;
|
|
q: integer;
|
|
curtree: PT4Tree;
|
|
begin
|
|
result := NUMCODES; // invalid code
|
|
ibi := posb shr 3; // divide by 8 (calculates related byte)
|
|
if ibi < srcbufLen then
|
|
begin
|
|
dwo := pinteger(@pbytearray(srcbuf)^[ibi])^;
|
|
dwo := AdjustWithFillOrder(dwo, posb, FillOrder);
|
|
// find code
|
|
curtree := @(T4Tree[WB]);
|
|
q := 31;
|
|
repeat
|
|
if curtree^.code <> NUMCODES then
|
|
begin
|
|
result := curtree^.code;
|
|
break;
|
|
end;
|
|
curtree := curtree^.childs[ord((dwo and (1 shl q)) <> 0)];
|
|
dec(q);
|
|
until q < 0;
|
|
end
|
|
else
|
|
result := NUMCODES - 1; // wrong position, send EOL
|
|
end;
|
|
|
|
|
|
// find MODE that matches to the one pointed by posb
|
|
// srcbuf: pointer to start of bits
|
|
// posb: bit inside srcbuf to read (start of code)
|
|
function FindMode(srcbuf: pbyte; posb: integer; FillOrder: integer): integer;
|
|
var
|
|
ibi: integer;
|
|
dwo, tdwo: dword;
|
|
q: integer;
|
|
begin
|
|
result := 0; // invalid code
|
|
ibi := posb shr 3; // divide vt 8 (find matching byte)
|
|
dwo := pinteger(@pbytearray(srcbuf)^[ibi])^;
|
|
dwo := AdjustWithFillOrder(dwo, posb, FillOrder);
|
|
// find mode
|
|
for q := 0 to 12 do
|
|
begin
|
|
tdwo := dwo shr (32 - T4_2DC[q].dim);
|
|
if tdwo = T4_2DC[q].code then
|
|
begin
|
|
result := q;
|
|
break;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
// returns word composed by the number of specified bits (max 32)
|
|
function getpels(srcbuf: pbyte; posb: integer; nbit: integer; FillOrder: integer): integer;
|
|
var
|
|
ibi: integer;
|
|
dwo: dword;
|
|
begin
|
|
ibi := posb shr 3; // divide by 8 (find matching byte)
|
|
dwo := pinteger(@pbytearray(srcbuf)^[ibi])^;
|
|
dwo := AdjustWithFillOrder(dwo, posb, FillOrder);
|
|
|
|
result := dwo shr (32 - nbit);
|
|
end;
|
|
|
|
|
|
// decode uncompressed code from srcbuf, at posb (bits) position
|
|
// length of return code corresponds to the value of code self
|
|
function decode_uncomp_code(srcbuf: pbyte; posb: integer; FillOrder: integer): integer;
|
|
var
|
|
ibi: integer;
|
|
dwo, tdwo: dword;
|
|
q: integer;
|
|
begin
|
|
result := 0; // invalid code (valid codes start from 1..)
|
|
ibi := posb shr 3; // divide by 8 (find matching code)
|
|
dwo := pinteger(@pbytearray(srcbuf)^[ibi])^;
|
|
dwo := AdjustWithFillOrder(dwo, posb, FillOrder);
|
|
for q := 1 to 11 do
|
|
begin
|
|
tdwo := dwo shr (32 - q);
|
|
if tdwo = 1 then
|
|
begin
|
|
result := q;
|
|
break;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
// replicates "1"(0) for "rl" times
|
|
// destbuf = destination buffer
|
|
// posw = bit inside dstbuf (writing begin)
|
|
// rl = bits to replicate
|
|
// WB = bit to replicate inverted (0 or 1)
|
|
// Width = row length
|
|
procedure PutCode(dstbuf: pbyte; posw: integer; rl: integer; Width: integer);
|
|
var
|
|
q: integer;
|
|
ibi, abi: integer;
|
|
pb: pbyte;
|
|
begin
|
|
rl := imin(Width - posw, rl);
|
|
q := 0;
|
|
while q < rl do
|
|
begin
|
|
ibi := posw shr 3;
|
|
abi := (rl - q) and $FFF8;
|
|
if ((posw and $7) = 0) and (abi > 0) then
|
|
begin
|
|
|
|
pb := dstbuf;
|
|
inc(pb, ibi);
|
|
|
|
FillChar(pb^, (rl - q) shr 3, 0);
|
|
|
|
inc(posw, abi);
|
|
inc(q, abi);
|
|
end
|
|
else
|
|
begin
|
|
pbytearray(dstbuf)^[ibi] := pbytearray(dstbuf)^[ibi] and (not bitmask[posw and 7]);
|
|
inc(posw);
|
|
inc(q);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
// decompress HUFFMAN row
|
|
// dstbuf = destination buffer (must be already allocated)
|
|
// srcbuf = source buffer
|
|
// Width = row size in pixels
|
|
// posb = initial bit to read from srcbuf
|
|
// ret. next bit to read (posb)
|
|
function _CCITTHuffmanGetLine(dstbuf, srcbuf: pbyte; srcbufLen: integer; Width: integer; posb: integer; FillOrder: integer): integer;
|
|
var
|
|
c: integer;
|
|
WB: integer; // 0=white 1=black
|
|
posw: integer; // next bit to write
|
|
lposb: integer; // original value of posb
|
|
tc: boolean; // if True terminating-code is missing
|
|
begin
|
|
if (Width and $7) <> 0 then
|
|
c := 1
|
|
else
|
|
c := 0;
|
|
fillmemory(dstbuf, (Width shr 3) + c, 255);
|
|
WB := 0; // start with WHITE
|
|
posw := 0;
|
|
lposb := posb; // save posb
|
|
tc := false;
|
|
while (posw < Width) or tc do
|
|
begin
|
|
c := FindCode(srcbuf, srcbufLen, posb, WB, FillOrder);
|
|
if c = NUMCODES then
|
|
begin
|
|
inc(posb);
|
|
inc(lposb);
|
|
end
|
|
else
|
|
begin
|
|
with T4Codes[WB][C] do
|
|
begin
|
|
inc(posb, dim);
|
|
if (rl = G3CODE_EOL) or (rl = G3CODE_EOF) then
|
|
begin
|
|
if (posb - dim) = lposb then
|
|
begin
|
|
continue; // EOL at the beginning of the row, ignore it!
|
|
end;
|
|
// terminate the row
|
|
if WB <> 0 then
|
|
PutCode(dstbuf, posw, Width - posw + 1, Width);
|
|
inc(posw, Width - posw + 1);
|
|
c := 0; // makes true c < 64 (and tc = false), then exit loop
|
|
end
|
|
else
|
|
if rl <> G3CODE_INVALID then
|
|
begin
|
|
if WB <> 0 then
|
|
PutCode(dstbuf, posw, rl, Width);
|
|
inc(posw, rl);
|
|
end;
|
|
end;
|
|
if c < 64 then
|
|
begin
|
|
tc := false;
|
|
if WB = 0 then
|
|
WB := 1
|
|
else
|
|
WB := 0;
|
|
end
|
|
else
|
|
tc := true;
|
|
end;
|
|
end;
|
|
result := posb;
|
|
end;
|
|
|
|
|
|
// decompress HUFFMAN row
|
|
// dstbuf = destination buffer (must be already allocated)
|
|
// srcbuf = source buffer
|
|
// Width = row size in pixels
|
|
// ret. byte read from srcbuf
|
|
// note: the difference between G3FAX1D and HUFFMAN is that in HUFFMAN each row has the size rounded to a Byte
|
|
function CCITTHuffmanGetLine(dstbuf, srcbuf: pbyte; srcbufLen: integer; Width: integer; FillOrder: integer): integer;
|
|
var
|
|
posb: integer;
|
|
begin
|
|
posb := _CCITTHuffmanGetLine(dstbuf, srcbuf, srcbufLen, Width, 0, FillOrder);
|
|
result := posb shr 3; // posb div 8
|
|
if (posb mod 8) > 0 then
|
|
inc(result);
|
|
end;
|
|
|
|
|
|
// search for first pixel not equal to CL (0=black <>0=white)
|
|
// consider inverted bits inside buf (0=white 1=black)
|
|
// ipos = starting position (bits)
|
|
// Width = row size in pixels
|
|
// ret. pixel position (starting from 0)
|
|
function finddiff(buf: pbyte; ipos: integer; Width: integer; CL: integer): integer;
|
|
var
|
|
ibi, ibb: integer;
|
|
by: integer;
|
|
db: pbyte;
|
|
begin
|
|
while ipos < Width do
|
|
begin
|
|
// calculate bit "ipos"
|
|
ibi := ipos shr 3; // extract byte position
|
|
ibb := ipos and 7; // extract bit position
|
|
|
|
if ibb = 0 then
|
|
begin
|
|
db := buf;
|
|
inc(db, ibi);
|
|
if CL = 0 then
|
|
begin
|
|
while (ipos + 32 < Width) and (pdword(db)^ = $FFFFFFFF) do
|
|
begin
|
|
inc(ipos, 32);
|
|
inc(db, 4);
|
|
end;
|
|
while (ipos + 16 < Width) and (pword(db)^ = $FFFF) do
|
|
begin
|
|
inc(ipos, 16);
|
|
inc(db, 2);
|
|
end;
|
|
while (ipos + 8 < Width) and (db^ = $FF) do
|
|
begin
|
|
inc(ipos, 8);
|
|
inc(db);
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
while (ipos + 32 < Width) and (pdword(db)^ = 0) do
|
|
begin
|
|
inc(ipos, 32);
|
|
inc(db, 4);
|
|
end;
|
|
while (ipos + 16 < Width) and (pword(db)^ = 0) do
|
|
begin
|
|
inc(ipos, 16);
|
|
inc(db, 2);
|
|
end;
|
|
while (ipos + 8 < Width) and (db^ = 0) do
|
|
begin
|
|
inc(ipos, 8);
|
|
inc(db);
|
|
end;
|
|
end;
|
|
if ipos >= Width then
|
|
begin
|
|
ipos := Width;
|
|
break;
|
|
end;
|
|
ibb := 0;
|
|
while ipos < Width do
|
|
begin
|
|
by := db^ and (1 shl (7 - ibb));
|
|
if (cl = by) or ((cl <> 0) and (by <> 0)) then
|
|
break;
|
|
inc(ibb);
|
|
inc(ipos);
|
|
end;
|
|
break;
|
|
end;
|
|
|
|
if ipos >= 0 then
|
|
by := pbytearray(buf)^[ibi] and (1 shl (7 - ibb))
|
|
else
|
|
by := 1;
|
|
if (cl = by) or ((cl <> 0) and (by <> 0)) then
|
|
break;
|
|
inc(ipos);
|
|
end;
|
|
result := ipos;
|
|
end;
|
|
|
|
|
|
// decompress CCITT 3 - 2D row
|
|
// predbuf: previous row (handled automatically)
|
|
// posb = initial bit to read from srcbuf
|
|
// ret. next bit to read (posb)
|
|
// note: dstbuf must be Zero initialized
|
|
function CCITT3_2D_GetLine(dstbuf, srcbuf: pbyte; srcbuflen: integer; Width: integer; predbuf: pbyte; posb: integer; FillOrder: integer; AlignEOL: boolean): integer;
|
|
var
|
|
c, v, q: integer;
|
|
WB: integer; // 0 = white 1 = black
|
|
CL: integer; // current color (0 = black 1 = white)
|
|
lposb: integer; // original value of posb
|
|
a0, b1, b2: integer; // a0 = was posw
|
|
run1, run2: integer;
|
|
maxlen: integer;
|
|
dim: integer;
|
|
begin
|
|
if (Width and $7) <> 0 then
|
|
dim := 1
|
|
else
|
|
dim := 0;
|
|
fillmemory(dstbuf, (Width shr 3) + dim, 255);
|
|
a0 := -1;
|
|
CL := 1; // start with WHITE
|
|
lposb := posb; // save posb
|
|
maxlen := srcbuflen shl 3;
|
|
while (a0 < Width) and (posb < maxlen) do
|
|
begin
|
|
c := FindMode(srcbuf, posb, FillOrder);
|
|
dim := T4_2DC[c].dim;
|
|
inc(posb, dim);
|
|
if AlignEOL and (c = 0) then
|
|
begin
|
|
repeat
|
|
v := getpels(srcbuf, posb, 1, FillOrder);
|
|
inc(posb);
|
|
inc(dim);
|
|
until v <> 0;
|
|
c := 12;
|
|
end;
|
|
case c of
|
|
12: // EOF
|
|
begin
|
|
if lposb <> (posb - dim) then
|
|
begin
|
|
// premature row end
|
|
if (CL = 0) and (a0 > -1) then
|
|
PutCode(dstbuf, a0, Width - a0, Width);
|
|
dec(posb, dim);
|
|
a0 := Width;
|
|
end
|
|
else
|
|
begin
|
|
v := getpels(srcbuf, posb, 1, FillOrder);
|
|
inc(posb); // bypass next bit
|
|
if v = 1 then
|
|
begin // 1D decode
|
|
if a0 < 0 then
|
|
a0 := 0;
|
|
posb := _CCITTHuffmanGetLine(dstbuf, srcbuf, srcbufLen, Width, posb, FillOrder);
|
|
inc(a0, Width);
|
|
end;
|
|
end;
|
|
end;
|
|
1: // PASS
|
|
begin
|
|
b2 := finddiff(predbuf, a0, Width, (CL));
|
|
b1 := finddiff(predbuf, b2, Width, (not CL) and $1);
|
|
b2 := finddiff(predbuf, b1, Width, (CL));
|
|
if a0 < 0 then
|
|
a0 := 0;
|
|
if CL = 0 then
|
|
PutCode(dstbuf, a0, b2 - a0, Width);
|
|
a0 := b2;
|
|
end;
|
|
2: // HORIZONTAL
|
|
begin
|
|
// run1
|
|
WB := (not CL) and $1;
|
|
run1 := 0;
|
|
repeat
|
|
v := FindCode(srcbuf, srcbufLen, posb, WB, FillOrder);
|
|
inc(posb, T4Codes[WB][v].dim);
|
|
inc(run1, T4Codes[WB][v].rl);
|
|
until (v < 64) or (posb >= maxlen);
|
|
// run2
|
|
WB := CL;
|
|
run2 := 0;
|
|
repeat
|
|
v := FindCode(srcbuf, srcbufLen, posb, WB, FillOrder);
|
|
inc(posb, T4Codes[WB][v].dim);
|
|
inc(run2, T4Codes[WB][v].rl);
|
|
until (v < 64) or (posb >= maxlen);
|
|
if (run1 >= 0) and (run2 >= 0) then
|
|
begin
|
|
if a0 < 0 then
|
|
a0 := 0;
|
|
if a0 + run1 > Width then
|
|
run1 := Width - a0;
|
|
if CL = 0 then
|
|
PutCode(dstbuf, a0, run1, Width);
|
|
inc(a0, run1);
|
|
if a0 + run2 > Width then
|
|
run2 := Width - a0;
|
|
if CL <> 0 then
|
|
PutCode(dstbuf, a0, run2, Width);
|
|
inc(a0, run2);
|
|
end;
|
|
end;
|
|
3..9: // VERTICAL
|
|
begin
|
|
b2 := finddiff(predbuf, a0, Width, (CL));
|
|
b1 := finddiff(predbuf, b2, Width, (not CL) and $1);
|
|
inc(b1, c - 6);
|
|
if a0 < 0 then
|
|
a0 := 0;
|
|
if CL = 0 then
|
|
begin
|
|
PutCode(dstbuf, a0, b1 - a0, Width);
|
|
CL := 1;
|
|
end
|
|
else
|
|
CL := 0;
|
|
a0 := b1;
|
|
end;
|
|
10..11: // Not compressed
|
|
begin
|
|
if a0 < 0 then
|
|
a0 := 0;
|
|
repeat
|
|
v := decode_uncomp_code(srcbuf, posb, FillOrder);
|
|
if v = 0 then
|
|
break;
|
|
inc(posb, v);
|
|
case v of
|
|
1..5:
|
|
begin
|
|
run1 := v;
|
|
inc(a0, run1);
|
|
end;
|
|
6:
|
|
begin
|
|
inc(a0, 5);
|
|
end;
|
|
7..11:
|
|
begin
|
|
run1 := v - 7;
|
|
inc(a0, run1);
|
|
CL := getpels(srcbuf, posb, 1, FillOrder);
|
|
inc(posb);
|
|
end;
|
|
end;
|
|
until (v > 6) or (posb >= maxlen) or (a0 >= Width);
|
|
end;
|
|
end;
|
|
end; // loop w..Width-1
|
|
result := posb;
|
|
|
|
q := Width shr 3;
|
|
if (Width and 7) > 0 then
|
|
inc(q);
|
|
CopyMemory(predbuf, dstbuf, q); // copy new row into previous one
|
|
end;
|
|
|
|
|
|
// Ret. rposb bit inside rdata buffer
|
|
// 0 = false (black) 1 = true (white)
|
|
function _GetRowBit(rdata: pbyte; rposb: integer): boolean;
|
|
begin
|
|
inc(rdata, rposb shr 3);
|
|
result := (rdata^ and bitmask[rposb and 7]) = 0;
|
|
end;
|
|
|
|
|
|
// Write "bl" bits of wo, into position wposb of wbuf
|
|
// "wposb" is increased by "bl"
|
|
procedure _PutBits(wbuf: pbyte; var wposb: integer; bl: integer; wo: integer; FillOrder: integer);
|
|
var
|
|
q, b, r: integer;
|
|
s, bp: pbyte;
|
|
begin
|
|
if FillOrder = 2 then
|
|
begin
|
|
q := 0; // bit counter
|
|
s := @wo;
|
|
while q < bl do
|
|
begin
|
|
// get source
|
|
b := bl - q - 1; // bit position in source
|
|
r := pbytearray(s)^[b shr 3] and (1 shl (b and 7));
|
|
// set dest
|
|
bp := pbyte(uint64(wbuf) + (uint64(wposb) shr 3));
|
|
if r <> 0 then
|
|
bp^ := bp^ or (1 shl (wposb and 7)) // set 1
|
|
else
|
|
bp^ := bp^ and not (1 shl (wposb and 7)); // set 0
|
|
inc(wposb);
|
|
inc(q);
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
if bl > 8 then
|
|
begin
|
|
bswap(pbytearray(@wo)^[0], pbytearray(@wo)^[1]);
|
|
IECopyBits_small(wbuf, pbyte(@wo), wposb, (16 - bl) mod 8, bl, 2147483647);
|
|
end
|
|
else
|
|
IECopyBits_small(wbuf, pbyte(@wo), wposb, 8 - bl, bl, 2147483647);
|
|
inc(wposb, bl);
|
|
end;
|
|
end;
|
|
|
|
|
|
// Write Huffman code "rt" of "bw" type (false = black, true = white) into wbuf buffer at wposb position.
|
|
// At the end update wposb to point to next bit to write.
|
|
// rt can be any value (even greater than Huffman "rl" codes).
|
|
procedure _PutRLCode(wbuf: pbyte; var wposb: integer; rt: integer; bwb: boolean; FillOrder: integer);
|
|
var
|
|
bw: integer;
|
|
q: integer;
|
|
begin
|
|
bw := ord(not bwb); // 1 = false (black) 0 = true (white)
|
|
// write Make-up code
|
|
while rt > 63 do
|
|
begin
|
|
if rt > 2560 then
|
|
begin
|
|
_PutBits(wbuf, wposb, T4Codes[bw, 103].dim, T4Codes[bw, 103].code, FillOrder);
|
|
dec(rt, 2560);
|
|
end
|
|
else
|
|
begin
|
|
q := 63 + (rt shr 6);
|
|
_PutBits(wbuf, wposb, T4Codes[bw, q].dim, T4Codes[bw, q].code, FillOrder);
|
|
dec(rt, T4Codes[bw, q].rl);
|
|
end;
|
|
end;
|
|
// write term code
|
|
_PutBits(wbuf, wposb, T4Codes[bw, rt].dim, T4Codes[bw, rt].code, FillOrder);
|
|
end;
|
|
|
|
|
|
// Compress rdata (of wb bits) and save to "fs"
|
|
// used for CCITT 1D (Huffman)
|
|
procedure CCITTHuffmanPutLine(rdata: pbyte; wb: integer; fs: TStream; var Aborting: boolean; FillOrder: integer);
|
|
var
|
|
bwr: byte;
|
|
bwrl: integer;
|
|
begin
|
|
bwrl := 0;
|
|
CCITTHuffmanPutLineG3(rdata, wb, fs, bwr, bwrl, Aborting, FillOrder);
|
|
CCITTHuffmanPutLineG3(nil, 0, fs, bwr, bwrl, Aborting, FillOrder); // finalize row (write remain byte)
|
|
end;
|
|
|
|
|
|
// Compress rdata (of wb bits) and save it into "fs"
|
|
// bwr: remaining byte to write
|
|
// bwrl: remainging bits in bwr to write
|
|
// Used by G3FAX1D
|
|
procedure CCITTHuffmanPutLineG3(rdata: pbyte; wb: integer; fs: TStream; var bwr: byte; var bwrl: integer; var Aborting: boolean; FillOrder: integer);
|
|
var
|
|
wposb: integer; // current writing position (in bits)
|
|
rt: integer;
|
|
wbuf, pb: pbyte; // writing buffer
|
|
b: byte;
|
|
begin
|
|
getmem(wbuf, imax(4, (wb shr 3) * 12 + 1)); // 12 times one row (+1 of eventually 1bwr)
|
|
try
|
|
wposb := 0;
|
|
if bwrl > 0 then
|
|
begin
|
|
// there are bits to write since last call
|
|
wbuf^ := bwr;
|
|
wposb := bwrl;
|
|
end;
|
|
_CCITTHuffmanPutLine(rdata, wb, wbuf, wposb, FillOrder);
|
|
// write buffer
|
|
rt := wposb shr 3;
|
|
if (wposb and 7) <> 0 then
|
|
begin
|
|
bwrl := wposb - rt * 8; // bits to write at the next call
|
|
|
|
pb := wbuf;
|
|
inc(pb, rt);
|
|
bwr := pb^; // byte to write at the next call
|
|
|
|
end
|
|
else
|
|
bwrl := 0;
|
|
SafeStreamWrite(fs, Aborting, wbuf^, rt);
|
|
finally
|
|
freemem(wbuf);
|
|
end;
|
|
|
|
if (wb = 0) and (bwrl > 0) then
|
|
begin
|
|
// finalize, write remain byte
|
|
b := bitclearmask[bwrl - 1];
|
|
if FillOrder = 2 then
|
|
ReverseBitsB(b);
|
|
bwr := bwr and b;
|
|
SafeStreamWrite(fs, Aborting, bwr, 1);
|
|
bwrl := 0;
|
|
end;
|
|
end;
|
|
|
|
|
|
// Compress rdata (of wb bits size) in wbuf
|
|
// move wpos (input / output)
|
|
procedure _CCITTHuffmanPutLine(rdata: pbyte; wb: integer; wbuf: pbyte; var wpos: integer; FillOrder: integer);
|
|
var
|
|
rposb: integer; // current reading position (in bits)
|
|
rt: integer;
|
|
bw: boolean; // true = white false = black : next color to process
|
|
begin
|
|
bw := true; // starting with White
|
|
rposb := 0;
|
|
while rposb < wb do
|
|
begin
|
|
rt := 0;
|
|
while (rposb < wb) and (_GetRowBit(rdata, rposb) = bw) do
|
|
begin
|
|
inc(rt);
|
|
inc(rposb);
|
|
end;
|
|
_PutRLCode(wbuf, wpos, rt, bw, FillOrder); // modifies wposb
|
|
bw := not bw;
|
|
end;
|
|
end;
|
|
|
|
|
|
function _PIXEL(buf: pbytearray; ix: integer): integer;
|
|
begin
|
|
result := ((buf[ix shr 3]) shr (7 - (ix and 7))) and 1;
|
|
end;
|
|
|
|
|
|
// bp: row buffer to compress (input)
|
|
// rp: previous row buffer (input)
|
|
// wbuf: compressed row buffer (output)
|
|
// wpos: position of the next bit to write
|
|
// bits: "bp" row length (in bits)
|
|
// note, bwr and bwrl ares inputs only
|
|
// ret: position of the current bit to write (= written bits)
|
|
procedure Fax3Encode2DRow(bp: pbytearray; rp: pbytearray; wbuf: pbyte; var wpos: integer; bits: integer; FillOrder: integer);
|
|
var
|
|
white: integer;
|
|
a0: integer;
|
|
a1: integer;
|
|
b1: integer;
|
|
a2, b2: integer;
|
|
d, r: integer;
|
|
begin
|
|
white := 0;
|
|
a0 := 0;
|
|
|
|
if _PIXEL(bp, 0) <> white then
|
|
a1 := 0
|
|
else
|
|
a1 := finddiff(pbyte(bp), 0, bits, (not white) and $1);
|
|
|
|
if _PIXEL(rp, 0) <> white then
|
|
b1 := 0
|
|
else
|
|
b1 := finddiff(pbyte(rp), 0, bits, (not white) and $1);
|
|
|
|
repeat
|
|
if b1 < bits then
|
|
r := ((rp[b1 shr 3]) shr (7 - (b1 and 7))) and 1
|
|
else
|
|
r := 0;
|
|
b2 := finddiff(pbyte(rp), b1, bits, (not r) and $1);
|
|
if (b2 >= a1) then
|
|
begin
|
|
d := b1 - a1;
|
|
if not ((-3 <= d) and (d <= 3)) then
|
|
begin // horizontal mode
|
|
a2 := finddiff(pbyte(bp), a1, bits, (not _PIXEL(bp, a1)) and $1);
|
|
_PutBits(wbuf, wpos, horizcode.dim, horizcode.code, FillOrder);
|
|
if (a0 + a1 = 0) or (_PIXEL(bp, a0) = white) then
|
|
begin
|
|
_PutRLCode(wbuf, wpos, a1 - a0, true, FillOrder);
|
|
_PutRLCode(wbuf, wpos, a2 - a1, false, FillOrder);
|
|
end
|
|
else
|
|
begin
|
|
_PutRLCode(wbuf, wpos, a1 - a0, false, FillOrder);
|
|
_PutRLCode(wbuf, wpos, a2 - a1, true, FillOrder);
|
|
end;
|
|
a0 := a2;
|
|
end
|
|
else
|
|
begin // vertical mode
|
|
_PutBits(wbuf, wpos, vcodes[d + 3].dim, vcodes[d + 3].code, FillOrder);
|
|
a0 := a1;
|
|
end;
|
|
end
|
|
else
|
|
begin // pass mode
|
|
_PutBits(wbuf, wpos, passcode.dim, passcode.code, FillOrder);
|
|
a0 := b2;
|
|
end;
|
|
if (a0 >= bits) then
|
|
break;
|
|
a1 := finddiff(pbyte(bp), a0, bits, (not _PIXEL(bp, a0)) and $1);
|
|
b1 := finddiff(pbyte(rp), a0, bits, _PIXEL(bp, a0));
|
|
b1 := finddiff(pbyte(rp), b1, bits, (not _PIXEL(bp, a0)) and $1);
|
|
until false;
|
|
end;
|
|
|
|
|
|
// Compress rdata (of wb bits) writing to fs
|
|
// bwr: remaining byte to write
|
|
// bwrl: remaining bits in bwr to write
|
|
// predline: pointer to the previous row. Allocated here. This is "nil" for the first row. If rdata = nil where are "finalizing" (then free predline).
|
|
// used for G3FAX2D
|
|
procedure CCITTHuffmanPutLineG32D(rdata: pbyte; wb: integer; fs: TStream; var bwr: byte; var bwrl: integer; var predline: pbyte; var Aborting: boolean; FillOrder: integer);
|
|
var
|
|
wbuf, pb: pbyte;
|
|
wpos, rt, rowlen: integer;
|
|
begin
|
|
getmem(wbuf, imax(4, (wb shr 3) * 12 + 1) ); // 12 times one row (+1 of eventually bwr)
|
|
|
|
try
|
|
wpos := 0;
|
|
if bwrl > 0 then
|
|
begin
|
|
// there are bits to write since last call
|
|
wbuf^ := bwr;
|
|
wpos := bwrl;
|
|
bwrl := 0;
|
|
end;
|
|
rowlen := (((wb + 31) shr 5) shl 2);
|
|
if predline = nil then
|
|
begin
|
|
// First row
|
|
// send EOL + 1 (first row 1D)
|
|
_PutBits(wbuf, wpos, 12, $1, FillOrder); // write EOF
|
|
_PutBits(wbuf, wpos, 1, $1, FillOrder); // mark code 1D
|
|
_CCITTHuffmanPutLine(rdata, wb, wbuf, wpos, FillOrder); // coding as 1D
|
|
getmem(predline, rowlen);
|
|
copymemory(predline, rdata, rowlen);
|
|
end
|
|
else
|
|
if rdata <> nil then
|
|
begin
|
|
// Other rows
|
|
// send EOL + 0
|
|
_PutBits(wbuf, wpos, 12, $1, FillOrder); // write EOF
|
|
_PutBits(wbuf, wpos, 1, $0, FillOrder); // mark code 2D
|
|
Fax3Encode2DRow(pbytearray(rdata), pbytearray(predline), wbuf, wpos, wb, FillOrder);
|
|
copymemory(predline, rdata, rowlen);
|
|
end;
|
|
if rdata = nil then
|
|
begin
|
|
// finalization
|
|
_PutBits(wbuf, wpos, 12, $1, FillOrder); // write EOF
|
|
freemem(predline);
|
|
predline := nil;
|
|
end;
|
|
// write buffer
|
|
rt := wpos shr 3;
|
|
if (wpos and 7) <> 0 then
|
|
begin
|
|
bwrl := wpos - rt * 8; // number of bits to write at the next call
|
|
|
|
pb := wbuf;
|
|
inc(pb, rt);
|
|
bwr := pb^; // bits to write at the next call
|
|
|
|
end;
|
|
SafeStreamWrite(fs, Aborting, wbuf^, rt);
|
|
|
|
finally
|
|
freemem(wbuf);
|
|
end;
|
|
end;
|
|
|
|
|
|
// Compress rdata (of wb bits) and write into "fs"
|
|
// bwr: remaining byte to write
|
|
// bwrl: number of remaining bits in bwr to write
|
|
// predline: pointer to the previous row. Allocated here. It is nil for the first row. If rdata =nil where are finalizing (then free predline).
|
|
// used for G4FAX
|
|
procedure CCITTHuffmanPutLineG4(rdata: pbyte; wb: integer; fs: TStream; var bwr: byte; var bwrl: integer; var predline: pbyte; var Aborting: boolean; FillOrder: integer);
|
|
var
|
|
wbuf, pb: pbyte;
|
|
wpos, rt, rowlen: integer;
|
|
begin
|
|
getmem(wbuf, imax(4, (wb shr 3) * 12 + 1) ); // 12 times one row (+1 of eventually bwr)
|
|
|
|
try
|
|
wpos := 0;
|
|
if bwrl > 0 then
|
|
begin
|
|
// there are bits to write since last call
|
|
wbuf^ := bwr;
|
|
wpos := bwrl;
|
|
bwrl := 0;
|
|
end;
|
|
rowlen := (((wb + 31) shr 5) shl 2);
|
|
if predline = nil then
|
|
begin
|
|
// Prepare for the first row
|
|
getmem(predline, rowlen);
|
|
fillchar(predline^, rowlen, 0); // all white
|
|
end;
|
|
if rdata <> nil then
|
|
begin
|
|
// Other rows
|
|
Fax3Encode2DRow(pbytearray(rdata), pbytearray(predline), wbuf, wpos, wb, FillOrder);
|
|
copymemory(predline, rdata, rowlen);
|
|
end;
|
|
if rdata = nil then
|
|
begin
|
|
// to follow the Standard write BEOF and round to 8 bits
|
|
_PutBits(wbuf, wpos, 12, $1, FillOrder);
|
|
_PutBits(wbuf, wpos, 12, $1, FillOrder);
|
|
if (wpos and 7) <> 0 then
|
|
_PutBits(wbuf, wpos, 8 - (wpos and 7), $0, FillOrder);
|
|
freemem(predline);
|
|
predline := nil;
|
|
end;
|
|
// write buffer
|
|
rt := wpos shr 3;
|
|
if (wpos and 7) <> 0 then
|
|
begin
|
|
bwrl := wpos - rt * 8; // number of bits to write at the next call
|
|
|
|
pb := wbuf;
|
|
inc(pb, rt);
|
|
bwr := pb^; // bits to write at the next call
|
|
|
|
end;
|
|
SafeStreamWrite(fs, Aborting, wbuf^, rt);
|
|
|
|
finally
|
|
freemem(wbuf);
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
//////////////////////////////////////////////////////////////////////////////////////////////////////////
|
|
//////////////////////////////////////////////////////////////////////////////////////////////////////////
|
|
// T4 tree builder
|
|
|
|
procedure AddT4Child(var baseitem: TT4Tree; const code: TT4Entry; codenum: integer);
|
|
var
|
|
bb: integer;
|
|
q: integer;
|
|
curitem: PT4Tree;
|
|
begin
|
|
curitem := @baseitem;
|
|
for q := code.dim - 1 downto 0 do
|
|
begin
|
|
bb := ord((code.code and (1 shl q)) <> 0); // extract next bit of the code
|
|
if curitem^.childs[bb] = nil then
|
|
begin
|
|
new(curitem^.childs[bb]);
|
|
curitem^.code := NUMCODES;
|
|
curitem^.childs[bb]^.childs[0] := nil;
|
|
curitem^.childs[bb]^.childs[1] := nil;
|
|
end;
|
|
curitem := curitem^.childs[bb];
|
|
end;
|
|
curitem^.code := codenum;
|
|
end;
|
|
|
|
|
|
procedure InitT4Tree();
|
|
var
|
|
q, w: integer;
|
|
begin
|
|
for w := 0 to 1 do
|
|
begin
|
|
T4Tree[w].childs[0] := nil;
|
|
T4Tree[w].childs[1] := nil;
|
|
for q := 0 to NUMCODES - 1 do
|
|
AddT4Child(T4Tree[w], T4Codes[w, q], q);
|
|
end;
|
|
end;
|
|
|
|
procedure FreeT4Tree(item: PT4Tree);
|
|
begin
|
|
if item <> nil then
|
|
begin
|
|
FreeT4Tree(item^.childs[0]);
|
|
FreeT4Tree(item^.childs[1]);
|
|
dispose(item);
|
|
end;
|
|
end;
|
|
|
|
// end of T4 tree builder
|
|
//////////////////////////////////////////////////////////////////////////////////////////////////////////
|
|
//////////////////////////////////////////////////////////////////////////////////////////////////////////
|
|
|
|
|
|
procedure IEInitialize_tifccitt;
|
|
begin
|
|
InitT4Tree;
|
|
end;
|
|
|
|
procedure IEFinalize_tifccitt;
|
|
begin
|
|
FreeT4Tree(T4Tree[0].childs[0]);
|
|
FreeT4Tree(T4Tree[0].childs[1]);
|
|
FreeT4Tree(T4Tree[1].childs[0]);
|
|
FreeT4Tree(T4Tree[1].childs[1]);
|
|
end;
|
|
|
|
|
|
end.
|
|
|