]> 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
Just use Mouse instead of Any::Moose
[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 8edad60f9d67019ebe1149ba72b06d603faf812e..eb009eacefb7f30c342aecfc2de0b5bc92330ee8 100644 (file)
--- a/lib/LaTeX/TikZ/Scope.pm
+++ b/lib/LaTeX/TikZ/Scope.pm
@@ -19,7 +19,7 @@ use Sub::Name ();
 
 use LaTeX::TikZ::Tools;
 
-use Any::Moose;
+use Mouse;
 
 =head1 ATTRIBUTES
 
@@ -28,9 +28,9 @@ use Any::Moose;
 =cut
 
 has '_mods' => (
- is       => 'ro',
+ is       => 'rw',
  isa      => 'Maybe[ArrayRef[LaTeX::TikZ::Mod::Formatted]]',
- init_arg => undef,
+ init_arg => 'mods',
  default  => sub { [ ] },
 );
 
@@ -47,75 +47,58 @@ has '_mods_cache' => (
 
 =cut
 
-has '_body' => (
- is       => 'rw',
- isa      => 'LaTeX::TikZ::Scope|ArrayRef[Str]',
+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;
 
-=head1 METHODS
+around 'BUILDARGS' => sub {
+ my ($orig, $class, %args) = @_;
 
-=head2 C<mod>
+ my $mods = $args{mods};
+ if (defined $mods and ref $mods eq 'ARRAY') {
+  for my $mod (@$mods) {
+   $mod = $ltmf_tc->coerce($mod);
+  }
+ }
 
-=cut
+ my $body = $args{body};
+ if ($my_tc->check($body)) {
+  push @$mods, $body->mods;
+  $args{body} = $body->body;
+ }
+
+ $args{mods} = $mods;
 
-sub 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);
 }
 
-=head2 C<body>
-
-=cut
-
-sub body {
- my $scope = shift;
-
- if (@_) {
-  $scope->_body($_[0]);
-  $scope;
- } else {
-  @{$scope->_body};
- }
-}
-
-use overload (
- '@{}' => 'dereference',
-);
-
-=head2 C<flatten>
+=head1 METHODS
 
 =cut
 
-sub flatten {
- my ($scope) = @_;
-
- 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);
-}
-
 my $inter = Sub::Name::subname('inter' => sub {
  my ($lh, $rh) = @_;
 
@@ -145,8 +128,6 @@ my $inter = Sub::Name::subname('inter' => sub {
 sub instantiate {
  my ($scope) = @_;
 
- $scope = $scope->flatten;
-
  my ($layer, @clips, @raw_mods);
  for ($scope->mods) {
   my $type = $_->type;
@@ -160,7 +141,7 @@ sub instantiate {
   }
  }
 
- my @body = $scope->body;
+ my @body = @{$scope->body};
 
  my $mods_string = @raw_mods ? ' [' . join(',', @raw_mods) . ']' : undef;
 
@@ -192,12 +173,6 @@ sub instantiate {
  return @body;
 }
 
-=head2 C<dereference>
-
-=cut
-
-sub dereference { [ $_[0]->instantiate ] }
-
 =head2 C<fold>
 
 =cut
@@ -208,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,
@@ -219,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;
   }
 
@@ -257,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;
   }
@@ -266,6 +234,10 @@ sub fold {
  $rev ? [ @right, @left ] : [ @left, @right ];
 }
 
+use overload (
+ '@{}' => sub { [ $_[0]->instantiate ] },
+);
+
 __PACKAGE__->meta->make_immutable;
 
 =head1 SEE ALSO
Perl object model for generating PGF/TikZ code.