<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">package Clip2;
#####################################################
### 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);
use Tk;

$VERSION     = 0.01;
@ISA         = qw(Exporter);
@EXPORT      = ();
@EXPORT_OK   = qw(&amp;new);
#%EXPORT_TAGS = ( DEFAULT =&gt; [qw(&amp;new &amp;setclipboundaries &amp;getxmin &amp;getymin &amp;getxmax &amp;getymax )],
%EXPORT_TAGS = ( DEFAULT =&gt; [qw(&amp;new)],
                   Both    =&gt; [qw(&amp;new)]);

sub new  {
	my ($pkg,$x1,$y1,$x2,$y2) = @_;
	bless {
		_xmin 	=&gt; $x1,
		_ymin 	=&gt; $y1,
		_xmax 	=&gt; $x2,
		_ymax 	=&gt; $y2
	}, $pkg;
}

sub setclipboundaries {
	my $obj 	= shift;
	my $x1		= shift;	
	my $y1		= shift;	
	my $x2		= shift;	
	my $y2		= shift;
	$obj-&gt;{_xmin} = $x1;
	$obj-&gt;{_ymin} = $y1;
	$obj-&gt;{_xmax} = $x2;
	$obj-&gt;{_ymax} = $y2;
}

sub code {
	my $obj = shift;
	my $x	= shift;
	my $y	= shift;

	return 	(($x&lt;$obj-&gt;getxmin())&lt;&lt;3) | (($x&gt;$obj-&gt;getxmax())&lt;&lt;2) |
		(($y&lt;$obj-&gt;getymin())&lt;&lt;1) | ($y&gt;$obj-&gt;getymax());
}

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 gettag { my $obj = shift; return $obj-&gt;{_tag}; }
sub getclipboundaries { 
	my $obj = shift; 
	my @xy = ( 
		$obj-&gt;getxmin(), 
		$obj-&gt;getymin(),
		$obj-&gt;getxmax(), 
		$obj-&gt;getymax()
	);
	return @xy;
}

sub cliped {
	my $obj = shift;
	my $xP 	= shift;
	my $yP 	= shift;
	my $xQ 	= shift;
	my $yQ 	= shift;
	my $cP 	= $obj-&gt;code( $xP, $yP );
	my $cQ 	= $obj-&gt;code( $xQ, $yQ );
	my $xmin = $obj-&gt;getxmin(); 
	my $xmax = $obj-&gt;getxmax(); 
	my $ymin = $obj-&gt;getymin(); 
	my $ymax = $obj-&gt;getymax(); 
	while( $cP | $cQ ) {
		if( $cP &amp; $cQ ) { return 0; }
		my $dx = $xQ - $xP;
		my $dy = $yQ - $yP;
		if ( $cP ) {
			if    ( $cP &amp; 8 ) { $yP += ( $xmin-$xP)*$dy/$dx; $xP=$xmin; }
			elsif ( $cP &amp; 4 ) { $yP += ( $xmax-$xP)*$dy/$dx; $xP=$xmax; }
			elsif ( $cP &amp; 2 ) { $xP += ( $ymin-$yP)*$dx/$dy; $yP=$ymin; }
			elsif ( $cP &amp; 1 ) { $xP += ( $ymax-$yP)*$dx/$dy; $yP=$ymax; }
			$cP = $obj-&gt;code( $xP, $yP );
		} else {
			if    ( $cQ &amp; 8 ) { $yQ += ( $xmin-$xQ)*$dy/$dx; $xQ=$xmin; }
			elsif ( $cQ &amp; 4 ) { $yQ += ( $xmax-$xQ)*$dy/$dx; $xQ=$xmax; }
			elsif ( $cQ &amp; 2 ) { $xQ += ( $ymin-$yQ)*$dx/$dy; $yQ=$ymin; }
			elsif ( $cQ &amp; 1 ) { $xQ += ( $ymax-$yQ)*$dx/$dy; $yQ=$ymax; }
			$cQ = $obj-&gt;code( $xQ, $yQ );
		} # end if
	} # end while
	return 1;
}

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