FYI, for future reference you can include each of your packages in a block inside a BEGIN block (and don't "use Package") so that your packages are available in a single file. For stuff like this it makes distributing the code a bit easier. I've modified your code accordingly (just removed the "Use Clip2;" etc. and added BEGIN{} around the packages.
#!/usr/bin/perl -w
#####################################################
### 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 lib ('.');
use Tk;
use Tk::Canvas;
use Math::Trig;
#use Vector2D;
#use Viewport;
#use Clip2;
use Getopt::Std;
my $width = 500;
my $height = 500;
my $background = 'blue';
my $fill = 'yellow';
my $initialX = 0;
my $initialY = 800;
my $gravity = new Vector2D(0, 1.62);
my $acceleration = new Vector2D(0, 20.0);
my $LanderVelocity = new Vector2D(0, 0 );
my $staticWindow = 0;
my $crashSpeed = 10.0;
my $crashSlope = 0.0;
my $fuel = 20;
my %opts = ();
getopts( 'W:H:b:f:F:g:x:y:X:Y:a:c:s:Sh', \%opts );
if( $opts{W} ) { $width = $opts{W} ; }
if( $opts{H} ) { $height = $opts{H} ; }
if( $opts{b} ) { $background = $opts{b} ; }
if( $opts{f} ) { $fill = $opts{f} ; }
if( $opts{F} ) { $fuel = $opts{F} ; }
if( $opts{x} ) { $initialX = $opts{x} ; }
if( $opts{y} ) { $initialY = $opts{y} ; }
if( $opts{g} ) { $gravity ->sety ($opts{g}) ; }
if( $opts{a} ) { $acceleration ->sety ($opts{a}) ; }
if( $opts{X} ) { $LanderVelocity->setx ($opts{X}) ; }
if( $opts{Y} ) { $LanderVelocity->sety ($opts{Y}) ; }
if( $opts{c} ) { $crashSpeed = $opts{c}; }
if( $opts{s} ) { $crashSlope = $opts{s}; }
if( $opts{S} ) { $staticWindow = 1; }
if( $opts{h} ) { &usage; exit;}
sub usage {
print <<USAGE;
-W <canvas width> Default is 500
-H <canvas height> Default is 500
-b <background color> Default is blue
-f <foreground color> Default is yellow
-F <fuel> Default is 20
-x <initail x position> Default is 0
-y <initail y position> Default is 800
-g <gravity> Default is 1.62 (the moon)
-a <engine thrust> Default is 20
-X <initail X velocity> Default is 0
-Y <initail Y velocity> Default is 0
-c <crash velocity> Default is 10
-s <landing slope tolerance> Default is 0
-S do not resize scene (ship may leave screen)
-h print this message
How to play:
pressing 'k' fires main thruster.
pressing 'j' rotates lander counter-clockwise
pressing 'l' rotates lander clockwise
pressing 'r' restarts the game.
Place g in m/sec2
----- -----------
Moon 1.62
Mercury 3.58
Venus 8.87
Earth 9.8
Mars 3.74
Jupiter 26.01
Saturn 11.17
Uranus 10.49
Neptune 13.25
Pluto 0.73
USAGE
}
my @LandScape = (
new Vector2D( -800, 40 ), #pt 0
new Vector2D( -500, 50 ), #pt 1
new Vector2D( -400, 50 ), #pt 2
new Vector2D( -300, 100 ), #pt 3
new Vector2D( -100, 0 ), #pt 4
new Vector2D( 100, 0 ), #pt 5
new Vector2D( 150, 75 ), #pt 7
new Vector2D( 300, 75 ), #pt 8
new Vector2D( 400, 300 ), #pt 9
new Vector2D( 450, 100 ), #pt 10
new Vector2D( 800, 0 ), #pt 11
);
my @Lander = (
new Vector2D( 0 + $initialX, 0 + $initialY), #pt 0
new Vector2D( 10 + $initialX, 0 + $initialY), #pt 1
new Vector2D( 5 + $initialX, 0 + $initialY), #pt 2
new Vector2D( 10 + $initialX, 10 + $initialY), #pt 3
new Vector2D( 20 + $initialX, 20 + $initialY), #pt 4
new Vector2D( 40 + $initialX, 20 + $initialY), #pt 5
new Vector2D( 50 + $initialX, 10 + $initialY), #pt 6
new Vector2D( 55 + $initialX, 0 + $initialY), #pt 7
new Vector2D( 50 + $initialX, 0 + $initialY), #pt 8
new Vector2D( 60 + $initialX, 0 + $initialY), #pt 9
new Vector2D( 55 + $initialX, 30 + $initialY), #pt 10
new Vector2D( 55 + $initialX, 40 + $initialY), #pt 11
new Vector2D( 40 + $initialX, 50 + $initialY), #pt 12
new Vector2D( 20 + $initialX, 50 + $initialY), #pt 13
new Vector2D( 5 + $initialX, 40 + $initialY), #pt 14
new Vector2D( 5 + $initialX, 30 + $initialY), #pt 15
new Vector2D( 30 + $initialX, -40 + $initialY), #thruster flame pt
+ 16
new Vector2D( 30 + $initialX, 25 + $initialY) #center of gravity
+ pt 17
);
my $top = MainWindow->new();
my $can = $top->Canvas(
-width => $width,
-height=> $height,
-background => $background )->form();
my $x_max = $width;
my $y_max = $height;
my $x_min = 5;
my $y_min = 5;
my $x_center = $can->reqwidth()/2.0;
my $y_center = $can->reqheight()/2.0;
my $pi = 4 * atan(1.0);
my $phi = $pi/15.0;
my $cosphi = cos ( $phi );
my $sinphi = sin ( $phi );
my $center = new Vector2D( $x_center, $y_center );
my $r_max = $can->reqwidth()/2;
my $start = $center->plus( new Vector2D( 0.9 * $r_max, 0 ) );
my $vp = new Viewport();
my $clipbox = new Clip2();
### set up Keys
sub rPressed { ### Restart game
$can->delete( 'Lander' );
$can->delete( 'crash' );
&initializeLander;
$vp->resetwindow();
foreach my $v ( @Lander ) {
$vp->updatewindowboundaries( $v->getx(), $v->gety() );
}
foreach my $v ( @LandScape ) {
$vp->updatewindowboundaries( $v->getx(), $v->gety() );
}
$vp->viewportboundaries ( $x_min, $x_max, $y_min, $y_max, 0.9 );
&play;
}
sub kPressed { ### Fire Thruster
#Draw Thruster Flame
if ( $fuel-- > 0 ) {
&drawThrusterFlame;
$LanderVelocity->incr( $acceleration );
} else {
print "Out of gas!!!!\n";
}
Ev('k');
}
sub lPressed { ### Rotate clockwise
&rotateLanderCounterClockwise;
Ev('l');
}
sub jPressed { ### Rotate clockwise
&rotateLanderClockwise;
Ev('j');
}
$top->bind( '<Key-k>', \&kPressed );
$top->bind( '<Key-l>', \&lPressed );
$top->bind( '<Key-j>', \&jPressed );
$top->bind( '<Key-r>', \&rPressed );
### set up window
foreach my $v ( @Lander ) {
$vp->updatewindowboundaries( $v->getx(), $v->gety() );
}
foreach my $v ( @LandScape ) {
$vp->updatewindowboundaries( $v->getx(), $v->gety() );
}
$vp->viewportboundaries ( $x_min, $x_max, $y_min, $y_max, 0.9 );
&drawLander;
&drawLandScape;
$can->after( 100, \&play );
MainLoop;
sub rotateLanderClockwise {
### $Lander[17] is Lander's center of gravity
foreach my $v ( @Lander ) {
$v = $v->rotate( $Lander[17], $cosphi, $sinphi );
}
$acceleration = $acceleration->rotate(
new Vector2D( 0.0, 0.0), $cosphi, $sinphi
);
}
sub rotateLanderCounterClockwise {
### $Lander[17] is Lander's center of gravity
foreach my $v ( @Lander ) {
$v = $v->rotate( $Lander[17], $cosphi, -$sinphi );
}
$acceleration = $acceleration->rotate(
new Vector2D( 0.0,0.0), $cosphi, -$sinphi
);
}
sub moveLander {
# The Physics:
# xt = x0 + v0t + ½at2
# vt = v0 + at
# a = -9.8
$can->delete( 'Lander' );
$LanderVelocity->decr ( $gravity );
foreach my $v ( @Lander ) {
my $u = $LanderVelocity + $gravity * 0.5;
$v->incr( $u );
if ( $staticWindow == 0 ) {
$vp->updatewindowboundaries( $v->getx(), $v->gety() );
}
}
if ( $staticWindow == 0 ) {
$vp->viewportboundaries ( $x_min, $x_max, $y_min, $y_max, 0.9
+);
&drawLandScape;
}
&drawLander;
}
sub play {
&moveLander;
&updateClipBox;
my $rc = &touchDown;
if ( $rc == 0 ) {
$can->after( 100, \&play );
} elsif ( $rc < 0 ) {
&drawCrash;
print "fuel = $fuel CRASH!!!!\n";
} else {
print "fuel = $fuel The eagle has landed!\n";
}
}
sub initializeLander {
@Lander = (
new Vector2D( 0 + $initialX, 0 + $initialY), #pt 0
new Vector2D( 10 + $initialX, 0 + $initialY), #pt 1
new Vector2D( 5 + $initialX, 0 + $initialY), #pt 2
new Vector2D( 10 + $initialX, 10 + $initialY), #pt 3
new Vector2D( 20 + $initialX, 20 + $initialY), #pt 4
new Vector2D( 40 + $initialX, 20 + $initialY), #pt 5
new Vector2D( 50 + $initialX, 10 + $initialY), #pt 6
new Vector2D( 55 + $initialX, 0 + $initialY), #pt 7
new Vector2D( 50 + $initialX, 0 + $initialY), #pt 8
new Vector2D( 60 + $initialX, 0 + $initialY), #pt 9
new Vector2D( 55 + $initialX, 30 + $initialY), #pt 10
new Vector2D( 55 + $initialX, 40 + $initialY), #pt 11
new Vector2D( 40 + $initialX, 50 + $initialY), #pt 12
new Vector2D( 20 + $initialX, 50 + $initialY), #pt 13
new Vector2D( 5 + $initialX, 40 + $initialY), #pt 14
new Vector2D( 5 + $initialX, 30 + $initialY), #pt 15
new Vector2D( 30 + $initialX, -40 + $initialY), #thruster flam
+e pt 16
new Vector2D( 30 + $initialX, 25 + $initialY) #center of gra
+vity pt 17
);
$LanderVelocity = new Vector2D(0, 0 );
$fuel = 20;
$acceleration = new Vector2D(0, 20.0);
if( $opts{F} ) { $fuel = $opts{F} ; }
if( $opts{X} ) { $LanderVelocity->setx ($opts{X}) ; }
if( $opts{Y} ) { $LanderVelocity->sety ($opts{Y}) ; }
if( $opts{a} ) { $acceleration ->sety ($opts{a}) ; }
}
sub drawCrash {
$can->create ( 'line',
$vp->x_viewport($clipbox->getxmin()),
$vp->y_viewport($clipbox->getymin()),
$vp->x_viewport($clipbox->getxmax()),
$vp->y_viewport($clipbox->getymax()),
-fill => 'red',
-tag => 'crash',
-width => 5
);
$can->create ( 'line',
$vp->x_viewport($clipbox->getxmax()),
$vp->y_viewport($clipbox->getymin()),
$vp->x_viewport($clipbox->getxmin()),
$vp->y_viewport($clipbox->getymax()),
-fill => 'red',
-tag => 'crash',
-width => 5
);
}
sub drawClipBox {
$can->create ( 'line',
$vp->x_viewport($clipbox->getxmin()),
$vp->y_viewport($clipbox->getymin()),
$vp->x_viewport($clipbox->getxmin()),
$vp->y_viewport($clipbox->getymax()),
-fill => $fill,
-tag => 'clipbox'
);
$can->create ( 'line',
$vp->x_viewport($clipbox->getxmin()),
$vp->y_viewport($clipbox->getymax()),
$vp->x_viewport($clipbox->getxmax()),
$vp->y_viewport($clipbox->getymax()),
-fill => $fill,
-tag => 'clipbox'
);
$can->create ( 'line',
$vp->x_viewport($clipbox->getxmax()),
$vp->y_viewport($clipbox->getymax()),
$vp->x_viewport($clipbox->getxmax()),
$vp->y_viewport($clipbox->getymin()),
-fill => $fill,
-tag => 'clipbox'
);
$can->create ( 'line',
$vp->x_viewport($clipbox->getxmax()),
$vp->y_viewport($clipbox->getymin()),
$vp->x_viewport($clipbox->getxmin()),
$vp->y_viewport($clipbox->getymin()),
-fill => $fill,
-tag => 'clipbox'
);
}
sub touchDown {
my $clipped = 0;
my $lineSlope = 0;
my ( $x1, $y1, $x2, $y2 );
for ( my $i=0; $i<$#LandScape and $clipped == 0 ; $i++ ) {
$x1 = $LandScape[$i]->getx();
$y1 = $LandScape[$i]->gety();
$x2 = $LandScape[$i+1]->getx();
$y2 = $LandScape[$i+1]->gety();
$clipped = $clipbox->cliped( $x1, $y1, $x2, $y2 );
$lineSlope = ($y2 - $y1)/($x2 - $x1);
}
if ( $clipped == 1 ) {
### calulate the speed at impact
my $speed = sqrt(
$LanderVelocity->getx() * $LanderVelocity->getx() +
$LanderVelocity->gety() * $LanderVelocity->gety());
print "landing speed is $speed\n" .
"Line slope $lineSlope\n";
if ( $speed >= $crashSpeed ) {
return -1;
} else {
if ( -$crashSlope <= $lineSlope &&
$lineSlope <= $crashSlope ) {
return 1;
} else {
return -1;
}
}
}
return 0;
}
sub drawThrusterFlame {
$can->create ( 'line',
$vp->x_viewport($Lander[4]->getx()),
$vp->y_viewport($Lander[4]->gety()),
$vp->x_viewport($Lander[16]->getx()),
$vp->y_viewport($Lander[16]->gety()),
-fill => $fill,
-tag => ['Flame', 'Lander']
);
$can->create ( 'line',
$vp->x_viewport($Lander[16]->getx()),
$vp->y_viewport($Lander[16]->gety()),
$vp->x_viewport($Lander[5]->getx()),
$vp->y_viewport($Lander[5]->gety()),
-fill => $fill,
-tag => ['Flame', 'Lander']
);
}
sub drawLandScape {
$can->delete( 'LandScape' );
my $start_x = $LandScape[0]->getx();
my $start_y = $LandScape[0]->gety();
for my $v ( @LandScape ) {
$can->create ( 'line',
$vp->x_viewport($start_x),
$vp->y_viewport($start_y),
$vp->x_viewport($v->getx()),
$vp->y_viewport($v->gety()),
-fill => $fill,
-tag => 'LandScape'
);
$start_x = $v->getx();
$start_y = $v->gety();
};
}
sub drawLander {
$can->create ( 'line',
$vp->x_viewport($Lander[0]->getx()),
$vp->y_viewport($Lander[0]->gety()),
$vp->x_viewport($Lander[1]->getx()),
$vp->y_viewport($Lander[1]->gety()),
-fill => $fill,
-tag => 'Lander'
);
$can->create ( 'line',
$vp->x_viewport($Lander[2]->getx()),
$vp->y_viewport($Lander[2]->gety()),
$vp->x_viewport($Lander[3]->getx()),
$vp->y_viewport($Lander[3]->gety()),
-fill => $fill,
-tag => 'Lander'
);
$can->create ( 'line',
$vp->x_viewport($Lander[3]->getx()),
$vp->y_viewport($Lander[3]->gety()),
$vp->x_viewport($Lander[4]->getx()),
$vp->y_viewport($Lander[4]->gety()),
-fill => $fill,
-tag => 'Lander'
);
$can->create ( 'line',
$vp->x_viewport($Lander[4]->getx()),
$vp->y_viewport($Lander[4]->gety()),
$vp->x_viewport($Lander[5]->getx()),
$vp->y_viewport($Lander[5]->gety()),
-fill => $fill,
-tag => 'Lander'
);
$can->create ( 'line',
$vp->x_viewport($Lander[5]->getx()),
$vp->y_viewport($Lander[5]->gety()),
$vp->x_viewport($Lander[6]->getx()),
$vp->y_viewport($Lander[6]->gety()),
-fill => $fill,
-tag => 'Lander'
);
$can->create ( 'line',
$vp->x_viewport($Lander[6]->getx()),
$vp->y_viewport($Lander[6]->gety()),
$vp->x_viewport($Lander[7]->getx()),
$vp->y_viewport($Lander[7]->gety()),
-fill => $fill,
-tag => 'Lander'
);
$can->create ( 'line',
$vp->x_viewport($Lander[8]->getx()),
$vp->y_viewport($Lander[8]->gety()),
$vp->x_viewport($Lander[9]->getx()),
$vp->y_viewport($Lander[9]->gety()),
-fill => $fill,
-tag => 'Lander'
);
$can->create ( 'line',
$vp->x_viewport($Lander[5]->getx()),
$vp->y_viewport($Lander[5]->gety()),
$vp->x_viewport($Lander[10]->getx()),
$vp->y_viewport($Lander[10]->gety()),
-fill => $fill,
-tag => 'Lander'
);
$can->create ( 'line',
$vp->x_viewport($Lander[10]->getx()),
$vp->y_viewport($Lander[10]->gety()),
$vp->x_viewport($Lander[11]->getx()),
$vp->y_viewport($Lander[11]->gety()),
-fill => $fill,
-tag => 'Lander'
);
$can->create ( 'line',
$vp->x_viewport($Lander[11]->getx()),
$vp->y_viewport($Lander[11]->gety()),
$vp->x_viewport($Lander[12]->getx()),
$vp->y_viewport($Lander[12]->gety()),
-fill => $fill,
-tag => 'Lander'
);
$can->create ( 'line',
$vp->x_viewport($Lander[12]->getx()),
$vp->y_viewport($Lander[12]->gety()),
$vp->x_viewport($Lander[13]->getx()),
$vp->y_viewport($Lander[13]->gety()),
-fill => $fill,
-tag => 'Lander'
);
$can->create ( 'line',
$vp->x_viewport($Lander[13]->getx()),
$vp->y_viewport($Lander[13]->gety()),
$vp->x_viewport($Lander[14]->getx()),
$vp->y_viewport($Lander[14]->gety()),
-fill => $fill,
-tag => 'Lander'
);
$can->create ( 'line',
$vp->x_viewport($Lander[14]->getx()),
$vp->y_viewport($Lander[14]->gety()),
$vp->x_viewport($Lander[15]->getx()),
$vp->y_viewport($Lander[15]->gety()),
-fill => $fill,
-tag => 'Lander'
);
$can->create ( 'line',
$vp->x_viewport($Lander[15]->getx()),
$vp->y_viewport($Lander[15]->gety()),
$vp->x_viewport($Lander[4]->getx()),
$vp->y_viewport($Lander[4]->gety()),
-fill => $fill,
-tag => 'Lander'
);
}
### get collision detection bounding box from lander
sub updateClipBox {
my $smallest_x = $Lander[0]->getx();
my $smallest_y = $Lander[0]->gety();
my $largest_x = $Lander[0]->getx();
my $largest_y = $Lander[0]->gety();
my $i = 0;
foreach my $v ( @Lander ) {
# pts 16 and 17 are not really parts of the lander
# pt 16 is the flame and 17 is center of gravity
if ( $i < 16 ) {
if( $v->getx() <= $smallest_x ) { $smallest_x = $v->getx()
+; }
if( $v->gety() <= $smallest_y ) { $smallest_y = $v->gety()
+; }
if( $v->getx() >= $largest_x ) { $largest_x = $v->getx();
+}
if( $v->gety() >= $largest_y ) { $largest_y = $v->gety();
+}
}
$i++;
}
$clipbox->setclipboundaries( $smallest_x, $smallest_y, $largest_x,
+ $largest_y);
}
=head1 LunarLander
A Lunar Lander Video game written in Perl/Tk.
=head1 DESCRIPTION
A Lunar Lander Video game written in Perl/Tk.
=head1 README
options:
-W <canvas width> Default is 500
-H <canvas height> Default is 500
-b <background color> Default is blue
-f <foreground color> Default is yellow
-F <fuel> Default is 20
-x <initail x position> Default is 0
-y <initail y position> Default is 800
-g <gravity> Default is 1.62 (the moon)
-a <engine thrust> Default is 20
-X <initail X velocity> Default is 0
-Y <initail Y velocity> Default is 0
-c <crash velocity> Default is 10
-s <landing slope tolerance> Default is 0
-S do not resize scene (ship may leave screen)
-h print this message
How to play:
pressing 'k' fires main thruster.
pressing 'j' rotates lander counter-clockwise
pressing 'l' rotates lander clockwise
pressing 'r' restarts the game.
Place g in m/sec2
----- -----------
Moon 1.62
Mercury 3.58
Venus 8.87
Earth 9.8
Mars 3.74
Jupiter 26.01
Saturn 11.17
Uranus 10.49
Neptune 13.25
Pluto 0.73
=head1 PREREQUISITES
This script requires the C<strict> module.
It also requires C<Tk 800.022>.
It also requires C<Tk::Canvas 800.022>.
It also requires C<Math::Trig>.
It also requires C<Vector2D Authur CECALA>
It also requires C<Viewport Author CECALA>
It also requires C<Clip2 Author CECALA>
It also requires C<Getopt::Std>
=head1 COREQUISITES
Tk
=pod OSNAMES
any
=pod SCRIPT CATEGORIES
Fun/Educational
Tk/Example
=cut
BEGIN
{
{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 = 1.00;
@ISA = qw(Exporter);
@EXPORT = ();
@EXPORT_OK = qw(&new);
#%EXPORT_TAGS = ( DEFAULT => [qw(&new &setclipboundaries &getxmin &get
+ymin &getxmax &getymax )],
%EXPORT_TAGS = ( DEFAULT => [qw(&new)],
Both => [qw(&new)]);
sub new {
my ($pkg,$x1,$y1,$x2,$y2) = @_;
bless {
_xmin => $x1,
_ymin => $y1,
_xmax => $x2,
_ymax => $y2
}, $pkg;
}
sub setclipboundaries {
my $obj = shift;
my $x1 = shift;
my $y1 = shift;
my $x2 = shift;
my $y2 = shift;
$obj->{_xmin} = $x1;
$obj->{_ymin} = $y1;
$obj->{_xmax} = $x2;
$obj->{_ymax} = $y2;
}
sub code {
my $obj = shift;
my $x = shift;
my $y = shift;
return (($x<$obj->getxmin())<<3) | (($x>$obj->getxmax())<<2) |
(($y<$obj->getymin())<<1) | ($y>$obj->getymax());
}
sub getxmin { my $obj = shift; return $obj->{_xmin}; }
sub getymin { my $obj = shift; return $obj->{_ymin}; }
sub getxmax { my $obj = shift; return $obj->{_xmax}; }
sub getymax { my $obj = shift; return $obj->{_ymax}; }
sub gettag { my $obj = shift; return $obj->{_tag}; }
sub getclipboundaries {
my $obj = shift;
my @xy = (
$obj->getxmin(),
$obj->getymin(),
$obj->getxmax(),
$obj->getymax()
);
return @xy;
}
sub cliped {
my $obj = shift;
my $xP = shift;
my $yP = shift;
my $xQ = shift;
my $yQ = shift;
my $cP = $obj->code( $xP, $yP );
my $cQ = $obj->code( $xQ, $yQ );
my $xmin = $obj->getxmin();
my $xmax = $obj->getxmax();
my $ymin = $obj->getymin();
my $ymax = $obj->getymax();
while( $cP | $cQ ) {
if( $cP & $cQ ) { return 0; }
my $dx = $xQ - $xP;
my $dy = $yQ - $yP;
if ( $cP ) {
if ( $cP & 8 ) { $yP += ( $xmin-$xP)*$dy/$dx; $xP=$xmin
+; }
elsif ( $cP & 4 ) { $yP += ( $xmax-$xP)*$dy/$dx; $xP=$xmax
+; }
elsif ( $cP & 2 ) { $xP += ( $ymin-$yP)*$dx/$dy; $yP=$ymin
+; }
elsif ( $cP & 1 ) { $xP += ( $ymax-$yP)*$dx/$dy; $yP=$ymax
+; }
$cP = $obj->code( $xP, $yP );
} else {
if ( $cQ & 8 ) { $yQ += ( $xmin-$xQ)*$dy/$dx; $xQ=$xmin
+; }
elsif ( $cQ & 4 ) { $yQ += ( $xmax-$xQ)*$dy/$dx; $xQ=$xmax
+; }
elsif ( $cQ & 2 ) { $xQ += ( $ymin-$yQ)*$dx/$dy; $yQ=$ymin
+; }
elsif ( $cQ & 1 ) { $xQ += ( $ymax-$yQ)*$dx/$dy; $yQ=$ymax
+; }
$cQ = $obj->code( $xQ, $yQ );
} # end if
} # end while
return 1;
}
1;
}
{package Vector2D;
#####################################################
### 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 overload
"-" => \&minus,
"+" => \&plus,
"*" => \&mult,
"bool" => \&bool;
$VERSION = 1.00;
@ISA = qw(Exporter);
@EXPORT = ();
@EXPORT_OK = qw(&new);
%EXPORT_TAGS = ( DEFAULT => [qw(&new &getx &gety &getxy)],
Both => [qw(&new &getx &gety)]);
sub new {
my ($pkg,$x,$y) = @_;
bless {
_x => $x,
_y => $y
}, $pkg;
}
sub getx { my $obj = shift; return $obj->{_x}; }
sub gety { my $obj = shift; return $obj->{_y}; }
sub setx { my $obj = shift; my $v = shift; $obj->{_x} = $v; }
sub sety { my $obj = shift; my $v = shift; $obj->{_y} = $v; }
sub getxy {
my $obj = shift;
my @xy = ( $obj->getx(), $obj->gety() );
return @xy;
}
sub plus {
my $u = shift;
my $v = shift;
return new Vector2D (
$u->getx() + $v->getx(),
$u->gety() + $v->gety()
);
}
sub minus {
my $u = shift;
my $v = shift;
return new Vector2D (
$u->getx() - $v->getx(),
$u->gety() - $v->gety()
);
}
sub mult {
my $v = shift;
my $c = shift;
return new Vector2D (
$c * $v->getx(),
$c * $v->gety()
);
}
sub bool { return defined( shift ); }
sub incr {
my $u = shift;
my $v = shift;
$u->{_x} += $v->{_x};
$u->{_y} += $v->{_y};
return $u;
}
sub decr {
my $u = shift;
my $v = shift;
$u->{_x} -= $v->{_x};
$u->{_y} -= $v->{_y};
return $u;
}
sub scale {
my $v = shift;
my $c = shift;
$v->{_x} *= $c;
$v->{_y} *= $c;
return $v;
}
sub rotate {
my $P = shift; #vector
my $C = shift; #vector
my $cosphi = shift;
my $sinphi = shift;
my $dx = $P->{_x} - $C->{_x};
my $dy = $P->{_y} - $C->{_y};
return new Vector2D (
$C->{_x} + $dx * $cosphi - $dy * $sinphi,
$C->{_y} + $dx * $sinphi + $dy * $cosphi
);
}
sub print {
my $v = shift; #vector
print "( " . $v->getx() . ", " . $v->gety() . ")\n";
}
1;}
{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 = 1.00;
@ISA = qw(Exporter);
@EXPORT = ();
@EXPORT_OK = qw(&new);
%EXPORT_TAGS = ( DEFAULT => [qw(&new)],
Both => [qw(&new)]);
use constant BIG => 1.0e+30;
sub new {
my ($pkg) = @_;
bless {
_xmin => BIG,
_ymin => BIG,
_xmax => -1 * BIG,
_ymax => -1 * BIG,
_xC => 0,
_yC => 0,
_XC => 0,
_YC => 0,
_f => 0,
_windowset => 0
}, $pkg;
}
sub getxmin { my $obj = shift; return $obj->{_xmin}; }
sub getymin { my $obj = shift; return $obj->{_ymin}; }
sub getxmax { my $obj = shift; return $obj->{_xmax}; }
sub getymax { my $obj = shift; return $obj->{_ymax}; }
sub getxC { my $obj = shift; return $obj->{_xC}; }
sub getyC { my $obj = shift; return $obj->{_yC}; }
sub getXC { my $obj = shift; return $obj->{_XC}; }
sub getYC { my $obj = shift; return $obj->{_YC}; }
sub getf { my $obj = shift; return $obj->{_f}; }
sub getwindowset { my $obj = shift; return $obj->{_windowset}; }
sub setxmin { my $obj = shift; my $v = shift; $obj->{_xmin} = $v; }
sub setymin { my $obj = shift; my $v = shift; $obj->{_ymin} = $v; }
sub setxmax { my $obj = shift; my $v = shift; $obj->{_xmax} = $v; }
sub setymax { my $obj = shift; my $v = shift; $obj->{_ymax} = $v; }
sub setxC { my $obj = shift; my $v = shift; $obj->{_xC} = $v; }
sub setyC { my $obj = shift; my $v = shift; $obj->{_yC} = $v; }
sub setXC { my $obj = shift; my $v = shift; $obj->{_XC} = $v; }
sub setYC { my $obj = shift; my $v = shift; $obj->{_YC} = $v; }
sub setf { my $obj = shift; my $v = shift; $obj->{_f} = $v; }
sub setwindowset { my $obj = shift; my $v = shift; $obj->{_windowse
+t} = $v; }
sub resetwindow {
my $obj = shift;
$obj->setxmin( BIG );
$obj->setymin( BIG );
$obj->setxmax( -1 * BIG );
$obj->setymax( -1 * BIG );
$obj->setxC( 0 );
$obj->setyC( 0 );
$obj->setXC( 0 );
$obj->setYC( 0 );
$obj->setf( 0 );
}
sub updatewindowboundaries {
my $obj = shift;
my $x = shift;
my $y = shift;
my $xmin = $obj->getxmin();
my $xmax = $obj->getxmax();
my $ymin = $obj->getymin();
my $ymax = $obj->getymax();
if ($x < $xmin) { $obj->setxmin( $x ); }
if ($x > $xmax) { $obj->setxmax( $x ); }
if ($y < $ymin) { $obj->setymin( $y ); }
if ($y > $ymax) { $obj->setymax( $y ); }
$obj->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->getxmin();
my $xmax = $obj->getxmax();
my $ymin = $obj->getymin();
my $ymax = $obj->getymax();
my ( $fx, $fy );
my $windowset = $obj->getwindowset();
if ( $windowset == 0 ) {
die "Viewport::updatewindowboundaries() has not been called\n"
+;
}
$obj->setXC( 0.5 * ( $Xmin + $Xmax ));
$obj->setYC( 0.5 * ( $Ymin + $Ymax ));
$fx = ($Xmax-$Xmin) / ( $xmax - $xmin + 1.0E-7);
$fy = ($Ymax-$Ymin) / ( $ymax - $ymin + 1.0E-7);
$obj->setf( $reductionfactor * ($fx<$fy?$fx:$fy));
$obj->setxC( 0.5 * ( $xmin + $xmax ));
$obj->setyC( 0.5 * ( $ymin + $ymax ));
}
sub x_viewport {
my $obj = shift;
my $x = shift;
my $xC = $obj->getxC();
my $XC = $obj->getXC();
my $f = $obj->getf();
my $rc = $XC + $f * ($x - $xC);
return $rc;
}
sub y_viewport {
my $obj = shift;
my $y = shift;
my $yC = $obj->getyC();
my $YC = $obj->getYC();
my $f = $obj->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->{_xmin}:$obj->{_ymin}:" .
"$obj->{_xmax}:$obj->{_ymax}:" .
"$obj->{_xC}:$obj->{_yC}:$obj->{_XC}:" .
"$obj->{_YC}:$obj->{_f}\n";
}
1;}
}