数据压缩 -- 源码

PutBits(CBIT,0);
PutBits(CBIT,root);
END;
root:=MakeTree(NP,@PFreq,@PtLen,@PtCode);
IF root>=NP THEN
WritePtLen(NP,PBIT,-1)
ELSE
BEGIN
PutBits(PBIT,0);
PutBits(PBIT,root);
END;
Pos:=0;
FOR i:=0 TO PRED(Size) DO BEGIN
IF (i AND 7)=0 THEN
BEGIN
flags:=Buf^[Pos];INC(Pos);
END ELSE
flags:=flags SHL 1;
IF (flags AND (1 SHL 7))<>0 THEN
BEGIN
k:=Buf^[Pos] (1 SHL 8);INC(Pos);EncodeC(k);
k:=Buf^[Pos]SHL 8;INC(Pos);INC(k,Buf^[Pos]);INC(Pos);EncodeP(k);
END ELSE BEGIN
k:=Buf^[Pos];INC(Pos);EncodeC(k);
END;
END;
FOR i:=0 TO PRED(NC) DO
CFreq[i]:=0;
FOR i:=0 TO PRED(NP) DO
PFreq[i]:=0;
END;

PROCEDURE Output(c,p:Word);
BEGIN
OutputMask:=OutputMask SHR 1;
IF OutputMask=0 THEN
BEGIN
OutputMask:=1 SHL 7;
IF (OutputPos>=WINDOWSIZE-24) THEN
BEGIN
SendBlock;OutputPos:=0;
END;
CPos:=OutputPos;INC(OutputPos);Buf^[CPos]:=0;
END;
Buf^[OutputPos]:=c;INC(OutputPos);INC(CFreq[c]);
IF c>=(1 SHL 8) THEN
BEGIN
Buf^[CPos]:=Buf^[CPos] OR OutputMask;
Buf^[OutputPos]:=(p SHR 8);INC(OutputPos);
Buf^[OutputPos]:=p;INC(OutputPos);c:=0;
WHILE p<>0 DO BEGIN
p:=p SHR 1;INC(c);
END;
INC(PFreq[c]);
END;
END;

{------------------------------- Lempel-Ziv part ------------------------------}

PROCEDURE InitSlide;
VAR
i:Word;
BEGIN
FOR i:=DICSIZ TO (DICSIZ UCHARMAX) DO BEGIN
Level^[i]:=1;
{$IFDEF PERCOLATE}
Position^[i]:=NUL;
{$ENDIF}
END;
FOR i:=DICSIZ TO PRED(2*DICSIZ) DO
Parent^[i]:=NUL;
Avail:=1;
FOR i:=1 TO DICSIZ-2 DO
Next^[i]:=SUCC(i);
Next^[PRED(DICSIZ)]:=NUL;
FOR i:=(2*DICSIZ) TO MAXHASHVAL DO
Next^[i]:=NUL;
END;

{ Hash function }
FUNCTION Hash(p:TwoByteInt;c:Byte):TwoByteInt;
BEGIN
Hash:=p (c SHL (DICBIT-9)) 2*DICSIZ;
END;

FUNCTION Child(q:TwoByteInt;c:Byte):TwoByteInt;
VAR
r:TwoByteInt;
BEGIN
r:=Next^[Hash(q,c)];Parent^[NUL]:=q;
WHILE Parent^[r]<>q DO
r:=Next^[r];
Child:=r;
END;

PROCEDURE MakeChild(q:TwoByteInt;c:Byte;r:TwoByteInt);
VAR
h,t:TwoByteInt;
BEGIN
h:=Hash(q,c);
t:=Next^[h];Next^[h]:=r;Next^[r]:=t;
Prev^[t]:=r;Prev^[r]:=h;Parent^[r]:=q;
INC(ChildCount^[q]);
END;

PROCEDURE Split(old:TwoByteInt);
VAR
new,t:TwoByteInt;
BEGIN
new:=Avail;Avail:=Next^[new];
ChildCount^[new]:=0;
t:=Prev^[old];Prev^[new]:=t;
Next^[t]:=new;
t:=Next^[old];Next^[new]:=t;
Prev^[t]:=new;
Parent^[new]:=Parent^[old];
Level^[new]:=MatchLen;
Position^[new]:=Pos;
MakeChild(new,Text^[MatchPos MatchLen],old);
MakeChild(new,Text^[Pos MatchLen],Pos);
END;

PROCEDURE InsertNode;
VAR
q,r,j,t:TwoByteInt;
c:Byte;
t1,t2:PChar;
BEGIN
IF MatchLen>=4 THEN
BEGIN
DEC(MatchLen);
r:=SUCC(MatchPos) OR DICSIZ;
q:=Parent^[r];
WHILE q=NUL DO BEGIN
r:=Next^[r];q:=Parent^[r];
END;
WHILE Level^[q]>=MatchLen DO BEGIN
r:=q;q:=Parent^[q];
END;
t:=q;
{$IFDEF PERCOLATE}
WHILE Position^[t]<0 DO BEGIN
Position^[t]:=Pos;t:=Parent^[t];
END;
IF t<DICSIZ THEN
Position^[t]:=Pos OR PERCFLAG;
{$ELSE}
WHILE t<DICSIZ DO BEGIN
Position^[t]:=Pos;t:=Parent^[t];
END;
{$ENDIF}
END ELSE BEGIN
q:=Text^[Pos] DICSIZ;c:=Text^[SUCC(Pos)];r:=Child(q,c);
IF r=NUL THEN
BEGIN
MakeChild(q,c,Pos);MatchLen:=1;
EXIT;
END;
MatchLen:=2;
END;
WHILE true DO BEGIN
IF r>=DICSIZ THEN
BEGIN
j:=MAXMATCH;MatchPos:=r;
END ELSE BEGIN
j:=Level^[r];MatchPos:=Position^[r] AND NOT PERCFLAG;
END;
IF MatchPos>=Pos THEN
DEC(MatchPos,DICSIZ);
t1:=addr(Text^[Pos MatchLen]);t2:=addr(Text^[MatchPos MatchLen]);
WHILE MatchLen<j DO BEGIN
IF t1^<>t2^ THEN
BEGIN
Split(r);
EXIT;
END;
INC(MatchLen);INC(t1);INC(t2);
END;
IF MatchLen>=MAXMATCH THEN
BREAK;
Position^[r]:=Pos;q:=r;
r:=Child(q,ORD(t1^));
IF r=NUL THEN
BEGIN
MakeChild(q,ORD(t1^),Pos);
EXIT;
END;
INC(MatchLen);
END;
t:=Prev^[r];Prev^[Pos]:=t;Next^[t]:=Pos;
t:=Next^[r];Next^[Pos]:=t;Prev^[t]:=Pos;

文章整理：西部数码--专业提供域名注册、虚拟主机服务
http://www.west263.com
以上信息与文章正文是不可分割的一部分,如果您要转载本文章,请保留以上信息，谢谢!