does => 'Maybe[LaTeX::TikZ::Point]',
);
-my $lts_tc = LaTeX::TikZ::Tools::type_constraint('LaTeX::TikZ::Set');
-
my $find_mods;
$find_mods = do {
no warnings 'recursion';
sub render {
my $tikz = shift;
- $lts_tc->assert_valid($_) for @_;
-
my $seq = LaTeX::TikZ::Set::Sequence->new(
kids => \@_,
);
my @decls;
if (@layers) {
- my $layers_decl = LaTeX::TikZ::Mod::Layer->declare(@layers);
- if (defined $layers_decl) {
- chomp $layers_decl;
- push @decls, $layers_decl;
- }
+ push @decls, LaTeX::TikZ::Mod::Layer->declare(@layers);
}
for (@other_mods) {
- my $decl = $_->declare($tikz);
- if (defined $decl) {
- chomp $decl;
- push @decls, $decl;
- }
+ push @decls, $_->declare($tikz);
}
my @content = (
"\\begin{tikzpicture}",
- do { my $s = $seq->draw($tikz); chomp $s; $s },
+ $seq->draw($tikz)->instantiate,
"\\end{tikzpicture}",
);
has '_body' => (
is => 'rw',
- isa => 'LaTeX::TikZ::Scope|Str',
+ isa => 'LaTeX::TikZ::Scope|ArrayRef[Str]',
init_arg => 'body',
);
-my $my_tc = LaTeX::TikZ::Tools::type_constraint(__PACKAGE__);
-my $ltmf_tc = LaTeX::TikZ::Tools::type_constraint('LaTeX::TikZ::Mod::Formatted');
+my $my_tc = LaTeX::TikZ::Tools::type_constraint(__PACKAGE__);
+my $ltmf_tc = LaTeX::TikZ::Tools::type_constraint('LaTeX::TikZ::Mod::Formatted');
+my $_body_tc = __PACKAGE__->meta->find_attribute_by_name('_body')
+ ->type_constraint;
sub mod {
my $scope = shift;
$scope->_body($_[0]);
$scope;
} else {
- $scope->_body;
+ @{$scope->_body};
}
}
use overload (
- '.' => \&concat,
- '""' => \&stringify,
+ '.' => \&concat,
);
sub flatten {
my ($scope) = @_;
do {
- my $body = $scope->body;
+ my $body = $scope->_body;
return $scope unless $my_tc->check($body);
$scope = $scope->new
->mod ($scope->mods, $body->mods)
- ->body($body->body)
+ ->body($body->_body)
} while (1);
}
return \@left, \@common, \@right;
});
-sub concat {
- my ($scope, $str, $rev) = @_;
+sub instantiate {
+ my ($scope) = @_;
$scope = $scope->flatten;
- my $body = $scope->body;
- my @mods = $scope->mods;
-
- if ($my_tc->check($str)) {
- $str = $str->flatten;
-
- my ($only_scope, $common, $only_str) = $inter->(
- $scope->_mods_cache,
- $str->_mods_cache,
- );
-
- if (@$common) {
- my $x = $scope->new
- ->mod(@$only_scope)
- ->body($body);
- my $y = $scope->new
- ->mod(@$only_str)
- ->body($str->body);
- ($x, $y) = ($y, $x) if $rev;
- return $scope->new
- ->mod(@$common)
- ->body($x . $y);
- }
- }
-
my ($layer, @clips, @raw_mods);
- for (@mods) {
+ for ($scope->mods) {
my $type = $_->type;
if ($type eq 'clip') {
unshift @clips, $_->content;
}
}
+ my @body = $scope->body;
+
my $mods_string = @raw_mods ? ' [' . join(',', @raw_mods) . ']' : undef;
- if (@raw_mods and $body =~ /^\s*\\draw\b\s*([^\[].*)\s*$/) {
- $body = "\\draw$mods_string $1\n"; # Has trailing semicolon
- $mods_string = undef; # Done with mods
+ if (@raw_mods and @body == 1 and $body[0] =~ /^\s*\\draw\b\s*([^\[].*)\s*$/) {
+ $body[0] = "\\draw$mods_string $1"; # Has trailing semicolon
+ $mods_string = undef; # Done with mods
}
for (0 .. $#clips) {
my $clip_string = "\\clip $clip ;";
my $mods_string = ($_ == $#clips and defined $mods_string)
? $mods_string : '';
- 1 while chomp $body;
- $body = <<" CLIP";
-\\begin{scope}$mods_string
-$clip_string
-$body
-\\end{scope}
- CLIP
+ unshift @body, "\\begin{scope}$mods_string",
+ $clip_string;
+ push @body, "\\end{scope}",
}
if (not @clips and defined $mods_string) {
- 1 while chomp $body;
- $body = <<" MODS";
-\\begin{scope}$mods_string
-$body
-\\end{scope}
- MODS
+ unshift @body, "\\begin{scope}$mods_string";
+ push @body, "\\end{scope}";
}
if (defined $layer) {
- 1 while chomp $body;
- $body = <<" LAYER";
-\\begin{pgfonlayer}{$layer}
-$body
-\\end{pgfonlayer}
- LAYER
+ unshift @body, "\\begin{pgfonlayer}{$layer}";
+ push @body, "\\end{pgfonlayer}";
}
- $rev ? $str . $body : $body . $str;
+ return @body;
}
-sub stringify { $_[0]->concat('') }
+sub concat {
+ my ($left, $right, $rev) = @_;
+
+ $_body_tc->assert_valid($right);
+
+ $left = $left->flatten;
+
+ my (@left, @right);
+
+ if ($my_tc->check($right)) {
+ $right = $right->flatten;
+
+ my ($only_left, $common, $only_right) = $inter->(
+ $left->_mods_cache,
+ $right->_mods_cache,
+ );
+
+ if (@$common) {
+ my $x = $left->new
+ ->mod(@$only_left)
+ ->body($left->_body);
+ my $y = $left->new
+ ->mod(@$only_right)
+ ->body($right->_body);
+ ($x, $y) = ($y, $x) if $rev;
+ return $left->new
+ ->mod(@$common)
+ ->body($x . $y);
+ } else {
+ @right = $right->instantiate;
+ }
+ } else {
+ @right = @$right;
+ }
+
+ @left = $left->instantiate;
+
+ $left->new
+ ->body($rev ? [ @right, @left ] : [ @left, @right ]);
+}
__PACKAGE__->meta->make_immutable;