From: Vincent Pit Date: Wed, 21 Jul 2010 17:00:53 +0000 (+0200) Subject: Complete patterns implementation, interface and tests X-Git-Tag: v0.01~21 X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2FLaTeX-TikZ.git;a=commitdiff_plain;h=d934d1a7f7268b248687f14e0ede2723010bf243 Complete patterns implementation, interface and tests --- diff --git a/MANIFEST b/MANIFEST index f5a6088..d9cbbf4 100644 --- a/MANIFEST +++ b/MANIFEST @@ -42,4 +42,5 @@ t/12-geo.t t/20-mod.t t/21-layer.t t/22-clip.t +t/23-pattern.t t/91-pod.t diff --git a/lib/LaTeX/TikZ/Formatter.pm b/lib/LaTeX/TikZ/Formatter.pm index b9a6e10..b3c242a 100644 --- a/lib/LaTeX/TikZ/Formatter.pm +++ b/lib/LaTeX/TikZ/Formatter.pm @@ -56,6 +56,15 @@ has 'origin' => ( coerce => 1, ); +sub id { + my $tikz = shift; + + join $;, map { + my $val = $tikz->$_; + defined($val) ? "$val" : '(undef)'; + } qw/unit format scale width height origin/; +} + my $find_mods; $find_mods = do { no warnings 'recursion'; diff --git a/lib/LaTeX/TikZ/Interface.pm b/lib/LaTeX/TikZ/Interface.pm index 20e26fd..b9371f6 100644 --- a/lib/LaTeX/TikZ/Interface.pm +++ b/lib/LaTeX/TikZ/Interface.pm @@ -77,6 +77,7 @@ sub load { require LaTeX::TikZ::Mod::Width; # width require LaTeX::TikZ::Mod::Color; # color require LaTeX::TikZ::Mod::Fill; # fill + require LaTeX::TikZ::Mod::Pattern; # pattern } =head1 AUTHOR diff --git a/lib/LaTeX/TikZ/Mod/Pattern.pm b/lib/LaTeX/TikZ/Mod/Pattern.pm index 89af81d..4260982 100644 --- a/lib/LaTeX/TikZ/Mod/Pattern.pm +++ b/lib/LaTeX/TikZ/Mod/Pattern.pm @@ -21,7 +21,7 @@ with 'LaTeX::TikZ::Mod'; has 'template' => ( is => 'ro', - isa => 'Str', + isa => 'ArrayRef[Str]', required => 1, ); @@ -57,22 +57,39 @@ sub declare { my $tikz_id = $tikz->id; my $cache = $pat->_cache->{$tikz_id}; - return $cache->[1] if defined $cache; - $cache = $pat->_cache->{$tikz_id} = [ ]; + return @{$cache->[1]} if defined $cache; + $cache = $pat->_cache->{$tikz_id} = [ ]; $cache->[0] = 'pat' . $id++; - my $template = $pat->template; - $template =~ s!#([^#]+)#! + my $template = [ map $_, @{$pat->template} ]; + s!#([^#]+)#! my ($command, @opts) = split /=/, $1, 2; @opts = split /,/, $opts[0] if @opts; $handlers{lc $command}->($pat, $tikz, @opts); - !ge; + !ge for @$template; $cache->[1] = $template; + + return @$template; } sub apply { 'fill', 'pattern=' . $_[0]->name($_[1]) } +use LaTeX::TikZ::Interface pattern => sub { + my $class = shift; + + my %args = @_; + if (exists $args{class}) { + $class = delete $args{class}; + $class = __PACKAGE__ . '::' . $class unless $class =~ /::/; + (my $pm = $class) =~ s{::}{/}g; + $pm .= '.pm'; + require $pm; + } + + $class->new(%args); +}; + __PACKAGE__->meta->make_immutable; =head1 AUTHOR diff --git a/lib/LaTeX/TikZ/Mod/Pattern/Dots.pm b/lib/LaTeX/TikZ/Mod/Pattern/Dots.pm index 3fea8a6..b029915 100644 --- a/lib/LaTeX/TikZ/Mod/Pattern/Dots.pm +++ b/lib/LaTeX/TikZ/Mod/Pattern/Dots.pm @@ -53,16 +53,16 @@ my $forge_template = Sub::Name::subname('forge_template' => sub { $center = "\\pgfqpoint{$half_width}{$half_width}"; $tile_size = "\\pgfqpoint{$width}{$width}"; - <<" PATTERN"; -\\pgfdeclarepatternformonly{#NAME#}{$low_left}{$up_right}{$tile_size}{% - \\pgfpathcircle{$center}{$dot_width} - \\pgfusepath{fill} -} - PATTERN + return [ + "\\pgfdeclarepatternformonly{#NAME#}{$low_left}{$up_right}{$tile_size}{", + "\\pgfpathcircle{$center}{$dot_width}", + "\\pgfusepath{fill}", + '}', + ]; }); around 'BUILDARGS' => sub { - my ($orig, $class, %args); + my ($orig, $class, %args) = @_; confess('Can\'t specify an explicit template for a '. __PACKAGE__ .' pattern') if exists $args{template}; diff --git a/lib/LaTeX/TikZ/Mod/Pattern/Lines.pm b/lib/LaTeX/TikZ/Mod/Pattern/Lines.pm index 494817a..d38222c 100644 --- a/lib/LaTeX/TikZ/Mod/Pattern/Lines.pm +++ b/lib/LaTeX/TikZ/Mod/Pattern/Lines.pm @@ -89,18 +89,18 @@ my $forge_template = Sub::Name::subname('forge_template' => sub { return; } - <<" PATTERN"; -\\pgfdeclarepatternformonly{#NAME#}{$low_left}{$up_right}{$tile_size}{% - \\pgfsetlinewidth{$line_width} - \\pgfpathmoveto{$line_begin} - \\pgfpathlineto{$line_end} - \\pgfusepath{stroke} -} - PATTERN + return [ + "\\pgfdeclarepatternformonly{#NAME#}{$low_left}{$up_right}{$tile_size}{", + "\\pgfsetlinewidth{$line_width}", + "\\pgfpathmoveto{$line_begin}", + "\\pgfpathlineto{$line_end}", + "\\pgfusepath{stroke}", + "}", + ]; }); around 'BUILDARGS' => sub { - my ($orig, $class, %args); + my ($orig, $class, %args) = @_; confess('Can\'t specify an explicit template for a '. __PACKAGE__ .' pattern') if exists $args{template}; diff --git a/t/01-api.t b/t/01-api.t index 4ccbc96..78b5621 100644 --- a/t/01-api.t +++ b/t/01-api.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More tests => 5 + 17 + 12; +use Test::More tests => 5 + 18 + 12; use LaTeX::TikZ; @@ -34,7 +34,7 @@ my @methods = qw/ point line polyline closed_polyline rectangle circle arc arrow raw_mod clip layer - width color fill + width color fill pattern /; for (@methods) { diff --git a/t/23-pattern.t b/t/23-pattern.t new file mode 100644 index 0000000..d5aa474 --- /dev/null +++ b/t/23-pattern.t @@ -0,0 +1,70 @@ +#!perl -T + +use strict; +use warnings; + +use Test::More tests => 2 + 4 * 2; + +use LaTeX::TikZ; + +my $tikz = Tikz->formatter( + format => '%d', +); + +sub check { + my ($set, $desc, $exp_decl, $exp) = @_; + + local $Test::Builder::Level = $Test::Builder::Level + 1; + + my ($head, $decl, $body) = eval { + $tikz->render(ref $set eq 'ARRAY' ? @$set : $set); + }; + is $@, '', "$desc: no error"; + + is $head->[-1], '\usetikzlibrary{patterns}', "$desc: header"; + + unless (ref $exp_decl eq 'ARRAY') { + $exp_decl = [ split /\n/, $exp_decl ]; + } + + unless (ref $exp eq 'ARRAY') { + $exp = [ split /\n/, $exp ]; + } + unshift @$exp, '\begin{tikzpicture}'; + push @$exp, '\end{tikzpicture}'; + + is_deeply $decl, $exp_decl, "$desc: declarations"; + is_deeply $body, $exp, "$desc: body"; +} + +my $lines = eval { + Tikz->raw("foo") + ->mod(Tikz->pattern(class => 'Lines')); +}; +is $@, '', 'creating a line pattern doesn\'t croak'; + +check $lines, 'a line pattern', <<'DECL', <<'BODY'; +\pgfdeclarepatternformonly{pata}{\pgfqpoint{-0.2pt}{-0.2pt}}{\pgfqpoint{0.3pt}{0.3pt}}{\pgfqpoint{0.2pt}{0.2pt}}{ +\pgfsetlinewidth{0.2pt} +\pgfpathmoveto{\pgfqpoint{-0.2pt}{0.1pt}} +\pgfpathlineto{\pgfqpoint{0.3pt}{0.1pt}} +\pgfusepath{stroke} +} +DECL +\draw [fill,pattern=pata] foo ; +BODY + +my $dots = eval { + Tikz->raw("foo") + ->mod(Tikz->pattern(class => 'Dots')); +}; +is $@, '', 'creating a dot pattern doesn\'t croak'; + +check $dots, 'a dot pattern', <<'DECL', <<'BODY'; +\pgfdeclarepatternformonly{patb}{\pgfqpoint{-0.2pt}{-0.2pt}}{\pgfqpoint{0.3pt}{0.3pt}}{\pgfqpoint{0.2pt}{0.2pt}}{ +\pgfpathcircle{\pgfqpoint{0.1pt}{0.1pt}}{0.2pt} +\pgfusepath{fill} +} +DECL +\draw [fill,pattern=patb] foo ; +BODY