And autoload type coercions when needed.
lib/LaTeX/TikZ.pm
lib/LaTeX/TikZ/Formatter.pm
lib/LaTeX/TikZ/Interface.pm
+lib/LaTeX/TikZ/Meta/TypeConstraint/Autocoerce.pm
lib/LaTeX/TikZ/Mod.pm
lib/LaTeX/TikZ/Mod/Clip.pm
lib/LaTeX/TikZ/Mod/Color.pm
lib/LaTeX/TikZ/Mod/Raw.pm
lib/LaTeX/TikZ/Mod/Width.pm
lib/LaTeX/TikZ/Point.pm
+lib/LaTeX/TikZ/Point/Math/Complex.pm
lib/LaTeX/TikZ/Scope.pm
lib/LaTeX/TikZ/Set.pm
lib/LaTeX/TikZ/Set/Circle.pm
t/00-load.t
t/01-api.t
t/10-set.t
+t/11-point.t
t/20-mod.t
t/21-layer.t
t/22-clip.t
'Any::Moose' => 0,
'Carp' => 0,
'List::Util' => 0,
+ 'Mouse' => '0.63', # register_type_constraint
'Scope::Guard' => 0,
'Sub::Name' => 0,
'constant' => 0,
--- /dev/null
+package LaTeX::TikZ::Meta::TypeConstraint::Autocoerce;
+
+use strict;
+use warnings;
+
+=head1 NAME
+
+LaTeX::TikZ::Meta::TypeConstraint::Autocoerce - Type constraint metaclass that autoloads type coercions.
+
+=head1 VERSION
+
+Version 0.01
+
+=cut
+
+our $VERSION = '0.01';
+
+use Sub::Name ();
+
+use Any::Moose;
+
+extends any_moose('Meta::TypeConstraint');
+
+has 'mapper' => (
+ is => 'ro',
+ isa => 'CodeRef',
+);
+
+has 'parent_name' => (
+ is => 'ro',
+ isa => 'ClassName',
+ required => 1,
+);
+
+has 'user_constraint' => (
+ is => 'ro',
+ isa => 'Maybe[CodeRef]',
+ required => 1,
+);
+
+around 'new' => sub {
+ my ($orig, $class, %args) = @_;
+
+ unless (exists $args{mapper}) {
+ $args{mapper} = sub { join '::', $_[0]->parent_name, $_[1] };
+ }
+
+ my $parent = delete $args{parent};
+ $args{parent_name} = defined $parent
+ ? (blessed($parent) ? $parent->name : $parent)
+ : '__ANON__';
+
+ $args{user_constraint} = $args{constraint};
+
+ if (any_moose() eq 'Moose') {
+ $args{coercion} = Moose::Meta::TypeCoercion->new;
+ }
+
+ my $parent_name = $args{parent_name};
+ $parent_name =~ s/::+/_/g;
+
+ my $tc;
+ $args{constraint} = Sub::Name::subname("${parent_name}_load" => sub {
+ my ($thing) = @_;
+
+ # First, try a possible user defined constraint
+ my $user = $tc->user_constraint;
+ if (defined $user) {
+ my $ok = $user->($thing);
+ return 1 if $ok;
+ }
+
+ # When ->check is called inside coerce, a return value of 0 means that
+ # coercion should take place, while 1 signifies that the value is already
+ # OK.
+
+ my $class = blessed($thing);
+ return 0 unless $class;
+ return 1 if $class->isa($tc->parent_name);
+
+ my $mapper = $tc->mapper;
+ my $pm = $class = $tc->$mapper($class);
+
+ $pm =~ s{::}{/}g;
+ $pm .= '.pm';
+ return 0 if $INC{$pm}; # already loaded
+
+ local $@;
+ eval { require $pm; 1 };
+
+ return 0;
+ });
+
+ $tc = $class->$orig(%args);
+};
+
+around 'coerce' => sub {
+ my ($orig, $tc, $thing) = @_;
+
+ # The original coerce gets an hold onto the type coercions *before* calling
+ # the constraint. Thus, we have to force the loading before recalling into
+ # $orig. This is achieved by calling ->check.
+ return $thing if $tc->check($thing);
+
+ $tc->$orig($thing);
+};
+
+__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::Meta::TypeConstraint::Autocoerce
=head1 NAME
-LaTeX::TikZ::Point - Interface role for what LaTeX::TikZ consider as 2D points.
+LaTeX::TikZ::Point - Internal representation of what LaTeX::TikZ consider as 2D points.
=head1 VERSION
our $VERSION = '0.01';
-use Any::Moose 'Role';
+use Any::Moose;
+use Any::Moose 'Util::TypeConstraints' => [ qw/
+ coerce
+ from
+ via
+ find_type_constraint
+ register_type_constraint
+/ ];
+
+has 'x' => (
+ is => 'ro',
+ isa => 'Num',
+ required => 1,
+);
+
+has 'y' => (
+ is => 'ro',
+ isa => 'Num',
+ required => 1,
+);
-requires qw(
- x
- y
+use LaTeX::TikZ::Meta::TypeConstraint::Autocoerce;
+
+register_type_constraint(
+ LaTeX::TikZ::Meta::TypeConstraint::Autocoerce->new(
+ name => 'LaTeX::TikZ::Point::Autocoerce',
+ parent => find_type_constraint(__PACKAGE__),
+ ),
);
+coerce 'LaTeX::TikZ::Point::Autocoerce'
+ => from 'LaTeX::TikZ::Point'
+ => via { $_ };
+
+__PACKAGE__->meta->make_immutable;
+
=head1 AUTHOR
Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
--- /dev/null
+package LaTeX::TikZ::Point::Math::Complex;
+
+use strict;
+use warnings;
+
+=head1 NAME
+
+LaTeX::TikZ::Point::Math::Complex - Coerce Math::Complex points into LaTeX::TikZ::Point objects.
+
+=head1 VERSION
+
+Version 0.01
+
+=cut
+
+our $VERSION = '0.01';
+
+use Math::Complex;
+
+use LaTeX::TikZ::Point;
+
+use Any::Moose 'Util::TypeConstraints' => [ qw/
+ class_type
+ coerce
+ from
+ via
+/ ];
+
+my $mc_tc = class_type 'Math::Complex';
+
+coerce 'LaTeX::TikZ::Point::Autocoerce'
+ => from 'Math::Complex'
+ => via { LaTeX::TikZ::Point->new(x => $_->Re, y => $_->Im); };
+
+=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::Math::Complex
our $VERSION = '0.01';
+use LaTeX::TikZ::Point;
+
use Any::Moose;
with 'LaTeX::TikZ::Set::Op';
has 'point' => (
is => 'ro',
- does => 'LaTeX::TikZ::Point',
+ does => 'LaTeX::TikZ::Point::Autocoerce',
required => 1,
+ coerce => 1,
);
sub path {
my $p = $set->point;
- '(' . $tikz->len($p->Re) . ',' . $tikz->len($p->Im) . ')';
+ '(' . $tikz->len($p->x) . ',' . $tikz->len($p->y) . ')';
}
use LaTeX::TikZ::Interface point => sub {
use strict;
use warnings;
-use Test::More tests => 27;
+use Test::More tests => 29;
BEGIN {
use_ok( 'LaTeX::TikZ' );
use_ok( 'LaTeX::TikZ::Formatter' );
use_ok( 'LaTeX::TikZ::Interface' );
+ use_ok(' LaTeX::TikZ::Meta::TypeConstraint::Autocoerce' );
use_ok( 'LaTeX::TikZ::Mod' );
use_ok( 'LaTeX::TikZ::Mod::Clip' );
use_ok( 'LaTeX::TikZ::Mod::Color' );
use_ok( 'LaTeX::TikZ::Mod::Raw' );
use_ok( 'LaTeX::TikZ::Mod::Width' );
use_ok( 'LaTeX::TikZ::Point' );
+ use_ok( 'LaTeX::TikZ::Point::Math::Complex' );
use_ok( 'LaTeX::TikZ::Scope' );
use_ok( 'LaTeX::TikZ::Set' );
use_ok( 'LaTeX::TikZ::Set::Circle' );
--- /dev/null
+#!perl -T
+
+use strict;
+use warnings;
+
+use Test::More tests => 1 + 2 * 1;
+
+use Math::Complex;
+
+use LaTeX::TikZ;
+
+my $tikz = Tikz->formatter(
+ format => '%d',
+);
+
+sub check {
+ my ($set, $desc, $exp) = @_;
+
+ local $Test::Builder::Level = $Test::Builder::Level + 1;
+
+ my ($head, $decl, $body) = eval {
+ $tikz->render(ref $set eq 'ARRAY' ? @$set : $set);
+ };
+ is $@, '', "$desc: no error";
+
+ unless (ref $exp eq 'ARRAY') {
+ $exp = [ split /\n/, $exp ];
+ }
+ unshift @$exp, '\begin{tikzpicture}';
+ push @$exp, '\end{tikzpicture}';
+
+ is_deeply $body, $exp, $desc;
+}
+
+my $z = Math::Complex->make(1, 2);
+
+my $p = eval {
+ Tikz->point($z);
+};
+is $@, '', 'creating a point from a Math::Complex object doesn\'t croak';
+
+check $p, 'a point from a Math::Complex object', <<'RES';
+\draw (1cm,2cm) ;
+RES
projects / perl / modules / LaTeX-TikZ.git / commitdiff