X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=lib%2FLaTeX%2FTikZ%2FSet%2FRectangle.pm;h=f70595d6d075670edb7b2fbc59c6c4dd78c7ddb2;hb=92147217516a40b35ca00c8e08939e8aa5478426;hp=88af295a570f21ec08cab917a3044279e7f7595d;hpb=5adf00c880491bac3bd793a07431cf161c03643f;p=perl%2Fmodules%2FLaTeX-TikZ.git diff --git a/lib/LaTeX/TikZ/Set/Rectangle.pm b/lib/LaTeX/TikZ/Set/Rectangle.pm index 88af295..f70595d 100644 --- a/lib/LaTeX/TikZ/Set/Rectangle.pm +++ b/lib/LaTeX/TikZ/Set/Rectangle.pm @@ -15,20 +15,26 @@ Version 0.01 our $VERSION = '0.01'; +use LaTeX::TikZ::Set::Point; + +use LaTeX::TikZ::Functor; + use Any::Moose; with 'LaTeX::TikZ::Set::Op'; has 'from' => ( is => 'ro', - does => 'LaTeX::TikZ::Point', + isa => 'LaTeX::TikZ::Set::Point', required => 1, + coerce => 1, ); has 'to' => ( is => 'ro', - does => 'LaTeX::TikZ::Point', + isa => 'LaTeX::TikZ::Set::Point', required => 1, + coerce => 1, ); has 'width' => ( @@ -47,14 +53,14 @@ sub path { $set->from->path(@_) . ' rectangle ' . $set->to->path(@_); } +my $meta = __PACKAGE__->meta; +my $tc1 = $meta->find_attribute_by_name('from')->type_constraint; +my $tc2 = $meta->find_attribute_by_name('to')->type_constraint; + 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], @@ -62,14 +68,18 @@ around 'BUILDARGS' => sub { ); } else { my %args = @_; - if (not exists $args{to} - and exists $args{from} and $tc1->check($args{from})) { + if (not exists $args{to} and exists $args{from}) { confess(<<' MSG') unless exists $args{width} and exists $args{height}; 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/; - $args{to} = $args{from}->translate($args{width}, $args{height}); + for qw/from width height/; + my $p = $args{from}->point; + $args{to} = LaTeX::TikZ::Point->new( + x => $p->x + $args{width}, + y => $p->y + $args{height}, + ); @_ = %args; } } @@ -81,14 +91,21 @@ use LaTeX::TikZ::Interface rectangle => sub { shift; my ($p, $q) = @_; - my $is_relative = !blessed($q) && ref($q) eq 'ARRAY'; + my $is_relative = !blessed($q) && ref($q) eq 'HASH'; __PACKAGE__->new( from => $p, - ($is_relative ? (width => $q->[0], height => $q->[1]) : (to => $q)), + ($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; =head1 AUTHOR