uses crt;
var n1,n2:string;
    lines:word;
    pom:string;
    i,j,k:word;
    buf,buf2:array[0..16385] of byte;
    f1,f2:file;
    ok:byte;
    kk:char;
    th:array[0..16383]of byte;
    ag,ap:word;
    first:byte;
    eo:byte;
label konec;


 procedure key;
 begin
  kk:=readkey;
 end;

   procedure put;
   begin
    blockwrite(f2,buf2[0],lines+2);
    if (ap>(lines+1)) then
      begin
       writeln('Error: Table is too long to fit line !!!!!!!!!!!!!!!!!!!!!!');
       close(f2);
       erase(f2);
       close(f1);
       halt(1);
      end;
    for i:=0 to 16383 do buf2[i]:=$20;
    buf2[lines]:=$a;
    buf2[lines+1]:=$d;
    ap:=0;
   end;



 procedure zpracuj;

   function getr:string;
   var p:string;
   begin
   p:='';
    if ((buf[ag]=0)or(buf[ag]=$a)) then
       begin
        getr:=p;
        eo:=1;
        exit;
       end else eo:=0;
    if (buf[ag]=ord('<')) then
      begin
       while ((buf[ag]<>ord('>'))and(buf[ag]<>0)) do
         begin
          p:=p+chr(buf[ag]);
          ag:=ag+1;
         end;
         if (buf[ag]=ord('>')) then p:=p+'>';
      end else
    if (buf[ag]=ord('&')) then
      begin
       while ((buf[ag]<>ord(';'))and(buf[ag]<>0)) do
         begin
          p:=p+chr(buf[ag]);
          ag:=ag+1;
         end;
         if (buf[ag]=ord(';')) then p:=p+';';
      end else
    if (buf[ag]=$20) then
      begin
       while (buf[ag]=$20) do
         begin
          p:=p+' ';
          ag:=ag+1;
         end;
         ag:=ag-1;
      end else
    if (buf[ag]<>0) then
      begin
       while ((buf[ag]<>$20)and(buf[ag]<>ord('<'))and(buf[ag]<>ord('&'))and(buf[ag]<>0)) do
         begin
          p:=p+chr(buf[ag]);
          ag:=ag+1;
         end;
         ag:=ag-1;
      end;
   getr:=p;
   end;

 var nasel:byte;
 label nas,nas2,kon2,kon3,kon4,kon5;

 begin
  ag:=0;
  for ag:=0 to lines-1 do
    begin
      if (ap>(lines+1)) then
        begin
         writeln('Error: Table is too long to fit line !!!!!!!!!!!!!!!!!!!!!!');
         close(f2);
         erase(f2);
         close(f1);
         halt(1);
        end;
      pom:=getr;
      if (eo=0)then
       begin
        if ((pom='<TH>')or(pom='<TH ALIGN=LEFT>'))then
         begin
          ap:=ap+3;
          th[ap-2]:=1;
          buf2[ap-2]:=ord('|');
         end else
        if (pom='<TH ALIGN=RIGHT>')then
         begin
          ap:=ap+3;
          th[ap-2]:=1;
          buf2[ap-2]:=ord('|');
          pom:=getr;
           for j:=ap to lines-1
             do
              begin
               if (th[j]=1) then
                 begin
                  ap:=j-(length(pom)+1);
                  goto kon2;
                 end;
              end;
         kon2:for j:=2 to length(pom) do buf2[ap+j-1]:=mem[seg(pom):ofs(pom)+j];
              ap:=ap+length(pom)+1;
         end else
        if (pom='<TD ALIGN=RIGHT>')then
         begin
          while ((th[ap]<>1)and(ap<lines-1))do ap:=ap+1;
          buf2[ap]:=ord('|');
          ap:=ap+2;
{          buf2[ap-2]:=ord('|');}
          pom:=getr;
           for j:=ap to lines-1
             do
              begin
               if (th[j]=1) then
                 begin
                  ap:=j-(length(pom)+1);
                  goto kon3;
                 end;
              end;
         kon3:for j:=2 to length(pom) do buf2[ap+j-1]:=mem[seg(pom):ofs(pom)+j];
              ap:=ap+length(pom)+1;
         end else
        if (pom='<TD ALIGN=CENTER>')then
         begin
          while ((th[ap]<>1)and(ap<lines-1))do ap:=ap+1;
          buf2[ap]:=ord('|');
          ap:=ap+2;
{          buf2[ap-2]:=ord('|');}
          pom:=getr;
           for j:=ap to lines-1
             do
              begin
               if (th[j]=1) then
                 begin
                  ap:=ap+(((j-(length(pom)+1))-ap)div 2);
                  goto kon4;
                 end;
              end;
         kon4:for j:=2 to length(pom) do buf2[ap+j-1]:=mem[seg(pom):ofs(pom)+j];
              ap:=ap+length(pom)+1;
         end else
        if ((pom='<TD>')or(pom='<TD ALIGN=LEFT>'))then
         begin
          while ((th[ap]<>1)and(ap<lines-1))do ap:=ap+1;
          buf2[ap]:=ord('|');
          if (ap<(lines-3))then ap:=ap+2;
         end else
        if ((pom='<TR>')or(pom=''))then
         begin
          if (first=0)then
           begin
            buf2[lines-1]:=ord('|');
            put;
           end;
          first:=0;
          for ap:=1 to (lines-1) do buf2[ap]:=ord('-');
          put;
         end else
         if (pom='&lt;')then
         begin
          buf2[ap]:=ord('<');
          ap:=ap+1;
         end else
         if (pom='&gt;')then
         begin
          buf2[ap]:=ord('>');
          ap:=ap+1;
         end else
         if (pom='&amp;')then
         begin
          buf2[ap]:=ord('&');
          ap:=ap+1;
         end else

         {Zbytek}
         begin
          for j:=1 to length(pom) do
           begin
            buf2[ap]:=mem[seg(pom):ofs(pom)+j];
            ap:=ap+1;
           end;
         end;
       end;
    end;
 end;

 procedure getline;
 begin
  ok:=1;
  for i:=0 to 16383 do buf[i]:=0;
  i:=0;
  j:=1;
  while ((j=1) and (buf[i]<>$d)) do
   begin
    blockread(f1,buf[i],1,j);
    if ((buf[i]<>$a) and (buf[i]<>$d)) then i:=i+1;
   end;
  if buf[0]=0 then ok:=0;
  if buf[i]=$d then buf[i]:=0;
 end;



