From: Vincent Pit Date: Tue, 20 Jul 2010 19:33:37 +0000 (+0200) Subject: Make Points into a real class X-Git-Tag: v0.01~38 X-Git-Url: http://git.vpit.fr/?a=commitdiff_plain;h=abde159aad84169c3dbf1aabd21c9d1bf81acf85;p=perl%2Fmodules%2FLaTeX-TikZ.git Make Points into a real class And autoload type coercions when needed. --- diff --git a/MANIFEST b/MANIFEST index 41853b7..5a07244 100644 --- a/MANIFEST +++ b/MANIFEST @@ -6,6 +6,7 @@ README 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 @@ -18,6 +19,7 @@ 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/Point/Math/Complex.pm lib/LaTeX/TikZ/Scope.pm lib/LaTeX/TikZ/Set.pm lib/LaTeX/TikZ/Set/Circle.pm @@ -32,6 +34,7 @@ lib/LaTeX/TikZ/Set/Sequence.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 diff --git a/Makefile.PL b/Makefile.PL index 5402691..cb0515a 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -15,6 +15,7 @@ my %PREREQ_PM = ( 'Any::Moose' => 0, 'Carp' => 0, 'List::Util' => 0, + 'Mouse' => '0.63', # register_type_constraint 'Scope::Guard' => 0, 'Sub::Name' => 0, 'constant' => 0, diff --git a/lib/LaTeX/TikZ/Meta/TypeConstraint/Autocoerce.pm b/lib/LaTeX/TikZ/Meta/TypeConstraint/Autocoerce.pm new file mode 100644 index 0000000..4706998 --- /dev/null +++ b/lib/LaTeX/TikZ/Meta/TypeConstraint/Autocoerce.pm @@ -0,0 +1,137 @@ +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<< >>, 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::Meta::TypeConstraint::Autocoerce diff --git a/lib/LaTeX/TikZ/Point.pm b/lib/LaTeX/TikZ/Point.pm index f2155e8..3c24469 100644 --- a/lib/LaTeX/TikZ/Point.pm +++ b/lib/LaTeX/TikZ/Point.pm @@ -5,7 +5,7 @@ use warnings; =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 @@ -15,13 +15,42 @@ Version 0.01 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<< >>, L. diff --git a/lib/LaTeX/TikZ/Point/Math/Complex.pm b/lib/LaTeX/TikZ/Point/Math/Complex.pm new file mode 100644 index 0000000..b09dbce --- /dev/null +++ b/lib/LaTeX/TikZ/Point/Math/Complex.pm @@ -0,0 +1,60 @@ +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<< >>, 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::Math::Complex diff --git a/lib/LaTeX/TikZ/Set/Point.pm b/lib/LaTeX/TikZ/Set/Point.pm index 2c613d8..58fb28c 100644 --- a/lib/LaTeX/TikZ/Set/Point.pm +++ b/lib/LaTeX/TikZ/Set/Point.pm @@ -15,14 +15,17 @@ Version 0.01 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 { @@ -30,7 +33,7 @@ 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 { diff --git a/t/00-load.t b/t/00-load.t index 301e307..4eac5ce 100644 --- a/t/00-load.t +++ b/t/00-load.t @@ -3,12 +3,13 @@ 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' ); @@ -21,6 +22,7 @@ BEGIN { 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' ); diff --git a/t/11-point.t b/t/11-point.t new file mode 100644 index 0000000..c7f53cd --- /dev/null +++ b/t/11-point.t @@ -0,0 +1,44 @@ +#!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