From: Vincent Pit 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