var f1,f2 : text;
    i:integer;
    a,b : integer;
    ss:string;
    ll:integer;
    c,d:integer;
    tabs:integer;
    TL:integer;
    THFlg:boolean;
    lalgflg,AlgFlg:integer;
    dcols,cols:integer;
    drows,drowsn,rs:array[1..100] of integer;
    rows,rowsn:array[1..100] of integer;
const rwsc:integer=0;
const n:word = 80;
      line:word = 0;
      rsc:integer=0;
      rowc:integer=0;
var  max:array[1..100] of integer;
     sx:array[1..100] of string;
     rws:array[1..100] of integer;
     rwss:array[1..100] of string;
     rwsp:array[1..100] of integer;



function Up(s:string):string;
var j:integer;
begin
  for j:=1 to length(s) do
    s[j]:=upcase(s[j]);
  up:=s;
end;

procedure WriteD(var f:text;s:string);
begin
  ss:=ss+s;
end;

procedure WritelnD(var f:text;s:string);
var j:integer;
begin
  ss:=ss+s;
  for j:=1 to rwsc do
    if line=rws[j] then begin
      Delete(ss,rwsp[j],length(rwss[j]));
      Insert(rwss[j],ss,rwsp[j]);
    end;
  Writeln(f,ss);
  ss:='';
  inc(line);
end;


function SubStr(s:string;l:integer):string;
var s1:string;
    j:integer;
begin
  s1:='';
  for j:=1 to l do
    s1:=s1+s[j];
  SubStr:=s1;
end;


function Poss(s1,s2,s:string):integer;
var j,k : integer;
begin
  j:=pos(s1,s);
  k:=pos(s2,s);
  if (j=0) then begin
    poss:=k;
    exit;
  end;
  if (k=0) then begin
    poss:=j;
    exit;
  end;
  if (k<j) then poss:=k else
    poss:=j;
end;

function Poss2(s1,s2,s:string):integer;
var j,k : integer;
    ps:integer;
begin
  j:=pos(s1,s);
  k:=pos(s2,s);
  if (j=0) then begin
    ps:=k;
  end else
  if (k=0) then begin
    ps:=j;
  end else
  if (k<j) then ps:=k else
    ps:=j;
  delete(s,1,ps+2);
  poss2:=poss(s1,s2,s);
end;


function Decode(var s:string;q:integer):string;
var s1,s2,s3 : string;
begin
  begin
{    drows:=1;}
    dcols:=1;
    s1:=copy(s,1,pos('>',s));
    delete(s,1,pos('>',s));
    if pos('<',s)<> 0 then
      s2:=copy(s,1,pos('<',s)-1)
    else s2:=s;
    sx[q]:=s1+s2;
    if pos('<',s)<> 0 then delete(s,1,pos('<',s)-1) else s:='';
    delete(s1,1,1);
    delete(s1,length(s1),1);
    algflg:=0;
    if Up(s1[1]+s1[2]) = 'TH' then THFlg:=true else THFlg:=false;
    delete(s1,1,2);
    if length(s1)>1 then begin
      delete(s1,1,1);
      If UP(Substr(s1,6))='ALIGN=' then begin
        delete(s1,1,6);
        if up(substr(s1,4))='LEFT' then algflg:=1;
        if up(substr(s1,5))='RIGHT' then algflg:=2;
        if up(substr(s1,6))='CENTER' then algflg:=3;
      end;
      if up(substr(s1,8))='COLSPAN=' then begin
        delete(s1,1,8);
        val(s1,a,b);
        dcols:=a;
      end;
      if up(substr(s1,8))='ROWSPAN=' then begin
        delete(s1,1,8);
        val(s1,a,b);
        inc(rsc);
        drows[rsc]:=a;
        rs[rsc]:=a;
        drowsn[rsc]:=q;

      end;
   end;
  end;
end;

procedure DoDebug(s:string);
var s1,s2 : string;
    j,k,l:integer;
begin
  for j:=0 to tabs do begin
    sx[j]:='';
  end;
  k:=0;
  while length(S)>0 do begin
    inc(k);
    for l:=1 to rsc do begin
      if (rs[l]>1) and (k=drowsn[l]) then begin
        inc(k,rs[l]-1);
        rs[l]:=1;
      end;
    end;
    if dcols>1 then inc(k,dcols-1);
    decode(s,k);
    while (length(sx[k])>0) and (sx[k][1]=' ') do delete(sx[k],1,1);
    while (length(sx[k])>0) and (sx[k][length(sx[k])]=' ') do delete(sx[k],length(sx[k]),1);
  end;
{  for j:=1 to tabs-1 do begin
    while (length(s)>0) and (s[1]=' ') do delete(s,1,1);
    if poss2('<TD','<TH',s)>0 then begin
      sx[j]:=copy(s,1,poss2('<TD','<TH',s)+2);
      delete(s,1,poss2('<TD','<TH',s)+2);
    end else begin
      sx[j]:=s;
      s:='';
    end;
    while (length(sx[j])>0) and (sx[j][1]=' ') do delete(sx[j],1,1);
    while (length(sx[j])>0) and (sx[j][length(sx[j])]=' ') do delete(sx[j],length(sx[j]),1);
  end;
  sx[tabs]:=s;
  while (length(sx[j])>0) and (sx[j][1]=' ') do delete(sx[j],1,1);
  while (length(sx[j])>0) and (sx[j][length(sx[j])]=' ') do delete(sx[j],length(sx[j]),1);}
