]> git.vpit.fr Git - perl/modules/LaTeX-TikZ.git/blobdiff - lib/LaTeX/TikZ/Scope.pm
projects / perl / modules / LaTeX-TikZ.git / blobdiff
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
This is 0.03
[perl/modules/LaTeX-TikZ.git] / lib / LaTeX / TikZ / Scope.pm
diff --git a/lib/LaTeX/TikZ/Scope.pm b/lib/LaTeX/TikZ/Scope.pm
index c048a1c700fdbd9bcba99b84d990d30f84d54b1a..a9e85b651bc78436c4460fef174a9c7a30e5fbbe 100644 (file)
--- 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.03
 
 =cut
 
-our $VERSION = '0.01';
+our $VERSION = '0.03';
 
 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 { [ ] },
 );
 
@@ -37,59 +43,61 @@ has '_mods_cache' => (
  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) = @_;
@@ -113,11 +121,13 @@ my $inter = Sub::Name::subname('inter' => sub {
  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;
@@ -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<fold>
+
+=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<LaTeX::TikZ>.
+
 =head1 AUTHOR
 
 Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
@@ -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.
 
Perl object model for generating PGF/TikZ code.