Contributor: SWAG SUPPORT TEAM
{You won't get that sort of compression from my routines, but here
they are anyway. When testing, you'll get best compression if you
use English and longish Strings.
}
Unit Compress;
Interface
Const
CompressedStringArraySize = 500; { err on the side of generosity }
Type
tCompressedStringArray = Array[1..CompressedStringArraySize] of Byte;
Function GetCompressedString(Arr : tCompressedStringArray) : String;
Procedure CompressString(st : String; Var Arr : tCompressedStringArray;
Var len : Integer);
{ converts st into a tCompressedStringArray of length len }
Implementation
Const
FreqChar : Array[4..14] of Char = 'etaonirshdl';
{ can't be in [0..3] because two empty bits signify a space }
Function GetCompressedString(Arr : tCompressedStringArray) : String;
Var
Shift : Byte;
i : Integer;
ch : Char;
st : String;
b : Byte;
Function GetHalfNibble : Byte;
begin
GetHalfNibble := (Arr[i] shr Shift) and 3;
if Shift = 0 then begin
Shift := 6;
inc(i);
end else dec(Shift,2);
end;
begin
st := '';
i := 1;
Shift := 6;
Repeat
b := GetHalfNibble;
if b = 0 then
ch := ' '
else begin
b := (b shl 2) or GetHalfNibble;
if b = $F then begin
b := GetHalfNibble shl 6;
b := b or GetHalfNibble shl 4;
b := b or GetHalfNibble shl 2;
b := b or GetHalfNibble;
ch := Char(b);
end else
ch := FreqChar[b];
end;
if ch #0 then st := st + ch;
Until ch = #0;
GetCompressedString := st;
end;
Procedure CompressString(st : String; Var Arr : tCompressedStringArray;
Var len : Integer);
{ converts st into a tCompressedStringArray of length len }
Var
i : Integer;
Shift : Byte;
Procedure OutHalfNibble(b : Byte);
begin
Arr[len] := Arr[len] or (b shl Shift);
if Shift = 0 then begin
Shift := 6;
inc(len);
end else dec(Shift,2);
end;
Procedure OutChar(ch : Char);
Var
i : Byte;
bych : Byte Absolute ch;
begin
if ch = ' ' then
OutHalfNibble(0)
else begin
i := 4;
While (i<15) and (FreqChar[i]ch) do inc(i);
OutHalfNibble(i shr 2);
OutHalfNibble(i and 3);
if i = $F then begin
OutHalfNibble(bych shr 6);
OutHalfNibble((bych shr 4) and 3);
OutHalfNibble((bych shr 2) and 3);
OutHalfNibble(bych and 3);
end;
end;
end;
begin
len := 1;
Shift := 6;
fillChar(Arr,sizeof(Arr),0);
For i := 1 to length(st) do OutChar(st[i]);
OutChar(#0); { end of compressed String signaled by #0 }
if Shift = 6
then dec(len);
end;
end.