begin
 if paramcount<2 then
   begin
konec:
    writeln('14TAB {-line length} description table'#13#10);
    exit;
   end;
 pom:=copy(paramstr(1),1,1);
 if pom='-'then
    begin
     if paramcount<3 then goto konec;
     n1:=paramstr(2);
     n2:=paramstr(3);
     pom:=copy(paramstr(1),2,length(paramstr(1))-1);
     val(pom,lines,i);
    end else
    begin
     lines:=80;
     n1:=paramstr(1);
     n2:=paramstr(2);
    end;
 if lines>16384 then
   begin
    writeln('To je moc znaku !'#13#10);
    exit;
   end;
 for i:=0 to 16383 do th[i]:=0;
 th[lines-1]:=1;

writeln('Length:',lines,' Descr.:',n1,' Target:',n2);
 assign(f1,n1);
 reset(f1,1);
 assign(f2,n2);
 rewrite(f2,1);
  getline;
  ap:=0;
  for i:=0 to 16383 do buf2[i]:=$20;
  buf2[lines]:=$a;
  buf2[lines+1]:=$d;
  first:=1;
  while ok=1 do
   begin
    zpracuj;
    getline;
   end;
          if (first=0)then
           begin
            buf2[lines-1]:=ord('|');
            put;
           end;
          first:=0;
          for ap:=1 to (lines-1) do buf2[ap]:=ord('-');
 put;
 close(f1);
 close(f2);
end.
