CAD::Drawing::Manipulate - Manipulate CAD::Drawing objects
Index
Code Index:
NAME
CAD::Drawing::Manipulate - Manipulate CAD::Drawing objects
Description
Move, Copy, Scale, Mirror, and Rotate methods for single entities and
groups of entities.
AUTHOR
Eric L. Wilhelm <ewilhelm at cpan dot org>
http://scratchcomputing.com
COPYRIGHT
This module is copyright (C) 2004-2006 by Eric L. Wilhelm. Portions
copyright (C) 2003 by Eric L. Wilhelm and A. Zahner Co.
LICENSE
This module is distributed under the same terms as Perl. See the Perl
source package for details.
You may use this software under one of the following licenses:
(1) GNU General Public License
(found at http://www.gnu.org/copyleft/gpl.html)
(2) Artistic License
(found at http://www.perl.com/pub/language/misc/Artistic.html)
NO WARRANTY
This software is distributed with ABSOLUTELY NO WARRANTY. The author,
his former employer, and any other contributors will in no way be held
liable for any loss or damages resulting from its use.
Modifications
The source code of this module is made freely available and
distributable under the GPL or Artistic License. Modifications to and
use of this software must adhere to one of these licenses. Changes to
the code should be noted as such and this notification (as well as the
above copyright information) must remain intact on all copies of the
code.
Additionally, while the author is actively developing this code,
notification of any intended changes or extensions would be most helpful
in avoiding repeated work for all parties involved. Please contact the
author with any such development plans.
Group Methods
These methods are called with required values, followed by a hash
reference of option values. Note the difference between this and the
individual entity manipulation syntax shown below. The absence of an
\%options hash reference implies everything in the drawing.
For details about each of the group manipulation methods, see the
corresponding individual entity manipulation method.
Options
The $opts value shown for each of the group manipulation methods is fed
directly to CAD::Drawing::select_addr(). See the documentation for
this function for additional details.
One of the most common methods of selection (after the implicit all)
may be the explicit list of addresses. This is done by simply passing
an array reference rather than a hash reference.
GroupMove
Move selected entities by @dist.
$drw->GroupMove(\@dist, $opts);
GroupCopy
Returns a list of addresses for newly created entities.
@new = $drw->GroupCopy(\@dist, $opts);
GroupClone
Returns a list of addresses for newly created entities.
@new = $drw->GroupClone($dest, $opts);
place
Clones items from $source into $drw and moves them to @pt. Selects items according to %opts and optionally rotates them by $opts{ang} (given in radians.)
$drw->place($source, \@pt, \%opts);
GroupMirror
Mirrors the entities specified by %options (see select_addr()) across
@axis.
@new = $drw->GroupMirror(\@axis, \%options);
GroupScale
Sorry, \@pt is required here.
$drw->GroupScale($factor, \@pt, \%opts);
GroupRotate
Rotates specified entities by $angle. A center point may be specified
via $opts{pt} = \@pt.
$drw->GroupRotate($angle, \%opts);
Individual Methods
Move
Moves entity at $addr by @dist (@dist may be three-dimensional.)
$drw->Move($addr, \@dist);
Copy
$drw->Copy($addr, \@dist);
Clone
Clones the entity at $addr into drawing $dest.
$drw->Clone($addr, $dest, \%opts);
%opts may contain:
to_layer => $layer_name, # layer to clone into
Mirror
Mirrors entity specified by $addr across @axis.
Returns the address of the manipulated entity. If $opts{copy} is true,
will clone the entity, otherwise modify in-place.
$drw->Mirror($addr, \@axis, \%opts);
Scale
$drw->Scale($addr, $factor, \@pt);
Rotate
Rotates entity specified by $addr by $angle (+ccw radians) about @pt.
Angle may be in degrees if $angle =~ s/d$// returns a true value (but I
hope the "d" is the only thing on the end, because I'm not looking for
anything beyond that.) $angle = "45" . "d" will get converted, but
$angle = "45" . "bad" will be called 0. Remember, this is Perl:)
$drw->Rotate($addr, $angle, \@pt);
Internal Functions
pointrotate
Internal use only.
($x, $y) = pointrotate($x, $y, $ang, $xc, $yc);
pointmirror
@point = pointmirror($axis, $pt);
angle_of
Polygon Methods
These don't do anything yet and need to be moved to another module anyway.
CutPline
IntPline
intersect_pgon
package CAD::Drawing::Manipulate;
our $VERSION = '0.12';
# use CAD::Drawing;
use CAD::Drawing::Defined;
use CAD::Drawing::Manipulate::Transform;
our @ISA = qw(
CAD::Drawing::Manipulate::Transform
);
use Math::Geometry::Planar;
use CAD::Calc qw(signdist);
use vars qw(
%movefunc
@mirrorfunc
@scalefunc
@rotatefunc
);
use warnings;
use strict;
use Carp;
########################################################################
########################################################################
########################################################################
sub GroupMove {
my $self = shift;
my ($dist, $opts) = @_;
my $retref = $self->select_addr($opts);
foreach my $addr (@$retref) {
$self->Move($addr, $dist);
}
} # end subroutine GroupMove definition
########################################################################
sub GroupCopy {
my $self = shift;
my ($dist, $opts) = @_;
my $retref = $self->select_addr($opts);
my @outlist;
foreach my $addr (@$retref) {
push(@outlist, $self->Copy($addr, $dist));
}
return(@outlist);
} # end subroutine GroupCopy definition
########################################################################
sub GroupClone {
my $self = shift;
my ($dest, $opts) = @_;
my $retref = $self->select_addr($opts);
my @outlist;
foreach my $addr (@$retref) {
push(@outlist, $self->Clone($addr, $dest, $opts));
}
return(@outlist);
} # end subroutine GroupClone definition
########################################################################
sub place {
my $self = shift;
my ($source, $pt, $opts) = @_;
my %options;
(ref($opts) eq "HASH") && (%options = %$opts);
my @newlist = $source->GroupClone($self, $opts);
if($options{ang}) {
$self->GroupRotate($options{ang}, \@newlist);
}
$self->GroupMove($pt, \@newlist);
# print "worked\n";
return(@newlist);
} # end subroutine place definition
########################################################################
sub GroupMirror {
my $self = shift;
my ($axis, $opts) = @_;
my $retref = $self->select_addr($opts);
my @outlist;
foreach my $addr (@$retref) {
push(@outlist, $self->Mirror($addr, $axis, $opts));
}
return(@outlist);
} # end subroutine GroupMirror definition
########################################################################
sub GroupScale {
my $self = shift;
my ($factor, $pt, $opts) = @_;
my $retref = $self->select_addr($opts);
foreach my $addr (@$retref) {
$self->Scale($addr, $factor, $pt);
}
} # end subroutine GroupScale definition
########################################################################
sub GroupRotate {
my $self = shift;
my ($angle, $opts) = @_;
my %opt;
(ref($opts) eq "HASH") && (%opt = %$opts);
my @pt = (0,0);
$opt{pt} && (@pt = @{$opt{pt}});
my $retref = $self->select_addr($opts);
foreach my $addr (@$retref) {
$self->Rotate($addr, $angle, \@pt);
}
} # end subroutine GroupRotate definition
########################################################################
########################################################################
sub Move {
my $self = shift;
my ($addr, $dist) = @_;
my $obj = $self->getobj($addr);
my $mv_this = $call_syntax{$addr->{type}}[1];
$movefunc{$mv_this}->($obj->{$mv_this}, $dist);
} # end subroutine Move definition
########################################################################
%movefunc = (
"pt" => sub {
my($pt, $dist) = @_;
foreach my $c (0..2) {
$pt->[$c] += $dist->[$c];
}
}, # end subroutine $movefunc{pt} definition
"pts" => sub {
my($pts, $dist) = @_;
for(my $i = 0; $i < @$pts; $i++) {
foreach my $c (0..2) {
$pts->[$i][$c] += $dist->[$c];
}
}
}, # end subroutine $movefunc{pts} definition
); # end %movefunc function hash definition
########################################################################
sub Copy {
my $self = shift;
my ($addr, $dist) = @_;
$addr = $self->Clone($addr);
$self->Move($addr, $dist);
return($addr);
} # end subroutine Copy definition
########################################################################
sub Clone {
my $self = shift;
my ($addr, $dest, $opts) = @_;
my %opts;
(defined($dest)) || ($dest = $self);
if(ref($opts) eq "HASH") {
%opts = %$opts;
}
my $type = $addr->{type};
my $obj = $self->getobj($addr);
$obj or croak("no object for $addr->{layer} $addr->{type} $addr->{id}");
# first gather the required arguments
my @args;
my @argstrings = (@{$call_syntax{$type}});
my $function = shift(@argstrings);
# uses the object's current contents as the options hash
my %optarg = %{$obj};
foreach my $argstring ( @argstrings) {
push(@args, $obj->{$argstring});
delete($optarg{$argstring});
}
# now build the rest of the options hash
$optarg{layer} = $addr->{layer};
defined($opts{"to layer"}) &&
($optarg{"layer"} = $opts{"to layer"}); # DEPRECATED!
defined($opts{"to_layer"}) &&
($optarg{"layer"} = $opts{"to_layer"});
delete($optarg{addr});
# print "layer cloned: $obj->{layer}\n";
$addr = $dest->$function(@args, \%optarg);
# print "landed on $addr->{layer}\n";
return($addr);
} # end subroutine Clone definition
########################################################################
sub Mirror {
my $self = shift;
my ($addr, $axis, $opts) = @_;
my %opts;
(ref($opts) eq "HASH") && (%opts = %$opts);
$opts{copy} && ($addr = $self->Clone($addr));
my $type = $addr->{type};
my $obj = $self->getobj($addr);
my $stg = $call_syntax{$type}[1];
$mirrorfunc[0]{$stg}->($obj->{$stg}, $axis);
my $syn_len = scalar(@{$call_syntax{$type}});
for(my $i = 2; $i < $syn_len; $i++) {
$stg = $call_syntax{$type}[$i];
$mirrorfunc[1]{$stg} && $mirrorfunc[1]{$stg}->($obj, $axis);
}
return($addr);
} # end subroutine Mirror definition
########################################################################
@mirrorfunc = (
{ # First hash for stage-1 operations
"pt" => sub {
my($pt, $axis) = @_;
@{$pt} = pointmirror($axis, $pt);
}, # end subroutine $mirror[0]{pt} definition
"pts" => sub {
my($pts, $axis) = @_;
for(my $i = 0; $i < @$pts; $i++) {
@{$pts->[$i]} = pointmirror($axis, $pts->[$i]);
}
}, # end subroutine $mirror[0]{pts} definition
}, # end %{$mirrorfunc[0]} hash definition
{ # Second hash for stage-2 operations
"angs" => sub {
my($obj, $axis) = @_;
my $a_ang = angle_of($axis);
# printf("angle: %0.4f\n", $a_ang * 180 / $pi);
# printf("s: %0.4f\n", $obj->{angs}[0] * 180 / $pi);
# printf("e: %0.4f\n", $obj->{angs}[1] * 180 / $pi);
$obj->{angs}[0] = $a_ang + ($a_ang - $obj->{angs}[0]);
$obj->{angs}[1] = $a_ang + ($a_ang - $obj->{angs}[1]);
@{$obj->{angs}} = reverse(@{$obj->{angs}});
checkarcangs($obj->{angs});
# printf("now s: %0.4f\n", $obj->{angs}[0] * 180 / $pi);
# printf("now e: %0.4f\n", $obj->{angs}[1] * 180 / $pi);
}, # end subroutine $mirrorfunc[1]{rad} definition
}, # end %{$mirrorfunc[1]} hash definition
); # end @mirrorfunc array definition
########################################################################
sub Scale {
my $self = shift;
my ($addr, $factor, $pt) = @_;
my $obj = $self->getobj($addr);
my $domove = (defined($pt->[0]) or defined($pt->[1]));
$domove && ($self->Move($addr, [map({-$_} @$pt)]));
my $stg = $call_syntax{$addr->{type}}[1];
$scalefunc[0]{$stg}->($obj->{$stg}, $factor);
# my $syn_len = scalar(@{$call_syntax{$addr->{type}}});
# for(my $i = 2; $i < $syn_len; $i++) {
# $stg = $call_syntax{$addr->{type}}[$i];
## print "looking for $stg for $addr->{type}\n";
## $scalefunc[1]{$stg} && print "ok, found it\n";
# $scalefunc[1]{$stg} && $scalefunc[1]{$stg}->($obj, $factor);
# }
foreach my $key ( keys(%{$scalefunc[1]})) {
defined($obj->{$key}) && $scalefunc[1]{$key}->($obj, $factor);
}
$domove && ($self->Move($addr, $pt));
} # end subroutine Scale definition
########################################################################
@scalefunc = (
{ # First hash for stage-1 operations
"pt" => sub {
my($pt, $factor) = @_;
foreach my $c (0..2) {
$pt->[$c] *= $factor;
}
}, # end subroutine $scalefunc[0]{pt} definition
"pts" => sub {
my($pts, $factor) = @_;
for(my $i = 0; $i < @$pts; $i++) {
foreach my $c (0..2) {
$pts->[$i][$c] *= $factor;
}
}
}, # end subroutine $scalefunc[0]{pts} definition
}, # end %{$scalefunc[0]} hash definition
{ # Second hash for stage-2 operations
"rad" => sub {
my($hashref, $factor) = @_;
$hashref->{rad} *= $factor;
}, # end subroutine $scalefunc[1]{rad} definition
"height" => sub {
my($hashref, $factor) = @_;
$hashref->{height} *= $factor;
}, # end subroutine $scalefunc[1]{height} definition
}, # end %{$scalefunc[1]} hash definition
); # end @scalefunc array definition
########################################################################
sub Rotate {
my $self = shift;
my ($addr, $angle, $pt) = @_;
(ref($pt) eq "ARRAY") || ($pt = [0,0]);
my $obj = $self->getobj($addr);
my $type = $addr->{type};
if($angle =~ s/d$//) {
# allow spec of angle in degrees with $angle . "d";
$angle *= $pi / 180;
}
my $stg = $call_syntax{$type}[1];
$rotatefunc[0]{$stg}->($obj->{$stg}, $angle, $pt);
my $syn_len = scalar(@{$call_syntax{$type}});
for(my $i = 2; $i < $syn_len; $i++) {
$stg = $call_syntax{$type}[$i];
$rotatefunc[1]{$stg} && $rotatefunc[1]{$stg}->($obj,$angle, $pt);
}
} # end subroutine Rotate definition
########################################################################
@rotatefunc = (
{ # First hash for stage-1 operations
"pt" => sub {
my($pt, $angle, $cpt) = @_;
@{$pt}[0,1] = pointrotate(@{$pt}[0,1], $angle, @{$cpt});
}, # end subroutine $rotatefunc[0]{pt} definition
"pts" => sub {
my($pts, $angle, $cpt) = @_;
for(my $i = 0; $i < @$pts; $i++) {
@{$pts->[$i]}[0,1] =
pointrotate(@{$pts->[$i]}[0,1],$angle, @{$cpt});
}
}, # end subroutine $rotatefunc[0]{pts} definition
}, # end %{$rotatefunc[0]} hash definition
{ # Second hash for stage-2 operations
"angs" => sub {
my($hashref, $angle) = @_;
foreach my $ang (0, 1) {
$hashref->{angs}[$ang] += $angle;
}
checkarcangs($hashref->{angs});
}, # end subroutine $rotatefunc[1]{angs} definition
# NOTE: I'm ignoring the vector on images and rotation
# angle of text for now
}, # end %{$rotatefunc[1]} hash definition
); # end @rotatefunc array definition
########################################################################
########################################################################
sub pointrotate {
my ($x, $y, $ang, $xc, $yc) = @_;
my $xn = $xc + cos($ang) * ($x - $xc) - sin($ang) * ($y - $yc);
my $yn = $yc + sin($ang) * ($x - $xc) + cos($ang) * ($y - $yc);
return($xn, $yn);
} # end subroutine pointrotate definition
########################################################################
sub pointmirror {
my ($axis, $pt) = @_;
# print "axis: ", join(" ", map({join(",", @{$_})} @{$axis}[0,1])), "\n";
# print "point: ", join(",", @{$pt}), "\n";
my $foot = PerpendicularFoot([ @{$axis}[0,1], $pt ]);
# print "foot: @$foot\n";
my $x = $foot->[0] - ($pt->[0] - $foot->[0]);
my $y = $foot->[1] - ($pt->[1] - $foot->[1]);
return($x, $y);
} # end subroutine pointmirror definition
########################################################################
sub angle_of {
my ($axis) = @_;
my @delta = signdist(@{$axis});
return(atan2($delta[1], $delta[0]));
} # end subroutine angle_of definition
########################################################################
########################################################################
sub CutPline {
my $self = shift;
} # end subroutine CutPline definition
########################################################################
sub IntPline {
my $self = shift;
} # end subroutine IntPline definition
########################################################################
sub intersect_pgon {
} # end subroutine intersect_pgon definition
########################################################################
1;