uses crt, dos;

const
     LineLength : integer = 80; {delka radku}
     maxpoc = 50; {maximalni pocet sloupecku}
     command : boolean =false;
     apoc : integer = 0;

     VALI  : integer =0;
     ALI  : integer =0;
     RSP : integer = 1;
     CSP : Integer = 1;

type
    TTab = array[1..maxpoc] of integer;

    PRow = ^TRow;
    PCol = ^TCol;
    TRow = record
        head : boolean;
        poc : integer;
        Col : Array[1..maxpoc] of PCol;
        ctab, rtab : TTAB;
        next : prow;
    end;

    TCol = record
        VALI, ALI, RSP, CSP : integer;

        text : string;
        next : pcol;
    end;
var
   s : string;
   error : boolean;
   vc, i : integer;
   InF, OutF : Text;
   LastLine : string;
   WTab : Array[1..maxpoc] of integer;
   deep, CTab, RTab : TTab; {pocet kousku, na kolik se to rozpada - bude po rozpadnuti se to snizovat,
                                    nakonec to
                                       bude obsahovat samy jednicky}
   first, last, Cur : prow;

function UnSpace(S:String):string;
var
   q : string;
   i, j : integer;
   ls : boolean;
begin
     j:=length(s);
     while (j>0) and (s[j]=' ') do dec(j);
     q:='';
     ls:=false;
     for i:=1 to j do
     begin
          if (((s[i]=' ') and not ls) or (s[i]<>' ')) then
          begin
               q:=q+s[i];
          end;
          if s[i]=' ' then ls:=true else ls:=false;
     end;
     UnSpace:=q
end;

function GetUnit(var q : string):boolean; {vraci true=prikaz, false jinak}
var
   f : integer;
begin
     GetUnit:=false;
     command:=false;
     q:='';
     while (not Eof(Inf)) and (LastLine = '') do
     begin
          ReadLn(inf, LastLine);
     end;
     if LastLine <> '' then
     begin
          while (length(LastLine) > 0) and (LastLine[1]=' ') do
          begin
               lastLine:=copy(lastline, 2, length(lastline));
          end;
          if length(lastline) > 0 then
          begin
               if lastline[1]='<' then
               begin
                    GetUnit:=true;
                    command:=true;
                    q:='';
                    while (length(lastline)>0) and (lastline[1]<>'>') do
                    begin
                         q:=q+lastline[1];
                         lastline:=copy(lastline, 2, length(lastline));
                    end;
                    lastline:=copy(lastline, 2, length(lastline)); {kvuli >}
               end else
               begin
                    q:='';
                    while (length(lastline)>0) and (lastline[1]<>'<') do
                    begin
                         if lastline[1]='&' then
                         begin
                              case upcase(lastline[2]) of
                                 'L' : begin
                                            q:=q+'<';
                                            lastline:=copy(lastline, 4, length(lastline));
                                       end;
                                 'G' : begin
                                            q:=q+'>';
                                            lastline:=copy(lastline, 4, length(lastline));
                                       end;
                                 else  begin
                                            q:=q+'&';
                                            lastline:=copy(lastline, 5, length(lastline));
                                       end;
                              end;
                         end else
                         begin
                              q:=q+lastline[1];
                              lastline:=copy(lastline, 2, length(lastline));
                         end;
                    end;
                    q:=Unspace(q);
               end;
          end;
     end;
end;

procedure Anal2(s:string);
var
   spc : boolean;
   i : integer;
   q : string;
begin
     spc:=false;
     for i:=1 to length(s) do
      if s[i]=' ' then spc:=true;
     if spc then
     begin
          q:='';
          while length(s)>0 do
          begin
               q:='';
               while (length(s)>0) and (s[1]<>' ') do
               begin
                    q:=q+s[1];
                    s:=copy(s, 2, length(s));
               end;
               if q <> '' then anal2(q);
               s:=copy(s, 2, length(s));
          end;
     end else
     begin
          if s='' then else
          if s='ALIGN=LEFT' then ALI:=1 else
          if s='ALIGN=RIGHT' then ALI:=2 else
          if s='ALIGN=CENTER' then ALI:=3 else
          if s='VALIGN=TOP' then VALI:=1 else
          if s='VALIGN=BOTTOM' then VALI:=2 else
          if s='VALIGN=MIDDLE' then VALI:=3 else
          if Copy(s, 1, 8)='ROWSPAN=' then
          begin
               q:=copy(s, 9, length(s));
               val(q, RSP, vc);
               if (vc <> 0) or (RSP<1) then
               begin
                    writeln('Error : bad value of ROWSPAN');
                    halt;
               end;
          end;
          if Copy(s, 1, 8)='COLSPAN=' then
          begin
               q:=copy(s, 9, length(s));
               val(q, CSP, vc);
               if (vc <> 0) or (CSP<1) then
               begin
                    writeln('Error : bad value of COLSPAN');
                    halt;
               end;
          end;
     end;
