CAD::Drawing::Calculate::Finite - Vector graphics and limited space.

  (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)

  CAD::Drawing

  $scale = $drw->fit_to_bound(\@bound, \@border, \%opts);

  @bound arg is a rectangle ([0,0],[11,8.5]) 

  @border is ([$left_sp, $bottom_sp], [$right_sp, $top_sp])

  %opts are weird

  $drw->get_clip_points($addr);

  $drw->get_world_clip_points($addr);

  $drw->get_image_rectangle($addr);

  $drw->get_world_image_rectangle();

  $drw->drw_to_img(\@point, $addr);

  $drw->img_to_drw(\@pixel, $addr);

package CAD::Drawing::Calculate::Finite;
our $VERSION = '0.06';

# use CAD::Drawing;
use CAD::Drawing::Defined;


use warnings;
use strict;
use Carp;
########################################################################

########################################################################

sub fit_to_bound {	
	my $self = shift;
	my ($bound, $border, $opt) = @_;
	my @bound = @$bound; # required argument
	my @border;
	if(ref($border) eq "ARRAY") {
		@border = @$border;
# 		print "calculating adjustment for border @border\n";
# 		print "working with bound of @bound\n";
# 		print "border consists of $border[0][0], $border[0][1],",  
#				"as well as $border[1][0] and $border[1][1]\n";exit;
		for(my $pt =0; $pt <scalar(@border); $pt++) {
			foreach my $c (0,1) {
				$bound[$pt][$c] += $border[$pt][$c];
			}
		}
	}
	my (@just_pt, @center, @from_pt, @use_ext);
	my ($world_ptx, $world_pty, $scale);
	my %opts;
	if(ref($opt) eq "HASH") {
		%opts = %$opt;
		if($opts{scale}) {
			$scale = $opts{scale};
# 			print "got scale option $scale\n";
		}
		if($opts{justify}) {
			@just_pt = @{$opts{justify}};
		}
		if($opts{from}) {
			@from_pt = @{$opts{from}};
			$scale or croak("must have scale to use",
 				"\"from\" option in fit_to_bound\n");
		}
		if($opts{center}) {
			@center = @{$opts{center}};
		}
		if($opts{use_extents}) {
			# XXX experimental and undocumented
			@use_ext = @{$opts{use_extents}};
		}
		
	}
	# Method is to scale and then move to fit into the given boundary
	# Calculate orthographic extents of real-world geometry
	unless($scale && (@from_pt)) {
		# XXX undocumented config:
		my @realbound = (@use_ext ? @use_ext : $self->OrthExtents());
# 		print "got boundary of @realbound\n";
# 		print "this translates to @{$realbound[0]} and @{$realbound[1]}\n";
		# Calculate height and width of real-world bounding box
		my $width_world = $realbound[0][1] - $realbound[0][0];
		$world_ptx = $realbound[0][0] + $width_world / 2;
		my $height_world = $realbound[1][1] - $realbound[1][0];
		$world_pty = $realbound[1][0] + $height_world / 2;
# 		print "calculated world size of $width_world,$height_world\n";
# 		print "calculated world center of $world_ptx,$world_pty\n";
		unless($scale) {
			# Calculate height and width of finite-space (given) bounding box
			my $width_finite = $bound[1][0] - $bound[0][0];
			my $height_finite = $bound[1][1] - $bound[0][1];
			# Calculate scale factor (least of the two quotients)
			$scale = (sort({$a<=>$b} 
					($width_finite / $width_world), 
					($height_finite / $height_world) ) )[0];
		}
	}
	else {
		($world_ptx, $world_pty) = @from_pt;
	}
	# Apply scaling
    # print "scaling by factor of $scale using point $world_ptx, $world_pty\n";
	$self->GroupScale($scale, [$world_ptx, $world_pty]);
	# Apply movement: 
	unless(@center) {
		@center = map({($bound[0][$_] + $bound[1][$_]) / 2} 0,1);
	}
	my $movex = $center[0] - $world_ptx;
	my $movey = $center[1] - $world_pty;
	# print "moving by $movex, $movey\n";
	# print "trying to reach center @center\n";
	if(@just_pt) { # paper covers rock
		$movex = $just_pt[0] - $world_ptx;
		$movey = $just_pt[1] - $world_pty;
	}
	$self->GroupMove([$movex, $movey]);
	return($scale);
} # end subroutine fit_to_bound definition
########################################################################

