{$A+,B-,D-,E-,F-,G+,I-,L-,N-,O-,P-,Q-,R-,S-,T-,V-,X+,Y-}
{$M 65520,0,655360}
{ Solved tasks - 1 2 }
uses strings;
type
    xjust=(left,center,right);
    yjust=(top,middle,bottom);
const
     ld:longint=80;
     dash='------------------------------------------------------------------------------------------------------------------';
     space='                                                                                                                 ';

type
    parr=^tarr;
    tarr=array[0..60000] of char;
var
   fin,fon:string;
   fi,fo:text;

   s,s1:string;
   ls:byte absolute s;

   p:pointer;

   cw:array[0..1000] of longint;
   dsp:array[0..1000] of longint;
   rw:array[0..10000] of longint;
   cline:array[0..1000] of pchar;
   lfs,cfs:array[0..1000] of boolean;
   xj:array[0..1000] of xjust;
   yj:array[0..1000] of yjust;
   rs,cs,ps:array[0..1000] of byte;

   r,c,cc:longint;
   cf:pchar;
   tmp,clarge:pchar;

   first:boolean;

   lsize,x,max:longint;

function scopy(ch:char;how:longint):string;
var rez:string;
 begin
  rez:='';
  while how>0 do begin s:=s+ch;dec(how);end;
  scopy:=rez;
 end;

procedure dels(var s:string);
 begin
  while (length(s)>0) and (s[1]=' ') do delete(s,1,1);
 end;

procedure make1s(var s:string);
var x,y:word;
    open:boolean;
 begin
  x:=1;
  while x<length(s) do
        begin
         if s[x]=' ' then
            begin
             y:=x;
             while (y<=length(s)) and (s[y]=' ') do inc(y);
             if y-x>1 then delete(s,x,y-x-1);
            end;
         inc(x);
        end;
  { replace the special characters }
  open:=false;
  for x:=1 to length(s) do
      begin
       if s[x]='<' then open:=true;
       if s[x]='>' then open:=false;
       if open then s[x]:=upcase(s[x]);
      end;
 end;

procedure repl(var s:string);
var x:word;
 begin
  x:=1;
  while (x<=length(s)) do
        begin
         if s[x]='&'
            then
                begin
                 if length(s)>=x+3
                    then
                        begin
                         if
                           ((s[x+1])='l') and
                           ((s[x+2])='t') and
                           ((s[x+3])=';')
                           then
                               begin
                                delete(s,x,4);
                                insert('<',s,x);
                               end;
                        end;
                 if length(s)>=x+3
                    then
                        begin
                         if
                           ((s[x+1])='g') and
                           ((s[x+2])='t') and
                           ((s[x+3])=';')
                           then
                               begin
                                delete(s,x,4);
                                insert('>',s,x);
                               end;
                        end;
                 if length(s)>=x+4
                    then
                        begin
                         if
                           ((s[x+1])='a') and
                           ((s[x+2])='m') and
                           ((s[x+3])='p') and
                           ((s[x+4])=';')
                           then
                               begin
                                delete(s,x,5);
                                insert('&',s,x);
                               end;
                        end;
                end;
         inc(x);
        end;
 end;

function finddepth:longint;
{ finds how deep the sentance should be }
 begin
  {W}
  finddepth:=1;
 end;

