X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=lib%2FLaTeX%2FTikZ%2FScope.pm;h=e72b919e89ea63b51507c66ebcf1e86bb513bb6a;hb=062ab95259610ce39ace60365b659d6113420ce7;hp=c048a1c700fdbd9bcba99b84d990d30f84d54b1a;hpb=32fbc7c8acf36e81b3c3436152e664e79c74dc87;p=perl%2Fmodules%2FLaTeX-TikZ.git diff --git a/lib/LaTeX/TikZ/Scope.pm b/lib/LaTeX/TikZ/Scope.pm index c048a1c..e72b919 100644 --- a/lib/LaTeX/TikZ/Scope.pm +++ b/lib/LaTeX/TikZ/Scope.pm @@ -9,22 +9,28 @@ LaTeX::TikZ::Scope - An object modeling a TikZ scope or layer. =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 + +=cut has '_mods' => ( - is => 'ro', + is => 'rw', isa => 'Maybe[ArrayRef[LaTeX::TikZ::Mod::Formatted]]', - init_arg => undef, + init_arg => 'mods', default => sub { [ ] }, ); @@ -37,59 +43,61 @@ has '_mods_cache' => ( default => sub { +{ } }, ); -has '_body' => ( - is => 'rw', - isa => 'LaTeX::TikZ::Scope|ArrayRef[Str]', +=head2 C + +=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) = @_; @@ -113,11 +121,13 @@ my $inter = Sub::Name::subname('inter' => sub { return \@left, \@common, \@right; }); +=head2 C + +=cut + sub instantiate { my ($scope) = @_; - $scope = $scope->flatten; - my ($layer, @clips, @raw_mods); for ($scope->mods) { my $type = $_->type; @@ -131,7 +141,7 @@ sub instantiate { } } - my @body = $scope->body; + my @body = @{$scope->body}; my $mods_string = @raw_mods ? ' [' . join(',', @raw_mods) . ']' : undef; @@ -163,7 +173,9 @@ sub instantiate { return @body; } -sub dereference { [ $_[0]->instantiate ] } +=head2 C + +=cut sub fold { my ($left, $right, $rev) = @_; @@ -171,10 +183,8 @@ sub fold { 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, @@ -182,36 +192,31 @@ sub fold { ); 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; } @@ -220,7 +225,7 @@ sub fold { 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; } @@ -229,8 +234,16 @@ sub fold { $rev ? [ @right, @left ] : [ @left, @right ]; } +use overload ( + '@{}' => sub { [ $_[0]->instantiate ] }, +); + __PACKAGE__->meta->make_immutable; +=head1 SEE ALSO + +L. + =head1 AUTHOR Vincent Pit, C<< >>, L. @@ -250,7 +263,7 @@ You can find documentation for this module with the perldoc command. =head1 COPYRIGHT & LICENSE -Copyright 2010 Vincent Pit, all rights reserved. +Copyright 2010,2011,2012,2013,2014,2015 Vincent Pit, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.