Beefy Boxes and Bandwidth Generously Provided by pair Networks
go ahead... be a heretic
 
PerlMonks  

(RhetTbull) Re: Re: Lunar Lander video game

by RhetTbull (Curate)
on Feb 07, 2002 at 16:47 UTC ( [id://143918]=note: print w/replies, xml ) Need Help??


in reply to Re: Lunar Lander video game
in thread Lunar Lander video game

Cool little game!

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;}
}

[download]

In Section Craft

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?

www.com | www.net | www.org
Node Status?
node history
Node Type: note [id://143918]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? • Last hour • Other CB clients
Other Users?
Others studying the Monastery: (7)
As of 2024-04-19 09:35 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found