procedure spocitej(s_par:word;s_typ:boolean);
var s_a:word;s_b,s_c:byte;
begin
  p[0].pocet1:=0;
  p[1].pocet1:=0;
  p[2].pocet1:=0;
  p[3].pocet1:=0;
  for s_a:=1 to s_par do
    begin
      if s_typ<>false then s_b:=vstbuf[s_a]
                      else s_b:=mapa[s_a];
      s_c:=s_b shr 6;
        inc(p[s_c].pocet1);
      s_c:=s_b shr 4;
       asm and s_c,00000011b end;
        inc(p[s_c].pocet1);
      s_c:=s_b shr 2;
       asm and s_c,00000011b end;
        inc(p[s_c].pocet1);
      s_c:=s_b;
       asm and s_c,00000011b end;
        inc(p[s_c].pocet1);
    end;
end;

procedure poradi;       {do 0 jde max}
var p_z:poradityp;
begin
  for e:=0 to 3 do p[e].por1:=e;

  if p[0].pocet1<p[1].pocet1 then begin p_z:=p[0];p[0]:=p[1];p[1]:=p_z;end;
  if p[2].pocet1<p[3].pocet1 then begin p_z:=p[2];p[2]:=p[3];p[3]:=p_z;end;
  if p[1].pocet1<p[2].pocet1 then begin p_z:=p[1];p[1]:=p[2];p[2]:=p_z;end;

  if p[0].pocet1<p[1].pocet1 then begin p_z:=p[0];p[0]:=p[1];p[1]:=p_z;end;
  if p[2].pocet1<p[3].pocet1 then begin p_z:=p[2];p[2]:=p[3];p[3]:=p_z;end;
  if p[1].pocet1<p[2].pocet1 then begin p_z:=p[1];p[1]:=p[2];p[2]:=p_z;end;
end;

{procedure textiky(pro_a:word);
begin
writeln;
writeln(p[0].pocet1,' ',p[0].por1);
writeln(p[1].pocet1,' ',p[1].por1);
writeln(p[2].pocet1,' ',p[2].por1);
writeln(p[3].pocet1,' ',p[3].por1);
a:=(pro_a shl 2);
writeln('kontrolni soucet: ',p[0].pocet1+p[1].pocet1+p[2].pocet1+p[3].pocet1,'/',a,'(dvojic*2=Bite)');

a:=1* p[0].pocet1+
   2* p[1].pocet1+
   3*(p[2].pocet1+p[3].pocet1)+
   4*8+1+(7);        bitu
writeln('celkem: ',a,'/',a shr 3,' ...priblizna komprimace');
end;}

procedure do_mapy(co_dat:boolean); {0/1}
var m_b:byte;
begin
  if ovl_bit=0 then mapa[ovl_byte]:=0;
  if co_dat=true then
    begin
      m_b:=1 shl (7-ovl_bit);
      mapa[ovl_byte]:=mapa[ovl_byte]+m_b;
    end;
  inc(ovl_bit);
  if ovl_bit=8 then begin ovl_bit:=0;inc(ovl_byte);end;
end;

procedure podminka_mapy(podm:word;pm_co:byte);
begin
  asm
    and     podm,00000011b
  end;
  case podm of
    1: if pm_co=p[0].por1 then do_mapy(true) else do_mapy(false);
    2: begin
         if pm_co=p[1].por1 then do_mapy(true);
         if (pm_co=p[2].por1) or (pm_co=p[3].por1) then do_mapy(false);
       end;
    3: begin
         if pm_co=p[2].por1 then do_mapy(true);
         if pm_co=p[3].por1 then do_mapy(false);
       end;
   end;