end;

function HowMuch(s:string):integer;
VAR J,K,L: INTEGER;
begin
  K:=0;
  while length(S)>0 do begin
    decode(s,1);
    inc(k,dcols);
  end;


{    j:=poss('<TD','<TH',s);
    while j<>0 do begin
      inc(k);
      delete(s,1,j+2);
      j:=poss('<TD','<TH',s);
    end;}
  howmuch:=k;
end;


procedure DoMax;
var j:integer;
begin
  j:=0;
  for j:=1 to tabs do begin
    delete(sx[j],1,pos('>',sx[j]));
    if length(sx[j])>max[j] then max[j]:=length(sx[j]);
  end;
end;

function TabLen:integer;
var k,j:integer;
begin
  k:=1;
  for j:=1 to tabs do
    k:=k+1+2+max[j];
  tablen:=k;
end;

procedure NulMax;
var j:integer;
begin
  for j:=1 to tabs do
    max[j]:=0;
end;

var J:integer;

procedure WriteHead;
begin
  WriteD(f2,'+');
  for j:=2 to tl-1 do WriteD(f2,'-');
  WritelnD(f2,'+');
end;

procedure WriteLineL;
var qq,q,kk,k,f:integer;
begin
  WriteD(f2,'+');
  for j:=1 to tabs do begin
    kk:=0;
      f:=1;
      if d=j then begin
        f:=c;
        while c>1 do begin
          dec(c);
          kk:=kk+3+max[j+c]
        end;
      end;
    qq:=0;
    for q:=1 to rowc do begin
      if (rowsn[q]=j) and (rows[q]>1) then begin
        dec(rows[q]);
        for k:=0 to kk+max[j]+1 do
          WriteD(f2,' ');
        qq:=1;
      end;
    end;
    if qq=0 then begin
      for k:=0 to kk+max[j]+1 do
        WriteD(f2,'-');
    end;
    WriteD(f2,'+');
    inc(j,f-1);
  end;
  WritelnD(f2,'');
end;

function mez(i:integer):string;
var s1:string;
    k:integer;
begin
  s1:='';
  if i<=0 then begin
    mez:='';
    exit;
  end;
  for k:=1 to i do
  s1:=s1+' ';
  mez:=s1;
end;

Procedure WriteLine;
var s1,s2 : string;
    j,k,m:integer;
    n:integer;
begin
  WriteD(f2,'|');
  n:=0;
  for j:=1 to tabs do begin
    s1:=copy(sx[j],1,pos('>',sx[j]));
    delete(sx[j],1,pos('>',sx[j]));
    s2:=sx[j];
    delete(s1,1,1);
    delete(s1,length(s1),1);
    algflg:=0;
    if Up(s1[1]+s1[2]) = 'TH' then THFlg:=true else THFlg:=false;
    delete(s1,1,2);
    if length(s1)>1 then begin
      delete(s1,1,1);
      If UP(Substr(s1,6))='ALIGN=' then begin
        delete(s1,1,6);
        if up(substr(s1,4))='LEFT' then algflg:=1;
        if up(substr(s1,5))='RIGHT' then algflg:=2;
        if up(substr(s1,6))='CENTER' then algflg:=3;
      end;
      if up(substr(s1,8))='COLSPAN=' then begin
        delete(s1,1,8);
        val(s1,a,b);
        cols:=a;
      end;
      if up(substr(s1,8))='ROWSPAN=' then begin
        delete(s1,1,8);
        val(s1,a,b);
        inc(rowc);
        rows[rowc]:=a;
        rowsn[rowc]:=j;
        inc(rwsc);
        rws[rwsc]:=line+(a*2-1) div 2;
        rwsp[rwsc]:=length(ss)+2;
        ll:=1;
      end;
      {..}
    end;
    k:=0;
    c:=cols;
    d:=j;
    while cols>1 do begin
      dec(cols);
      k:=k+3+max[j+cols]
    end;
    if (algflg=0) and (lalgflg<>0) then algflg:=lalgflg;
    if (Algflg=0) and (thflg=true) then begin
      m:=(max[j]+k-length(s2)) div 2;
      if ll=1 then begin
        rwss[rwsc]:=mez(m)+s2+mez(k+max[j]-length(s2)-m)+' |';
        WriteD(f2,' '+mez(k+max[j])+' |');
      end else
        WriteD(f2,' '+mez(m)+s2+mez(k+max[j]-length(s2)-m)+' |');
    end;
    if (Algflg=0) and (thflg=false) then begin
{      m:=(max[j]-length(s2)) div 2;}
      if ll=1 then begin
        rwss[rwsc]:=mez(m)+s2+mez(k+max[j]-length(s2)-m)+' |';
        WriteD(f2,' '+mez(k+max[j])+' |');
      end else
        WriteD(f2,' '+s2+mez(k+max[j]-length(s2))+' |');
    end;
    if algflg>0 then begin
      if algflg=1 then begin
        WriteD(f2,' '+s2+mez(k+max[j]-length(s2))+' |');
      end;
      if algflg=3 then begin
        m:=(k+max[j]-length(s2)) div 2;
        WriteD(f2,' '+mez(m)+s2+mez(k+max[j]-length(s2)-m)+' |');
      end;
      if algflg=2 then begin
        WriteD(f2,' '+mez(k+max[j]-length(s2))+s2+' |');
      end;
     end;
    ll:=0;
    inc(j,c-1);
    if j=tabs-n then inc(j,n);
  end;
  WritelnD(f2,'');
