From: Vincent Pit Date: Wed, 21 Jul 2010 10:36:30 +0000 (+0200) Subject: Fix Rectangle constructor arguments X-Git-Tag: v0.01~32 X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2FLaTeX-TikZ.git;a=commitdiff_plain;h=d3c71e26ff4759bbd943d85b4b054b1dc883df29 Fix Rectangle constructor arguments --- diff --git a/lib/LaTeX/TikZ/Set/Rectangle.pm b/lib/LaTeX/TikZ/Set/Rectangle.pm index ddb66fc..08cba5a 100644 --- a/lib/LaTeX/TikZ/Set/Rectangle.pm +++ b/lib/LaTeX/TikZ/Set/Rectangle.pm @@ -51,14 +51,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], @@ -66,14 +66,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}); + my $p = $args{from}->point; + $args{to} = LaTeX::TikZ::Point->new( + x => $p->x + $args{width}, + y => $p->y + $args{height}, + ); @_ = %args; } } @@ -85,11 +89,11 @@ 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)), ); };