Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl Monk, Perl Meditation
 
PerlMonks  

Rocket

by tinypig (Beadle)
on May 05, 2003 at 01:41 UTC ( [id://255552]=sourcecode: print w/replies, xml ) Need Help??
Category: Fun Stuff
Author/Contact Info tinypig
Description: This was my first adventure in creating a Perl/Tk game. I think I stuck with it long enough that it is both stable and somewhat fun. Although it's nothing I would spend a quarter on in an arcade, I think it makes for an interesting diversion. The code won't work without the accompanying files, so if you want to play the game, get the compressed tar or zip file. Feel free to comment/criticize, etc. 
#!/usr/local/bin/perl
###################################################################
#                                                                 #
# rocket.pl - Land a rocket ship on a moving platform             #
# David Bradford - Tinypig software - www.tinypig.com             #
# Copyright (c) 2003 David Bradford.                              #
# All rights reserved.  This program is free software; you can    #
# redistribute it and/or modify it under the same terms as Perl   #
# itself; however, you must leave this copyright statement        #
# intact.                                                         #
#                                                                 #
###################################################################

use strict;

#####################
# Class: Game_Piece #
#####################

# This is the base class for game_pieces
package Game_Piece;

# Class:  Game_Piece
# Method: r
# Return a random integer from 1 to the first parameter.
sub r {
    my ($this,$num) = @_;
    return int(rand($num) + 1);
}

###############
# Class: Base #
###############
package Base;
use vars qw(@ISA);
@ISA = ('Game_Piece');

# Constants
sub HEIGHT      {10;}
sub SIDE_WIDTH  {10;}
sub BOTH_SIDES  {(SIDE_WIDTH) * 2;}

# Class:  Base
# Method: new
# Called to instantiate the class.
sub new {
    my ($class, $screen, $width) = @_;
    my $this = bless {
        'inc'    => 0,
        'move'   => 1,
        'screen' => $screen,
        'width'  => $width,
    }, $class;

    # initialize

    return $this;
}

# Class:  Base
# Method: calcMove
# This routine calculates where the base should move next
sub calcMove {
    my ($this,$hpos,$move) = @_;

    if( $$hpos + $$move < 1 ) { $$move = $this->{'inc'} }
    elsif( $$hpos + $$move > 
           (&main::SCR_WIDTH) - $this->{'width'} - BOTH_SIDES ) { $$mo
+ve = -$this->{'inc'} }
    $$hpos += $$move;
}

# Class:  Base
# Method: getHpos
# Returns the horizontal position of the base in pixels.
sub getHpos {
    my $this = shift;
    return ( $this->{'hpos'} + SIDE_WIDTH );
}

# Class:  Base
# Method: getMove
# Returns the move attribute.
sub getMove {
    my $this = shift;
    return $this->{'move'};
}

# Class:  Base
# Method: getWidth
# Set the width attribute of the base
sub getWidth {
    my $this = shift;
    return $this->{'width'};
}

# Class:  Base
# Method: initPosition
# Prepares the base to be drawn in a random horizontal position.
sub initPosition {
    my $this = shift;
    $this->{'hpos'} = $this->r((&main::SCR_WIDTH) - $this->{'width'} -
+ BOTH_SIDES );
}

# Class:  Base
# Method: make
# Draw the base.
sub make {
    my ( $this, $color ) = @_;
    $this->{'screen'}->delete('base');
    $this->{'screen'}->createPolygon( $this->{'hpos'} +  0, 500,
                            $this->{'hpos'} + (SIDE_WIDTH), 490,
                            $this->{'hpos'} + (SIDE_WIDTH) + $this->{'
+width'}, 490,
                            $this->{'hpos'} + (BOTH_SIDES) + $this->{'
+width'}, 500,
                           -fill    => $color,
                           -outline => 'white',
                           -tags    => ['base', 'base_and_rocket', 'ev
+erything'] );
    $this->{'screen'}->lower('base','everything');
}

# Class:  Base
# Method: move
# This routine will reverse the direction of the base if it has hit ei
+ther side of
# the screen, and also moves the base one "tick" in whatever direction
+ it is going.
sub move {
    my ( $this, $tag ) = @_;
    if(!&main::DEBUG) {
        $this->calcMove(\$this->{'hpos'},\$this->{'move'});
        $this->{'screen'}->move($tag, $this->{'move'},0);
    }
}

# Class: Base
# Method: predictPosition
# Predicts where the base will be n ticks from now
sub predictPosition {
    my ($this, $n) = @_;
    my $hpos = $this->{'hpos'};
    my $move = $this->{'move'};
    for(my $i = 1; $i < $n; ++$i) {
        $this->calcMove(\$hpos,\$move);
    }
    return $hpos;
}

# Class:  Base
# Method: setIncrement
# Sets the number of pixels the base will move each "tick".  This is u
+sed
# to increase the difficulty throughout the game.
sub setIncrement {
    my ($this, $inc) = @_;
    $this->{'inc'}  = $inc;
    $this->{'move'} = $this->{'move'}<0?-$inc:$inc;
}

# Class:  Base
# Method: setWidth
# Set the width attribute of the base
sub setWidth {
    my ($this,$width) = @_;
    $this->{'width'} = $width;
}

#################
# Class: Rocket #
#################

package Rocket;
use vars qw(@ISA);
@ISA = ('Game_Piece');

# Constants
sub WIDTH     {         40;}
sub HEIGHT    {         55;}
sub BASECOLOR {     'blue';}
sub CONECOLOR {   'purple';}
sub FINCOLOR  {'dark grey';}

# Class:  Rocket
# Method: new
# Called to instantiate the class.
sub new {
    my ($class, $screen) = @_;
    my $this = bless {
        'screen'       => $screen,
        'everyother'   => 0,
        'screen_width' => &main::SCR_WIDTH
    }, $class;

    $this->initPosition();
    return $this;
}

# Class:  Rocket
# Method: changeDirection
# The rocket is always be in motion.  When a player decides to 
# change direction or just go straight down, this routine is 
# called.
sub changeDirection {
    my ($this,$dir) = @_;
    if( $dir eq 'left' ) {
        $this->{'move'} = -(&main::INCREMENT);
    } elsif( $dir eq 'right' ) {
        $this->{'move'} =  &main::INCREMENT;
    } elsif( $dir eq 'down' ) {
        $this->{'move'} =     0;
    }
}

# Class:  Rocket
# Method: crashTick
# When the rocket crashes, each time this routine is called it
# moves each of the pieces one "tick" in their course of being
# blown apart.
sub crashTick {
    my ($this) = @_;
    $this->_movePiece('p1', -1,                             -1);
    $this->_movePiece('p2',  1,                             -1);
    $this->_movePiece('p3', -1, $this->{'everyother'} % 2 * -1);
    $this->_movePiece('p4',  1, $this->{'everyother'} % 2 * -1);
    $this->_movePiece('p5', -1, $this->{'everyother'} % 2 *  1);
    $this->_movePiece('p6',  1, $this->{'everyother'} % 2 *  1);
    $this->_movePiece('p7', -1,                              1);
    $this->_movePiece('p8',  1,                              1);
    $this->{'everyother'} = $this->{'everyother'}?0:1;
}

# Class:  Rocket
# Method: delete
# Deletes the rocket from the screen after it explodes or 
# lands successfully
sub delete {
    my $this = shift;
    $this->{'screen'}->clearRocket();
}

# Class:  Rocket
# Method: getHpos
# Get the horizontal position of the rocket in pixels.
sub getHpos {
    my $this = shift;
    return $this->{'hpos'};
}

# Class:  Rocket
# Method: getVpos
# Get the vertical position of the rocket in pixels.
sub getVpos {
    my $this = shift;
    return $this->{'vpos'};
}

# Class:  Rocket
# Method: initPosition
# Prepares the rocket to be drawn in a random horizontal initial
# position at the top of the screen, preparing it to begin descent.
sub initPosition {
    my $this = shift;
    $this->{'move'} = 0;
    $this->{'vpos'} = 0;
    if( &main::DEBUG ) { $this->{'vpos'} = (&main::SCR_HEIGHT) - $this
+->HEIGHT - 10 - 3 }
    $this->{'hpos'} = $this->r((&main::SCR_WIDTH) - $this->WIDTH);
}

# Class:  Rocket
# Method: makeRocket
# Draw the rocket for the first time.  These polygons will be manipula
+ted after
# creation to animate them and only need to be "drawn" initially once,
+ or after
# the rocket is deleted.
sub makeRocket {
    my ($this) = @_;
    $this->_makePiece( 'p1', $this->CONECOLOR, 10, 15, 20,  0, 20, 15)
+;
    $this->_makePiece( 'p2', $this->CONECOLOR, 20,  0, 30, 15, 20, 15)
+;
    $this->_makePiece( 'p3', $this->BASECOLOR, 10, 15, 10, 30, 20, 30,
+ 20, 15 );
    $this->_makePiece( 'p4', $this->BASECOLOR, 20, 15, 30, 15, 30, 30,
+ 20, 30 );
    $this->_makePiece( 'p5', $this->BASECOLOR, 10, 30, 20, 30, 20, 45,
+ 10, 45 );
    $this->_makePiece( 'p6', $this->BASECOLOR, 20, 30, 30, 30, 30, 45,
+ 20, 45 );
    $this->_makePiece( 'p7', $this->FINCOLOR,  10, 45,  0, 55, 20, 55,
+ 20, 45 );
    $this->_makePiece( 'p8', $this->FINCOLOR,  30, 45, 40, 55, 20, 55,
+ 20, 45 );
    $this->{'screen'}->raise('rocket','base');
}

# Class:  Rocket
# Method: move
# Moves the rocket for one "tick".  Also makes sure it doesn't move be
+yond
# the edge of the screen horizontally.
sub move {
    my ($this) = @_;
    my $inc = &main::INCREMENT;
    if( &main::DEBUG ) { $inc = 0; }
    if( $this->{'hpos'} + $this->{'move'} > 0 && 
        $this->{'hpos'} + $this->{'move'} <= $this->{'screen_width'} -
+ $this->WIDTH + &main::RIGHT_SIDE_FIX) {

        $this->{'screen'}->move('rocket',$this->{'move'},$inc);
        $this->{'hpos'} += $this->{'move'};
    } else {
        $this->{'screen'}->move('rocket',0,$inc);
    }
    $this->{'vpos'} += $inc;
}

# Class:  Rocket
# Method: _makePiece
# Used internally by instances of this class and called by makeRocket,
+ this 
# does the actual work of drawing each polygon in the rocket.
sub _makePiece {
    my ( $this, $tag, $color, @points ) = @_;
    for( my $i = 0; $i < $#points; $i += 2 ) {
        $points[$i    ] += $this->{'hpos'};
        $points[$i + 1] += $this->{'vpos'};
    }
    $this->{'screen'}->createPolygon(@points,
                     -fill => $color,
                     -tags => [$tag,'rocket','base_and_rocket','everyt
+hing','game_pieces']);
}

# Class:  Rocket
# Method: _movePiece
# Used internally by instances of this class and called by crashTick, 
+this 
# actually does the work of moving the individual pieces one "tick" af
+ter
# a crash.
sub _movePiece {
    my ( $this, $piece_tag, $x_multip, $y_multip ) = @_;
    $this->{'screen'}->move( $piece_tag, 
                     $x_multip * $this->r(&main::EXPLODE_MOVE),
                     $y_multip * $this->r(&main::EXPLODE_MOVE) );
}


#################
# Class: Screen #
#################
package Screen;

# Class:  Screen
# Method: new
# Called to instantiate the class.
sub new {
    my ($class, $MW) = @_;
    my $this;
    my $canvas = $MW
        ->Canvas(
                    -width       => &main::SCR_WIDTH,
                    -height      => &main::SCR_HEIGHT,
                    -border      => 1,
                    -relief      => 'ridge',
                    -background  => 'black'
                )
        ->pack();
    my $image = $MW->Photo(-format => 'jpeg', -file => &main::ROCKET_D
+IR.'/stars.jpg');

    $canvas->createImage(250,250,-image => $image);

    $this = bless {
        'canvas' => $canvas
    }, $class;
    return $this;
}

# Class:  Screen
# Method: afterCancel
# Cancels a specific alarm that is set, or all alarms.  These alarms a
+re
# set to cause routines like "tick" to be called by the OS every few m
+illiseconds
# in order to animate the game.
sub afterCancel {
    my $this = shift;
    $this->{'canvas'}->afterCancel(@_);
}

# Class:  Screen
# Method: clearGamePieces
# Clears all game pieces from the screen.
sub clearGamePieces {
    my $this = shift;
    $this->{'canvas'}->delete('game_pieces');
}

# Class:  Screen
# Method: clearMessages
# Clears all messages from the screen.
sub clearMessages {
    my $this = shift;
    $this->{'canvas'}->delete('messages');
}

# Class:  Screen
# Method: clearRocket
# Clears the rocket from the screen.
sub clearRocket {
    my $this = shift;
    $this->{'canvas'}->delete('rocket');
}

# Class:  Screen
# Method: createPolygon
# Allows game piece objects to draw a polygon on the canvas.
sub createPolygon {
    my $this = shift;
    $this->{'canvas'}->createPolygon(@_);
}

# Class:  Screen
# Method: delete
# Allows game piece objects to delete themselves from the canvas.
sub delete {
    my $this = shift;
    $this->{'canvas'}->delete(@_);
}

# Method: lower
# Lower an object in relation to other objects
sub lower {
    my $this = shift;
    $this->{'canvas'}->lower(@_);
}

# Class:  Screen
# Method: move
# Used by the game piece objects to move themselves across the canvas.
sub move {
    my $this = shift;
    $this->{'canvas'}->move(@_);
}

# Class:  Screen
# Method: raise
# Raise an object in relation to other objects
sub raise {
    my $this = shift;
    $this->{'canvas'}->raise(@_);
}

# Class:  Screen
# Method: showDebug
# Displayes the debugging info
sub showDebug {
    my ($this,@arg) = @_;
    $this->{'canvas'}->delete('debug');
    $this->_showText('debug', 100, 80, "Rocket vpos: $arg[0]");
    $this->_showText('debug', 100,100, "Rocket hpos: $arg[1]");
    $this->_showText('debug', 100,120, "Base hpos: $arg[2]");
    $this->_showText('debug', 100,140, "Status: $arg[3]");

    $this->_showText('debug', 350, 80, "Base width: $arg[4]");
    $this->_showText('debug', 350,100, "Base extra: $arg[5]");
    $this->_showText('debug', 240,200, 'if( $rocket->getHpos() >= ( $b
+ase->getHpos() - SUCCESS_PLAY ) &&
        $rocket->getHpos() + $rocket->WIDTH <= 
        ( $base->getHpos() + $base->getWidth() + SUCCESS_PLAY ) ) { ok
+ }');
}

# Class:  Screen
# Method: showGameOver
# This displays the Game Over message.
sub showGameOver {
    my $this = shift;
    $this->_showText( 'message', 250, 200, "GAME\nOVER");
}

# Class:  Screen
# Method: showGuys
# Draws the icons representing each life (rocket) the player has left.
sub showGuys {
    my ($this,$rocket,$guys) = @_;
    $this->{'canvas'}->delete('guys');
    for(1..$guys-1) {
        my $guy_hval = $_ * 20 + 320;
        $this->{'canvas'}->createPolygon( $guy_hval +  7, 15,
                                          $guy_hval + 12,  9,
                                          $guy_hval + 17, 15,
                                          -fill => $rocket->CONECOLOR,
                                          -tags => ['guys','everything
+'] );
        $this->{'canvas'}->createPolygon( $guy_hval +  7, 15,
                                          $guy_hval + 17, 15,
                                          $guy_hval + 17, 25,
                                          $guy_hval +  7, 25,
                                          -fill => $rocket->BASECOLOR,
                                          -tags => ['guys','everything
+'] );
        $this->{'canvas'}->createPolygon( $guy_hval +  7, 25,
                                          $guy_hval + 17, 25,
                                          $guy_hval + 22, 30,
                                          $guy_hval +  2, 30,
                                          $guy_hval +  7, 25,
                                          -fill => $rocket->FINCOLOR,
                                          -tags => ['guys','everything
+'] );
    }
}

# Class:  Screen
# Method: showPause
# Displays the "PAUSE" message.
sub showPause {
    my $this = shift;
    $this->_showText('message', 250, 200, 'PAUSE', 'pause');
}

# Class:  Screen
# Method: showScores
# Displays the score and the high score.
sub showScores {
    my ($this, $score, $high) = @_;
    my ($display_high, $display_score);
    $this->delete('scores');
    $score ||= 0;
    $display_score = sprintf("%6d", $score);
    $display_high  = sprintf("%6d",  $high);
    $this->_showText('score',  80, 41, $display_score);
    $this->_showText('score', 250, 41, $display_high );
}

# Class:  Screen
# Method: showTitles
# Displayes the "SCORE" and "HIGH" titles.
sub showTitles {
    my $this = shift;
    $this->_showText('title', 250, 16, 'HIGH' );
    $this->_showText('title',  80, 16, 'SCORE');
}

# Class:  Screen
# Method: _showText
# Used internally by instances of this class to display certain 
# types of text on the screen.
sub _showText {
    my ( $this, $type, $x, $y, $text, $extra_tag ) = @_;
    if( $type eq 'message' ) {
        $this->{'canvas'}->createText( $x, $y, 
                           -fill => 'white',
                           -font => 'Arial 20 bold',
                           -text => $text,
                           -tags => [ 'messages', 'everything', $extra
+_tag ]);
    } elsif( $type eq 'score' ) {
        $this->{'canvas'}->createText( $x, $y, 
                            -fill    => 'white',
                            -font    => 'Arial 20 bold',
                            -text    => $text,
                            -tags    => [ 'scores', 'everything', $ext
+ra_tag ]);
    } elsif( $type eq 'title' ) {
        $this->{'canvas'}->createText( $x, $y, 
                            -fill    => 'red',
                            -font    => 'Arial 10 bold',
                            -text    => $text,
                            -tags    => [ 'titles', 'everything', $ext
+ra_tag ]);
    } elsif( $type eq 'debug' ) {
        $this->{'canvas'}->createText( $x, $y, 
                            -fill    => 'red',
                            -font    => 'Arial 10 bold',
                            -text    => $text,
                            -tags    => [ 'debug', 'everything', $extr
+a_tag ]);
    }
}




########
# MAIN #
########

package main;
use Tk;
use Tk::Dialog;
use Tk::JPEG;

my ( $anim_seq, $autopilot, $base, $cheat, %config );
my ( $game, $guys, $nosound );
my ( $pause_cb, $rocket, $score, $screen, $sound_c, %timer_id, $width 
+);
my ( $frame, $hmenu, $menu, $MW); # window variables

# Constants
sub BWIDTH      {10;}
sub COPYRIGHT   {'(c) 2003 David Bradford, Tinypig Software (www.tinyp
+ig.com)';}
sub DEBUG       {0;}
sub FONT        {'Arial 8 normal';}
sub PADX        {5;}
sub PADY        {3;}
sub ROCKET_DIR  {'.';}
sub VERSION     {'1.02';}

# game constants
sub AUTO_DOWN_RAND       {  30;}
sub AUTO_WRONG_DEVIATE   {  50;}
sub AUTO_WRONG_DONE_RAND { 100;}
sub AUTO_WRONG_RAND      {  30;}
sub BASE_RAND            {   3;}
sub CRASH_DELAY          {  15;}
sub CRASH_FRAMES         {  55;}
sub EXPLODE_MOVE         {   6;}
sub EXTRA_GUY            {1000;}
sub INCREMENT            {   2;}
sub INI_FILE             {'rocket.ini';}
sub MAX_GUYS             {   5;}
sub PIECE_SPACING        {   2;}
sub RIGHT_SIDE_FIX       {   4;}
sub SCR_WIDTH            { 500;}
sub SCR_HEIGHT           { 500;}
sub SUCCESS_FRAME_MIN    { 200;}
sub SUCCESS_FRAME_PLAY   { 100;}
sub SUCCESS_PLAY         {   8;}
sub SUCCESS_POINTS       { 100;}
sub TICK_DELAY           {  15;}
sub CRASH_SOUND          {'arcade11.wav';}
sub EXTRA_GUY_SOUND      {'arcade07.wav';}
sub LANDING_SOUND        {'arcade02.wav';}

# Initialization
my $auto_down      = 0;
my $gameover       = 0;
my $level          = 0;
my $paused         = 0;
my $purpose        = 0;
my $success_frames = 0;
my @b_colors       = ( 'green', 'magenta',    'blue',  'red', 'turquoi
+se' );
my @b_increments   = (       3,         4,         5,      6,         
+  7 );
my @next_level     = (     400,       800,      1200,   1600,      999
+999 );
my @width          = (      58,        56,        54,     52,         
+ 50 );
my $auto_wrong     = 0;

readConfig();

eval {
    require Win32::Sound;
};
$nosound         = $@?1:0;
$config{'sound'} = $@?0:$config{'sound'};
$sound_c         = $config{'sound'};

setupWindow();

$screen = Screen->new($MW);

# Debugging key binds
$MW->bind('<s>' => sub { $score += SUCCESS_POINTS; $screen->showScores
+($score, $config{'high'}) });
$MW->bind('<a>' => sub { $score -= SUCCESS_POINTS; $screen->showScores
+($score, $config{'high'}) });
$MW->bind('<f>' => sub { ++$guys;                  $screen->showGuys($
+rocket, $guys)            });
$MW->bind('<d>' => sub { $guys -= $guys>1?1:0;     $screen->showGuys($
+rocket, $guys)            });

# game key binds
$MW->bind('<x>'      => sub { exit }                             );
$MW->bind('<n>'      => \&startGame                              );
$MW->bind('<p>'      => \&pause                                  );
$MW->bind('<Left>'   => sub { $rocket->changeDirection('left')  });
$MW->bind('<Right>'  => sub { $rocket->changeDirection('right') });
$MW->bind('<Down>'   => sub { $rocket->changeDirection('down')  });
$MW->bind('<Up>'     => sub { if($cheat=$cheat?0:1) { calcAutopilot() 
+} else { $autopilot = 0 } });

# menu key binds
$MW->bind('<Alt-Key-r>' => sub {  $menu->Post; Tk::Menu->Unpost });
$MW->bind('<Alt-Key-h>' => sub { $hmenu->Post; Tk::Menu->Unpost });

$base   =   Base->new($screen,$width[$level]);
$rocket = Rocket->new($screen);

$screen->showTitles();
$base->initPosition();
# run as if game is over until a new game is started
gameOver();

# MainLoop gives control back to windows.
MainLoop;

# Subroutine: tick
# This is the main subroutine in the game.  Each time it is called,
# game pieces move their alloted distance and checks are made
# for success or failure.  This is out of alphabetical order because
# it is the main routine.
sub tick() {
    if( $paused ) {
        $timer_id{'t'} = $MW->after(TICK_DELAY, \&tick);
    } else {
        # if the game is over, auto-pilot the rocket
        if($autopilot) {
            # Here I am trying to make the auto-pilot look a little 
            # more human by giving it the wrong target location
            # every so often
            if( r(AUTO_WRONG_RAND) == 1 && !$auto_wrong && !$cheat ) {
                if( r(2) == 1 ) {
                    my $scr_max = (SCR_WIDTH) - $rocket->WIDTH + RIGHT
+_SIDE_FIX - $base->SIDE_WIDTH;
                    my $scr_min = $base->SIDE_WIDTH;
                    $auto_wrong = $autopilot - (AUTO_WRONG_DEVIATE) + 
+r((AUTO_WRONG_DEVIATE) * 2);
                    if( $auto_wrong < $scr_min ) { $auto_wrong = $scr_
+min }
                    if( $auto_wrong > $scr_max ) { $auto_wrong = $scr_
+max } 
                } else {
                    $auto_down = r(AUTO_DOWN_RAND);
                }
            }
            my $goal = $auto_wrong?$auto_wrong:$autopilot;
            if( abs($rocket->getHpos() - $goal) < 2 || $auto_down) {
                 $rocket->changeDirection('down'); 
                 if($auto_wrong){ if(r(AUTO_WRONG_DONE_RAND) == 1) { $
+auto_wrong = 0 } }
                 if($auto_down) { --$auto_down }
            } elsif($rocket->getHpos() < $goal) {
                 $rocket->changeDirection('right');
            } elsif($rocket->getHpos() > $goal) {
                 $rocket->changeDirection('left');
            } 
        }
        $rocket->move();
        if( DEBUG ) {
            $rocket->changeDirection('down');
            my $status = detectCrash()?'land':'CRASH';
            $screen->showDebug($rocket->getVpos(), $rocket->getHpos(),
+ $base->getHpos(), $status,
                                $base->getWidth(), $base->BOTH_SIDES, 
+); 
        }
        if( $rocket->getVpos() < ( (SCR_HEIGHT) - $rocket->HEIGHT - $b
+ase->HEIGHT - PIECE_SPACING ) ) {
            $base->move('base');
            $timer_id{'t'} = $MW->after(TICK_DELAY, \&tick);
        } else {
            $auto_wrong = 0;
            if( detectCrash() ) {
                success();
            } else {
                crash();
            }
        }
    }
}

sub calcAutopilot {
    # calculate number of ticks until landing
    my $k = int((((SCR_HEIGHT) - $rocket->HEIGHT - $base->HEIGHT - 2 -
+ $rocket->getVpos()) / INCREMENT) + .5);
    # calculate horizontal position rocket needs to be at
    $autopilot = $base->predictPosition($k) + ($base->SIDE_WIDTH) + r(
+SUCCESS_PLAY);
    if( !$cheat ) { $auto_down = r(AUTO_DOWN_RAND) };
}

# Subroutine: crash
# This routine is called when a crash is detected.
sub crash {
    --$guys unless $gameover;
    $anim_seq = 1;
    playSound(CRASH_SOUND);
    $success_frames = r(SUCCESS_FRAME_PLAY) + SUCCESS_FRAME_MIN;
    crashAnim();
}

# Subroutine: crashAnim
# Called by crash, this routine is like the "tick" routine for the 
# crash animation (the explosion and the base moving back and forth).
sub crashAnim {
    if( !$paused ) {
        ++$anim_seq;
        if( $anim_seq <= CRASH_FRAMES ) {
            $rocket->crashTick();
            $base->move('base');
            $timer_id{'c'} = $MW->after(CRASH_DELAY, \&crashAnim);
        } else {
            $rocket->delete();
            if( $anim_seq <= $success_frames ) {
                $base->move('base');
                $timer_id{'c'} = $MW->after(CRASH_DELAY, \&crashAnim);
            } else {
                if( $guys > 0 ) { 
                    init();
                } else {
                    gameOver();
                }
            }
        }
    } else {
        $timer_id{'c'} = $MW->after(CRASH_DELAY, \&crashAnim);
    }
}

# Subroutine: detectCrash
# Tell us if we are not aligned correctly with the base,
# and ready for a crash.
sub detectCrash {
    if( $rocket->getHpos() >= ( $base->getHpos() - SUCCESS_PLAY ) &&
        $rocket->getHpos() + $rocket->WIDTH <= 
        ( $base->getHpos() + $base->getWidth() + SUCCESS_PLAY ) ) 
    { return 1 }
    return 0;
}

# Subroutine: gameOver
# This routine is called after a crash, when it is determined you have
# no more "guys" left.
sub gameOver {
    $screen->showGameOver();
    startGame(1);
}

# Subroutine: gameOverAnim
# Called by gameOver, this routine is like the "tick" routine for the 
# game over animation (the base just keeps moving back and forth 
# until a new game is started).
sub gameOverAnim {
    $base->move('base');
    $timer_id{'c'} = $MW->after(CRASH_DELAY, \&gameOverAnim);
}

# Subroutine: init
# This routine resets the board after a successful landing, a crash,
# or the beginning of the game.
sub init {
    $rocket->initPosition();
    for(keys %timer_id) { $screen->afterCancel($timer_id{$_}) }
    %timer_id = ();
    $screen->clearGamePieces();
    if(!$gameover){ $screen->clearMessages() }
    $screen->showGuys($rocket, $guys);
    $rocket->makeRocket();

    # Autopilot the ship if the game is over
    if($gameover || $cheat ) {
        calcAutopilot();
    } else {
        $autopilot = 0;
    }

    tick();
}

# Subroutine: pause
# Called to pause the game, either when the pause key is pressed
# or when an option or help window pops up.
sub pause {
    my $pause = shift;
    $pause   ||= '';
    $paused  ||= 0;
    $purpose ||= 0;
    if( ref $pause ) { $pause = shift };
    if( !$gameover ) {
        if( ( $paused && $pause eq '' ) || ( $pause eq 'off' && !$purp
+ose ) ) {
            $paused   = 0;
            $pause_cb = 0;
            $purpose  = 0;
            $screen->clearMessages();
        } else {
            $paused   = 1;
            $pause_cb = 1;
            $purpose = ($pause eq '' || $purpose)?1:0;
            $screen->showPause();
        }
    }
}

# Subroutine: playSound
# Plays the specified sound. (Win32 only)
sub playSound {
    my $sound = shift;
    if(!$nosound && $config{'sound'} && !$gameover) {
        Win32::Sound::Play(ROCKET_DIR."/$sound",&Win32::Sound::SND_ASY
+NC);
    }
}

# Subroutine: r
# Return a random integer from 1 to the first parameter.
sub r {
    my $num = shift;
    return int(rand($num) + 1);
}

# Subroutine: readConfig
# Read the configuration file
sub readConfig {
    open IN, ROCKET_DIR.'/'.INI_FILE or die "Can't open ini file: $!";
    while(<IN>) {
        chomp;
        s/\s//g;
        my ($key, $value) = split /=/;
        $config{$key} = $value;
    }
    close IN;
}

# Subroutine: setBaseLevel
# This is called to set the difficulty level of the game
# by adjusting the base.
sub setBaseLevel {
    my $level = shift;
    $base->setWidth($width[$level]);
    $base->make($b_colors[$level]); #ZZZ all of this stuff should be c
+ontained in Base
    $base->setIncrement($b_increments[$level]);
}

# Subroutine: setHigh
# set the high score
sub setHigh {
    my $h = shift;
    $config{'high'} = $h;
    writeConfig();
}

# Subroutine: setupWindow
# Create the main window
sub setupWindow {
    $MW = MainWindow->new;
    $MW->title("Rocket");
    $frame = $MW->Frame(-relief      => 'ridge',
                        -borderwidth => 2)
                           ->pack(-side   => 'top',
                                  -anchor => 'n',
                                  -fill   => 'x');
    $menu = $frame
       ->Menubutton(-text      => "Rocket",
                    -underline => 0,
                    -font      => FONT,
                    -tearoff   => 0,
                    -menuitems => [['command'      => " New Game (n)",
                                    -underline     => 1,
                                    -font          => FONT,
                                    -command       => \&startGame],
                                   ['checkbutton'  => " Pause (p)",
                                    -underline     => 1,
                                    -onvalue       => 1,
                                    -offvalue      => 0,
                                    -variable      => \$pause_cb,
                                    -command       => \&pause,
                                    -font          => FONT,
                                    -command       => \&pause],
                                   ['command'      => " Options",
                                    -underline     => 1,
                                    -font          => FONT,
                                    -command       => \&showOptions],
                                   ['command'      => " Exit (x)",
                                    -underline     => 2,
                                    -font          => FONT,
                                    -command       => sub { exit }]])
                    ->pack(-side => 'left');
    $hmenu = $frame
       ->Menubutton(-text      => "Help",
                    -underline => 0,
                    -font      => FONT,
                    -tearoff   => 0,
                    -menuitems => [['command'  => "Help",
                                    -underline => 0,
                                    -font      => FONT,
                                    -command   => \&showHelp],
                                   ['command'  => "About",
                                    -underline => 0,
                                    -font      => FONT,
                                    -command   => \&showAbout]])
                    ->pack(-side => 'left');
}

# Subroutine: startGame
# Initializes the game.  Called when a new game is started.
sub startGame {
    $gameover  = shift;
    if(ref $gameover){ $gameover = shift };
    if(!$gameover) {
        $score = 0;
        $level = 0;
    }
    $guys    = MAX_GUYS;
    $purpose =        0;
    pause('off');
    $screen->showScores($score, $config{'high'});
    $screen->showGuys($rocket, $guys);
    setBaseLevel($level);
    init();
}

# Subroutine: showAbout
# Called to bring up the About window.
sub showAbout {
   my $howtouse_d=$MW->Dialog(
   -text           => qq|Rocket\nversion |.VERSION."\n".COPYRIGHT.qq|\
+n\n|,
   -title          => 'About',
   -font           => FONT,
   -default_button => 'Ok',
   -buttons        => ['Ok']);
   pause('on');
   $howtouse_d->geometry('480x160');
   $howtouse_d->Show;
   pause('off');
}

# Subroutine: showHelp
# Called to bring up the Help window.
sub showHelp {
    my $help_d;
    my $text = qq|Rocket
    version |.VERSION."\n".COPYRIGHT.qq|
    
    Land the rocket on the moving platform.
    Use the left, right, and down arrows to navigate.
    Other keys: 
    p - pause
    x - exit
    n - new game
    
    There is no "thrust".  It's part of the challenge.
    
    
    |;
    $text =~ s/    //g;
    $help_d=$MW->Dialog(
    -text           => $text,
    -title          => 'Help',
    -font           => FONT,
    -default_button => 'Ok',
    -buttons        => ['Ok']);
    pause('on');
    $help_d->Show;
    pause('off');
}

# Subroutine: showOptions
# Called to bring up the Options window.
sub showOptions {
   my $option_d=$MW->Toplevel();
   my $index;
   my $state = 'normal';
   my $subok = sub { 
                   $option_d->destroy;
                   $config{'sound'} = $sound_c;
                   writeConfig();
                   pause('off')
               };
   if( $nosound ) {
       $state = 'disabled';
       $sound_c = 0;
   }

   pause('on');
   $option_d->geometry('130x80');
   $option_d->grab();
   $option_d->bind('<Return>' => $subok );
   $option_d->bind('<Alt-Key-p>' => sub { $sound_c = $sound_c?0:1 } );
   $option_d->title("Options");
   $option_d->focus;

   my $undoc_cb=$option_d
         ->Checkbutton(-text      => "Play sound",
                       -underline => 0,
                       -variable  => \$sound_c,
                       -font      => FONT,
                       -state     => $state)
         ->pack(-side => 'top',
                -padx => PADX,
                -pady => PADY);
   my $ok=$option_d->Button(-text    => 'OK',
                            -font    => FONT,
                            -width   => BWIDTH,
                            -command => $subok )
                            ->pack(-side   => 'top');
   $option_d->waitWindow();
}

# Subroutine: success
# This is called when a successful landing on the base is detected.
sub success {
    if(!$gameover) {
        $score += SUCCESS_POINTS;
        if( $score > $config{'high'} ) { 
            setHigh($score);
        }
    }
    $screen->showScores($score, $config{'high'});
    if( $gameover && r(BASE_RAND) == 1 ) {
        setBaseLevel(r($#b_increments + 1) - 1);
    }
    $score ||= 0;
    if( $score >= $next_level[$level] && $level < $#b_increments ) {
        setBaseLevel(++$level);
    }
    if( !($score % EXTRA_GUY) && !$gameover ) {
        ++$guys;
        $screen->showGuys($rocket, $guys);
        playSound(EXTRA_GUY_SOUND);
    } else {
        playSound(LANDING_SOUND);
    }
    $anim_seq = 1;
    $success_frames = r(SUCCESS_FRAME_PLAY) + SUCCESS_FRAME_MIN;
    successAnim();
}

# Subroutine: successAnim
# Called by success, this routine is like the "tick" routine for the 
# success animation (that period of time where the rocket is just goin
+g
# back and forth on the platform after a landing).
sub successAnim {
    if( !$paused ) {
        ++$anim_seq;
        if( $anim_seq <= $success_frames ) {
            # strictly speaking in OO terms, this is cheating.  The ba
+se 
            # shouldn't know anything about the rocket, but it's much
            # more convenient and efficient to use the canvas methods
            # to move the rocket with the base.  I refuse to feel guil
+ty! :)
            $base->move('base_and_rocket'); 
            $timer_id{'t'} = $MW->after(TICK_DELAY, \&successAnim);
        } else {
            init();
        }
    } else {
        $timer_id{'t'} = $MW->after(TICK_DELAY, \&successAnim);
    }
}

# Subroutine: writeConfig
# Write the configuration back to the config file
sub writeConfig {
    open OUT, '>'.ROCKET_DIR.'/'.INI_FILE or die "Can't open ini file:
+ $!";
    for(keys %config) {
        print OUT "$_ = $config{$_}\n";
    }
    close OUT;
}

__END__

=head1 NAME

Rocket

=head1 DESCRIPTION 

This is a game, the object of which is to land a rocket on a moving pl
+atform.

=head1 README

Unzip the archive into its own directory.  cd to the directory.

Usage:

perl rocket.pl

You fly the rocket with the left, right, and down keys.
Other keys: 
<p>  - pause
<x>  - exit
<n>  - new game
<up> - God mode?

=head1 PREREQUISITES

This script requires C<Tk>, C<Tk::Dialog>, C<Tk::JPEG>, and C<Win32::S
+ound> (for sound under Win32 - no sound support
for Unix).

=head1 OSNAMES

Win32, Unix

=head1 SCRIPT CATEGORIES

Win32
Games

=head1 VERSION

1.02

=head1 HISTORY

Version 1.02
    - Cleaned up code
Version 1.01
    - Added autopilot AI
    - Cleaned up code
Version 1.00
    - Finally stable (whew)

=head1 AUTHOR

David Bradford dmbradford@altavista.com

=head1 COPYRIGHT

Copyright (c) 2003 David Bradford.  All rights reserved.  This program
+ is free software;
you can redistribute it and/or modify it under the same terms as Perl 
+itself; however, you
must leave this copyright statement intact.

=head1 DATE

May 1, 2003

=head1 SOURCE

This distribution can also be found at the author's web site 

http://www.tinypig.com

=cut
Replies are listed 'Best First'.
Re: Rocket
by Coruscate (Sexton) on May 05, 2003 at 07:08 UTC

    Perhaps the game could be modified to permit playing the audio on *nix systems as well. Modify the sound config checks so that playSound() will execute the Win32::Sound method on a windows box, while it will execute the following line on a *nix box:

    system "play " . ROCKET_DIR . "/$sound >/dev/null 2>&1 &";

    This way, *nix users get sound too ;)

    If the above content is missing any vital points or you feel that any of the information is misleading, incorrect or irrelevant, please feel free to downvote the post. At the same time, please reply to this node or /msg me to inform me as to what is wrong with the post, so that I may update the node to the best of my ability.

[reply]
[d/l]
      Yep, I definitely need to add sound support for Unix. Thanks for the how-to info.
[reply]
Re: Rocket
by BrowserUk (Patriarch) on May 05, 2003 at 06:11 UTC

    Neat code++

    A couple of problems. The program shouldn't die (at line 857) in the .ini file doesn't exist yet and/or a mention of what should be in the .ini file would be useful.

    A breif mention of what/where/size of stars.jpg would be friendly.

    Examine what is said, not who speaks.
    "Efficiency is intelligent laziness." -David Dunham
    "When I'm working on a problem, I never think about beauty. I think only how to solve the problem. But when I have finished, if the solution is not beautiful, I know it is wrong." -Richard Buckminster Fuller
[reply]
      Actually with what I need in that file I could just try to build it instead of dieing. And I can have my error messages for missing files point to the archive too. Thanks for the reply.
[reply]

Back to Code Catacombs

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: sourcecode [id://255552]
help
Chatterbox?
and the web crawler heard nothing...

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

    No recent polls found