sub get_clip_points {
	my $self = shift;
	my ($addr) = @_;
	($addr->{type} eq "images") or croak("not an image\n");
	my $obj = $self->getobj($addr);
	if($obj->{clipping}) {
		my @imgpoints = @{$obj->{clipping}};
		my @points;
		my $num = scalar(@imgpoints);
		if($num == 2) {
			my @x = sort({$a<=>$b} $imgpoints[0][0], $imgpoints[1][0]);
			my @y = sort({$a<=>$b} $imgpoints[0][1], $imgpoints[1][1]);
			@points = (	# make a polyline that is ccw from lower left
					[ $x[0], $y[1] ], 
					[ $x[1], $y[1] ],
					[ $x[1], $y[0] ],
					[ $x[0], $y[0] ]
					);
		}
		elsif($num > 2) {
			for(my $pt = 0; $pt < $num; $pt++) {
				$points[$pt] = [@{$imgpoints[$pt]}];
			}
		}
		else {
			return();
		}
#        $image_debug && print "yes have points @points\n";
		return(@points);	
	}
	else {
		# just give the extents pixels
		my @points = $self->get_image_rectangle($addr);
		return(@points);
	}
} # end subroutine get_clip_points definition
########################################################################

sub get_world_clip_points {
	my $self = shift;
	my ($addr) = @_;
	my @points = $self->get_clip_points($addr);
	if(@points) {
		@points = map({[$self->img_to_drw($_, $addr)]} @points);
		return(@points);
	}
	return();
} # end subroutine get_world_clip_points definition
########################################################################

sub get_image_rectangle {
	my $self = shift;
	my $addr = shift;
	($addr->{type} eq "images") or croak("not an image\n");
	my $obj = $self->getobj($addr);
	my @points = (
		[0, $obj->{size}[1]],
		[@{$obj->{size}}], 
		[$obj->{size}[0], 0],
		[0,0]
		);
	return(@points);
} # end subroutine get_image_rectangle definition
########################################################################

sub get_world_image_rectangle {
	my $self = shift;
	my $addr = shift;
	($addr->{type} eq "images") or croak("not an image\n");
	my @points = map({[$self->img_to_drw($_, $addr)]}
		$self->get_image_rectangle($addr)
		);
	return(@points);
} # end subroutine get_world_image_rectangle definition
########################################################################

sub drw_to_img {
	my $self = shift;
	my ($pt, $addr) = @_;
	my $obj = $self->getobj($addr);
	$obj or croak ("no image at $addr->{layer}, $addr->{id}");
	my @point = @$pt;
	my $nx = ($point[0] - $obj->{pt}[0] ) / $obj->{vector}[0][0];
	my $ny = $obj->{size}[1] - 
			($point[1] - $obj->{pt}[1] ) / $obj->{vector}[1][1];
	return($nx, $ny);
} # end subroutine drw_to_img definition
########################################################################

sub img_to_drw {
	my $self = shift;
	my ($pixel, $addr) = @_;
	my $obj = $self->getobj($addr);
	$obj or croak ("no image at $addr->{layer}, $addr->{id}");
	my @point = @$pixel;
	my $px = ($point[0] - 0.5) * $obj->{vector}[0][0] + $obj->{pt}[0];
	my $py = $obj->{pt}[1] + 
			($obj->{size}[1] - $point[1]+0.5) * $obj->{vector}[1][1];
	return($px,$py);
} # end subroutine img_to_drw definition
########################################################################
1;