end;

function AnalCom(S:String):integer;
var
   q2 : string;
begin
     AnalCom:=0;
     ALI:=0;
     RSP:=1;
     CSP:=1;
     if (Length(S)>2) and (S[2]='T') then
     begin
          if s[3]='H' then
          begin
               AnalCom:=1;
               Anal2(copy(s, 4, length(s)));
          end else
          if s[3]='D' then
          begin
               AnalCom:=2;
               Anal2(copy(s, 4, length(s)));
          end;
     end else
     begin
          writeLn('error : error in command in table_description');
          halt;
     end;
end;

procedure Analyza;
var
   f, c1, c2, c3 : integer;
   s : string;
   i, j : integer;
   lst, xxx : pcol;
begin
     for i:=1 to maxpoc do wtab[i]:=0;
     for i:=1 to maxpoc do ctab[i]:=1;
     for i:=1 to maxpoc do rtab[i]:=1;
     LastLine:='';
     reset(inf);
     s:='';
     first:=nil; last:=nil;
     while (not eof(inf)) or (lastline<>'') do
     begin
          i:=0;
          if s='' then getunit(s);
          while ((not eof(inf))or(lastline<>'')) and not (((s<>'') or (getunit(s))) and (AnalCom(s)=0)) do
          begin
               s:='';
          {nic}
          end;

          i:=apoc;
          while ((rtab[i]<2)) and (i>0) do dec(i);
          if (i>0) then dec(rtab[i]);

          new(cur);
          cur^.next:=nil;
          cur^.head:=false;
          for j:=1 to maxpoc do cur^.col[j]:=nil;
          cur^.poc:=0;

          if first = nil then
          begin
               first:=cur;
               last:=cur;
          end else
          begin
               last^.next:=cur;
               last:=cur;
          end;
          cur^.head:=false;

          while ((not eof(inf))or(lastline<>'')) and not ((getunit(s) and (analcom(s)=0))) do
          begin
               if command and (analcom(s)>0) then
               begin
                    inc(i);
                    if i > apoc then apoc:=i;
                    if analcom(s)=1 then cur^.head:=true;
                    lst:=nil;
               end else
               begin
                    if ali = 0 then
                       if Cur^.head then ali:=3 else ali:=1;
                    if lst = nil then
                    begin
                         new(lst);
                         cur^.col[i]:=lst;
                    end else
                    begin
                         new(xxx);
                         lst^.next:=xxx;
                         lst:=xxx;
                    end;
                    if length(s)>wtab[i] then wtab[i]:=length(s);
                    cur^.poc:=i;
                    lst^.text:=s;
                    lst^.vali:=vali;
                    lst^.ali:=ali;
                    lst^.rsp:=rsp;
                    lst^.csp:=csp;
                    lst^.next:=nil;

                    if ctab[i]>1 then
                    begin
                         dec(ctab[i]);
                         for j:=apoc+1 downto i do ctab[j]:=ctab[j-1];
                         ctab[i]:=1;
                    end;
                    ctab[i]:=csp;
                    rtab[i]:=rsp;
               end;
          end;
          cur^.ctab:=ctab;
          cur^.rtab:=rtab;
     end;
     close(inf);
end;

function Fill(s : string; width, vali, ali : integer):string;
var
   ri : boolean;
begin
     if ALI=1 then {left}
     begin
          while length(s)<width do
          begin
               s:=s+' ';
          end;
     end else
     if ALI=2 then {right}
     begin
          while length(s)<width do
          begin
               s:=' '+s;
          end;
     end else
     if (ALI=3) or (Ali=0) then {center}
     begin
          ri:=true;
          while length(s)<width do
          begin
               if ri then s:=s+' ' else s:=' '+s;
               ri:=not ri;
          end;
     end;

     fill:=s;
end;

function GetWidth(Q : PRow; i : integer) : integer;
var
   XTab : TTab;
   f, poc, li, ri, ff : integer;
   ok : boolean;
begin
     XTab:=Q^.CTab; poc:=Q^.Poc;
     li:=i;
     ri:=i;

     repeat
           ok:=true;
           for f:=1 to poc do ok:=ok and (XTab[f]=1);

           if (not ok) and (Q^.Next <> nil) then
           begin
                ff:=li-1;
                for f:=1 to ff do
                begin
                     li:=li+Xtab[f]-1;
                end;
                ff:=ri;
                for f:=1 to ff do
                begin
                     ri:=ri+Xtab[f]-1;
                end;
                Q:=Q^.Next;
                XTab:=Q^.CTab;
           end;

     until ok or (Q^.Next=nil);

     ff:=0;
     for f:=li to ri do
     begin
          ff:=ff+WTab[f];
     end;
     ff:=ff+(ri-li)*3;
     GetWidth:=ff;