end;
procedure tabulka_huffman(tab_co:byte);
var tab_a:byte;
begin
  if ovl_bit=0 then vystbuf[ovl_byte_tab]:=0;
  asm
    and     tab_co,00000011b
  end;
  case tab_co of
    0: begin
       end;
    1: begin
         tab_a:=1 shl (7-ovl_bit);
{plus}   vystbuf[ovl_byte_tab]:=vystbuf[ovl_byte_tab] or tab_a;
         inc(ovl_bit);if ovl_bit=8 then begin ovl_bit:=0;inc(ovl_byte_tab);end;
       end;
    2: begin
         tab_a:=1 shl (7-ovl_bit);
{plus}   vystbuf[ovl_byte_tab]:=vystbuf[ovl_byte_tab] or tab_a;
         inc(ovl_bit);if ovl_bit=8 then begin ovl_bit:=0;inc(ovl_byte_tab);end;
         tab_a:=1 shl (7-ovl_bit);
{plus}   vystbuf[ovl_byte_tab]:=vystbuf[ovl_byte_tab] or tab_a;
         inc(ovl_bit);if ovl_bit=8 then begin ovl_bit:=0;inc(ovl_byte_tab);end;
       end;
    3: begin
         tab_a:=1 shl (7-ovl_bit);
{plus}   vystbuf[ovl_byte_tab]:=vystbuf[ovl_byte_tab] or tab_a;
         inc(ovl_bit);if ovl_bit=8 then begin ovl_bit:=0;inc(ovl_byte_tab);end;
         tab_a:=1 shl (7-ovl_bit);
{plus}   vystbuf[ovl_byte_tab]:=vystbuf[ovl_byte_tab] or tab_a;
         inc(ovl_bit);if ovl_bit=8 then begin ovl_bit:=0;inc(ovl_byte_tab);end;
         tab_a:=1 shl (7-ovl_bit);
{plus}   vystbuf[ovl_byte_tab]:=vystbuf[ovl_byte_tab] or tab_a;
       end;
  end;
  inc(ovl_bit);if ovl_bit=8 then begin ovl_bit:=0;inc(ovl_byte_tab);end;
end;


Procedure CompK;
begin
    zapsanox:=0;
    spocitej(nacteno,true);
    pocty_mapa:=p;
    poradi;
{textiky(nacteno);}

  {mapovani}
  ovl_byte:=1;
  ovl_bit:=0;
  for b:=1 to 3 do      {pro mapu 1x2,3,4-2x3,4,3x4}
  for a:=1 to nacteno do
    begin
      e:=vstbuf[a];
      f:=e shr 6;
       podminka_mapy(b,f);
      f:=e shr 4;
       podminka_mapy(b,f);
      f:=e shr 2;
       podminka_mapy(b,f);
       podminka_mapy(b,e);
    end;

     spocitej(OVL_BYTE,false);
     pocty_huff:=p;
     poradi;
{textiky(ovl_byte);}


{... vzdy komprimuj}
vystbuf[ 1]:=ord('A');
vystbuf[ 2]:=hi(pocty_mapa[0].pocet1);
vystbuf[ 3]:=lo(pocty_mapa[0].pocet1);
vystbuf[ 4]:=hi(pocty_mapa[1].pocet1);
vystbuf[ 5]:=lo(pocty_mapa[1].pocet1);
vystbuf[ 6]:=hi(pocty_mapa[2].pocet1);
vystbuf[ 7]:=lo(pocty_mapa[2].pocet1);
vystbuf[ 8]:=hi(pocty_mapa[3].pocet1);
vystbuf[ 9]:=lo(pocty_mapa[3].pocet1);
vystbuf[10]:=hi(pocty_huff[0].pocet1);
vystbuf[11]:=lo(pocty_huff[0].pocet1);
vystbuf[12]:=hi(pocty_huff[1].pocet1);
vystbuf[13]:=lo(pocty_huff[1].pocet1);
vystbuf[14]:=hi(pocty_huff[2].pocet1);
vystbuf[15]:=lo(pocty_huff[2].pocet1);
vystbuf[16]:=hi(pocty_huff[3].pocet1);
vystbuf[17]:=lo(pocty_huff[3].pocet1);

ovl_byte_tab:=delka_hlavicky+1;
ovl_bit:=0;
{---komprimace---}
  for a:=1 to OVL_BYTE do
    begin
      e:=mapa[a];
      f:=e shr 6;
       tabulka_huffman(f);
      f:=e shr 4;
       tabulka_huffman(f);
      f:=e shr 2;
       tabulka_huffman(f);
       tabulka_huffman(e);
    end;
{----------------}
ZapsanoX:=OVL_BYTE_TAB;
end;
