=head1 VERSION
-Version 0.01
+Version 0.02
=cut
-our $VERSION = '0.01';
+our $VERSION = '0.02';
use Sub::Name ();
use LaTeX::TikZ::Tools;
-use Any::Moose;
+use Mouse;
+
+=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',
- isa => 'LaTeX::TikZ::Scope|ArrayRef[Str]',
+=head2 C<body>
+
+=cut
+
+has 'body' => (
+ is => 'ro',
+ isa => '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;
-sub mod {
- my $scope = shift;
+around 'BUILDARGS' => sub {
+ my ($orig, $class, %args) = @_;
- my $cache = $scope->_mods_cache;
+ my $mods = $args{mods};
+ if (defined $mods and ref $mods eq 'ARRAY') {
+ for my $mod (@$mods) {
+ $mod = $ltmf_tc->coerce($mod);
+ }
+ }
- for (@_) {
- my $mod = $ltmf_tc->check($_) ? $_ : $ltmf_tc->coerce($_);
- my $tag = $mod->tag;
- next if exists $cache->{$tag};
- $cache->{$tag} = $mod;
- push @{$scope->_mods}, $mod;
+ my $body = $args{body};
+ if ($my_tc->check($body)) {
+ push @$mods, $body->mods;
+ $args{body} = $body->body;
}
- $scope;
-}
+ $args{mods} = $mods;
+
+ $class->$orig(%args);
+};
-sub body {
+sub BUILD {
my $scope = shift;
- if (@_) {
- $scope->_body($_[0]);
- $scope;
- } else {
- @{$scope->_body};
+ my $cache = $scope->_mods_cache;
+
+ my @unique_mods;
+ for my $mod ($scope->mods) {
+ my $tag = $mod->tag;
+ next if exists $cache->{$tag};
+ $cache->{$tag} = $mod;
+ push @unique_mods, $mod;
}
+ $scope->_mods(\@unique_mods);
}
-use overload (
- '@{}' => 'dereference',
-);
-
-sub flatten {
- my ($scope) = @_;
+=head1 METHODS
- do {
- my $body = $scope->_body;
- return $scope unless $my_tc->check($body);
- $scope = $scope->new
- ->mod ($scope->mods, $body->mods)
- ->body($body->_body)
- } while (1);
-}
+=cut
my $inter = Sub::Name::subname('inter' => sub {
my ($lh, $rh) = @_;
return \@left, \@common, \@right;
});
+=head2 C<instantiate>
+
+=cut
+
sub instantiate {
my ($scope) = @_;
- $scope = $scope->flatten;
-
my ($layer, @clips, @raw_mods);
for ($scope->mods) {
my $type = $_->type;
}
}
- 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) = @_;
my (@left, @right);
if ($my_tc->check($left)) {
- $left = $left->flatten;
if ($my_tc->check($right)) {
- $right = $right->flatten;
my ($only_left, $common, $only_right) = $inter->(
$left->_mods_cache,
);
my $has_different_layers;
- for (@$only_left) {
+ for (@$only_left, @$only_right) {
if ($_->type eq 'layer') {
$has_different_layers = 1;
last;
}
}
- unless ($has_different_layers) {
- for (@$only_right) {
- if ($_->type eq 'layer') {
- $has_different_layers = 1;
- last;
- }
- }
- }
if (!$has_different_layers and @$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 $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>.