function getnum(var s:string):longint;
var rez:longint;
 begin
  rez:=0;
  while (length(s)>0) and (s[1] in ['0'..'9']) do
        begin
         rez:=rez*10+ord(s[1])-48;
         delete(s,1,1);
        end;
  getnum:=rez;
 end;
{****************************************}
procedure calc;
var x:longint;

 begin
  make1s(s);

  repeat
   dels(s);
   if ls=0 then exit;
   if s[1]='<'
      then
          begin
           delete(s,1,2);

           if s[1]<>'R'
              then
                  begin { new field }
                   x:=strlen(cf);
                   if x>cw[cc] then cw[cc]:=x;
                   if x>strlen(clarge) then strcopy(clarge,cf);

                   inc(cc);
                   rs[cc]:=0;
                   cs[cc]:=0;
                   strpcopy(cf,'');
                  end;
           case s[1] of
            'R':
                begin
                 { keep the line }
                 inc(r);

                 rw[r]:=finddepth;

                 strpcopy(clarge,'');
                 if cc>c then c:=cc;
                 cc:=0;
                end;
            'H':xj[cc]:=center;
            'D':xj[cc]:=left;
           end; { case }

           delete(s,1,1);
           while (ls>0) and (s[1]=' ') do
                 begin
                  delete(s,1,1);
                  { add the alligment }
                  case s[1] of
                  'A':
                      begin { allign= }
                       delete(s,1,6);
                       x:=getnum(s);
                       case s[1] of
                       'L':
                           begin
                            xj[cc]:=left;
                            delete(s,1,4);
                           end;
                       'C':
                           begin
                            xj[cc]:=center;
                            delete(s,1,6);
                           end;
                       'R':
                           begin
                            xj[cc]:=right;
                            delete(s,1,5);
                           end;
                       end; { case }
                      end;
                  'V':
                      begin { valign= }
                       delete(s,1,7);
                       x:=getnum(s);
                       case s[1] of
                        'T':
                            begin
                             yj[cc]:=top;
                             delete(s,1,3);
                            end;
                        'M':
                            begin
                             yj[cc]:=middle;
                             delete(s,1,6);
                            end;
                        'B':
                            begin
                             yj[cc]:=bottom;
                             delete(s,1,6);
                            end;
                       end; { case }
                      end;
                  'C':
                      begin { colspan= }
                       delete(s,1,8);
                       x:=getnum(s);
                       cs[cc]:=x;
                      end;
                  'R':
                      begin { rowspan= }
                       delete(s,1,8);
                       x:=getnum(s);
                       rs[cc]:=x;
                      end;
                  end; { case }
                 end;
           delete(s,1,1); { > }
          end
      else
          begin { the text }
           x:=pos('<',s);
           if x=0
              then
                  begin
                   s1:=s;
                   x:=length(s1);
                  end
              else
                  begin
                   s1:=copy(s,1,x-1);
                   dec(x);
                  end;
           repl(s1);
           strpcopy(tmp,s1);
           cf:=strcat(cf,tmp);
           delete(s,1,x);
          end;
  until false;
 end;

{ KEEP KEEP KEEP KEEP KEEP KEEP }
procedure keepcline;
var x,y:longint;
    tmp:longint;
 begin
  for y:=1 to rw[r] do
      begin
       { draw boeder }
               for x:=1 to cc-1 do
                   begin
                    if x=1
                       then
                           begin
                            if r=1 then write(fo,'+')
                                   else write(fo,'|');
                           end
                       else
                    if (y=1) and lfs[x]
                       then write(fo,'+')
                       else write(fo,'-');
                    write(fo,copy(dash,1,cw[x]+2));
                   end;
       if r=1 then writeln(fo,'+')
              else writeln(fo,'|');
       { draw line }
       for x:=1 to cc-1 do
           begin
            tmp:=strlen(cline[x]);
            write(fo,'| ');
            case xj[x] of
            left  :
                   write(fo,parr(cline[x])^,copy(space,1,cw[x]-tmp));
            center:
                   write(fo,
                            copy(space,1,(cw[x]-tmp) div 2),
                            parr(cline[x])^,
                            copy(space,1,(cw[x]-tmp+1) div 2));
            right :
                   write(fo,copy(space,1,cw[x]-tmp),parr(cline[x])^);
            end; { case }
            write(fo,' ');
           end;
       writeln(fo,'|');
      end;

 end;

procedure keep;
var x:longint;

 begin
  make1s(s);

  repeat
   dels(s);
   if ls=0 then exit;
   if s[1]='<'
      then
          begin
           delete(s,1,2);

           if s[1]<>'R'
              then
                  begin { new field }
                   { keep the old field }
                   x:=strlen(cf);
                   if x>strlen(clarge) then strcopy(clarge,cf);
                   getmem(cline[cc],x+1);
                   strcopy(cline[cc],cf);
                   cfs[cc]:=true;

