X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=lib%2FLaTeX%2FTikZ%2FScope.pm;fp=lib%2FLaTeX%2FTikZ%2FScope.pm;h=05308ddb07a067041770ff797aad66eedc28815b;hb=93bfe14caec156fc11587863a486220b986b6b2e;hp=7b2eadafe97da7c09de89e883c617d79cf7b39d8;hpb=22f1a59ec62500605cf907a4117faf25160ad92c;p=perl%2Fmodules%2FLaTeX-TikZ.git

diff --git a/lib/LaTeX/TikZ/Scope.pm b/lib/LaTeX/TikZ/Scope.pm
index 7b2eada..05308dd 100644
--- a/lib/LaTeX/TikZ/Scope.pm
+++ b/lib/LaTeX/TikZ/Scope.pm
@@ -39,12 +39,14 @@ has '_mods_cache' => (
 
 has '_body' => (
  is       => 'rw',
- isa      => 'LaTeX::TikZ::Scope|Str',
+ isa      => 'LaTeX::TikZ::Scope|ArrayRef[Str]',
  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 $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;
@@ -69,24 +71,23 @@ sub body {
   $scope->_body($_[0]);
   $scope;
  } else {
-  $scope->_body;
+  @{$scope->_body};
  }
 }
 
 use overload (
- '.'  => \&concat,
- '""' => \&stringify,
+ '.' => \&concat,
 );
 
 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)
+                 ->body($body->_body)
  } while (1);
 }
 
@@ -112,38 +113,13 @@ my $inter = Sub::Name::subname('inter' => sub {
  return \@left, \@common, \@right;
 });
 
-sub concat {
- my ($scope, $str, $rev) = @_;
+sub instantiate {
+ my ($scope) = @_;
 
  $scope = $scope->flatten;
 
- my $body = $scope->body;
- my @mods = $scope->mods;
-
- if ($my_tc->check($str)) {
-  $str = $str->flatten;
-
-  my ($only_scope, $common, $only_str) = $inter->(
-   $scope->_mods_cache,
-   $str->_mods_cache,
-  );
-
-  if (@$common) {
-   my $x = $scope->new
-                 ->mod(@$only_scope)
-                 ->body($body);
-   my $y = $scope->new
-                 ->mod(@$only_str)
-                 ->body($str->body);
-   ($x, $y) = ($y, $x) if $rev;
-   return $scope->new
-                ->mod(@$common)
-                ->body($x . $y);
-  }
- }
-
  my ($layer, @clips, @raw_mods);
- for (@mods) {
+ for ($scope->mods) {
   my $type = $_->type;
   if ($type eq 'clip') {
    unshift @clips, $_->content;
@@ -155,11 +131,13 @@ sub concat {
   }
  }
 
+ my @body = $scope->body;
+
  my $mods_string = @raw_mods ? ' [' . join(',', @raw_mods) . ']' : undef;
 
- if (@raw_mods and $body =~ /^\s*\\draw\b\s*([^\[].*)\s*$/) {
-  $body = "\\draw$mods_string $1\n"; # Has trailing semicolon
-  $mods_string = undef;              # Done with mods
+ if (@raw_mods and @body == 1 and $body[0] =~ /^\s*\\draw\b\s*([^\[].*)\s*$/) {
+  $body[0]     = "\\draw$mods_string $1"; # Has trailing semicolon
+  $mods_string = undef;                   # Done with mods
  }
 
  for (0 .. $#clips) {
@@ -167,37 +145,64 @@ sub concat {
   my $clip_string = "\\clip $clip ;";
   my $mods_string = ($_ == $#clips and defined $mods_string)
                      ? $mods_string : '';
-  1 while chomp $body;
-  $body = <<"  CLIP";
-\\begin{scope}$mods_string
-$clip_string
-$body
-\\end{scope}
-  CLIP
+  unshift @body, "\\begin{scope}$mods_string",
+                 $clip_string;
+  push    @body, "\\end{scope}",
  }
 
  if (not @clips and defined $mods_string) {
-  1 while chomp $body;
-  $body = <<"  MODS";
-\\begin{scope}$mods_string
-$body
-\\end{scope}
-  MODS
+  unshift @body, "\\begin{scope}$mods_string";
+  push    @body, "\\end{scope}";
  }
 
  if (defined $layer) {
-  1 while chomp $body;
-  $body = <<"  LAYER";
-\\begin{pgfonlayer}{$layer}
-$body
-\\end{pgfonlayer}
-  LAYER
+  unshift @body, "\\begin{pgfonlayer}{$layer}";
+  push    @body, "\\end{pgfonlayer}";
  }
 
- $rev ? $str . $body : $body . $str;
+ return @body;
 }
 
-sub stringify { $_[0]->concat('') }
+sub concat {
+ my ($left, $right, $rev) = @_;
+
+ $_body_tc->assert_valid($right);
+
+ $left = $left->flatten;
+
+ my (@left, @right);
+
+ if ($my_tc->check($right)) {
+  $right = $right->flatten;
+
+  my ($only_left, $common, $only_right) = $inter->(
+   $left->_mods_cache,
+   $right->_mods_cache,
+  );
+
+  if (@$common) {
+   my $x = $left->new
+                ->mod(@$only_left)
+                ->body($left->_body);
+   my $y = $left->new
+                ->mod(@$only_right)
+                ->body($right->_body);
+   ($x, $y) = ($y, $x) if $rev;
+   return $left->new
+               ->mod(@$common)
+               ->body($x . $y);
+  } else {
+   @right = $right->instantiate;
+  }
+ } else {
+  @right = @$right;
+ }
+
+ @left = $left->instantiate;
+
+ $left->new
+      ->body($rev ? [ @right, @left ] : [ @left, @right ]);
+}
 
 __PACKAGE__->meta->make_immutable;