uses Lacrt,objects;
type tblok=(shoda,jednamene,jednavice,nplus,nminus,vzdalena);
     poletype=array[0..65535] of word;

Procedure Zapis(var kb:TStream;delta,j:longint);
var j2:word;
    blok:tblok;
begin
case delta of
 0:blok:=shoda;
-1:blok:=jednamene;
 1:blok:=jednavice;
 else
 if delta>0 then blok:=nplus else blok:=nminus;
end;
j2:=abs(delta);
kb.write(j,2);     {zapisu delku bloku}
kb.write(blok,1);  {zapisu typ bloku}
if j2>1 then kb.write(j2,2);  {pro nplus a nminus zapisu hodnotu N}
end;

Procedure Komprese(var kb:TStream;var p:poletype);
var delta1,delta2:longint;
    i,j:word;
begin
delta1:=0-p[0];
j:=0;
for i:=0 to 65535 do
    begin
    inc(j);
    delta2:=i-p[i];
    if delta2<>delta1 then
       begin
       Zapis(kb,delta1,j-1);
       delta1:=delta2;
       j:=1;
       end;
    end;
if j<>0 then Zapis(kb,delta2,j-1);  {a zapisu zbytek}
end;

var t:text;
    f1,f2:TDosStream;
    s:string;
    pole,pole2:poletype;
    k,l:byte;
    i,j:longint;
    kb1,kb2:TMemoryStream;
begin
for i:=0 to 65535 do begin pole[i]:=i;pole2[i]:=0;end;
Assign(t,'velkmala.txt');
Reset(t);
while not Eof(t) do
   begin
   readln(t,s);
   s:=SkipAllSpaces(s);
   if s[1]<>'#' then
      begin
      k:=Pos(';',s);
      i:=Hex2Dec(Copy(s,1,k-1));
      delete(s,1,k);
      if (i<65536) and (s[1] in ['C','S']) then
         begin
         delete(s,1,2);
         k:=pos(';',s);
         j:=Hex2Dec(Copy(s,1,k-1));
         pole[i]:=j;
         end;
      end;
   end;

for i:=0 to 65535 do pole2[i]:=0;
for i:=0 to 65535 do
    if pole2[i]=0 then
       begin
       pole2[i]:=i;
       if pole[i]=i then pole2[i]:=i else
          pole2[pole[i]]:=i;
       end;
Close(t);

{ukazalo se, ze vietnamstina trosku popletla standardni ASCII prirazeni,}
{tak to opravim...}
for i:=65 to 90 do pole2[i]:=i;
for i:=97 to 122 do pole2[i]:=i-32;

{A ted komprese!}
{type tblok=(shoda,jednamene,jednavice,nplus,nminus,vzdalena);}

kb1.init(40000,40000);
kb2.init(40000,40000);

Komprese(kb1,pole);
Komprese(kb2,pole2);
kb1.seek(0);
kb2.seek(0);

f1.Init('uni_vm.dat',stCreate);
f1.CopyFrom(kb1,kb1.GetSize);
f1.Done;
kb1.done;

f2.Init('uni_mv.dat',stCreate);
f2.CopyFrom(kb2,kb2.GetSize);
f2.Done;
kb2.done;
end.