end;

procedure DecodTr(var s:string);
var s1,s2 : string;
begin
  rsc:=0;
  s1:=copy(s,1,pos('>',s));
  delete(s,1,pos('>',s));
  delete(s1,1,4);
  if length(s1)>0 then begin
      delete(s1,length(s1),1);
      If UP(Substr(s1,6))='ALIGN=' then begin
        delete(s1,1,6);
        if up(substr(s1,4))='LEFT' then lalgflg:=1;
        if up(substr(s1,5))='RIGHT' then lalgflg:=2;
        if up(substr(s1,6))='CENTER' then lalgflg:=3;
      end;
  end;
end;

var s,s1:string;
begin
  i:=0;
  ss:='';
  if paramcount=3 then begin
    i:=1;
    s:=paramstr(1);
    delete(s,1,1);
    val(s,a,b);
    n:=a;

  end;
  assign(f1,paramstr(i+1));
  Reset(f1);
  assign(f2,paramstr(i+2));
  rewrite(f2);
  rsc:=0;
  dcols:=1;
  i:=0;
      Readln(f1,s1);
    while not eof(f1) do
    begin
      s:='';
      repeat
        s:=s+s1;
        Readln(f1,s1);
      until up(copy(s1,1,3))='<TR';
      while (length(s)>0) and (s[1]=' ') do delete(s,1,1);
     if up(copy(s,1,3))='<TR' then begin
        delete(s,1,pos('>',s));
        if i=0 then begin
          tabs:=howmuch(s);
          i:=1;
          rsc:=0;
          dcols:=1;
{          rs:=1;}
        end;
        DoDebug(s);
        DoMax;
{      end;}
      end else begin
        for j:=1 to tabs-1 do
          sx[j]:='';
        sx[tabs]:='<TD>'+s;
{        writeline;}
        DoMax;
      end;
    end;
    s:=s1;
      while (length(s)>0) and (s[1]=' ') do delete(s,1,1);
     if up(copy(s,1,3))='<TR' then begin
        delete(s,1,pos('>',s));
        if i=0 then begin
          tabs:=howmuch(s);
          i:=1;
          rsc:=0;
          dcols:=1;
{          rs:=1;}
        end;
        DoDebug(s);
        DoMax;
{      end;}
      end else begin
        for j:=1 to tabs-1 do
          sx[j]:='';
        sx[tabs]:='<TD>'+s;
{        writeline;}
        DoMax;
      end;
    TL:=tablen;
    cols:=1;
    ll:=0;
    if n<TL then begin
      Write('Error: Table is too long to fit line.');
      close(F1);
      close(F2);
      exit;
    end;
    Close(f1);
    Reset(f1);
    cols:=1;
    I:=0;
    rsc:=0;
    WriteHead;
    dcols:=1;
    rowc:=0;
    Readln(f1,s1);
    while not eof(f1) do begin
{      Readln(f1,s);}
      s:='';
      repeat
        s:=s+s1;
        Readln(f1,s1);
      until up(copy(s1,1,3))='<TR';
{      s:=up(s);}
      while (length(s)>0) and (s[1]=' ') do delete(s,1,1);
     if up(copy(s,1,3))='<TR' then begin
        IF I=0 THEN I:=1 else
          WriteLineL;
        lalgflg:=0;
        if s[4]<>'>' then DecodTR(s) else delete(s,1,4);
        DoDebug(s);
        WriteLine;
      end else begin
        for j:=1 to tabs-1 do
          sx[j]:='';
        sx[tabs]:='<TD>'+s;
        writeline;
      end;
    end;
      s:=s1;
      while (length(s)>0) and (s[1]=' ') do delete(s,1,1);
     if up(copy(s,1,3))='<TR' then begin
        IF I=0 THEN I:=1 else
          WriteLineL;
        lalgflg:=0;
        if s[4]<>'>' then DecodTR(s) else delete(s,1,4);
        DoDebug(s);
        WriteLine;
      end else begin
        for j:=1 to tabs-1 do
          sx[j]:='';
        sx[tabs]:='<TD>'+s;
        writeline;
      end;
    WriteHead;
  close(F2);
  close(f1);
end
.