Complete patterns implementation, interface and tests

diff --git a/MANIFEST b/MANIFEST
index f5a6088da3fd60aeebb58632c363824ebc748ab7..d9cbbf4ada21b4d3f01d11f4391a32b2d09a937f 100644 (file)
--- 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 b9a6e10de4e7aae925e04899cc2411440a0d73ee..b3c242ad2ae5aa8f96c4fd50adddcc2f9a45e8eb 100644 (file)
--- 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 20e26fdc66fa627929bbb123fa42eb9e58b178c6..b9371f6d91e9aa9414f6dd3aba9ddc10a6210f62 100644 (file)
--- 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 89af81dea0e057b8057dff4ecb712c129ace1327..426098224b321a1670d5adb08a7f18e2e3fbc725 100644 (file)
--- 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 3fea8a6b08bd863e5b9384f64b05e83eb788dd1c..b029915d02c60b3b506ebcd4c2780ee9a6b1892d 100644 (file)
--- 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 494817a0b41edc97dccb4c0bc6bd634e616878a8..d38222c576f2b6e9980ff44deb26eb10ce47467c 100644 (file)
--- 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 4ccbc96155b8da09b030e59708412d822da94521..78b56213fc4fd5944282504479af2bc482da6adc 100644 (file)
--- 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 (file)
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