end;

function GetHeight(Q : PRow; i : integer) : integer;
var
   XTab : TTab;
   f, poc, li, ri, ff : integer;
   ok : boolean;
begin
     XTab:=Q^.RTab; poc:=Q^.Poc;
     li:=i;
     ri:=i;

     repeat
           ok:=true;
           for f:=1 to poc do ok:=ok and (XTab[f]=1);

           if (not ok) and (Q^.Next <> nil) then
           begin
                ff:=li-1;
                for f:=1 to ff do
                begin
                     li:=li+Xtab[f]-1;
                end;
                ff:=ri;
                for f:=1 to ff do
                begin
                     ri:=ri+Xtab[f]-1;
                end;
                Q:=Q^.Next;
                XTab:=Q^.RTab;
           end;

     until ok or (Q^.Next=nil);

     ff:=ri-li+1;
     ff:=ff*2-1;
     GetHeight:=ff;
end;

procedure Vystup;
var
   WW, Q : PRow;
   j, width, i, hh, i1, oo : integer;
   s, s2, x : string;
   prvni, again, fa  : boolean;
   zz : pcol;
begin
     width:=1;
     for j:=1 to apoc do width:=width+1+wtab[j]+2;
     if width > linelength then
     begin
          writeln('Error: Table is too long to fit line.');
          halt;
     end;
     s:='+';
     for j:=1 to apoc do
     begin
          for i:=1 to wtab[j] do s:=s+'-';
          s:=s+'---';
     end;
     s[length(s)]:='+';
     s2:=s;
     s:='|';
     for j:=1 to apoc do
     begin
          for i:=1 to wtab[j] do s:=s+'-';
          s:=s+'--+';
     end;
     s[length(s)]:='|';

     Rewrite(outf);
{     WriteLn(outf, s2);}
      s:=s2;
     Q:=first;
     prvni:=true;
     while Q <> nil do
     begin
          again:=true;
          fa:=true;
          while again do
          begin
          again:=false;
          x:='|';
          for i:=1 to q^.poc do
          begin
               zz:=Q^.Col[i];
               HH:=GetHeight(Q, i);
               if zz^.VALI = 1 then {top} else
               if zz^.VALI = 2 then {bottom}
               begin
                    zz^.Vali:=1;
                    Q^.col[i]:=nil;
                    HH:=HH div 2;
                    WW:=Q;
                    while (WW^.Next<>nil) and (HH>0) do
                    begin
                         WW:=WW^.Next;
                         dec(HH);
                    end;
                    WW^.Col[i]:=zz;
               end
                    else
               if zz^.VALI = 3 then {middle};



               zz:=Q^.Col[i];
               if Q^.Col[i]<> nil then
               begin
                    x:=x+' '+fill(Q^.Col[i]^.text, GetWidth(Q, i),Q^.Col[i]^.VALI, Q^.Col[i]^.ALI)+' |';
                    if not prvni then s[length(x)]:='+';
                    if zz^.next <> nil then again:=true;
                         Q^.Col[i]:=zz^.next;
               end else
               begin
                    i1:=length(x);
                    x:=x+' '+fill('', GetWidth(Q, i), 0, 0)+' |';
                    for oo:=i1+1 to length(x) do s[oo]:=' ';
                    s[length(x)]:='|';
               end;
          end;
          if not prvni then s[length(x)]:='|';
          if fa then WriteLn(outf, s);
          WriteLn(outf, x);
          fa:=false;
     end;
          q:=q^.next;
{          if q <> nil then writeLn(outf, s) else writeln(outf, s2);}


          s:='|';
          for j:=1 to apoc do
          begin
          for i:=1 to wtab[j] do s:=s+'-';
          s:=s+'---';
          end;
          s[length(s)]:='|';
          prvni:=false;
     end;
     WriteLn(outf, s2);
     close(outf);
end;

begin
     ClrScr;
     error:=false;
     if ParamCount > 0 then
     begin
          s:=paramstr(1); i:=1;
          if s[1]='-' then
          begin
               s:=copy(s, 2, length(s));
               val(s, LineLength, vc);
               if vc <> 0 then error:=true;
               if ParamCount > 1 then
               begin
                    s:=paramstr(2); i:=2;
               end else
                   Error:=true;
          end;
          if not error then
          begin
               Assign(InF, s);
               if paramcount > i then
               begin
                    s:=paramstr(i+1);
                    Assign(outf, s);
               end else
                   Error:=true;
          end;
     end else
         error:=true;
     if error then
     begin
          writeLn('usage : ');
          writeLn('10TAB [-n] table_description formatted_table');
          writeln;
          halt;
     end;

     Analyza;
     Vystup;
end.