377 lines
9.8 KiB
Plaintext
377 lines
9.8 KiB
Plaintext
unit BWTExpandUnit;
|
|
{-------------------------------------------------------------------------------
|
|
Burrows Wheeler Transformation
|
|
Block Expansion Unit
|
|
------------------------------
|
|
reSource v2.6
|
|
Copyright (C) 1998-2001 Victor Kasenda / gruv
|
|
http://go.to/gruv
|
|
email: vickas@singnet.com.sg
|
|
|
|
|
|
Notes:
|
|
SwapBlock
|
|
After every decoding procedure is called, SwapBlocks is called.
|
|
in_block will always contain the latest block and out_block the block
|
|
to be used for further decoding.
|
|
block_length will always contain the length of in_block.
|
|
|
|
-------------------------------------------------------------------------------}
|
|
|
|
|
|
(**) interface (**)
|
|
uses // delphi
|
|
SysUtils, Classes, Dialogs,
|
|
// general
|
|
StructsUnit, ArchiveFileUnit, ArchiveHeadersUnit, CRC32Unit,
|
|
// engine
|
|
RLEUnit, MTFDecoderUnit, GroupAriModelUnit,
|
|
// arithmetic engine
|
|
FileStrucAriDecoderUnit,
|
|
// base class
|
|
BWTBaseUnit;
|
|
|
|
type
|
|
T256longintarray = array[-1..255] of longint;
|
|
P256longintarray = ^T256longintarray;
|
|
|
|
TExpander = class(TBWTBase)
|
|
private
|
|
FLastCRC32Result: boolean;
|
|
//block1, block2: PBlock;
|
|
block_length: integer; // length of out_block
|
|
|
|
transformation_block: PLongintBlock;
|
|
count, running_total: P256longintarray;
|
|
//count, running_total: array[-1..255] of longint;
|
|
|
|
// classes
|
|
FileStrucAriDecoder: TFileStrucAriDecoder;
|
|
MTFDecoder: TMTFDecoder;
|
|
|
|
{procedure AllocateStructs;
|
|
procedure FreeStructs;}
|
|
procedure InitStructs;
|
|
|
|
// Decoding routines
|
|
procedure AriDecode(InFile: TArchiveFile);
|
|
procedure MTFDecode(const virtual_char_index: longint);
|
|
procedure RecoverSortedBlock(const first_sym_index, virtual_char_index: longint);
|
|
//procedure RLEDecode;
|
|
|
|
public
|
|
//property OnProgressChange
|
|
|
|
//procedure ExpandStream(InStream, OutStream: TStream);
|
|
procedure ExpandBlock(InFile: TArchiveFile; OutFile: TFileStream);
|
|
|
|
{Can call these after ExpandBlock to get error results}
|
|
function GetLastCRC32Result: boolean;
|
|
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
end;
|
|
|
|
|
|
(**) implementation (**)
|
|
uses ErrorUnit;
|
|
|
|
{-------------------------------------------------------------------------------
|
|
Create
|
|
Destroy
|
|
|
|
-------------------------------------------------------------------------------}
|
|
|
|
constructor TExpander.Create;
|
|
begin
|
|
inherited Create;
|
|
MTFDecoder := TMTFDecoder.create;
|
|
FileStrucAriDecoder := TFileStrucAriDecoder.Create;
|
|
end;
|
|
|
|
|
|
destructor TExpander.Destroy;
|
|
begin
|
|
FileStrucAriDecoder.Free;
|
|
MTFDecoder.free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------
|
|
Allocate Structs
|
|
Free Structs
|
|
|
|
Swap Blocks
|
|
in_block and out_block exchange pointer values
|
|
-------------------------------------------------------------------------------}
|
|
|
|
{procedure TExpander.AllocateStructs;
|
|
begin
|
|
New(transformation_block);
|
|
New(block1);
|
|
New(block2);
|
|
|
|
in_block := block1;
|
|
out_block := block2;
|
|
end;
|
|
|
|
procedure TExpander.FreeStructs;
|
|
begin
|
|
Dispose(block2);
|
|
Dispose(block1);
|
|
Dispose(transformation_block);
|
|
end;}
|
|
|
|
procedure TExpander.InitStructs;
|
|
begin
|
|
in_block := BlockMan.block1;
|
|
out_block := BlockMan.block2;
|
|
transformation_block := BlockMan.longintblock1;
|
|
// blocksize is definitely greater than 256, so count and running_total
|
|
// can use longintblock
|
|
count := P256longintarray(BlockMan.longintblock2);
|
|
running_total := P256longintarray(BlockMan.longintblock3);
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------
|
|
ExpandBlock
|
|
|
|
IN Assertion:
|
|
InFile has been seeed to the pos to retrieve the block
|
|
OutFile has been seeked to the pos to add data
|
|
-------------------------------------------------------------------------------}
|
|
procedure TExpander.ExpandBlock(InFile: TArchiveFile; OutFile: TFileStream);
|
|
var
|
|
DataBlockHeader: TDataBlockHeader;
|
|
crc: longword;
|
|
begin
|
|
//AllocateStructs;
|
|
|
|
{InFile := _InFile;
|
|
OutFile := _OutFile;}
|
|
//InFile.ResetBuffer;
|
|
|
|
InitStructs;
|
|
DataBlockHeader := TDataBlockHeader.Create;
|
|
DataBlockHeader.ReadFromFile(InFile);
|
|
|
|
InFile.SetReadByteLimit(DataBlockHeader.compressed_size);
|
|
|
|
AriDecode(Infile);
|
|
MTFDecode(DataBlockHeader.virtual_char_index);
|
|
RecoverSortedBlock(DataBlockHeader.first_sym_index, DataBlockHeader.virtual_char_index);
|
|
{RLEDecode;}
|
|
|
|
// check crc
|
|
CalculateCRC32(in_block, block_length, crc);
|
|
if (DataBlockHeader.crc32 <> crc) then
|
|
begin
|
|
ShowMessage('CRC does not match!');
|
|
FLastCRC32Result := false;
|
|
end
|
|
else
|
|
begin
|
|
FLastCRC32Result := true;
|
|
end;
|
|
|
|
// Write to OutFile
|
|
OutFile.Write(in_block[0], block_length);
|
|
|
|
//FreeStructs;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------
|
|
24/04/2001. IN DEVELOPMENT. DO NOT USE.
|
|
|
|
ExpandStream
|
|
|
|
|
|
Notes:
|
|
Stream compression/decompression does not maintain any data header.
|
|
You must specify the block size yourself.
|
|
|
|
IN Assertion:
|
|
InStream has been seeed to the pos to retrieve the block
|
|
OutStream has been seeked to the pos to add data
|
|
-------------------------------------------------------------------------------}
|
|
(*
|
|
procedure TExpander.ExpandStream(InStream, OutStream: TStream);
|
|
var
|
|
DataBlockHeader: TDataBlockHeader;
|
|
crc: longword;
|
|
begin
|
|
|
|
InitStructs;
|
|
//DataBlockHeader := TDataBlockHeader.Create;
|
|
//DataBlockHeader.ReadFromFile(InFile);
|
|
|
|
InFile.SetReadByteLimit(DataBlockHeader.compressed_size);
|
|
|
|
AriDecode(Infile);
|
|
MTFDecode(DataBlockHeader.virtual_char_index);
|
|
RecoverSortedBlock(DataBlockHeader.first_sym_index, DataBlockHeader.virtual_char_index);
|
|
{RLEDecode;}
|
|
|
|
// check crc
|
|
CalculateCRC32(in_block, block_length, crc);
|
|
if (DataBlockHeader.crc32 <> crc) then
|
|
begin
|
|
ShowMessage('CRC does not match!');
|
|
FLastCRC32Result := false;
|
|
end
|
|
else
|
|
begin
|
|
FLastCRC32Result := true;
|
|
end;
|
|
|
|
// Write to OutFile
|
|
OutFile.Write(in_block[0], block_length);
|
|
|
|
//FreeStructs;
|
|
end;
|
|
*)
|
|
|
|
{-------------------------------------------------------------------------------
|
|
AriDecode
|
|
|
|
OUT Assertion:
|
|
Sets block_length
|
|
-------------------------------------------------------------------------------}
|
|
procedure TExpander.AriDecode(InFile: TArchiveFile);
|
|
begin
|
|
// FileStrucAriDecoder := TFileStrucAriDecoder.Create;
|
|
FileStrucAriDecoder.DecodeBlock(InFile, out_block, block_length);
|
|
SwapBlocks;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------
|
|
Move To Front Decode and count
|
|
-------------------------------------------------------------------------------}
|
|
procedure TExpander.MTFDecode(const virtual_char_index: longint);
|
|
var
|
|
i, j: integer;
|
|
b: byte;
|
|
begin
|
|
MTFDecoder.Init;
|
|
|
|
// Reset counts to 0
|
|
for i := 0 to 255 do
|
|
count[i] := 0;
|
|
|
|
// Count[-1] = 1 since it is the virtual smallest char
|
|
// -1 is the virtual character
|
|
count[-1] := 1;
|
|
|
|
// i: outblock index
|
|
// j: inblock index
|
|
i := 0;
|
|
j := 0;
|
|
|
|
// the decode/count loop is unrolled to 2 parts to ignore the virtual char
|
|
while (i < virtual_char_index) do
|
|
begin
|
|
b := MTFDecoder.Decode(in_block[j]);
|
|
out_block[i] := b;
|
|
inc(count[b]);
|
|
inc(i);
|
|
inc(j);
|
|
end;
|
|
|
|
inc(i); // leave one char in outblock for virtual char
|
|
|
|
while (j < block_length) do // 2nd time
|
|
begin
|
|
b := MTFDecoder.Decode(in_block[j]);
|
|
out_block[i] := b;
|
|
inc(count[b]);
|
|
inc(i);
|
|
inc(j);
|
|
end;
|
|
|
|
|
|
// add one to the block length because the virtual char was added
|
|
// outblock is now 1 char greater
|
|
inc(block_length);
|
|
|
|
SwapBlocks;
|
|
end;
|
|
|
|
|
|
{-------------------------------------------------------------------------------
|
|
RecoverSortedBlock
|
|
|
|
Processes in_block to produce out_block.
|
|
Reverses the process of Sort + Transform
|
|
IN Assertion: Memory has been allocated for out_block and transformation_block
|
|
first_sym_index has been set
|
|
-------------------------------------------------------------------------------}
|
|
procedure TExpander.RecoverSortedBlock(const first_sym_index, virtual_char_index: longint);
|
|
var
|
|
i, j, sum, idx: longint;
|
|
begin
|
|
{Map the symbols from the last column to the first column}
|
|
sum := 0;
|
|
for i := -1 to 255 do
|
|
begin
|
|
running_total[i] := sum;
|
|
sum := sum + count[i];
|
|
count[i] := 0;
|
|
end;
|
|
|
|
// the loop is unrolled to 2 parts to account for the virtual char
|
|
for i := 0 to virtual_char_index-1 do
|
|
begin
|
|
idx := in_block[i];
|
|
|
|
transformation_block[count[idx] + running_total[idx]] := i;
|
|
inc(count[idx]);
|
|
end;
|
|
|
|
// i = virtual_char_index
|
|
// we assign manually since -1 cannot be represented in a byte}
|
|
transformation_block[count[-1] + running_total[-1]] := virtual_char_index;
|
|
|
|
for i := virtual_char_index+1 to block_length-1 do
|
|
begin
|
|
idx := in_block[i];
|
|
|
|
transformation_block[count[idx] + running_total[idx]] := i;
|
|
inc(count[idx]);
|
|
end;
|
|
|
|
// Recover
|
|
i := first_sym_index;
|
|
for j := 0 to block_length-1 do
|
|
begin
|
|
out_block[j] := in_block[i];
|
|
i := transformation_block[i];
|
|
end;
|
|
|
|
// cut the virtual char. outblock less one char.
|
|
dec(block_length);
|
|
|
|
SwapBlocks;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------
|
|
Run Length Decode
|
|
-------------------------------------------------------------------------------}
|
|
{procedure TExpander.RLEDecode;
|
|
var
|
|
RunLengthDecoder: TRunLengthDecoder;
|
|
begin
|
|
RunLengthDecoder := TRunLengthDecoder.Create;
|
|
RunLengthDecoder.DecodeBlock(in_block, out_block, block_length, block_length);
|
|
RunLengthDecoder.Free;
|
|
SwapBlocks;
|
|
end;}
|
|
|
|
|
|
function TExpander.GetLastCRC32Result: boolean;
|
|
begin
|
|
result := FLastCRC32Result;
|
|
end;
|
|
|
|
|
|
end.
|