=head1 VERSION
-Version 0.01
+Version 0.02
=cut
-our $VERSION = '0.01';
+our $VERSION = '0.02';
use Sub::Name ();
use Any::Moose;
+=head1 ATTRIBUTES
+
+=head2 C<mods>
+
+=cut
+
has '_mods' => (
- is => 'ro',
+ is => 'rw',
isa => 'Maybe[ArrayRef[LaTeX::TikZ::Mod::Formatted]]',
- init_arg => undef,
+ init_arg => 'mods',
default => sub { [ ] },
);
default => sub { +{ } },
);
-has '_body' => (
- is => 'rw',
+=head2 C<body>
+
+=cut
+
+has 'body' => (
+ is => 'ro',
isa => 'LaTeX::TikZ::Scope|ArrayRef[Str]',
+ required => 1,
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 $_body_tc = __PACKAGE__->meta->find_attribute_by_name('_body')
- ->type_constraint;
+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;
+
+around 'BUILDARGS' => sub {
+ my ($orig, $class, %args) = @_;
-sub mod {
+ my $mods = $args{mods};
+ if (defined $mods and ref $mods eq 'ARRAY') {
+ for my $mod (@$mods) {
+ $mod = $ltmf_tc->coerce($mod);
+ }
+ }
+
+ $class->$orig(%args);
+};
+
+sub BUILD {
my $scope = shift;
my $cache = $scope->_mods_cache;
- for (@_) {
- my $mod = $ltmf_tc->check($_) ? $_ : $ltmf_tc->coerce($_);
+ my @unique_mods;
+ for my $mod ($scope->mods) {
my $tag = $mod->tag;
next if exists $cache->{$tag};
$cache->{$tag} = $mod;
- push @{$scope->_mods}, $mod;
+ push @unique_mods, $mod;
}
-
- $scope;
+ $scope->_mods(\@unique_mods);
}
-sub body {
- my $scope = shift;
+=head1 METHODS
- if (@_) {
- $scope->_body($_[0]);
- $scope;
- } else {
- @{$scope->_body};
- }
-}
+=head2 C<flatten>
-use overload (
- '@{}' => 'dereference',
-);
+=cut
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)
+ $scope = $scope->new(
+ mods => [ $scope->mods, $body->mods ],
+ body => $body->body,
+ );
} while (1);
}
return \@left, \@common, \@right;
});
+=head2 C<instantiate>
+
+=cut
+
sub instantiate {
my ($scope) = @_;
}
}
- my @body = $scope->body;
+ my @body = @{$scope->body};
my $mods_string = @raw_mods ? ' [' . join(',', @raw_mods) . ']' : undef;
return @body;
}
-sub dereference { [ $_[0]->instantiate ] }
+=head2 C<fold>
+
+=cut
sub fold {
my ($left, $right, $rev) = @_;
$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);
- return $left->new
- ->mod(@$common)
- ->body(fold($x, $y, $rev));
+ my $has_different_layers;
+ for (@$only_left, @$only_right) {
+ if ($_->type eq 'layer') {
+ $has_different_layers = 1;
+ last;
+ }
+ }
+
+ if (!$has_different_layers and @$common) {
+ my $x = $left->new(
+ mods => $only_left,
+ body => $left->body,
+ );
+ my $y = $left->new(
+ mods => $only_right,
+ body => $right->body,
+ );
+ return $left->new(
+ mods => $common,
+ body => fold($x, $y, $rev),
+ );
} else {
@right = $right->instantiate;
}
} else {
- $_body_tc->assert_valid($right);
+ $body_tc->assert_valid($right);
@right = @$right;
}
if ($my_tc->check($right)) {
return fold($right, $left, 1);
} else {
- $_body_tc->assert_valid($_) for $left, $right;
+ $body_tc->assert_valid($_) for $left, $right;
@left = @$left;
@right = @$right;
}
$rev ? [ @right, @left ] : [ @left, @right ];
}
+use overload (
+ '@{}' => sub { [ $_[0]->instantiate ] },
+);
+
__PACKAGE__->meta->make_immutable;
+=head1 SEE ALSO
+
+L<LaTeX::TikZ>.
+
=head1 AUTHOR
Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.