数据压缩 -- 源码[9]

        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;
  while (n>0)and(clen^[pred(n)]=0) do
    dec(n);
  putbits(cbit,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
          for k:=0 to pred(count) do
            putbits(ptlen[0],ptcode[0])
        else
          if count<=18 then
            begin
              putbits(ptlen[1],ptcode[1]);
              putbits(4,count-3);
            end else
              if count=19 then
                begin
                  putbits(ptlen[0],ptcode[0]);
                  putbits(ptlen[1],ptcode[1]);
                  putbits(4,15);
                end else begin
                  putbits(ptlen[2],ptcode[2]);
                  putbits(cbit,count-20);
                end;
      end else
        putbits(ptlen[k+2],ptcode[k+2]);
  end;
end;

procedure encodec(c:twobyteint);
begin
  putbits(clen^[c],ccode[c]);
end;

procedure encodep(p:word);
var
  c,q:word;
begin
  c:=0;q:=p;
  while q<>0 do begin
    q:=q shr 1;inc(c);
  end;
  putbits(ptlen[c],ptcode[c]);
  if c>1 then
    putbits(pred(c),p and ($ffff shr (17-c)));
end;

procedure sendblock;
var
  i,k,flags,root,pos,size:word;
begin
  root:=maketree(nc,@cfreq,pbyte(clen),@ccode);
  size:=cfreq[root];
  putbits(16,size);
  if root>=nc then
    begin
      counttfreq;
      root:=maketree(nt,@tfreq,@ptlen,@ptcode);
      if root>=nt then
        writeptlen(nt,tbit,3)
      else
        begin
          putbits(tbit,0);
          putbits(tbit,root);
        end;
      writeclen;
    end else begin
      putbits(tbit,0);
      putbits(tbit,0);
      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;