]> 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
Make LaTeX::TikZ::Scope objects immutable
[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 3686beb28b5e7f73d4b5302524f41b8d317b7fb8..1a57c613f36fbf1513be0a3f72d5ea3d331939d7 100644 (file)
--- a/lib/LaTeX/TikZ/Scope.pm
+++ b/lib/LaTeX/TikZ/Scope.pm
@@ -9,11 +9,11 @@ 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 ();
 
@@ -21,10 +21,16 @@ use LaTeX::TikZ::Tools;
 
 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 { [ ] },
 );
 
@@ -37,58 +43,66 @@ has '_mods_cache' => (
  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->coerce($_);
-  $ltmf_tc->assert_valid($mod);
+ 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);
 }
 
@@ -114,6 +128,10 @@ my $inter = Sub::Name::subname('inter' => sub {
  return \@left, \@common, \@right;
 });
 
+=head2 C<instantiate>
+
+=cut
+
 sub instantiate {
  my ($scope) = @_;
 
@@ -132,7 +150,7 @@ sub instantiate {
   }
  }
 
- my @body = $scope->body;
+ my @body = @{$scope->body};
 
  my $mods_string = @raw_mods ? ' [' . join(',', @raw_mods) . ']' : undef;
 
@@ -164,7 +182,9 @@ sub instantiate {
  return @body;
 }
 
-sub dereference { [ $_[0]->instantiate ] }
+=head2 C<fold>
+
+=cut
 
 sub fold {
  my ($left, $right, $rev) = @_;
@@ -183,36 +203,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;
   }
 
@@ -221,7 +236,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;
   }
@@ -230,8 +245,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>.
Perl object model for generating PGF/TikZ code.