<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">package Viewport;
#####################################################
### Copyright (c) 2002 Russell B Cecala. All rights
### reserved.  This program is free software; you can
### redistribute it and/or modify it under the same 
### terms as Perl itself.
#####################################################
use strict;
use Exporter;

use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);

$VERSION     = 0.01;
@ISA         = qw(Exporter);
@EXPORT      = ();
@EXPORT_OK   = qw(&amp;new);
%EXPORT_TAGS = ( DEFAULT =&gt; [qw(&amp;new)],
                   Both    =&gt; [qw(&amp;new)]);
use constant BIG =&gt; 1.0e+30;

sub new  {
	my ($pkg) = @_;
	bless {
		_xmin 	=&gt;  BIG,
		_ymin 	=&gt;  BIG,
		_xmax 	=&gt; -1 * BIG,
		_ymax 	=&gt; -1 * BIG,
		_xC 	=&gt; 0,
		_yC 	=&gt; 0,
		_XC 	=&gt; 0,
		_YC 	=&gt; 0,
		_f  	=&gt; 0,
		_windowset =&gt; 0
	}, $pkg;
}
sub getxmin { my $obj = shift; return $obj-&gt;{_xmin}; }
sub getymin { my $obj = shift; return $obj-&gt;{_ymin}; }

sub getxmax { my $obj = shift; return $obj-&gt;{_xmax}; }
sub getymax { my $obj = shift; return $obj-&gt;{_ymax}; }

sub getxC   { my $obj = shift; return $obj-&gt;{_xC};   }
sub getyC   { my $obj = shift; return $obj-&gt;{_yC};   }

sub getXC   { my $obj = shift; return $obj-&gt;{_XC};   }
sub getYC   { my $obj = shift; return $obj-&gt;{_YC};   }
sub getf    { my $obj = shift; return $obj-&gt;{_f};    }
sub getwindowset    { my $obj = shift; return $obj-&gt;{_windowset};    }

sub setxmin { my $obj = shift; my $v = shift; $obj-&gt;{_xmin} = $v; }
sub setymin { my $obj = shift; my $v = shift; $obj-&gt;{_ymin} = $v; }

sub setxmax { my $obj = shift; my $v = shift; $obj-&gt;{_xmax} = $v; }
sub setymax { my $obj = shift; my $v = shift; $obj-&gt;{_ymax} = $v; }

sub setxC   { my $obj = shift; my $v = shift; $obj-&gt;{_xC}   = $v; }
sub setyC   { my $obj = shift; my $v = shift; $obj-&gt;{_yC}   = $v; }

sub setXC   { my $obj = shift; my $v = shift; $obj-&gt;{_XC}   = $v; }
sub setYC   { my $obj = shift; my $v = shift; $obj-&gt;{_YC}   = $v; }
sub setf    { my $obj = shift; my $v = shift; $obj-&gt;{_f}    = $v; }
sub setwindowset    { my $obj = shift; my $v = shift; $obj-&gt;{_windowset}    = $v; }

sub resetwindow { 
	my $obj = shift; 
	$obj-&gt;setxmin( BIG );
	$obj-&gt;setymin( BIG );
	$obj-&gt;setxmax( -1 * BIG );
	$obj-&gt;setymax( -1 * BIG );
	$obj-&gt;setxC( 0 );
	$obj-&gt;setyC( 0 );
	$obj-&gt;setXC( 0 );
	$obj-&gt;setYC( 0 );
	$obj-&gt;setf( 0 );
}

sub updatewindowboundaries {
	my $obj = shift;
	my $x	= shift;
	my $y	= shift;
	my $xmin = $obj-&gt;getxmin();
	my $xmax = $obj-&gt;getxmax();
	my $ymin = $obj-&gt;getymin();
	my $ymax = $obj-&gt;getymax();
	if ($x &lt; $xmin) { $obj-&gt;setxmin( $x ); }
	if ($x &gt; $xmax) { $obj-&gt;setxmax( $x ); }
	if ($y &lt; $ymin) { $obj-&gt;setymin( $y ); }
	if ($y &gt; $ymax) { $obj-&gt;setymax( $y ); }
	$obj-&gt;setwindowset( 1 );
}

sub viewportboundaries {
	my $obj 		= shift;
	my $Xmin		= shift;
	my $Xmax		= shift;
	my $Ymin		= shift;
	my $Ymax		= shift;
	my $reductionfactor 	= shift;
	my $xmin = $obj-&gt;getxmin();
	my $xmax = $obj-&gt;getxmax();
	my $ymin = $obj-&gt;getymin();
	my $ymax = $obj-&gt;getymax();
	my ( $fx, $fy );
	my $windowset = $obj-&gt;getwindowset();
	if ( $windowset == 0 ) {
		die "Viewport::updatewindowboundaries() has not been called\n";
	}
		
	$obj-&gt;setXC( 0.5 * ( $Xmin + $Xmax ));
	$obj-&gt;setYC( 0.5 * ( $Ymin + $Ymax ));
	$fx = ($Xmax-$Xmin) / ( $xmax - $xmin + 1.0E-7);
	$fy = ($Ymax-$Ymin) / ( $ymax - $ymin + 1.0E-7);
	$obj-&gt;setf( $reductionfactor * ($fx&lt;$fy?$fx:$fy));
	$obj-&gt;setxC( 0.5 * ( $xmin + $xmax ));
	$obj-&gt;setyC( 0.5 * ( $ymin + $ymax ));
}

sub x_viewport {
	my $obj = shift;
	my $x 	= shift;
	my $xC	= $obj-&gt;getxC();
	my $XC	= $obj-&gt;getXC();
	my $f	= $obj-&gt;getf();
	my $rc 	= $XC + $f * ($x - $xC);
	return $rc;
}

sub y_viewport {
	my $obj = shift;
	my $y 	= shift;
	my $yC	= $obj-&gt;getyC();
	my $YC	= $obj-&gt;getYC();
	my $f	= $obj-&gt;getf();
	my $rc  = $YC + $f * ($yC-$y);
	#works but upside down my $rc  = $YC + $f * ($y-$yC);
	return $rc;
}

sub print {
	my $obj = shift;
	print  	"$obj-&gt;{_xmin}:$obj-&gt;{_ymin}:" .
		"$obj-&gt;{_xmax}:$obj-&gt;{_ymax}:" .
		"$obj-&gt;{_xC}:$obj-&gt;{_yC}:$obj-&gt;{_XC}:" .
		"$obj-&gt;{_YC}:$obj-&gt;{_f}\n";
}

1;
</pre></body></html>