#
# Copyright (C) 1997, 2000 Laurent CAPRANI (laurent.caprani@laposte.net)
# Copyright (C) 1997, 1999 Laboratoire de recherche en gestion du logiciel (www.lrgl.uqam.ca)
# Econoweb RTF is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
use strict;

package RTF::WordGrove;

sub surround {
	my ($container, $offset, $length, %properties) = @_;
	my $children = $container->{Contents};
	if ($length) {
		$properties{Contents} = [@{$children}[$offset..$offset+$length-1]]
	}
	my $elt = new XML::Grove::Element (\%properties);
	splice @{$children}, $offset, $length, $elt;
	return $elt;
}

sub list_surround {
	my ($element, $lists, $reduction) = @_;
	foreach my $list (@{$lists}) {
		my $liststart = $list->{start} - $reduction;
		my $itemstart = $liststart;
		foreach my $item (@{$list->{items}}) {
			my $lists = $item->{lists};
			$reduction = list_surround($element, $lists, $reduction);
			my $nbchildren = $item->{nbchildren};
			surround($element, $itemstart, $nbchildren, (Name => 'li'));
			$reduction += $nbchildren-1;
			$itemstart++;
		}
		my $nbitems = @{$list->{items}};
		my $tag = ($list->{style} < 23)? 'ol': 'ul';
		surround($element, $liststart, $nbitems, (Name => $tag));
		$reduction += $nbitems-1;
	}
	return $reduction;
}

sub list_group {
	my ($element) = @_;

	my $lists = [];
	my @curlists = ({items => [{lists => $lists}]});
	{
		my $childno = 0;
		foreach my $child (@{$element->{Contents}}) {
			if (exists $child->{Attributes} and exists $child->{Attributes}{ls}) {
				my ($lev, $style) = split(/;/, $child->{Attributes}{ls});

				if ($lev == $#curlists-1 and $curlists[-1]{style} != $style) {
					if ($style == 255) {
						my $currentlist = $curlists[-1];
						my $currentitem = $currentlist->{items}[-1];
						$currentitem->{nbchildren}++;
					} else {
						pop @curlists;
					}
				}
				while ($lev > $#curlists-1) {
					my $currentlist = $curlists[-1];
					my $currentitem = $currentlist->{items}[-1];
					my $newlist = {
						start => $childno,
						style => $style,
						items => [],
					};
					push @{$currentitem->{lists}}, $newlist;
					$currentitem->{nbchildren}++;
					push @curlists, $newlist;
				}
				$#curlists = $lev+1;	#	may pop
				if ($style != 255) {
					push @{$curlists[-1]{items}}, {
						nbchildren => 1,
					};
				}
			} else {
				$#curlists = 0;	#	may pop
			}
			$childno++;
		}
	}
#	print "<!-- ", "=" x 74, "\n";
#	use Data::Dumper;
#	print Dumper($lists);
#	print "=" x 75, " -->\n";
	list_surround($element, $lists, 0);
}

sub table_group {
	my ($element) = @_;

	my @tables;
	{
		my ($row, $col);
		my $childno = 0;
		foreach my $child (@{$element->{Contents}}) {
			if (exists $child->{Attributes} and exists $child->{Attributes}{intbl}) {
				unless (defined $row) {
					push @tables, [$childno];
					$row = 0; $col = 0;
				}
				my ($r, $c) = split(/;/, $child->{Attributes}{intbl});
				if ($r > $row) {
					push @{$tables[-1]}, ([]) x ($r - $row);
					$row = $r; $col = 0;
				}
				if ($c > $col) {
					push @{$tables[-1][-1]}, (0) x ($c - $col);
					$col = $c;
				}
				$tables[-1][-1][-1]++;
			} elsif (defined $row) {
					undef $row; undef $col;
			}
			$childno++;
		}
	}
#	print "<!-- ", "=" x 74, "\n";
#	use Data::Dumper;
#	print Dumper(\@tables);
#	print "=" x 75, " -->\n";
	{
		my $reduction = 0;
		foreach (@tables) {
			my ($tblstart, @rows) = @{$_};
			$tblstart -= $reduction;
			my $rowstart = $tblstart;
			foreach (@rows) {
				my $colstart = $rowstart;
				foreach my $nbparas (@{$_}) {
					surround($element, $colstart, $nbparas, (Name => 'td'));
					$reduction += $nbparas;
					$colstart++;
				}
				surround($element, $rowstart, $colstart - $rowstart, (Name => 'tr'));
				$rowstart++;
			}
			surround($element, $tblstart, $rowstart - $tblstart,(
				Name => 'table',
				Attributes => {
					border => "1",
					width => "100%",
				}
			));
			$reduction--;
		}
	}
}

# A sequence of paragraphs with the same border attributes
sub div_group {
	my ($element) = @_;
	my $children = $element->{Contents};

	my @divs;
	{
		my $childno = 0;
		foreach my $child (@{$element->{Contents}}) {
			if ($child->{Name} eq 'p' and exists $child->{Attributes} and exists $child->{Attributes}{border}) {
				my $border = $child->{Attributes}{border};
				if (@divs and $divs[-1][0] eq $border and $divs[-1][2] == $childno -1) {
					$divs[-1][2] = $childno;
				} else {
					push @divs, [$border, $childno, $childno];
				}
			}
			$childno++;
		}
	}
	{
		my $reduction = 0;
		foreach my $div (@divs) {
			my ($border, $start, $end) = @$div;
			surround($element, $start - $reduction, $end - $start +1,
				(Name => 'div', Attributes => {border => $border})
			);
			$reduction += $end - $start;
		}
	}
}

1;