]> git.vpit.fr Git - perl/modules/LaTeX-TikZ.git/commitdiff
Initial commit
authorVincent Pit <vince@profvince.com>
Sat, 17 Jul 2010 22:01:46 +0000 (00:01 +0200)
committerVincent Pit <vince@profvince.com>
Sat, 17 Jul 2010 22:11:53 +0000 (00:11 +0200)
36 files changed:
.gitignore [new file with mode: 0644]
Changes [new file with mode: 0644]
MANIFEST [new file with mode: 0644]
META.yml [new file with mode: 0644]
Makefile.PL [new file with mode: 0644]
README [new file with mode: 0644]
lib/LaTeX/TikZ.pm [new file with mode: 0644]
lib/LaTeX/TikZ/API.pm [new file with mode: 0644]
lib/LaTeX/TikZ/Formatter.pm [new file with mode: 0644]
lib/LaTeX/TikZ/Mod.pm [new file with mode: 0644]
lib/LaTeX/TikZ/Mod/Clip.pm [new file with mode: 0644]
lib/LaTeX/TikZ/Mod/Color.pm [new file with mode: 0644]
lib/LaTeX/TikZ/Mod/Fill.pm [new file with mode: 0644]
lib/LaTeX/TikZ/Mod/Formatted.pm [new file with mode: 0644]
lib/LaTeX/TikZ/Mod/Layer.pm [new file with mode: 0644]
lib/LaTeX/TikZ/Mod/Pattern.pm [new file with mode: 0644]
lib/LaTeX/TikZ/Mod/Pattern/Dots.pm [new file with mode: 0644]
lib/LaTeX/TikZ/Mod/Pattern/Lines.pm [new file with mode: 0644]
lib/LaTeX/TikZ/Mod/Raw.pm [new file with mode: 0644]
lib/LaTeX/TikZ/Mod/Width.pm [new file with mode: 0644]
lib/LaTeX/TikZ/Point.pm [new file with mode: 0644]
lib/LaTeX/TikZ/Scope.pm [new file with mode: 0644]
lib/LaTeX/TikZ/Set.pm [new file with mode: 0644]
lib/LaTeX/TikZ/Set/Circle.pm [new file with mode: 0644]
lib/LaTeX/TikZ/Set/Line.pm [new file with mode: 0644]
lib/LaTeX/TikZ/Set/Mod.pm [new file with mode: 0644]
lib/LaTeX/TikZ/Set/Mutable.pm [new file with mode: 0644]
lib/LaTeX/TikZ/Set/Op.pm [new file with mode: 0644]
lib/LaTeX/TikZ/Set/Path.pm [new file with mode: 0644]
lib/LaTeX/TikZ/Set/Point.pm [new file with mode: 0644]
lib/LaTeX/TikZ/Set/Raw.pm [new file with mode: 0644]
lib/LaTeX/TikZ/Set/Rectangle.pm [new file with mode: 0644]
lib/LaTeX/TikZ/Set/Sequence.pm [new file with mode: 0644]
lib/LaTeX/TikZ/Tools.pm [new file with mode: 0644]
t/00-load.t [new file with mode: 0644]
t/91-pod.t [new file with mode: 0644]