{                   if cs[cc]=0
                      then }inc(cc);
{                      else
                          begin
                           for x:=cc+1 to cc+cs[cc]-1 do
                               cfs[cc]:=false;
                           inc(cc,cs[cc]);
                          end;}
                   rs[cc]:=0;
                   cs[cc]:=0;
                   strpcopy(cf,'');
                  end;
           case s[1] of
            'R':
                begin
                 { keep the line }

                 if r>0 then keepcline; { keeps the old line }
                 inc(r);

                 { delocc all mem for field }
                 for x:=1 to cc-1 do
                     freemem(cline[x],strlen(cline[x])+1);
                 lfs:=cfs;
                 for x:=1 to cc-1 do cfs[x]:=false;

                 strpcopy(clarge,'');
                 cc:=0;
                end;
            'H':xj[cc]:=center;
            'D':xj[cc]:=left;
           end; { case }

           delete(s,1,1);
           while (ls>0) and (s[1]=' ') do
                 begin
                  delete(s,1,1);
                  { add the alligment }
                  case s[1] of
                  'A':
                      begin { allign= }
                       delete(s,1,6);
                       x:=getnum(s);
                       case s[1] of
                       'L':
                           begin
                            xj[cc]:=left;
                            delete(s,1,4);
                           end;
                       'C':
                           begin
                            xj[cc]:=center;
                            delete(s,1,6);
                           end;
                       'R':
                           begin
                            xj[cc]:=right;
                            delete(s,1,5);
                           end;
                       end; { case }
                      end;
                  'V':
                      begin { valign= }
                       delete(s,1,7);
                       x:=getnum(s);
                       case s[1] of
                        'T':
                            begin
                             yj[cc]:=top;
                             delete(s,1,3);
                            end;
                        'M':
                            begin
                             yj[cc]:=middle;
                             delete(s,1,6);
                            end;
                        'B':
                            begin
                             yj[cc]:=bottom;
                             delete(s,1,6);
                            end;
                       end; { case }
                      end;
                  'C':
                      begin { colspan= }
                       delete(s,1,8);
                       x:=getnum(s);
                       cs[cc]:=x;
                      end;
                  'R':
                      begin { rowspan= }
                       delete(s,1,8);
                       x:=getnum(s);
                       rs[cc]:=x;
                      end;
                  end; { case }
                 end;
           delete(s,1,1); { > }
          end
      else
          begin { the text }
           x:=pos('<',s);
           if x=0
              then
                  begin
                   s1:=s;
                   x:=length(s1);
                  end
              else
                  begin
                   s1:=copy(s,1,x-1);
                   dec(x);
                  end;
           repl(s1);
           strpcopy(tmp,s1);
           cf:=strcat(cf,tmp);
           delete(s,1,x);
          end;
  until false;
 end;


begin { main }
 if paramcount=3
    then
        begin
         s:=paramstr(1);
         delete(s,1,1);
         ld:=getnum(s);
         fin:=paramstr(2);
         fon:=paramstr(3);
        end
    else
        begin
         fin:=paramstr(1);
         fon:=paramstr(2);
        end;

 getmem(p,65000);
 getmem(cf,65000);
 getmem(clarge,65000);
 getmem(tmp,300);

 { Calcculate }
 strpcopy(cf,'');
 strpcopy(clarge,'');
 c:=0;
 cc:=0;
 r:=0;
 for x:=0 to 1000 do cs[x]:=0;
 for x:=0 to 1000 do rs[x]:=0;

 assign(fi,fin);
 reset(fi);
 settextbuf(fi,p^,64000);
 while not seekeof(fi) do
       begin
        readln(fi,s);
        s:=s+'<TH>';
        calc;
       end;
 s:='<TR>';calc;
 close(fi);

 { refine the max length }
 lsize:=0;
 dec(c);
 for x:=1 to c do
     inc(lsize,cw[x]);
 inc(lsize,c*3+1);
 if lsize>ld then
    begin
     writeln('Error: Table is too long to fit line.');
     halt;
    end;

 { keep }

 cfs[1]:=true;
 for x:=2 to c do
     cfs[x]:=false;

 for x:=0 to 1000 do cs[x]:=0;
 for x:=0 to 1000 do rs[x]:=0;
 cc:=0;
 r:=0;

 strpcopy(cf,'');
 first:=true;

 assign(fi,fin);
 reset(fi);
 assign(fo,fon);
 rewrite(fo);

 settextbuf(fi,p^,64000);
 while not seekeof(fi) do
       begin
        readln(fi,s);
        s:=s+'<TH>';
        keep;
       end;
 s:='<TR>';keep;
 writeln(fo,'+',copy(dash,1,lsize-2),'+');

 close(fi);
 close(fo);

end. { main }