; EXIT;
DEC(decode_j);
END;
WHILE TRUE DO BEGIN
c:=DecodeC;
IF c<=UCHARMAX THEN
BEGIN
Buffer^[r]:=c;INC(r);
IF r=count THEN
EXIT;
END ELSE BEGIN
decode_j:=c-(UCHARMAX+1-THRESHOLD);
decode_i:=(LongInt(r)-DecodeP-1)AND PRED(DICSIZ);
DEC(decode_j);
WHILE decode_j>=0 DO BEGIN
Buffer^[r]:=Buffer^[decode_i];
decode_i:=SUCC(decode_i) AND PRED(DICSIZ);
INC(r);
IF r=count THEN
EXIT;
DEC(decode_j);
END;
END;
END;
END;
PROCEDURE Decode;
VAR
p:PByte;
l:Longint;
a:Word;
BEGIN
{Initialize decoder variables}
GetMem(p,DICSIZ);
InitGetBits;BlockSize:=0;
decode_j:=0;
{skip file size}
l:=OrigSize;DEC(compSize,4);
{unpacks the file}
WHILE l>0 DO BEGIN
IF l>DICSIZ THEN
a:=DICSIZ
ELSE
a:=l;
DecodeBuffer(a,p);
OutFile.Write(p^,a);DEC(l,a);
END;
FreeMem(p,DICSIZ);
END;
{********************************* Compression ********************************}
{-------------------------------- Huffman part --------------------------------}
PROCEDURE CountLen(i:TwoByteInt);
BEGIN
IF i<n THEN
BEGIN
IF Depth<16 THEN
INC(LenCnt[Depth])
ELSE
INC(LenCnt[16]);
END ELSE BEGIN
INC(Depth);
CountLen(Left^[i]);CountLen(Right^[i]);
DEC(Depth);
END;
END;
PROCEDURE MakeLen(root:TwoByteInt);
VAR
i,k:TwoByteInt;
cum:word;
BEGIN
FOR i:=0 TO 16 DO
LenCnt[i]:=0;
CountLen(root);cum:=0;
FOR i:=16 DOWNTO 1 DO
INC(cum,LenCnt[i] SHL (16-i));
WHILE cum<>0 DO BEGIN
DEC(LenCnt[16]);
FOR i:=15 DOWNTO 1 DO
IF LenCnt[i]<>0 THEN
BEGIN
DEC(LenCnt[i]);INC(LenCnt[SUCC(i)],2);
BREAK;
END;
DEC(cum);
END;
FOR i:=16 DOWNTO 1 DO BEGIN
k:=PRED(Longint(LenCnt[i]));
WHILE k>=0 DO BEGIN
DEC(k);Len^[SortPtr^[0]]:=i;
ASM
ADD WORD PTR SortPtr,2; {SortPtr:=addr(SortPtr^[1]);}
END;
END;
END;
END;
PROCEDURE DownHeap(i:TwoByteInt);
VAR
j,k:TwoByteInt;
BEGIN
k:=Heap^[i];j:=i SHL 1;
WHILE (j<=HeapSize) DO BEGIN
IF (j<HeapSize)AND(Freq^[Heap^[j]]>Freq^[Heap^[SUCC(j)]]) THEN INC(j);
IF Freq^[k]<=Freq^[Heap^[j]] THEN break;
Heap^[i]:=Heap^[j];i:=j;j:=i SHL 1;
END;
Heap^[i]:=k;
END;
PROCEDURE MakeCode(n:TwoByteInt;Len:PByte;Code:PWord);
VAR
i,k:TwoByteInt;
start:ARRAY[0..17] OF Word;
BEGIN
start[1]:=0;
FOR i:=1 TO 16 DO
start[SUCC(i)]:=(start[i]+LenCnt[i])SHL 1;
FOR i:=0 TO PRED(n) DO BEGIN
k:=Len^[i];
Code^[i]:=start[k];
INC(start[k]);
END;
END;
FUNCTION MakeTree(NParm:TwoByteInt;Freqparm:PWord;LenParm:PByte;Codeparm:PWord):TwoByteInt;
VAR
i,j,k,Avail:TwoByteInt;
BEGIN
n:=NParm;Freq:=Freqparm;Len:=LenParm;Avail:=n;HeapSize:=0;Heap^[1]:=0;
FOR i:=0 TO PRED(n) DO BEGIN
Len^[i]:=0;
IF Freq^[i]<>0 THEN
BEGIN
INC(HeapSize);Heap^[HeapSize]:=i;
END;
END;
IF HeapSize<2 THEN
BEGIN
Codeparm^[Heap^[1]]:=0;MakeTree:=Heap^[1];
EXIT;
END;
FOR i:=(HeapSize div 2)DOWNTO 1 DO DownHeap(i);
SortPtr:=Codeparm;
REPEAT
i:=Heap^[1];
IF i<n THEN
BEGIN
SortPtr^[0]:=i;
ASM
ADD WORD PTR SortPtr,2; {SortPtr:=addr(SortPtr^[1]);}
END;
END;
Heap^[1]:=Heap^[HeapSize];DEC(HeapSize);DownHeap(1);
j:=Heap^[1];
IF j<n THEN
BEGIN
SortPtr^[0]:=j;
ASM
ADD WORD PTR SortPtr,2; {SortPtr:=addr(SortPtr^[1]);}
END;
END;
k:=Avail;INC(Avail);
Freq^[k]:=Freq^[i]+Freq^[j];Heap^[1]:=k;DownHeap(1);
Left^[k]:=i;Right^[k]:=j;
UNTIL HeapSize<=1;
SortPtr:=Codeparm;
MakeLen(k);MakeCode(NParm,LenParm,Codeparm);
MakeTree:=k;
END;
PROCEDURE CountTFreq;
VAR
i,k,n,Count:TwoByteInt;
BEGIN
FOR i:=0 TO PRED(NT) DO
TFreq[i]:=0;n:=NC;
WHILE (n>0)AND(CLen^[PRED(n)]=0) DO
DEC(n);
i:=0;
WHILE i<n DO BEGIN
k:=CLen^[i];INC(i);
IF k=0 THEN
BEGIN
Count:=1;
WHILE (i<n)AND(CLen^[i]=0) DO BEGIN
INC(i);INC(Count);
END;
IF Count<=2 THEN
INC(TFreq[0],Count)
ELSE
IF Count<=18 THEN
INC(TFreq[1])
ELSE
IF Count=19 THEN
BEGIN
INC(TFreq[0]);INC(TFreq[1]);
END ELSE
INC(TFreq[2]);
END ELSE
INC(TFreq[k+2]);
END;
END;
PROCEDURE WritePtLen(n,nBit,ispecial:TwoByteInt);
VAR
i,k:TwoByteInt;
BEGIN
WHILE (n>0)AND(PtLen[PRED(n)]=0) DO
DEC(n);
PutBits(nBit,n);i:=0;
WHILE (i<n) DO BEGIN
k:=PtLen[i];INC(i);
IF k<=6 THEN
PutBits(3,k)
ELSE
BEGIN
DEC(k,3);
PutBits(k,(1 SHL k)-2);
END;
IF i=ispecial THEN
BEGIN
WHILE (i<6)AND(PtLen[i]=0) DO
INC(i);
PutBits(2,(i-3)AND 3);
END;
END;
END;
PROCEDURE WriteCLen;
VAR
i,k,n,Count:TwoByteInt;
BEGIN
n:=NC;
W 上一页 [1] [2] [3] [4] [5] [6] [7] 下一页 | 
