X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=lib%2FLaTeX%2FTikZ%2FSet%2FRectangle.pm;h=79dda06e264f662f83eb6c26bf916f300c250cac;hb=af7d6a5aef3bf5fec0c187b3a13a14adc88251fd;hp=08cba5a7034e315a3ef77fc2a64e771dd6daad7d;hpb=d3c71e26ff4759bbd943d85b4b054b1dc883df29;p=perl%2Fmodules%2FLaTeX-TikZ.git diff --git a/lib/LaTeX/TikZ/Set/Rectangle.pm b/lib/LaTeX/TikZ/Set/Rectangle.pm index 08cba5a..79dda06 100644 --- a/lib/LaTeX/TikZ/Set/Rectangle.pm +++ b/lib/LaTeX/TikZ/Set/Rectangle.pm @@ -17,6 +17,9 @@ our $VERSION = '0.01'; use LaTeX::TikZ::Set::Point; +use LaTeX::TikZ::Interface; +use LaTeX::TikZ::Functor; + use Any::Moose; with 'LaTeX::TikZ::Set::Op'; @@ -72,7 +75,7 @@ Attributes 'width' and 'height' are required when 'to' was not given MSG $args{from} = $tc1->coerce($args{from}); $meta->find_attribute_by_name($_)->type_constraint->assert_valid($args{$_}) - for qw/width height/; + for qw/from width height/; my $p = $args{from}->point; $args{to} = LaTeX::TikZ::Point->new( x => $p->x + $args{width}, @@ -85,17 +88,26 @@ Attributes 'width' and 'height' are required when 'to' was not given $class->$orig(@_); }; -use LaTeX::TikZ::Interface rectangle => sub { - shift; - my ($p, $q) = @_; +LaTeX::TikZ::Interface->register( + rectangle => sub { + shift; + my ($p, $q) = @_; - my $is_relative = !blessed($q) && ref($q) eq 'HASH'; + my $is_relative = !blessed($q) && ref($q) eq 'HASH'; - __PACKAGE__->new( - from => $p, - ($is_relative ? (map +($_ => $q->{$_}), qw/width height/) : (to => $q)), - ); -}; + __PACKAGE__->new( + from => $p, + ($is_relative ? (map +($_ => $q->{$_}), qw/width height/) : (to => $q)), + ); + }, +); + +LaTeX::TikZ::Functor->default_rule( + (__PACKAGE__) => sub { + my ($functor, $set, @args) = @_; + $set->new(map { $_ => $set->$_->$functor(@args) } qw/from to/) + } +); __PACKAGE__->meta->make_immutable;