X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=lib%2FLaTeX%2FTikZ%2FFormatter.pm;h=899b4b036c7cd2ed70c210016820c3754b5c67ad;hb=4a815ba07fc07f94629ca6364fae6204988e3dab;hp=b3c242ad2ae5aa8f96c4fd50adddcc2f9a45e8eb;hpb=d934d1a7f7268b248687f14e0ede2723010bf243;p=perl%2Fmodules%2FLaTeX-TikZ.git diff --git a/lib/LaTeX/TikZ/Formatter.pm b/lib/LaTeX/TikZ/Formatter.pm index b3c242a..899b4b0 100644 --- a/lib/LaTeX/TikZ/Formatter.pm +++ b/lib/LaTeX/TikZ/Formatter.pm @@ -17,6 +17,10 @@ our $VERSION = '0.01'; use Sub::Name (); +use LaTeX::TikZ::Point; + +use LaTeX::TikZ::Interface; + use LaTeX::TikZ::Tools; use Any::Moose; @@ -35,61 +39,83 @@ has 'format' => ( ); has 'scale' => ( - is => 'ro', + is => 'rw', isa => 'Num', default => 1, ); has 'width' => ( - is => 'ro', + is => 'rw', isa => 'Maybe[Num]', ); has 'height' => ( - is => 'ro', + is => 'rw', isa => 'Maybe[Num]', ); has 'origin' => ( - is => 'ro', - isa => 'Maybe[LaTeX::TikZ::Point::Autocoerce]', + is => 'rw', + isa => 'LaTeX::TikZ::Point::Autocoerce', coerce => 1, ); sub id { my $tikz = shift; + my $origin = $tikz->origin; + if (defined $origin) { + my ($x, $y) = map $origin->$_, qw/x y/; + $origin = "($x;$y)"; + } else { + $origin = "(0;0)"; + } + join $;, map { - my $val = $tikz->$_; - defined($val) ? "$val" : '(undef)'; - } qw/unit format scale width height origin/; + defined() ? "$_" : '(undef)'; + } map($tikz->$_, qw/unit format scale width height/), $origin; } -my $find_mods; -$find_mods = do { - no warnings 'recursion'; +my $find_mods = do { + our %seen; - Sub::Name::subname('find_mods' => sub { - my ($set, $layers, $others) = @_; + my $find_mods_rec; + $find_mods_rec = do { + no warnings 'recursion'; + + Sub::Name::subname('find_mods_rec' => sub { + my ($set, $layers, $others) = @_; - for ($set->mods) { - if ($_->isa('LaTeX::TikZ::Mod::Layer')) { - push @$layers, $_; - } else { - push @$others, $_; + for ($set->mods) { + my $tag = $_->tag; + next if $seen{$tag}++; + + if ($_->isa('LaTeX::TikZ::Mod::Layer')) { + push @$layers, $_; + } else { + push @$others, $_; + } } - } - my @subsets = $set->isa('LaTeX::TikZ::Set::Sequence') - ? $set->kids - : $set->isa('LaTeX::TikZ::Set::Path') - ? $set->ops - : (); + my @subsets = $set->isa('LaTeX::TikZ::Set::Sequence') + ? $set->kids + : $set->isa('LaTeX::TikZ::Set::Path') + ? $set->ops + : (); + + $find_mods_rec->($_, $layers, $others) for @subsets; + }); + }; - $find_mods->($_, $layers, $others) for @subsets; - }) + Sub::Name::subname('find_mods' => sub { + local %seen = (); + + $find_mods_rec->(@_); + }); }; +my $translate; + sub render { my $tikz = shift; @@ -97,12 +123,32 @@ sub render { kids => \@_, ); + unless ($translate) { + require LaTeX::TikZ::Functor; + $translate = LaTeX::TikZ::Functor->new( + rules => [ + 'LaTeX::TikZ::Set::Point' => sub { + my ($functor, $set, $v) = @_; + + $set->new( + point => [ + $set->x + $v->x, + $set->y + $v->y, + ], + label => $set->label, + pos => $set->pos, + ); + }, + ], + ); + } + + my $origin = $tikz->origin; + $seq = $seq->$translate($origin) if defined $origin; + my (@layers, @other_mods); $find_mods->($seq, \@layers, \@other_mods); - my $o = $tikz->origin; - $seq = $seq->translate($o) if defined $o; - my $w = $tikz->width; my $h = $tikz->height; my $canvas = ''; @@ -169,11 +215,13 @@ sub thickness { 0.8 * $width * ($tikz->scale / 5); } -use LaTeX::TikZ::Interface formatter => sub { - shift; +LaTeX::TikZ::Interface->register( + formatter => sub { + shift; - __PACKAGE__->new(@_); -}; + __PACKAGE__->new(@_); + }, +); __PACKAGE__->meta->make_immutable;