diff --git a/.gitignore b/.gitignore
new file mode 100644 (file)
index 0000000..f14afad
--- /dev/null
@@ -0,0 +1,25 @@
+blib*
+pm_to_blib*
+
+Makefile
+Makefile.old
+Build
+_build*
+
+*.tar.gz
+LaTeX-TikZ-*
+
+core.*
+*.[co]
+*.so
+*.bs
+*.out
+*.def
+*.exp
+
+cover_db
+*.gcda
+*.gcov
+*.gcno
+
+Debian_CPANTS.txt
diff --git a/Changes b/Changes
new file mode 100644 (file)
index 0000000..9593a84
--- /dev/null
+++ b/Changes
@@ -0,0 +1,5 @@
+Revision history for LaTeX-TikZ
+
+0.01    2010-01-02 21:10 UTC
+        First version, released on an unsuspecting world.
+
diff --git a/MANIFEST b/MANIFEST
new file mode 100644 (file)
index 0000000..a85376d
--- /dev/null
+++ b/MANIFEST
@@ -0,0 +1,34 @@
+Changes
+MANIFEST
+META.yml
+Makefile.PL
+README
+lib/LaTeX/TikZ.pm
+lib/LaTeX/TikZ/API.pm
+lib/LaTeX/TikZ/Formatter.pm
+lib/LaTeX/TikZ/Mod.pm
+lib/LaTeX/TikZ/Mod/Clip.pm
+lib/LaTeX/TikZ/Mod/Color.pm
+lib/LaTeX/TikZ/Mod/Fill.pm
+lib/LaTeX/TikZ/Mod/Formatted.pm
+lib/LaTeX/TikZ/Mod/Layer.pm
+lib/LaTeX/TikZ/Mod/Pattern.pm
+lib/LaTeX/TikZ/Mod/Pattern/Dots.pm
+lib/LaTeX/TikZ/Mod/Pattern/Lines.pm
+lib/LaTeX/TikZ/Mod/Raw.pm
+lib/LaTeX/TikZ/Mod/Width.pm
+lib/LaTeX/TikZ/Point.pm
+lib/LaTeX/TikZ/Scope.pm
+lib/LaTeX/TikZ/Set.pm
+lib/LaTeX/TikZ/Set/Circle.pm
+lib/LaTeX/TikZ/Set/Line.pm
+lib/LaTeX/TikZ/Set/Mod.pm
+lib/LaTeX/TikZ/Set/Mutable.pm
+lib/LaTeX/TikZ/Set/Op.pm
+lib/LaTeX/TikZ/Set/Path.pm
+lib/LaTeX/TikZ/Set/Point.pm
+lib/LaTeX/TikZ/Set/Raw.pm
+lib/LaTeX/TikZ/Set/Rectangle.pm
+lib/LaTeX/TikZ/Set/Sequence.pm
+t/00-load.t
+t/91-pod.t
diff --git a/META.yml b/META.yml
new file mode 100644 (file)
index 0000000..e69de29
diff --git a/Makefile.PL b/Makefile.PL
new file mode 100644 (file)
index 0000000..5402691
--- /dev/null
@@ -0,0 +1,58 @@
+use 5.006;
+
+use strict;
+use warnings;
+use ExtUtils::MakeMaker;
+
+my $dist = 'LaTeX-TikZ';
+
+(my $name = $dist) =~ s{-}{::}g;
+
+(my $file = $dist) =~ s{-}{/}g;
+$file = "lib/$file.pm";
+
+my %PREREQ_PM = (
+ 'Any::Moose'   => 0,
+ 'Carp'         => 0,
+ 'List::Util'   => 0,
+ 'Scope::Guard' => 0,
+ 'Sub::Name'    => 0,
+ 'constant'     => 0,
+);
+
+my %META = (
+ configure_requires => {
+  'ExtUtils::MakeMaker' => 0,
+ },
+ build_requires => {
+  'ExtUtils::MakeMaker' => 0,
+  'Test::More'          => 0,
+  %PREREQ_PM,
+ },
+ dynamic_config => 0,
+ resources => {
+  bugtracker => "http://rt.cpan.org/NoAuth/ReportBug.html?Queue=$dist",
+  homepage   => "http://search.cpan.org/dist/$dist/",
+  license    => 'http://dev.perl.org/licenses/',
+  repository => "http://git.profvince.com/?p=perl%2Fmodules%2F$dist.git",
+ },
+);
+
+WriteMakefile(
+ NAME             => $name,
+ AUTHOR           => 'Vincent Pit <perl@profvince.com>',
+ LICENSE          => 'perl',
+ VERSION_FROM     => $file,
+ ABSTRACT_FROM    => $file,
+ PL_FILES         => {},
+ PREREQ_PM        => \%PREREQ_PM,
+ MIN_PERL_VERSION => 5.006,
+ META_MERGE       => \%META,
+ dist             => {
+  PREOP    => "pod2text $file > \$(DISTVNAME)/README",
+  COMPRESS => 'gzip -9f', SUFFIX => 'gz'
+ },
+ clean            => {
+  FILES => "$dist-* *.gcov *.gcda *.gcno cover_db Debian_CPANTS.txt"
+ }
+);
diff --git a/README b/README
new file mode 100644 (file)
index 0000000..e69de29
diff --git a/lib/LaTeX/TikZ.pm b/lib/LaTeX/TikZ.pm
new file mode 100644 (file)
index 0000000..713aff8
--- /dev/null
@@ -0,0 +1,68 @@
+package LaTeX::TikZ;
+
+use strict;
+use warnings;
+
+=head1 NAME
+
+LaTeX::TikZ - Perl object model for generating PGF/TikZ code.
+
+=head1 VERSION
+
+Version 0.01
+
+=cut
+
+our $VERSION = '0.01';
+
+use LaTeX::TikZ::API;
+
+sub import {
+ shift;
+
+ my %args = @_;
+ my $name = $args{as};
+ $name = 'Tikz' unless defined $name;
+ unless ($name =~ /^[a-z_][a-z0-9_]*$/i) {
+  require Carp;
+  Carp::confess('Invalid name');
+ }
+
+ my $pkg   = caller;
+ my $const = sub () { 'LaTeX::TikZ::API' };
+ {
+  no strict 'refs';
+  *{$pkg . '::' . $name} = $const;
+ }
+
+ LaTeX::TikZ::API->load;
+
+ return;
+}
+
+=head1 AUTHOR
+
+Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
+
+You can contact me by mail or on C<irc.perl.org> (vincent).
+
+=head1 BUGS
+
+Please report any bugs or feature requests to C<bug-latex-tikz at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=LaTeX-TikZ>.
+I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
+
+=head1 SUPPORT
+
+You can find documentation for this module with the perldoc command.
+
+    perldoc LaTeX::TikZ
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2010 Vincent Pit, all rights reserved.
+
+This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
+
+=cut
+
+1; # End of LaTeX::TikZ
diff --git a/lib/LaTeX/TikZ/API.pm b/lib/LaTeX/TikZ/API.pm
new file mode 100644 (file)
index 0000000..c16adc8
--- /dev/null
@@ -0,0 +1,104 @@
+package LaTeX::TikZ::API;
+
+use strict;
+use warnings;
+
+=head1 NAME
+
+LaTeX::TikZ::API - LaTeX::TikZ public API register and loader.
+
+=head1 VERSION
+
+Version 0.01
+
+=cut
+
+our $VERSION = '0.01';
+
+use Sub::Name ();
+
+sub import {
+ shift;
+
+ register(@_);
+}
+
+sub register {
+ while (@_ >= 2) {
+  my ($name, $code) = splice @_, 0, 2;
+
+  unless (defined $name and $name =~ /^[a-z_][a-z0-9_]+$/i) {
+   require Carp;
+   Carp::confess('Invalid interface name');
+  }
+
+  if (do { no strict 'refs'; defined &{__PACKAGE__."::$name"} }) {
+   require Carp;
+   Carp::confess("'$name' is already defined in the interface");
+  }
+
+  unless (defined $code and ref $code eq 'CODE') {
+   require Carp;
+   Carp::confess('Invalid code reference');
+  }
+
+  Sub::Name::subname($name => $code);
+
+  {
+   no strict 'refs';
+   *{__PACKAGE__.'::'.$name} = $code;
+  }
+ }
+
+ return;
+}
+
+sub load {
+ require LaTeX::TikZ::Set::Mod;
+
+ require LaTeX::TikZ::Set::Raw;       # raw
+
+ require LaTeX::TikZ::Set::Path;      # path
+ require LaTeX::TikZ::Set::Sequence;  # seq
+
+ require LaTeX::TikZ::Set::Point;     # point
+ require LaTeX::TikZ::Set::Line;      # line
+ require LaTeX::TikZ::Set::Rectangle; # rectangle
+ require LaTeX::TikZ::Set::Circle;    # circle
+
+ require LaTeX::TikZ::Mod::Raw;       # raw_mod
+
+ require LaTeX::TikZ::Mod::Clip;      # clip
+ require LaTeX::TikZ::Mod::Layer;     # layer
+
+ require LaTeX::TikZ::Mod::Width;     # width
+ require LaTeX::TikZ::Mod::Color;     # color
+ require LaTeX::TikZ::Mod::Fill;      # fill
+}
+
+=head1 AUTHOR
+
+Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
+
+You can contact me by mail or on C<irc.perl.org> (vincent).
+
+=head1 BUGS
+
+Please report any bugs or feature requests to C<bug-latex-tikz at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=LaTeX-TikZ>.
+I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
+
+=head1 SUPPORT
+
+You can find documentation for this module with the perldoc command.
+
+    perldoc LaTeX::TikZ
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2010 Vincent Pit, all rights reserved.
+
+This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
+
+=cut
+
+1; # End of LaTeX::TikZ::API
diff --git a/lib/LaTeX/TikZ/Formatter.pm b/lib/LaTeX/TikZ/Formatter.pm
new file mode 100644 (file)
index 0000000..88bda48
--- /dev/null
@@ -0,0 +1,202 @@
+package LaTeX::TikZ::Formatter;
+
+use strict;
+use warnings;
+
+=head1 NAME
+
+LaTeX::TikZ::Formatter - LaTeX::TikZ formatter object.
+
+=head1 VERSION
+
+Version 0.01
+
+=cut
+
+our $VERSION = '0.01';
+
+use Sub::Name ();
+
+use LaTeX::TikZ::Tools;
+
+use Any::Moose;
+use Any::Moose 'Util::TypeConstraints';
+
+has 'unit' => (
+ is      => 'ro',
+ isa     => enum([ qw/cm pt/ ]),
+ default => 'cm',
+);
+
+has 'format' => (
+ is      => 'ro',
+ isa     => 'Str',
+ default => '%s',
+);
+
+has 'scale' => (
+ is      => 'ro',
+ isa     => 'Num',
+ default => 1,
+);
+
+has 'width' => (
+ is  => 'ro',
+ isa => 'Maybe[Num]',
+);
+
+has 'height' => (
+ is  => 'ro',
+ isa => 'Maybe[Num]',
+);
+
+has 'origin' => (
+ is   => 'ro',
+ 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';
+
+ Sub::Name::subname('find_mods' => sub {
+  my ($set, $layers, $others) = @_;
+
+  if ($set->isa('LaTeX::TikZ::Set::Mod')) {
+   for ($set->mods) {
+    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
+                  : ();
+
+  $find_mods->($_, $layers, $others) for @subsets;
+ })
+};
+
+sub render {
+ my $tikz = shift;
+
+ $lts_tc->assert_valid($_) for @_;
+
+ my $seq = LaTeX::TikZ::Set::Sequence->new(
+  kids => \@_,
+ );
+
+ 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 = '';
+ if (defined $w and defined $h) {
+  $seq->clip(Tikz->rectangle(Tikz->point(0) => [ $w, $h ]));
+  $_ = $tikz->len($_) for $w, $h;
+  $canvas = ",papersize={$w,$h},body={$w,$h}";
+ }
+
+ my @header = (
+  "\\usepackage[pdftex,hcentering,vcentering$canvas]{geometry}",
+  "\\usepackage{tikz}",
+  "\\usetikzlibrary{patterns}",
+ );
+
+ my @decls;
+ if (@layers) {
+  my $layers_decl = LaTeX::TikZ::Mod::Layer->declare(@layers);
+  if (defined $layers_decl) {
+   chomp $layers_decl;
+   push @decls, $layers_decl;
+  }
+ }
+ for (@other_mods) {
+  my $decl = $_->declare($tikz);
+  if (defined $decl) {
+   chomp $decl;
+   push @decls, $decl;
+  }
+ }
+
+ my @content = (
+  "\\begin{tikzpicture}",
+  do { my $s = $seq->draw($tikz); chomp $s; $s },
+  "\\end{tikzpicture}",
+ );
+
+ return \@header, \@decls, \@content;
+}
+
+sub len {
+ my ($tikz, $len) = @_;
+
+ $len = 0 if LaTeX::TikZ::Tools::numeq($len, 0);
+
+ sprintf $tikz->format . $tikz->unit, $len * $tikz->scale;
+}
+
+sub angle {
+ my ($tikz, $a) = @_;
+
+ $a = ($a * 180) / CORE::atan2(0, -1);
+ $a += 360 if LaTeX::TikZ::Tools::numcmp($a, 0) < 0;
+
+ require POSIX;
+ sprintf $tikz->format, POSIX::ceil($a);
+}
+
+sub label {
+ my ($tikz, $name, $pos) = @_;
+
+ my $scale = sprintf '%0.2f', $tikz->scale / 5;
+
+ "node[scale=$scale,$pos] {\$$name\$}";
+}
+
+sub thickness {
+ my ($tikz, $width) = @_;
+
+ # width=1 is 0.4 points for a scale of 2.5
+ 0.8 * $width * ($tikz->scale / 5);
+}
+
+__PACKAGE__->meta->make_immutable;
+
+=head1 AUTHOR
+
+Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
+
+You can contact me by mail or on C<irc.perl.org> (vincent).
+
+=head1 BUGS
+
+Please report any bugs or feature requests to C<bug-latex-tikz at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=LaTeX-TikZ>.
+I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
+
+=head1 SUPPORT
+
+You can find documentation for this module with the perldoc command.
+
+    perldoc LaTeX::TikZ
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2010 Vincent Pit, all rights reserved.
+
+This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
+
+=cut
+
+1; # End of LaTeX::TikZ::Formatter
diff --git a/lib/LaTeX/TikZ/Mod.pm b/lib/LaTeX/TikZ/Mod.pm
new file mode 100644 (file)
index 0000000..dbee13d
--- /dev/null
@@ -0,0 +1,57 @@
+package LaTeX::TikZ::Mod;
+
+use strict;
+use warnings;
+
+=head1 NAME
+
+LaTeX::TikZ::Mod - Base role for LaTeX::TikZ modifiers.
+
+=head1 VERSION
+
+Version 0.01
+
+=cut
+
+our $VERSION = '0.01';
+
+use Any::Moose 'Role';
+use Any::Moose 'Util::TypeConstraints';
+
+requires qw(
+ tag
+ cover
+ declare
+ apply
+);
+
+coerce 'LaTeX::TikZ::Mod'
+    => from 'Str'
+    => via { LaTeX::TikZ::Mod::Raw->new($_) };
+
+=head1 AUTHOR
+
+Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
+
+You can contact me by mail or on C<irc.perl.org> (vincent).
+
+=head1 BUGS
+
+Please report any bugs or feature requests to C<bug-latex-tikz at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=LaTeX-TikZ>.
+I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
+
+=head1 SUPPORT
+
+You can find documentation for this module with the perldoc command.
+
+    perldoc LaTeX::TikZ
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2010 Vincent Pit, all rights reserved.
+
+This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
+
+=cut
+
+1; # End of LaTeX::TikZ::Mod
diff --git a/lib/LaTeX/TikZ/Mod/Clip.pm b/lib/LaTeX/TikZ/Mod/Clip.pm
new file mode 100644 (file)
index 0000000..5fdac3d
--- /dev/null
@@ -0,0 +1,172 @@
+package LaTeX::TikZ::Mod::Clip;
+
+use strict;
+use warnings;
+
+=head1 NAME
+
+LaTeX::TikZ::Mod::Clip - A modifier that clips sequences with a path.
+
+=head1 VERSION
+
+Version 0.01
+
+=cut
+
+our $VERSION = '0.01';
+
+use Sub::Name ();
+
+use LaTeX::TikZ::Formatter;
+use LaTeX::TikZ::Mod::Formatted;
+
+use LaTeX::TikZ::Tools;
+
+use Any::Moose;
+
+with 'LaTeX::TikZ::Mod';
+
+has clip => (
+ is       => 'ro',
+ isa      => 'LaTeX::TikZ::Set::Op',
+ required => 1,
+);
+
+my $default_formatter = LaTeX::TikZ::Formatter->new(
+ unit   => 'cm',
+ format => '%.07f',
+ scale  => 1,
+);
+
+sub tag { ref $_[0] }
+
+my $get_tc = do {
+ my %tc;
+
+ Sub::Name::subname('get_tc' => sub {
+  my ($class) = @_;
+
+  return $tc{$class} if exists $tc{class};
+
+  my $tc = LaTeX::TikZ::Tools::type_constraint($class);
+  return unless defined $tc;
+
+  $tc{$class} ||= $tc;
+ })
+};
+
+my $cover_rectangle = Sub::Name::subname('cover_rectangle' => sub {
+ my ($old, $new, $self_tc) = @_;
+
+ my $p = $new->from;
+ my $q = $new->to;
+
+ my $x = $p->x;
+ my $y = $p->y;
+ my $X = $q->x;
+ my $Y = $q->y;
+
+ ($x, $X) = ($X, $x) if $x > $X;
+ ($y, $Y) = ($Y, $y) if $y > $Y;
+
+ if ($self_tc->check($old)) {
+  # The old rectangle covers the new one if and only if it's inside the new.
+
+  for ($old->from, $old->to) {
+   my $r = $_->x;
+   return 0 if LaTeX::TikZ::Tools::numcmp($r, $x) < 0
+            or LaTeX::TikZ::Tools::numcmp($X, $r) < 0;
+   my $i = $_->y;
+   return 0 if LaTeX::TikZ::Tools::numcmp($i, $y) < 0
+            or LaTeX::TikZ::Tools::numcmp($Y, $i) < 0;
+  }
+
+  return 1;
+ }
+
+ return 0;
+});
+
+my $cover_circle = Sub::Name::subname('cover_circle' => sub {
+ my ($old, $new, $self_tc) = @_;
+
+ my $c2 = $new->center;
+ my $r2 = $new->radius;
+
+ if ($self_tc->check($old)) {
+  # The old circle covers the new one if and only if it's inside the new.
+
+  my $c1 = $old->center;
+  my $r1 = $old->radius;
+
+  my $d = abs($c1 - $c2);
+
+  return    LaTeX::TikZ::Tools::numcmp($d, $r2)       <= 0
+         && LaTeX::TikZ::Tools::numcmp($d + $r1, $r2) <= 0;
+ }
+
+ return 0;
+});
+
+my @handlers = (
+ [ 'LaTeX::TikZ::Set::Rectangle' => $cover_rectangle ],
+ [ 'LaTeX::TikZ::Set::Circle'    => $cover_circle    ],
+);
+
+sub cover {
+ my ($old, $new) = map $_->clip, @_[0, 1];
+
+ for (@handlers) {
+  my $tc = $get_tc->($_->[0]);
+  next unless defined $tc and $tc->check($new);
+  return $_->[1]->($old, $new, $tc);
+ }
+
+ $old->path($default_formatter) eq $new->path($default_formatter);
+}
+
+sub declare { }
+
+sub apply {
+ my ($self) = @_;
+
+ LaTeX::TikZ::Mod::Formatted->new(
+  type    => 'clip',
+  content => $_[0]->clip->path($_[1]),
+ )
+}
+
+use LaTeX::TikZ::API clip => sub {
+ shift;
+
+ __PACKAGE__->new(clip => $_[0]);
+};
+
+__PACKAGE__->meta->make_immutable;
+
+=head1 AUTHOR
+
+Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
+
+You can contact me by mail or on C<irc.perl.org> (vincent).
+
+=head1 BUGS
+
+Please report any bugs or feature requests to C<bug-latex-tikz at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=LaTeX-TikZ>.
+I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
+
+=head1 SUPPORT
+
+You can find documentation for this module with the perldoc command.
+
+    perldoc LaTeX::TikZ
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2010 Vincent Pit, all rights reserved.
+
+This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
+
+=cut
+
+1; # End of LaTeX::TikZ::Mod::Clip
diff --git a/lib/LaTeX/TikZ/Mod/Color.pm b/lib/LaTeX/TikZ/Mod/Color.pm
new file mode 100644 (file)
index 0000000..53fe411
--- /dev/null
@@ -0,0 +1,69 @@
+package LaTeX::TikZ::Mod::Color;
+
+use strict;
+use warnings;
+
+=head1 NAME
+
+LaTeX::TikZ::Mod::Color - A modifier that sets the line color.
+
+=head1 VERSION
+
+Version 0.01
+
+=cut
+
+our $VERSION = '0.01';
+
+use Any::Moose;
+
+with 'LaTeX::TikZ::Mod';
+
+has 'color' => (
+ is       => 'ro',
+ isa      => 'Str',
+ required => 1,
+);
+
+sub tag { ref $_[0] }
+
+sub cover { $_[0]->color eq $_[1]->color }
+
+sub declare { }
+
+sub apply { 'color=' . $_[0]->color }
+
+use LaTeX::TikZ::API color => sub {
+ shift;
+
+ __PACKAGE__->new(color => $_[0]);
+};
+
+__PACKAGE__->meta->make_immutable;
+
+=head1 AUTHOR
+
+Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
+
+You can contact me by mail or on C<irc.perl.org> (vincent).
+
+=head1 BUGS
+
+Please report any bugs or feature requests to C<bug-latex-tikz at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=LaTeX-TikZ>.
+I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
+
+=head1 SUPPORT
+
+You can find documentation for this module with the perldoc command.
+
+    perldoc LaTeX::TikZ
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2010 Vincent Pit, all rights reserved.
+
+This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
+
+=cut
+
+1; # End of LaTeX::TikZ::Mod::Color
diff --git a/lib/LaTeX/TikZ/Mod/Fill.pm b/lib/LaTeX/TikZ/Mod/Fill.pm
new file mode 100644 (file)
index 0000000..8d350d7
--- /dev/null
@@ -0,0 +1,69 @@
+package LaTeX::TikZ::Mod::Fill;
+
+use strict;
+use warnings;
+
+=head1 NAME
+
+LaTeX::TikZ::Mod::Fill - A modifier that fills a closed path with a color.
+
+=head1 VERSION
+
+Version 0.01
+
+=cut
+
+our $VERSION = '0.01';
+
+use Any::Moose;
+
+with 'LaTeX::TikZ::Mod';
+
+has 'color' => (
+ is       => 'ro',
+ isa      => 'Str',
+ required => 1,
+);
+
+sub tag { ref $_[0] }
+
+sub cover { $_[0]->color eq $_[1]->color }
+
+sub declare { }
+
+sub apply { 'fill=' . $_[0]->color }
+
+use LaTeX::TikZ::API fill => sub {
+ shift;
+
+ __PACKAGE__->new(color => $_[0]);
+};
+
+__PACKAGE__->meta->make_immutable;
+
+=head1 AUTHOR
+
+Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
+
+You can contact me by mail or on C<irc.perl.org> (vincent).
+
+=head1 BUGS
+
+Please report any bugs or feature requests to C<bug-latex-tikz at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=LaTeX-TikZ>.
+I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
+
+=head1 SUPPORT
+
+You can find documentation for this module with the perldoc command.
+
+    perldoc LaTeX::TikZ
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2010 Vincent Pit, all rights reserved.
+
+This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
+
+=cut
+
+1; # End of LaTeX::TikZ::Mod::Fill
diff --git a/lib/LaTeX/TikZ/Mod/Formatted.pm b/lib/LaTeX/TikZ/Mod/Formatted.pm
new file mode 100644 (file)
index 0000000..5bda247
--- /dev/null
@@ -0,0 +1,70 @@
+package LaTeX::TikZ::Mod::Formatted;
+
+use strict;
+use warnings;
+
+=head1 NAME
+
+LaTeX::TikZ::Mod::Formatted - Intermediate object between a modifier object and its code representation.
+
+=head1 VERSION
+
+Version 0.01
+
+=cut
+
+our $VERSION = '0.01';
+
+use Any::Moose;
+use Any::Moose 'Util::TypeConstraints';
+
+has 'type' => (
+ is       => 'ro',
+ isa      => enum([ qw/clip layer raw/ ]),
+ required => 1,
+);
+
+has 'content' => (
+ is       => 'ro',
+ isa      => 'Str',
+ required => 1,
+);
+
+coerce 'LaTeX::TikZ::Mod::Formatted'
+    => from 'Str'
+    => via { LaTeX::TikZ::Mod::Formatted->new(type => 'raw', content => $_) };
+
+sub tag {
+ my ($self) = @_;
+
+ ref($self) . '/' . $self->type . '/' . $self->content;
+}
+
+__PACKAGE__->meta->make_immutable;
+
+=head1 AUTHOR
+
+Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
+
+You can contact me by mail or on C<irc.perl.org> (vincent).
+
+=head1 BUGS
+
+Please report any bugs or feature requests to C<bug-latex-tikz at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=LaTeX-TikZ>.
+I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
+
+=head1 SUPPORT
+
+You can find documentation for this module with the perldoc command.
+
+    perldoc LaTeX::TikZ
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2010 Vincent Pit, all rights reserved.
+
+This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
+
+=cut
+
+1; # End of LaTeX::TikZ::Mod::Formatted
diff --git a/lib/LaTeX/TikZ/Mod/Layer.pm b/lib/LaTeX/TikZ/Mod/Layer.pm
new file mode 100644 (file)
index 0000000..f8d57a2
--- /dev/null
@@ -0,0 +1,224 @@
+package LaTeX::TikZ::Mod::Layer;
+
+use strict;
+use warnings;
+
+=head1 NAME
+
+LaTeX::TikZ::Mod::Layer - A modifier that specifies a drawing layer.
+
+=head1 VERSION
+
+Version 0.01
+
+=cut
+
+our $VERSION = '0.01';
+
+use List::Util ();
+
+use LaTeX::TikZ::Mod::Formatted;
+
+use Any::Moose;
+use Any::Moose 'Util::TypeConstraints';
+
+with 'LaTeX::TikZ::Mod';
+
+has 'name' => (
+ is       => 'ro',
+ isa      => 'Str',
+ required => 1,
+);
+
+subtype 'LaTeX::TikZ::Mod::LevelList'
+     => as 'ArrayRef[LaTeX::TikZ::Mod::Layer]';
+
+coerce 'LaTeX::TikZ::Mod::LevelList'
+    => from 'Str'
+    => via { [ __PACKAGE__->new(name => $_) ] };
+
+coerce 'LaTeX::TikZ::Mod::LevelList'
+    => from 'ArrayRef[Str]'
+    => via { [ map __PACKAGE__->new(name => $_), @$_ ] };
+
+has '_above' => (
+ is       => 'ro',
+ isa      => 'LaTeX::TikZ::Mod::LevelList',
+ init_arg => 'above',
+ default  => sub { [ ] },
+ coerce   => 1,
+);
+
+sub above { @{$_[0]->_above} }
+
+has '_below' => (
+ is       => 'ro',
+ isa      => 'LaTeX::TikZ::Mod::LevelList',
+ init_arg => 'below',
+ default  => sub { [ ] },
+ coerce   => 1,
+);
+
+sub below { @{$_[0]->_below} }
+
+has '_score' => (
+ is       => 'ro',
+ isa      => 'Int',
+ init_arg => undef,
+ lazy     => 1,
+ builder  => '_build_score',
+);
+
+my %layers;
+
+around 'new' => sub {
+ my ($orig, $self, %args) = @_;
+
+ my $name = $args{name};
+ if (defined $name) {
+  $self->meta->find_attribute_by_name('name')
+             ->type_constraint->assert_valid($name);
+  confess("Can't redefine layer '$name'") if keys(%args) > 1;
+  my $layer = $layers{$name};
+  return $layer if defined $layer;
+ }
+
+ return $self->$orig(%args);
+};
+
+sub BUILD {
+ my ($self) = @_;
+
+ $layers{$self->name} = $self;
+}
+
+sub DEMOLISH {
+ my ($self) = @_;
+
+ delete $layers{$self->name};
+}
+
+sub tag {
+ my ($self) = @_;
+
+ ref($self) . '/' . $self->name;
+}
+
+sub cover { $_[0]->name eq $_[1]->name }
+
+{
+ our %score;
+
+ sub score {
+  my $layer = $_[0];
+
+  my $name = $layer->name;
+
+  return $score{$name} if exists $score{$name};
+
+  my (@lower, $min);
+  for ($layer->above) {
+   my $cur = $_->score;
+   if (defined $cur) {
+    $min = $cur if not defined $min or $min < $cur;
+   } else {
+    push @lower, $_;
+   }
+  }
+
+  my (@higher, $max);
+  for ($layer->below) {
+   my $cur = $_->score;
+   if (defined $cur) {
+    $max = $cur if not defined $max or $max < $cur;
+   } else {
+    push @higher, $_;
+   }
+  }
+
+  if (defined $min) {
+   if (defined $max) {
+    confess("Order mismatch for $name") unless $min < $max;
+    $score{$name} = ($min + $max) / 2;
+   } else {
+    my $i = List::Util::max(values %score);
+    $score{$_} = ++$i for $name, @higher;
+   }
+  } elsif (defined $max) {
+   my $i = List::Util::min(values %score);
+   $score{$_} = --$i for @lower, $name;
+  } else {
+   my $i = 0;
+   $score{$_} = ++$i for @lower, $name, @higher;
+  }
+
+  $score{$name}
+ }
+
+ sub declare {
+  shift;
+
+  return unless @_;
+
+  local %score = (main => 0);
+
+  $_->score for @_;
+
+  my @layers = sort { $score{$a} <=> $score{$b} }
+                map { ref() ? $_->name : $_ }
+                 keys %score;
+
+  my $intro = join '',
+               map "\\pgfdeclarelayer{$_}\n",
+                grep $_ ne 'main',
+                 @layers;
+
+  $intro . "\\pgfsetlayers{" . join(',', @layers) . "}\n";
+ }
+}
+
+sub apply {
+ my ($self) = @_;
+
+ LaTeX::TikZ::Mod::Formatted->new(
+  type    => 'layer',
+  content => $self->name,
+ )
+}
+
+use LaTeX::TikZ::API layer => sub {
+ shift;
+
+ __PACKAGE__->new(name => $_[0]);
+};
+
+__PACKAGE__->meta->make_immutable(
+ inline_constructor => 0,
+);
+
+=head1 AUTHOR
+
+Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
+
+You can contact me by mail or on C<irc.perl.org> (vincent).
+
+=head1 BUGS
+
+Please report any bugs or feature requests to C<bug-latex-tikz at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=LaTeX-TikZ>.
+I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
+
+=head1 SUPPORT
+
+You can find documentation for this module with the perldoc command.
+
+    perldoc LaTeX::TikZ
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2010 Vincent Pit, all rights reserved.
+
+This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
+
+=cut
+
+1; # End of LaTeX::TikZ::Mod::Layer
diff --git a/lib/LaTeX/TikZ/Mod/Pattern.pm b/lib/LaTeX/TikZ/Mod/Pattern.pm
new file mode 100644 (file)
index 0000000..89af81d
--- /dev/null
@@ -0,0 +1,103 @@
+package LaTeX::TikZ::Mod::Pattern;
+
+use strict;
+use warnings;
+
+=head1 NAME
+
+LaTeX::TikZ::Mod::Pattern - A modifier that fills a closed path with a pattern.
+
+=head1 VERSION
+
+Version 0.01
+
+=cut
+
+our $VERSION = '0.01';
+
+use Any::Moose;
+
+with 'LaTeX::TikZ::Mod';
+
+has 'template' => (
+ is       => 'ro',
+ isa      => 'Str',
+ required => 1,
+);
+
+has '_cache' => (
+ is       => 'ro',
+ isa      => 'HashRef',
+ init_arg => undef,
+ default  => sub { +{ } },
+);
+
+sub name {
+ my ($pat, $tikz) = @_;
+
+ my $cache = $pat->_cache->{$tikz->id};
+ confess('Template not yet declared') unless defined $cache;
+
+ $cache->[0];
+}
+
+my $id = 'a';
+
+my %handlers = (
+ name  => sub { $_[0]->name($_[1]) },
+ width => sub { sprintf '%0.1fpt', $_[1]->thickness($_[2]) },
+);
+
+sub tag { ref $_[0] }
+
+sub cover { 1 }
+
+sub declare {
+ my ($pat, $tikz) = @_;
+
+ my $tikz_id = $tikz->id;
+ my $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 ($command, @opts) = split /=/, $1, 2;
+  @opts = split /,/, $opts[0] if @opts;
+  $handlers{lc $command}->($pat, $tikz, @opts);
+ !ge;
+ $cache->[1] = $template;
+}
+
+sub apply { 'fill', 'pattern=' . $_[0]->name($_[1]) }
+
+__PACKAGE__->meta->make_immutable;
+
+=head1 AUTHOR
+
+Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
+
+You can contact me by mail or on C<irc.perl.org> (vincent).
+
+=head1 BUGS
+
+Please report any bugs or feature requests to C<bug-latex-tikz at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=LaTeX-TikZ>.
+I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
+
+=head1 SUPPORT
+
+You can find documentation for this module with the perldoc command.
+
+    perldoc LaTeX::TikZ
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2010 Vincent Pit, all rights reserved.
+
+This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
+
+=cut
+
+1; # End of LaTeX::TikZ::Mod::Pattern
diff --git a/lib/LaTeX/TikZ/Mod/Pattern/Dots.pm b/lib/LaTeX/TikZ/Mod/Pattern/Dots.pm
new file mode 100644 (file)
index 0000000..3fea8a6
--- /dev/null
@@ -0,0 +1,111 @@
+package LaTeX::TikZ::Mod::Pattern::Dots;
+
+use strict;
+use warnings;
+
+=head1 NAME
+
+LaTeX::TikZ::Mod::Pattern::Dots - A dotted pattern modifier.
+
+=head1 VERSION
+
+Version 0.01
+
+=cut
+
+our $VERSION = '0.01';
+
+use Sub::Name ();
+
+use Any::Moose;
+
+extends 'LaTeX::TikZ::Mod::Pattern';
+
+has 'dot_width' => (
+ is      => 'ro',
+ isa     => 'Int',
+ default => 1,
+);
+
+has 'space_width' => (
+ is      => 'ro',
+ isa     => 'Int',
+ default => 1,
+);
+
+my $W = Sub::Name::subname('WIDTH' => sub { sprintf '#WIDTH=%0.1f#', @_ });
+
+my $forge_template = Sub::Name::subname('forge_template' => sub {
+ my ($dot_width, $space_width) = @_;
+
+ my ($low_left, $up_right, $tile_size, $center);
+ my ($width, $half_width, $shadow_min, $shadow_max);
+
+ $width      = $W->($space_width);
+ $half_width = $W->($space_width / 2);
+
+ $shadow_min = $W->(- $dot_width);
+ $shadow_max = $W->($space_width + $dot_width);
+ $dot_width  = $W->($dot_width);
+
+ $low_left   = "\\pgfqpoint{$shadow_min}{$shadow_min}";
+ $up_right   = "\\pgfqpoint{$shadow_max}{$shadow_max}";
+ $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
+});
+
+around 'BUILDARGS' => sub {
+ my ($orig, $class, %args);
+
+ confess('Can\'t specify an explicit template for a '. __PACKAGE__ .' pattern')
+                                                      if exists $args{template};
+
+ my @params = qw/dot_width space_width/;
+
+ my $meta = $class->meta;
+ for (@params) {
+  my $attr = $meta->find_attribute_by_name($_);
+  $args{$_} = $attr->default if $attr->has_default and not exists $args{$_};
+  $attr->type_constraint->assert_valid($args{$_});
+ }
+
+ $args{template} = $forge_template->(@args{@params});
+
+ $class->$orig(%args);
+};
+
+__PACKAGE__->meta->make_immutable;
+
+=head1 AUTHOR
+
+Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
+
+You can contact me by mail or on C<irc.perl.org> (vincent).
+
+=head1 BUGS
+
+Please report any bugs or feature requests to C<bug-latex-tikz at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=LaTeX-TikZ>.
+I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
+
+=head1 SUPPORT
+
+You can find documentation for this module with the perldoc command.
+
+    perldoc LaTeX::TikZ
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2010 Vincent Pit, all rights reserved.
+
+This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
+
+=cut
+
+1; # End of LaTeX::TikZ::Mod::Pattern::Dots
diff --git a/lib/LaTeX/TikZ/Mod/Pattern/Lines.pm b/lib/LaTeX/TikZ/Mod/Pattern/Lines.pm
new file mode 100644 (file)
index 0000000..494817a
--- /dev/null
@@ -0,0 +1,161 @@
+package LaTeX::TikZ::Mod::Pattern::Lines;
+
+use strict;
+use warnings;
+
+=head1 NAME
+
+LaTeX::TikZ::Mod::Pattern::Lines - An hatched pattern modifier.
+
+=head1 VERSION
+
+Version 0.01
+
+=cut
+
+our $VERSION = '0.01';
+
+use Sub::Name ();
+
+use LaTeX::TikZ::Tools;
+
+use Any::Moose;
+use Any::Moose 'Util::TypeConstraints';
+
+extends 'LaTeX::TikZ::Mod::Pattern';
+
+enum 'LaTeX::TikZ::Mod::Pattern::Direction' => (
+ 'horizontal', 'vertical', 'north east', 'north west',
+);
+
+has 'direction' => (
+ is      => 'ro',
+ isa     => 'LaTeX::TikZ::Mod::Pattern::Direction',
+ default => 'horizontal',
+);
+
+has 'line_width' => (
+ is      => 'ro',
+ isa     => 'Int',
+ default => 1,
+);
+
+has 'space_width' => (
+ is      => 'ro',
+ isa     => 'Int',
+ default => 1,
+);
+
+my $W = Sub::Name::subname('WIDTH' => sub { sprintf '#WIDTH=%0.1f#', @_ });
+
+my $forge_template = Sub::Name::subname('forge_template' => sub {
+ my ($direction, $line_width, $space_width) = @_;
+
+ my ($low_left, $up_right, $tile_size, $line_begin, $line_end);
+ my ($width, $half_width, $shadow_min, $shadow_max);
+
+ $width      = $W->($space_width);
+ $half_width = $W->($space_width / 2);
+
+ $shadow_min = $W->(- $line_width);
+ $shadow_max = $W->($space_width + $line_width);
+ $line_width = $W->($line_width);
+
+ $low_left   = "\\pgfqpoint{$shadow_min}{$shadow_min}";
+ $up_right   = "\\pgfqpoint{$shadow_max}{$shadow_max}";
+ $tile_size  = "\\pgfqpoint{$width}{$width}";
+
+ if ($direction =~ /^(?:horizontal|vertical)$/) {
+
+  if ($direction eq 'horizontal') {
+   $line_begin = "\\pgfqpoint{$shadow_min}{$half_width}";
+   $line_end   = "\\pgfqpoint{$shadow_max}{$half_width}";
+  } else {
+   $line_begin = "\\pgfqpoint{$half_width}{$shadow_min}";
+   $line_end   = "\\pgfqpoint{$half_width}{$shadow_max}";
+  }
+
+ } elsif ($direction =~ /^north (?:east|west)$/) {
+
+  if ($direction eq 'north east') {
+   $line_begin = "\\pgfqpoint{$shadow_min}{$shadow_min}";
+   $line_end   = "\\pgfqpoint{$shadow_max}{$shadow_max}";
+  } else {
+   $line_begin = "\\pgfqpoint{$shadow_min}{$shadow_max}";
+   $line_end   = "\\pgfqpoint{$shadow_max}{$shadow_min}";
+  }
+
+ } else {
+  return;
+ }
+
+ <<" PATTERN";
+\\pgfdeclarepatternformonly{#NAME#}{$low_left}{$up_right}{$tile_size}{%
+ \\pgfsetlinewidth{$line_width}
+ \\pgfpathmoveto{$line_begin}
+ \\pgfpathlineto{$line_end}
+ \\pgfusepath{stroke}
+}
+ PATTERN
+});
+
+around 'BUILDARGS' => sub {
+ my ($orig, $class, %args);
+
+ confess('Can\'t specify an explicit template for a '. __PACKAGE__ .' pattern')
+                                                      if exists $args{template};
+
+ my @params = qw/direction line_width space_width/;
+
+ my $meta = $class->meta;
+ for (@params) {
+  my $attr = $meta->find_attribute_by_name($_);
+  $args{$_} = $attr->default if $attr->has_default and not exists $args{$_};
+  $attr->type_constraint->assert_valid($args{$_});
+ }
+
+ $args{template} = $forge_template->(@args{@params});
+
+ $class->$orig(%args);
+};
+
+sub tag { join '/', ref $_[0], $_[0]->direction }
+
+sub cover {
+ my ($this, $other) = @_;
+
+ LaTeX::TikZ::Tools::numeq($this->line_width, $other->line_width) or return 0;
+
+ my $ratio = $other->space_width / $this->space_width;
+
+ return LaTeX::TikZ::Tools::numeq($ratio, int $ratio);
+}
+
+__PACKAGE__->meta->make_immutable;
+
+=head1 AUTHOR
+
+Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
+
+You can contact me by mail or on C<irc.perl.org> (vincent).
+
+=head1 BUGS
+
+Please report any bugs or feature requests to C<bug-latex-tikz at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=LaTeX-TikZ>.
+I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
+
+=head1 SUPPORT
+
+You can find documentation for this module with the perldoc command.
+
+    perldoc LaTeX::TikZ
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2010 Vincent Pit, all rights reserved.
+
+This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
+
+=cut
+
+1; # End of LaTeX::TikZ::Mod::Pattern::Lines
diff --git a/lib/LaTeX/TikZ/Mod/Raw.pm b/lib/LaTeX/TikZ/Mod/Raw.pm
new file mode 100644 (file)
index 0000000..e7ff0fd
--- /dev/null
@@ -0,0 +1,73 @@
+package LaTeX::TikZ::Mod::Raw;
+
+use strict;
+use warnings;
+
+=head1 NAME
+
+LaTeX::TikZ::Mod::Raw - A literal TikZ modifier.
+
+=head1 VERSION
+
+Version 0.01
+
+=cut
+
+our $VERSION = '0.01';
+
+use Any::Moose;
+
+with 'LaTeX::TikZ::Mod';
+
+has 'content' => (
+ is       => 'ro',
+ isa      => 'Str',
+ required => 1,
+);
+
+sub tag {
+ my ($self) = @_;
+
+ ref($self) . '%' . $self->content;
+}
+
+sub cover { 1 }
+
+sub declare { }
+
+sub apply { $_[0]->content }
+
+use LaTeX::TikZ::API raw_mode => sub {
+ shift;
+
+ __PACKAGE__->new(content => $_[0]);
+};
+
+__PACKAGE__->meta->make_immutable;
+
+=head1 AUTHOR
+
+Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
+
+You can contact me by mail or on C<irc.perl.org> (vincent).
+
+=head1 BUGS
+
+Please report any bugs or feature requests to C<bug-latex-tikz at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=LaTeX-TikZ>.
+I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
+
+=head1 SUPPORT
+
+You can find documentation for this module with the perldoc command.
+
+    perldoc LaTeX::TikZ
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2010 Vincent Pit, all rights reserved.
+
+This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
+
+=cut
+
+1; # End of LaTeX::TikZ::Mod::Raw
diff --git a/lib/LaTeX/TikZ/Mod/Width.pm b/lib/LaTeX/TikZ/Mod/Width.pm
new file mode 100644 (file)
index 0000000..bc6ad70
--- /dev/null
@@ -0,0 +1,71 @@
+package LaTeX::TikZ::Mod::Width;
+
+use strict;
+use warnings;
+
+=head1 NAME
+
+LaTeX::TikZ::Mod::Width - A modifier that sets the line width.
+
+=head1 VERSION
+
+Version 0.01
+
+=cut
+
+our $VERSION = '0.01';
+
+use LaTeX::TikZ::Tools;
+
+use Any::Moose;
+
+with 'LaTeX::TikZ::Mod';
+
+has 'width' => (
+ is       => 'ro',
+ isa      => 'Int',
+ required => 1,
+);
+
+sub tag { ref $_[0] }
+
+sub cover { LaTeX::TikZ::Tools::numeq($_[0]->width, $_[1]->width) }
+
+sub declare { }
+
+sub apply { sprintf 'line width=%0.1fpt', $_[1]->thickness($_[0]->width) }
+
+use LaTeX::TikZ::API width => sub {
+ shift;
+
+ __PACKAGE__->new(width => $_[0]);
+};
+
+__PACKAGE__->meta->make_immutable;
+
+=head1 AUTHOR
+
+Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
+
+You can contact me by mail or on C<irc.perl.org> (vincent).
+
+=head1 BUGS
+
+Please report any bugs or feature requests to C<bug-latex-tikz at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=LaTeX-TikZ>.
+I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
+
+=head1 SUPPORT
+
+You can find documentation for this module with the perldoc command.
+
+    perldoc LaTeX::TikZ
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2010 Vincent Pit, all rights reserved.
+
+This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
+
+=cut
+
+1; # End of LaTeX::TikZ::Mod::Width
diff --git a/lib/LaTeX/TikZ/Point.pm b/lib/LaTeX/TikZ/Point.pm
new file mode 100644 (file)
index 0000000..f2155e8
--- /dev/null
@@ -0,0 +1,50 @@
+package LaTeX::TikZ::Point;
+
+use strict;
+use warnings;
+
+=head1 NAME
+
+LaTeX::TikZ::Point - Interface role for what LaTeX::TikZ consider as 2D points.
+
+=head1 VERSION
+
+Version 0.01
+
+=cut
+
+our $VERSION = '0.01';
+
+use Any::Moose 'Role';
+
+requires qw(
+ x
+ y
+);
+
+=head1 AUTHOR
+
+Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
+
+You can contact me by mail or on C<irc.perl.org> (vincent).
+
+=head1 BUGS
+
+Please report any bugs or feature requests to C<bug-latex-tikz at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=LaTeX-TikZ>.
+I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
+
+=head1 SUPPORT
+
+You can find documentation for this module with the perldoc command.
+
+    perldoc LaTeX::TikZ
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2010 Vincent Pit, all rights reserved.
+
+This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
+
+=cut
+
+1; # End of LaTeX::TikZ::Point
diff --git a/lib/LaTeX/TikZ/Scope.pm b/lib/LaTeX/TikZ/Scope.pm
new file mode 100644 (file)
index 0000000..7b2eada
--- /dev/null
@@ -0,0 +1,229 @@
+package LaTeX::TikZ::Scope;
+
+use strict;
+use warnings;
+
+=head1 NAME
+
+LaTeX::TikZ::Scope - An object modeling a TikZ scope or layer.
+
+=head1 VERSION
+
+Version 0.01
+
+=cut
+
+our $VERSION = '0.01';
+
+use Sub::Name ();
+
+use LaTeX::TikZ::Tools;
+
+use Any::Moose;
+
+has '_mods' => (
+ is       => 'ro',
+ isa      => 'Maybe[ArrayRef[LaTeX::TikZ::Mod::Formatted]]',
+ init_arg => undef,
+ default  => sub { [ ] },
+);
+
+sub mods { @{$_[0]->_mods} }
+
+has '_mods_cache' => (
+ is       => 'ro',
+ isa      => 'Maybe[HashRef[LaTeX::TikZ::Mod::Formatted]]',
+ init_arg => undef,
+ default  => sub { +{ } },
+);
+
+has '_body' => (
+ is       => 'rw',
+ isa      => 'LaTeX::TikZ::Scope|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');
+
+sub mod {
+ my $scope = shift;
+
+ my $cache = $scope->_mods_cache;
+
+ for (@_) {
+  my $mod = $ltmf_tc->check($_) ? $_ : $ltmf_tc->coerce($_);
+  my $tag = $mod->tag;
+  next if exists $cache->{$tag};
+  $cache->{$tag} = $mod;
+  push @{$scope->_mods}, $mod;
+ }
+
+ $scope;
+}
+
+sub body {
+ my $scope = shift;
+
+ if (@_) {
+  $scope->_body($_[0]);
+  $scope;
+ } else {
+  $scope->_body;
+ }
+}
+
+use overload (
+ '.'  => \&concat,
+ '""' => \&stringify,
+);
+
+sub flatten {
+ my ($scope) = @_;
+
+ do {
+  my $body = $scope->body;
+  return $scope unless $my_tc->check($body);
+  $scope = $scope->new
+                 ->mod ($scope->mods, $body->mods)
+                 ->body($body->body)
+ } while (1);
+}
+
+my $inter = Sub::Name::subname('inter' => sub {
+ my ($lh, $rh) = @_;
+
+ my (@left, @common, @right);
+ my %where;
+
+ --$where{$_} for keys %$lh;
+ ++$where{$_} for keys %$rh;
+
+ while (my ($key, $where) = each %where) {
+  if ($where < 0) {
+   push @left,   $lh->{$key};
+  } elsif ($where > 0) {
+   push @right,  $rh->{$key};
+  } else {
+   push @common, $rh->{$key};
+  }
+ }
+
+ return \@left, \@common, \@right;
+});
+
+sub concat {
+ my ($scope, $str, $rev) = @_;
+
+ $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) {
+  my $type = $_->type;
+  if ($type eq 'clip') {
+   unshift @clips, $_->content;
+  } elsif ($type eq 'layer') {
+   confess("Can't apply two layers in a row") if defined $layer;
+   $layer = $_->content;
+  } else { # raw
+   push @raw_mods, $_->content;
+  }
+ }
+
+ 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
+ }
+
+ for (0 .. $#clips) {
+  my $clip        = $clips[$_];
+  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
+ }
+
+ if (not @clips and defined $mods_string) {
+  1 while chomp $body;
+  $body = <<"  MODS";
+\\begin{scope}$mods_string
+$body
+\\end{scope}
+  MODS
+ }
+
+ if (defined $layer) {
+  1 while chomp $body;
+  $body = <<"  LAYER";
+\\begin{pgfonlayer}{$layer}
+$body
+\\end{pgfonlayer}
+  LAYER
+ }
+
+ $rev ? $str . $body : $body . $str;
+}
+
+sub stringify { $_[0]->concat('') }
+
+__PACKAGE__->meta->make_immutable;
+
+=head1 AUTHOR
+
+Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
+
+You can contact me by mail or on C<irc.perl.org> (vincent).
+
+=head1 BUGS
+
+Please report any bugs or feature requests to C<bug-latex-tikz at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=LaTeX-TikZ>.
+I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
+
+=head1 SUPPORT
+
+You can find documentation for this module with the perldoc command.
+
+    perldoc LaTeX::TikZ
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2010 Vincent Pit, all rights reserved.
+
+This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
+
+=cut
+
+1; # End of LaTeX::TikZ::Scope
diff --git a/lib/LaTeX/TikZ/Set.pm b/lib/LaTeX/TikZ/Set.pm
new file mode 100644 (file)
index 0000000..dcaab09
--- /dev/null
@@ -0,0 +1,97 @@
+package LaTeX::TikZ::Set;
+
+use strict;
+use warnings;
+
+=head1 NAME
+
+LaTeX::TikZ::Set - Base role for LaTeX::TikZ set objects.
+
+=head1 VERSION
+
+Version 0.01
+
+=cut
+
+our $VERSION = '0.01';
+
+use LaTeX::TikZ::Set::Mod;
+
+use LaTeX::TikZ::Tools;
+
+use Any::Moose 'Role';
+
+requires qw(
+ draw
+);
+
+sub mod {
+ my $set = $_[0];
+
+ return $set unless @_ > 1;
+
+ # If $set is already a Tikz::Set::Mod object, the overridden method is
+ # called instead. This ensures that you can't have two T::S::M objects in a
+ # row.
+
+ # Prepend a new set with the mods
+ my $new = LaTeX::TikZ::Set::Mod->new(
+  set  => $set,
+  mods => [ @_[1 .. $#_] ],
+ );
+
+ $_[0] = $new unless defined wantarray;
+
+ $new;
+}
+
+my $ltml_tc = LaTeX::TikZ::Tools::type_constraint('LaTeX::TikZ::Mod::Layer');
+my $ltmc_tc = LaTeX::TikZ::Tools::type_constraint('LaTeX::TikZ::Mod::Clip');
+
+sub layer {
+ return $_[0] unless @_ > 1;
+
+ my $layer = $_[1];
+
+ $_[0]->mod(
+  $ltml_tc->check($layer) ? $layer
+                          : LaTeX::TikZ::Mod::Layer->new(name => $layer)
+ )
+}
+
+sub clip {
+ return $_[0] unless @_ > 1;
+
+ $_[0]->mod(
+  map {
+   $ltmc_tc->check($_) ? $_ : LaTeX::TikZ::Mod::Clip->new($_)
+  } @_[1 .. $#_]
+ )
+}
+
+=head1 AUTHOR
+
+Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
+
+You can contact me by mail or on C<irc.perl.org> (vincent).
+
+=head1 BUGS
+
+Please report any bugs or feature requests to C<bug-latex-tikz at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=LaTeX-TikZ>.
+I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
+
+=head1 SUPPORT
+
+You can find documentation for this module with the perldoc command.
+
+    perldoc LaTeX::TikZ
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2010 Vincent Pit, all rights reserved.
+
+This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
+
+=cut
+
+1; # End of LaTeX::TikZ::Set
diff --git a/lib/LaTeX/TikZ/Set/Circle.pm b/lib/LaTeX/TikZ/Set/Circle.pm
new file mode 100644 (file)
index 0000000..c3a0ec0
--- /dev/null
@@ -0,0 +1,82 @@
+package LaTeX::TikZ::Set::Circle;
+
+use strict;
+use warnings;
+
+=head1 NAME
+
+LaTeX::TikZ::Set::Circle - A set object representing a circle.
+
+=head1 VERSION
+
+Version 0.01
+
+=cut
+
+our $VERSION = '0.01';
+
+use LaTeX::TikZ::Tools;
+
+use Any::Moose;
+use Any::Moose 'Util::TypeConstraints';
+
+with 'LaTeX::TikZ::Set::Op';
+
+has 'center' => (
+ is       => 'ro',
+ does     => 'LaTeX::TikZ::Point',
+ required => 1,
+);
+
+subtype 'LaTeX::TikZ::Set::Circle::Radius'
+     => as 'Num'
+     => where { LaTeX::TikZ::Tools::numcmp($_, 0) >= 1 }
+     => message { "$_ isn't a non-negative real number" };
+
+has 'radius' => (
+ is       => 'ro',
+ isa      => 'LaTeX::TikZ::Set::Circle::Radius',
+ required => 1,
+);
+
+sub path {
+ my $set  = shift;
+ my $tikz = $_[0];
+
+ $set->center->path(@_) . ' circle (' . $tikz->len($set->radius) . ')';
+}
+
+use LaTeX::TikZ::API circle => sub {
+ shift;
+
+ __PACKAGE__->new(center => $_[0], radius => $_[1]);
+};
+
+__PACKAGE__->meta->make_immutable;
+
+=head1 AUTHOR
+
+Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
+
+You can contact me by mail or on C<irc.perl.org> (vincent).
+
+=head1 BUGS
+
+Please report any bugs or feature requests to C<bug-latex-tikz at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=LaTeX-TikZ>.
+I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
+
+=head1 SUPPORT
+
+You can find documentation for this module with the perldoc command.
+
+    perldoc LaTeX::TikZ
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2010 Vincent Pit, all rights reserved.
+
+This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
+
+=cut
+
+1; # End of LaTeX::TikZ::Set::Circle
diff --git a/lib/LaTeX/TikZ/Set/Line.pm b/lib/LaTeX/TikZ/Set/Line.pm
new file mode 100644 (file)
index 0000000..238e1f7
--- /dev/null
@@ -0,0 +1,73 @@
+package LaTeX::TikZ::Set::Line;
+
+use strict;
+use warnings;
+
+=head1 NAME
+
+LaTeX::TikZ::Set::Line - A set object representing a line.
+
+=head1 VERSION
+
+Version 0.01
+
+=cut
+
+our $VERSION = '0.01';
+
+use Any::Moose;
+
+with 'LaTeX::TikZ::Set::Op';
+
+has 'from' => (
+ is       => 'ro',
+ does     => 'LaTeX::TikZ::Point',
+ required => 1,
+);
+
+has 'to' => (
+ is       => 'ro',
+ does     => 'LaTeX::TikZ::Point',
+ required => 1,
+);
+
+sub path {
+ my $set = shift;
+
+ $set->from->path(@_) . ' -- ' . $set->to->path(@_);
+}
+
+use LaTeX::TikZ::API line => sub {
+ shift;
+
+ __PACKAGE__->new(from => $_[0], to => $_[1]);
+};
+
+__PACKAGE__->meta->make_immutable;
+
+=head1 AUTHOR
+
+Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
+
+You can contact me by mail or on C<irc.perl.org> (vincent).
+
+=head1 BUGS
+
+Please report any bugs or feature requests to C<bug-latex-tikz at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=LaTeX-TikZ>.
+I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
+
+=head1 SUPPORT
+
+You can find documentation for this module with the perldoc command.
+
+    perldoc LaTeX::TikZ
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2010 Vincent Pit, all rights reserved.
+
+This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
+
+=cut
+
+1; # End of LaTeX::TikZ::Set::Line
diff --git a/lib/LaTeX/TikZ/Set/Mod.pm b/lib/LaTeX/TikZ/Set/Mod.pm
new file mode 100644 (file)
index 0000000..82c5510
--- /dev/null
@@ -0,0 +1,170 @@
+package LaTeX::TikZ::Set::Mod;
+
+use strict;
+use warnings;
+
+=head1 NAME
+
+LaTeX::TikZ::Set::Mod - A set object that stores modifiers to be applied underneath.
+
+=head1 VERSION
+
+Version 0.01
+
+=cut
+
+our $VERSION = '0.01';
+
+use Scope::Guard ();
+
+use LaTeX::TikZ::Tools;
+
+use LaTeX::TikZ::Scope;
+
+use Any::Moose;
+
+with qw(
+ LaTeX::TikZ::Set
+ LaTeX::TikZ::Set::Mutable
+);
+
+has '_set' => (
+ is       => 'rw',
+ does     => 'LaTeX::TikZ::Set',
+ init_arg => 'set',
+ required => 1,
+);
+
+sub set { $_[0]->_set }
+
+
+has '_mods' => (
+ is       => 'ro',
+ isa      => 'Maybe[ArrayRef[LaTeX::TikZ::Mod]]',
+ init_arg => 'mods',
+ default  => sub { [ ] },
+);
+
+sub mods { @{$_[0]->_mods} }
+
+my $ltm_tc  = LaTeX::TikZ::Tools::type_constraint('LaTeX::TikZ::Mod');
+my $ltml_tc = LaTeX::TikZ::Tools::type_constraint('LaTeX::TikZ::Mod::Layer');
+
+sub mod {
+ my $set = shift;
+
+ push @{$set->_mods},
+  map { $ltm_tc->check($_) ? $_ : $ltm_tc->coerce($_) }
+   @_;
+
+ $set;
+}
+
+sub add {
+ my $set = shift;
+
+ my $kid = $set->_set;
+ if ($kid->does('LaTeX::TikZ::Set::Mutable')) {
+  $kid->add(@_);
+ } else {
+  require LaTeX::TikZ::Set::Sequence;
+  $set->_set(LaTeX::TikZ::Set::Sequence->new(
+   kids => $kid,
+  ));
+ }
+
+ $set;
+}
+
+{
+ our %mods;
+ our $last_mod = 0;
+
+ sub mods_unique {
+  my ($set) = @_;
+
+  my (@mods, $has_layer);
+MOD:
+  for my $mod ($set->mods) {
+   $has_layer = 1 if $ltml_tc->check($mod);
+   my $tag = $mod->tag;
+   my @candidates;
+   if (defined $tag) {
+    my $old     = $mods{$tag};
+    @candidates = $old ? map $_->[0], @$old : ();
+   } else {
+    @candidates = values %mods;
+   }
+   $_->cover($mod) and next MOD for @candidates;
+   push @{$mods{$tag}}, [ $mod, $last_mod++ ];
+   push @mods,          $mod;
+  }
+
+  if ($has_layer) {
+   # Clips and mods don't propagate through layers. Hence if a layer is set,
+   # force their reuse.
+   @mods = map $_->[0], sort { $a->[1] <=> $b->[1] } map @$_, values %mods;
+  }
+
+  return @mods;
+ }
+
+ sub draw {
+  my ($set, $tikz) = @_;
+
+  local $last_mod = $last_mod;
+
+  # Save a deep copy
+  my %saved_idx = map { $_ => $#{$mods{$_}} } keys %mods;
+  my $guard     = Scope::Guard->new(sub {
+   for (keys %mods) {
+    if (exists $saved_idx{$_}) {
+     $#{$mods{$_}} = $saved_idx{$_};
+    } else {
+     delete $mods{$_};
+    }
+   }
+  });
+
+  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;
+ }
+}
+
+__PACKAGE__->meta->make_immutable;
+
+=head1 AUTHOR
+
+Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
+
+You can contact me by mail or on C<irc.perl.org> (vincent).
+
+=head1 BUGS
+
+Please report any bugs or feature requests to C<bug-latex-tikz at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=LaTeX-TikZ>.
+I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
+
+=head1 SUPPORT
+
+You can find documentation for this module with the perldoc command.
+
+    perldoc LaTeX::TikZ
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2010 Vincent Pit, all rights reserved.
+
+This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
+
+=cut
+
+1; # End of LaTeX::TikZ::Set::Mod
diff --git a/lib/LaTeX/TikZ/Set/Mutable.pm b/lib/LaTeX/TikZ/Set/Mutable.pm
new file mode 100644 (file)
index 0000000..c6e2143
--- /dev/null
@@ -0,0 +1,49 @@
+package LaTeX::TikZ::Set::Mutable;
+
+use strict;
+use warnings;
+
+=head1 NAME
+
+LaTeX::TikZ::Set::Mutable - A role for set objects that can be appended to.
+
+=head1 VERSION
+
+Version 0.01
+
+=cut
+
+our $VERSION = '0.01';
+
+use Any::Moose 'Role';
+
+requires qw(
+ add
+);
+
+=head1 AUTHOR
+
+Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
+
+You can contact me by mail or on C<irc.perl.org> (vincent).
+
+=head1 BUGS
+
+Please report any bugs or feature requests to C<bug-latex-tikz at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=LaTeX-TikZ>.
+I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
+
+=head1 SUPPORT
+
+You can find documentation for this module with the perldoc command.
+
+    perldoc LaTeX::TikZ
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2010 Vincent Pit, all rights reserved.
+
+This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
+
+=cut
+
+1; # End of LaTeX::TikZ::Set::Mutable
diff --git a/lib/LaTeX/TikZ/Set/Op.pm b/lib/LaTeX/TikZ/Set/Op.pm
new file mode 100644 (file)
index 0000000..ffd79a5
--- /dev/null
@@ -0,0 +1,55 @@
+package LaTeX::TikZ::Set::Op;
+
+use strict;
+use warnings;
+
+=head1 NAME
+
+LaTeX::TikZ::Set::Op - A role for set objects that can be part of a path.
+
+=head1 VERSION
+
+Version 0.01
+
+=cut
+
+our $VERSION = '0.01';
+
+use Any::Moose 'Role';
+
+requires qw(
+ path
+);
+
+sub draw {
+ my $set = shift;
+
+ "\\draw " . $set->path(@_) . " ;\n";
+}
+
+=head1 AUTHOR
+
+Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
+
+You can contact me by mail or on C<irc.perl.org> (vincent).
+
+=head1 BUGS
+
+Please report any bugs or feature requests to C<bug-latex-tikz at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=LaTeX-TikZ>.
+I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
+
+=head1 SUPPORT
+
+You can find documentation for this module with the perldoc command.
+
+    perldoc LaTeX::TikZ
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2010 Vincent Pit, all rights reserved.
+
+This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
+
+=cut
+
+1; # End of LaTeX::TikZ::Set::Op;
diff --git a/lib/LaTeX/TikZ/Set/Path.pm b/lib/LaTeX/TikZ/Set/Path.pm
new file mode 100644 (file)
index 0000000..319298b
--- /dev/null
@@ -0,0 +1,87 @@
+package LaTeX::TikZ::Set::Path;
+
+use strict;
+use warnings;
+
+=head1 NAME
+
+LaTeX::TikZ::Set::Path - A set object representing a path.
+
+=head1 VERSION
+
+Version 0.01
+
+=cut
+
+our $VERSION = '0.01';
+
+use LaTeX::TikZ::Tools;
+
+use Any::Moose;
+
+with qw(
+ LaTeX::TikZ::Set::Op
+ LaTeX::TikZ::Set::Mutable
+);
+
+has '_ops' => (
+ is       => 'ro',
+ isa      => 'Maybe[ArrayRef[LaTeX::TikZ::Set::Op]]',
+ init_arg => 'ops',
+ default  => sub { [ ] },
+);
+
+sub ops { @{$_[0]->_ops} }
+
+my $ltso_tc = LaTeX::TikZ::Tools::type_constraint('LaTeX::TikZ::Set::Op');
+
+sub add {
+ my $set = shift;
+
+ $ltso_tc->check($_) for @_;
+
+ push @{$_[0]->_ops}, @_;
+
+ $set;
+}
+
+sub path {
+ my $set = shift;
+
+ join ' ', map $_->path(@_), $set->ops;
+}
+
+use LaTeX::TikZ::API path => sub {
+ shift;
+
+ __PACKAGE__->new(ops => \@_);
+};
+
+__PACKAGE__->meta->make_immutable;
+
+=head1 AUTHOR
+
+Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
+
+You can contact me by mail or on C<irc.perl.org> (vincent).
+
+=head1 BUGS
+
+Please report any bugs or feature requests to C<bug-latex-tikz at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=LaTeX-TikZ>.
+I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
+
+=head1 SUPPORT
+
+You can find documentation for this module with the perldoc command.
+
+    perldoc LaTeX::TikZ
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2010 Vincent Pit, all rights reserved.
+
+This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
+
+=cut
+
+1; # End of LaTeX::TikZ::Set::Path
diff --git a/lib/LaTeX/TikZ/Set/Point.pm b/lib/LaTeX/TikZ/Set/Point.pm
new file mode 100644 (file)
index 0000000..85c35cf
--- /dev/null
@@ -0,0 +1,69 @@
+package LaTeX::TikZ::Set::Point;
+
+use strict;
+use warnings;
+
+=head1 NAME
+
+LaTeX::TikZ::Set::Point - A set object representing a point.
+
+=head1 VERSION
+
+Version 0.01
+
+=cut
+
+our $VERSION = '0.01';
+
+use Any::Moose;
+
+with 'LaTeX::TikZ::Set::Op';
+
+has 'point' => (
+ is       => 'ro',
+ does     => 'LaTeX::TikZ::Point',
+ required => 1,
+);
+
+sub path {
+ my ($set, $tikz) = @_;
+
+ my $p = $set->point;
+
+ '(' . $tikz->len($p->Re) . ',' . $tikz->len($p->Im) . ')';
+}
+
+use LaTeX::TikZ::API point => sub {
+ shift;
+
+ __PACKAGE__->new(point => $_[0]);
+};
+
+__PACKAGE__->meta->make_immutable;
+
+=head1 AUTHOR
+
+Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
+
+You can contact me by mail or on C<irc.perl.org> (vincent).
+
+=head1 BUGS
+
+Please report any bugs or feature requests to C<bug-latex-tikz at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=LaTeX-TikZ>.
+I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
+
+=head1 SUPPORT
+
+You can find documentation for this module with the perldoc command.
+
+    perldoc LaTeX::TikZ
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2010 Vincent Pit, all rights reserved.
+
+This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
+
+=cut
+
+1; # End of LaTeX::TikZ::Set::Point
diff --git a/lib/LaTeX/TikZ/Set/Raw.pm b/lib/LaTeX/TikZ/Set/Raw.pm
new file mode 100644 (file)
index 0000000..66784ea
--- /dev/null
@@ -0,0 +1,63 @@
+package LaTeX::TikZ::Set::Raw;
+
+use strict;
+use warnings;
+
+=head1 NAME
+
+LaTeX::TikZ::Set::Raw - A literal chunk of TikZ code.
+
+=head1 VERSION
+
+Version 0.01
+
+=cut
+
+our $VERSION = '0.01';
+
+use Any::Moose;
+
+with 'LaTeX::TikZ::Set::Op';
+
+has 'content' => (
+ is       => 'ro',
+ isa      => 'Str',
+ required => 1,
+);
+
+sub path { $_[0]->content }
+
+use LaTeX::TikZ::API raw => sub {
+ shift;
+
+ __PACKAGE__->new(content => join ' ', @_);
+};
+
+__PACKAGE__->meta->make_immutable;
+
+=head1 AUTHOR
+
+Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
+
+You can contact me by mail or on C<irc.perl.org> (vincent).
+
+=head1 BUGS
+
+Please report any bugs or feature requests to C<bug-latex-tikz at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=LaTeX-TikZ>.
+I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
+
+=head1 SUPPORT
+
+You can find documentation for this module with the perldoc command.
+
+    perldoc LaTeX::TikZ
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2010 Vincent Pit, all rights reserved.
+
+This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
+
+=cut
+
+1; # End of LaTeX::TikZ::Set::Raw
diff --git a/lib/LaTeX/TikZ/Set/Rectangle.pm b/lib/LaTeX/TikZ/Set/Rectangle.pm
new file mode 100644 (file)
index 0000000..0c35c9d
--- /dev/null
@@ -0,0 +1,119 @@
+package LaTeX::TikZ::Set::Rectangle;
+
+use strict;
+use warnings;
+
+=head1 NAME
+
+LaTeX::TikZ::Set::Rectangle - A set object representing a rectangle.
+
+=head1 VERSION
+
+Version 0.01
+
+=cut
+
+our $VERSION = '0.01';
+
+use Any::Moose;
+
+with 'LaTeX::TikZ::Set::Op';
+
+has 'from' => (
+ is       => 'ro',
+ does     => 'LaTeX::TikZ::Point',
+ required => 1,
+);
+
+has 'to' => (
+ is       => 'ro',
+ does     => 'LaTeX::TikZ::Point',
+ required => 1,
+);
+
+has 'width' => (
+ is  => 'ro',
+ isa => 'Num',
+);
+
+has 'height' => (
+ is  => 'ro',
+ isa => 'Num',
+);
+
+sub path {
+ my $set = shift;
+
+ $set->from->path(@_) . ' rectangle ' . $set->to->path(@_);
+}
+
+around 'BUILDARGS' => sub {
+ my $orig  = shift;
+ my $class = shift;
+
+ my $meta = __PACKAGE__->meta;
+ my $tc1  = $meta->find_attribute_by_name('from')->type_constraint;
+ my $tc2  = $meta->find_attribute_by_name('to')->type_constraint;
+
+ if (@_ == 2 and $tc1->check($_[0]) and $tc2->check($_[1])) {
+  @_ = (
+   from => $_[0],
+   to   => $_[1],
+  );
+ } else {
+  my %args = @_;
+  if (not exists $args{to}
+      and exists $args{from} and $tc1->check($args{from})) {
+   confess(<<'   MSG') unless exists $args{width} and exists $args{height};
+Attributes 'width' and 'height' are required when 'to' was not given
+   MSG
+   $meta->find_attribute_by_name($_)->type_constraint->assert_valid($args{$_})
+                                                           for qw/width height/;
+   $args{to} = $args{from}->translate($args{width}, $args{height});
+   @_ = %args;
+  }
+ }
+
+ $class->$orig(@_);
+};
+
+use LaTeX::TikZ::API rectangle => sub {
+ shift;
+ my ($p, $q) = @_;
+
+ my $is_relative = !blessed($q) && ref($q) eq 'ARRAY';
+
+ __PACKAGE__->new(
+  from => $p,
+  ($is_relative ? (width => $q->[0], height => $q->[1]) : (to => $q)),
+ );
+};
+
+__PACKAGE__->meta->make_immutable;
+
+=head1 AUTHOR
+
+Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
+
+You can contact me by mail or on C<irc.perl.org> (vincent).
+
+=head1 BUGS
+
+Please report any bugs or feature requests to C<bug-latex-tikz at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=LaTeX-TikZ>.
+I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
+
+=head1 SUPPORT
+
+You can find documentation for this module with the perldoc command.
+
+    perldoc LaTeX::TikZ
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2010 Vincent Pit, all rights reserved.
+
+This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
+
+=cut
+
+1; # End of LaTeX::TikZ::Set::Rectangle
diff --git a/lib/LaTeX/TikZ/Set/Sequence.pm b/lib/LaTeX/TikZ/Set/Sequence.pm
new file mode 100644 (file)
index 0000000..3f14bb7
--- /dev/null
@@ -0,0 +1,99 @@
+package LaTeX::TikZ::Set::Sequence;
+
+use strict;
+use warnings;
+
+=head1 NAME
+
+LaTeX::TikZ::Set::Sequence - A set object grouping a sequence of objects.
+
+=head1 VERSION
+
+Version 0.01
+
+=cut
+
+our $VERSION = '0.01';
+
+use List::Util ();
+
+use Any::Moose;
+use Any::Moose 'Util::TypeConstraints'
+               => [ qw/subtype as where find_type_constraint/ ];
+
+with qw(
+ LaTeX::TikZ::Set
+ LaTeX::TikZ::Set::Mutable
+);
+
+subtype 'LaTeX::TikZ::Set::Sequence::Elements'
+     => as 'Object'
+     => where {
+             $_->does('LaTeX::TikZ::Set::Op')
+          or $_->isa('LaTeX::TikZ::Set::Sequence')
+          or $_->isa('LaTeX::TikZ::Set::Mod')
+     };
+
+has '_kids' => (
+ is       => 'ro',
+ isa      => 'Maybe[ArrayRef[LaTeX::TikZ::Set::Sequence::Elements]]',
+ init_arg => 'kids',
+ default  => sub { [ ] },
+);
+
+sub kids { @{$_[0]->_kids} }
+
+my $ltsse_tc = find_type_constraint('LaTeX::TikZ::Set::Sequence::Elements');
+
+sub add {
+ my $set = shift;
+
+ $ltsse_tc->assert_valid($_) for @_;
+
+ push @{$set->_kids}, @_;
+
+ $set;
+}
+
+sub draw {
+ my $set = shift;
+
+ List::Util::reduce { $a . $b } map $_->draw(@_), $set->kids;
+}
+
+use LaTeX::TikZ::API seq => sub {
+ shift;
+
+ die 'wut' if $_[0]->isa('LaTeX::TikZ::Set::Op');
+
+ __PACKAGE__->new(kids => \@_);
+};
+
+__PACKAGE__->meta->make_immutable;
+
+=head1 AUTHOR
+
+Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
+
+You can contact me by mail or on C<irc.perl.org> (vincent).
+
+=head1 BUGS
+
+Please report any bugs or feature requests to C<bug-latex-tikz at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=LaTeX-TikZ>.
+I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
+
+=head1 SUPPORT
+
+You can find documentation for this module with the perldoc command.
+
+    perldoc LaTeX::TikZ
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2010 Vincent Pit, all rights reserved.
+
+This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
+
+=cut
+
+1; # End of LaTeX::TikZ::Set::Sequence
diff --git a/lib/LaTeX/TikZ/Tools.pm b/lib/LaTeX/TikZ/Tools.pm
new file mode 100644 (file)
index 0000000..9a33324
--- /dev/null
@@ -0,0 +1,68 @@
+package LaTeX::TikZ::Tools;
+
+use strict;
+use warnings;
+
+=head1 NAME
+
+LaTeX::TikZ::Tools - Miscellanous tools for LaTeX::TikZ classes.
+
+=head1 VERSION
+
+Version 0.01
+
+=cut
+
+our $VERSION = '0.01';
+
+use Any::Moose 'Util::TypeConstraints' => [ 'find_type_constraint' ];
+
+use constant EPS => 1e-10;
+
+sub numeq { abs($_[0] - $_[1]) < EPS }
+
+sub numcmp { $_[0] < $_[1] - EPS ? -1 : $_[0] > $_[1] + EPS ? 1 : 0 }
+
+sub numround {
+ my $x = $_[0];
+ my $i = int $x;
+ $x + EPS < $i + 0.5 ? $i : $i + 1;
+}
+
+sub type_constraint {
+ my ($class) = @_;
+
+ my $file = $class;
+ $file =~ s{::}{/}g;
+ $file .= '.pm';
+ require $file;
+
+ find_type_constraint($class);
+}
+
+=head1 AUTHOR
+
+Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
+
+You can contact me by mail or on C<irc.perl.org> (vincent).
+
+=head1 BUGS
+
+Please report any bugs or feature requests to C<bug-latex-tikz at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=LaTeX-TikZ>.
+I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
+
+=head1 SUPPORT
+
+You can find documentation for this module with the perldoc command.
+
+    perldoc LaTeX::TikZ
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2010 Vincent Pit, all rights reserved.
+
+This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
+
+=cut
+
+1; # End of LaTeX::TikZ::Tools
diff --git a/t/00-load.t b/t/00-load.t
new file mode 100644 (file)
index 0000000..79d5bdd
--- /dev/null
@@ -0,0 +1,46 @@
+#!perl -T
+
+use strict;
+use warnings;
+
+use Test::More tests => 28;
+
+BEGIN {
+ use_ok( 'LaTeX::TikZ' );
+ use_ok( 'LaTeX::TikZ::API' );
+ use_ok( 'LaTeX::TikZ::Formatter' );
+ use_ok( 'LaTeX::TikZ::Mod' );
+ use_ok( 'LaTeX::TikZ::Mod::Clip' );
+ use_ok( 'LaTeX::TikZ::Mod::Color' );
+ use_ok( 'LaTeX::TikZ::Mod::Fill' );
+ use_ok( 'LaTeX::TikZ::Mod::Formatted' );
+ use_ok( 'LaTeX::TikZ::Mod::Layer' );
+ use_ok( 'LaTeX::TikZ::Mod::Pattern' );
+ use_ok( 'LaTeX::TikZ::Mod::Pattern::Dots' );
+ use_ok( 'LaTeX::TikZ::Mod::Pattern::Lines' );
+ use_ok( 'LaTeX::TikZ::Mod::Raw' );
+ use_ok( 'LaTeX::TikZ::Mod::Width' );
+ use_ok( 'LaTeX::TikZ::Point' );
+ use_ok( 'LaTeX::TikZ::Scope' );
+ use_ok( 'LaTeX::TikZ::Set' );
+ use_ok( 'LaTeX::TikZ::Set::Circle' );
+ use_ok( 'LaTeX::TikZ::Set::Line' );
+ use_ok( 'LaTeX::TikZ::Set::Mod' );
+ use_ok( 'LaTeX::TikZ::Set::Mutable' );
+ use_ok( 'LaTeX::TikZ::Set::Op' );
+ use_ok( 'LaTeX::TikZ::Set::Path' );
+ use_ok( 'LaTeX::TikZ::Set::Point' );
+ use_ok( 'LaTeX::TikZ::Set::Raw' );
+ use_ok( 'LaTeX::TikZ::Set::Rectangle' );
+ use_ok( 'LaTeX::TikZ::Set::Sequence' );
+ use_ok( 'LaTeX::TikZ::Tools' );
+}
+
+diag( "Testing LaTeX::TikZ $LaTeX::TikZ::VERSION, Perl $], $^X" );
+
+use Any::Moose;
+
+my $moose   = any_moose();
+my $version = do { no strict 'refs'; ${$moose . '::VERSION'} };
+
+diag( "Any::Moose uses $moose $version" );
diff --git a/t/91-pod.t b/t/91-pod.t
new file mode 100644 (file)
index 0000000..ee8b18a
--- /dev/null
@@ -0,0 +1,12 @@
+#!perl -T
+
+use strict;
+use warnings;
+use Test::More;
+
+# Ensure a recent version of Test::Pod
+my $min_tp = 1.22;
+eval "use Test::Pod $min_tp";
+plan skip_all => "Test::Pod $min_tp required for testing POD" if $@;
+
+all_pod_files_ok();