From: Vincent Pit Date: Sat, 17 Jul 2010 22:01:46 +0000 (+0200) Subject: Initial commit X-Git-Tag: v0.01~63 X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2FLaTeX-TikZ.git;a=commitdiff_plain;h=e8f0879ade07eed4f58cd52c0771f4e1ecc90b09 Initial commit --- e8f0879ade07eed4f58cd52c0771f4e1ecc90b09 diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..f14afad --- /dev/null +++ b/.gitignore @@ -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 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 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 index 0000000..e69de29 diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..5402691 --- /dev/null +++ b/Makefile.PL @@ -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 ', + 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 index 0000000..e69de29 diff --git a/lib/LaTeX/TikZ.pm b/lib/LaTeX/TikZ.pm new file mode 100644 index 0000000..713aff8 --- /dev/null +++ b/lib/LaTeX/TikZ.pm @@ -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<< >>, L. + +You can contact me by mail or on C (vincent). + +=head1 BUGS + +Please report any bugs or feature requests to C, or through the web interface at L. +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 index 0000000..c16adc8 --- /dev/null +++ b/lib/LaTeX/TikZ/API.pm @@ -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<< >>, L. + +You can contact me by mail or on C (vincent). + +=head1 BUGS + +Please report any bugs or feature requests to C, or through the web interface at L. +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 index 0000000..88bda48 --- /dev/null +++ b/lib/LaTeX/TikZ/Formatter.pm @@ -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<< >>, L. + +You can contact me by mail or on C (vincent). + +=head1 BUGS + +Please report any bugs or feature requests to C, or through the web interface at L. +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 index 0000000..dbee13d --- /dev/null +++ b/lib/LaTeX/TikZ/Mod.pm @@ -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<< >>, L. + +You can contact me by mail or on C (vincent). + +=head1 BUGS + +Please report any bugs or feature requests to C, or through the web interface at L. +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 index 0000000..5fdac3d --- /dev/null +++ b/lib/LaTeX/TikZ/Mod/Clip.pm @@ -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<< >>, L. + +You can contact me by mail or on C (vincent). + +=head1 BUGS + +Please report any bugs or feature requests to C, or through the web interface at L. +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 index 0000000..53fe411 --- /dev/null +++ b/lib/LaTeX/TikZ/Mod/Color.pm @@ -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<< >>, L. + +You can contact me by mail or on C (vincent). + +=head1 BUGS + +Please report any bugs or feature requests to C, or through the web interface at L. +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 index 0000000..8d350d7 --- /dev/null +++ b/lib/LaTeX/TikZ/Mod/Fill.pm @@ -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<< >>, L. + +You can contact me by mail or on C (vincent). + +=head1 BUGS + +Please report any bugs or feature requests to C, or through the web interface at L. +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 index 0000000..5bda247 --- /dev/null +++ b/lib/LaTeX/TikZ/Mod/Formatted.pm @@ -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<< >>, L. + +You can contact me by mail or on C (vincent). + +=head1 BUGS + +Please report any bugs or feature requests to C, or through the web interface at L. +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 index 0000000..f8d57a2 --- /dev/null +++ b/lib/LaTeX/TikZ/Mod/Layer.pm @@ -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<< >>, L. + +You can contact me by mail or on C (vincent). + +=head1 BUGS + +Please report any bugs or feature requests to C, or through the web interface at L. +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 index 0000000..89af81d --- /dev/null +++ b/lib/LaTeX/TikZ/Mod/Pattern.pm @@ -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<< >>, L. + +You can contact me by mail or on C (vincent). + +=head1 BUGS + +Please report any bugs or feature requests to C, or through the web interface at L. +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 index 0000000..3fea8a6 --- /dev/null +++ b/lib/LaTeX/TikZ/Mod/Pattern/Dots.pm @@ -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<< >>, L. + +You can contact me by mail or on C (vincent). + +=head1 BUGS + +Please report any bugs or feature requests to C, or through the web interface at L. +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 index 0000000..494817a --- /dev/null +++ b/lib/LaTeX/TikZ/Mod/Pattern/Lines.pm @@ -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<< >>, L. + +You can contact me by mail or on C (vincent). + +=head1 BUGS + +Please report any bugs or feature requests to C, or through the web interface at L. +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 index 0000000..e7ff0fd --- /dev/null +++ b/lib/LaTeX/TikZ/Mod/Raw.pm @@ -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<< >>, L. + +You can contact me by mail or on C (vincent). + +=head1 BUGS + +Please report any bugs or feature requests to C, or through the web interface at L. +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 index 0000000..bc6ad70 --- /dev/null +++ b/lib/LaTeX/TikZ/Mod/Width.pm @@ -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<< >>, L. + +You can contact me by mail or on C (vincent). + +=head1 BUGS + +Please report any bugs or feature requests to C, or through the web interface at L. +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 index 0000000..f2155e8 --- /dev/null +++ b/lib/LaTeX/TikZ/Point.pm @@ -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<< >>, L. + +You can contact me by mail or on C (vincent). + +=head1 BUGS + +Please report any bugs or feature requests to C, or through the web interface at L. +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 index 0000000..7b2eada --- /dev/null +++ b/lib/LaTeX/TikZ/Scope.pm @@ -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<< >>, L. + +You can contact me by mail or on C (vincent). + +=head1 BUGS + +Please report any bugs or feature requests to C, or through the web interface at L. +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 index 0000000..dcaab09 --- /dev/null +++ b/lib/LaTeX/TikZ/Set.pm @@ -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<< >>, L. + +You can contact me by mail or on C (vincent). + +=head1 BUGS + +Please report any bugs or feature requests to C, or through the web interface at L. +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 index 0000000..c3a0ec0 --- /dev/null +++ b/lib/LaTeX/TikZ/Set/Circle.pm @@ -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<< >>, L. + +You can contact me by mail or on C (vincent). + +=head1 BUGS + +Please report any bugs or feature requests to C, or through the web interface at L. +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 index 0000000..238e1f7 --- /dev/null +++ b/lib/LaTeX/TikZ/Set/Line.pm @@ -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<< >>, L. + +You can contact me by mail or on C (vincent). + +=head1 BUGS + +Please report any bugs or feature requests to C, or through the web interface at L. +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 index 0000000..82c5510 --- /dev/null +++ b/lib/LaTeX/TikZ/Set/Mod.pm @@ -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<< >>, L. + +You can contact me by mail or on C (vincent). + +=head1 BUGS + +Please report any bugs or feature requests to C, or through the web interface at L. +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 index 0000000..c6e2143 --- /dev/null +++ b/lib/LaTeX/TikZ/Set/Mutable.pm @@ -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<< >>, L. + +You can contact me by mail or on C (vincent). + +=head1 BUGS + +Please report any bugs or feature requests to C, or through the web interface at L. +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 index 0000000..ffd79a5 --- /dev/null +++ b/lib/LaTeX/TikZ/Set/Op.pm @@ -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<< >>, L. + +You can contact me by mail or on C (vincent). + +=head1 BUGS + +Please report any bugs or feature requests to C, or through the web interface at L. +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 index 0000000..319298b --- /dev/null +++ b/lib/LaTeX/TikZ/Set/Path.pm @@ -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<< >>, L. + +You can contact me by mail or on C (vincent). + +=head1 BUGS + +Please report any bugs or feature requests to C, or through the web interface at L. +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 index 0000000..85c35cf --- /dev/null +++ b/lib/LaTeX/TikZ/Set/Point.pm @@ -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<< >>, L. + +You can contact me by mail or on C (vincent). + +=head1 BUGS + +Please report any bugs or feature requests to C, or through the web interface at L. +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 index 0000000..66784ea --- /dev/null +++ b/lib/LaTeX/TikZ/Set/Raw.pm @@ -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<< >>, L. + +You can contact me by mail or on C (vincent). + +=head1 BUGS + +Please report any bugs or feature requests to C, or through the web interface at L. +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 index 0000000..0c35c9d --- /dev/null +++ b/lib/LaTeX/TikZ/Set/Rectangle.pm @@ -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<< >>, L. + +You can contact me by mail or on C (vincent). + +=head1 BUGS + +Please report any bugs or feature requests to C, or through the web interface at L. +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 index 0000000..3f14bb7 --- /dev/null +++ b/lib/LaTeX/TikZ/Set/Sequence.pm @@ -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<< >>, L. + +You can contact me by mail or on C (vincent). + +=head1 BUGS + +Please report any bugs or feature requests to C, or through the web interface at L. +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 index 0000000..9a33324 --- /dev/null +++ b/lib/LaTeX/TikZ/Tools.pm @@ -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<< >>, L. + +You can contact me by mail or on C (vincent). + +=head1 BUGS + +Please report any bugs or feature requests to C, or through the web interface at L. +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 index 0000000..79d5bdd --- /dev/null +++ b/t/00-load.t @@ -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 index 0000000..ee8b18a --- /dev/null +++ b/t/91-pod.t @@ -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();