From: Vincent Pit <vince@profvince.com>
Date: Sun, 18 Jul 2010 00:44:06 +0000 (+0200)
Subject: Stop drawing with the newline
X-Git-Tag: v0.01~61
X-Git-Url: http://git.vpit.fr/?a=commitdiff_plain;h=93bfe14caec156fc11587863a486220b986b6b2e;p=perl%2Fmodules%2FLaTeX-TikZ.git

Stop drawing with the newline

Lines are now stored as lists. This requires ->draw to always return a
LaTeX::TikZ::Scope object.
---

diff --git a/lib/LaTeX/TikZ/Formatter.pm b/lib/LaTeX/TikZ/Formatter.pm
index 88bda48..6426607 100644
--- a/lib/LaTeX/TikZ/Formatter.pm
+++ b/lib/LaTeX/TikZ/Formatter.pm
@@ -55,8 +55,6 @@ has 'origin' => (
  does => 'Maybe[LaTeX::TikZ::Point]',
 );
 
-my $lts_tc = LaTeX::TikZ::Tools::type_constraint('LaTeX::TikZ::Set');
-
 my $find_mods;
 $find_mods = do {
  no warnings 'recursion';
@@ -87,8 +85,6 @@ $find_mods = do {
 sub render {
  my $tikz = shift;
 
- $lts_tc->assert_valid($_) for @_;
-
  my $seq = LaTeX::TikZ::Set::Sequence->new(
   kids => \@_,
  );
@@ -116,23 +112,15 @@ sub render {
 
  my @decls;
  if (@layers) {
-  my $layers_decl = LaTeX::TikZ::Mod::Layer->declare(@layers);
-  if (defined $layers_decl) {
-   chomp $layers_decl;
-   push @decls, $layers_decl;
-  }
+  push @decls, LaTeX::TikZ::Mod::Layer->declare(@layers);
  }
  for (@other_mods) {
-  my $decl = $_->declare($tikz);
-  if (defined $decl) {
-   chomp $decl;
-   push @decls, $decl;
-  }
+  push @decls, $_->declare($tikz);
  }
 
  my @content = (
   "\\begin{tikzpicture}",
-  do { my $s = $seq->draw($tikz); chomp $s; $s },
+  $seq->draw($tikz)->instantiate,
   "\\end{tikzpicture}",
  );
 
diff --git a/lib/LaTeX/TikZ/Mod/Layer.pm b/lib/LaTeX/TikZ/Mod/Layer.pm
index f8d57a2..ca0b2bd 100644
--- a/lib/LaTeX/TikZ/Mod/Layer.pm
+++ b/lib/LaTeX/TikZ/Mod/Layer.pm
@@ -168,12 +168,14 @@ sub cover { $_[0]->name eq $_[1]->name }
                 map { ref() ? $_->name : $_ }
                  keys %score;
 
-  my $intro = join '',
-               map "\\pgfdeclarelayer{$_}\n",
-                grep $_ ne 'main',
-                 @layers;
-
-  $intro . "\\pgfsetlayers{" . join(',', @layers) . "}\n";
+  my @intro = map "\\pgfdeclarelayer{$_}",
+               grep $_ ne 'main',
+                @layers;
+
+  return (
+   @intro,
+   "\\pgfsetlayers{" . join(',', @layers) . "}",
+  );
  }
 }
 
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;
 
diff --git a/lib/LaTeX/TikZ/Set/Mod.pm b/lib/LaTeX/TikZ/Set/Mod.pm
index 82c5510..7658340 100644
--- a/lib/LaTeX/TikZ/Set/Mod.pm
+++ b/lib/LaTeX/TikZ/Set/Mod.pm
@@ -128,15 +128,9 @@ MOD:
 
   my @mods = $set->mods_unique;
 
-  my $body = $set->_set->draw($tikz);
-
-  if (@mods) {
-   $body = LaTeX::TikZ::Scope->new
-                             ->mod(map $_->apply($tikz), @mods)
-                             ->body($body)
-  }
-
-  $body;
+  LaTeX::TikZ::Scope->new
+                    ->mod(map $_->apply($tikz), @mods)
+                    ->body($set->_set->draw($tikz))
  }
 }
 
diff --git a/lib/LaTeX/TikZ/Set/Op.pm b/lib/LaTeX/TikZ/Set/Op.pm
index ffd79a5..c7f7e1b 100644
--- a/lib/LaTeX/TikZ/Set/Op.pm
+++ b/lib/LaTeX/TikZ/Set/Op.pm
@@ -15,6 +15,8 @@ Version 0.01
 
 our $VERSION = '0.01';
 
+use LaTeX::TikZ::Scope;
+
 use Any::Moose 'Role';
 
 requires qw(
@@ -24,7 +26,8 @@ requires qw(
 sub draw {
  my $set = shift;
 
- "\\draw " . $set->path(@_) . " ;\n";
+ LaTeX::TikZ::Scope->new
+                   ->body([ "\\draw " . $set->path(@_) . ' ;' ]);
 }
 
 =head1 AUTHOR