[SPOILER] Solution to Perl 'Expert' Quiz of the Week #26 ( Roller Coaster )

this was a fun one.  I added some controls, see the title bar.  There is
also a stats window to show acceleration, velocity, position.

controls:
<s>top
<q>uit
<+>speed up
<->slow down
<u>pside down ( reverse gravity, hope you are strapped in! )
<p>ause time
<r>ebound ( reverse direction )

fun combos using reverse and upside down and speed up and slow down... um,
can you tell the requirements came from an eight year old?

>> start of script file >>

# coaster_car.pl
#
# roller coaster with some controls
# input file is required
#

use strict;
use warnings;

use Tk;

my $file = $ARGV[0];
$file = "loops.rc" unless $file;

my $border = 15;
my $car_color = 'blue';
my $car_count = 50;
my $gravity = 19.8;  # I like it fast...

my @roller_coaster_data;
my $current_point = 0;
my $increment_point = 1;

my $display_height = 400;
my $display_width  = 600;


my $title = 'coaster  <q>uit  <p>ause  <r>ebound <s>top <+>accel <->decel
<u>psidedown';
my $stats_window = MainWindow->new( -title => 'stats' );
my $main_window = MainWindow->new( -title => $title );

my $main_canvas = $main_window->Canvas( 
                -height => $display_height + $border*2,
                -width => $display_width + $border*2 )->pack( -fill =>
'both');

my $stats_canvas = $stats_window->Canvas( 
                -height => 70,
                -width => 100 )->pack( -fill => 'both');

# position main window, use geometry property.
# $stats_window->configure( -geome

load_data_file( \@roller_coaster_data, $file );

for my $track ( 0 .. $#roller_coaster_data )
{
    my ( $x, $y ) = 
        get_track_location( \@roller_coaster_data, $track );

    add_point( $main_canvas, $x, $y );
}

my @cars;
for( 1 .. $car_count )
{
    my $car_box = $main_canvas->createRectangle( 
        0, 0, 5, 5, 
        -outline => $car_color );
    push( @cars, $car_box );
}

my $current_car = 0;
my $car_delay_time = 20;

my $x_previous;
my $y_previous;
my $x_future;
my $y_future;

my $x_current = -1;
my $y_current = -1;

my $acceleration = 0;
my $velocity = 0;

my $acc_text = 0;
my $vel_text = 0;
my $xpos_text = 0;
my $ypos_text = 0;

$main_window->bind("<Key>", [ \&key_in, Ev('k'), Ev('K') ] ); 
$stats_window->bind("<Key>", [ \&key_in, Ev('k'), Ev('K') ] ); 

my $h_car_timer = 0;
start_timer();

MainLoop();


#############################################################
#############################################################
#############################################################

sub move_car
{
    my $data = shift;

    stop_timer();

    # initialize
    if( $x_current == -1 )
    {
        ( $x_previous, $y_previous ) = 
            get_track_location( $data, $current_point );
        $current_point += $increment_point;

        ( $x_future, $y_future ) = 
            get_track_location( $data, $current_point );
        $current_point += $increment_point;

        $x_current = $x_previous;
        $y_current = $y_previous;
    }

    if( $velocity < 0 )
    {
        my $x = $x_future;
        my $y = $y_future;
        $x_future = $x_previous;
        $y_future = $y_previous;
        $x_previous = $x;
        $y_previous = $y;

        $increment_point = -$increment_point;
        $current_point += $increment_point * 2;
        $velocity = -$velocity;
    }

    # move car

    my $time_available = $car_delay_time / 1000;

    my $dx_remaining = $x_future - $x_current;
    my $dy_remaining = $y_future - $y_current;
    my $d_remaining  = get_hyp( $dx_remaining, $dy_remaining );

    # leave loop when time available is zero.

    while( 1 )
    {
        # convert velocity to new vector
        # vx / vtotal = dx / dist
        # vx = dx * vtotal / dist
        # vy = dy * vtotal / dist

        my $d_used = $velocity * $time_available;

        # did we have enough track to move this time tick?
        if( abs($d_used) < $d_remaining )
        {
            # apply distance traveled vector to car x and y position
            # dx_used / dx_remaining = d_used / d_remaining
            # pos_x += dx_used

            $y_current += $d_used * $dy_remaining / $d_remaining;
            $x_current += $d_used * $dx_remaining / $d_remaining;
            last;
        }

        $y_current = $y_future;
        $x_current = $x_future;

        # keep track of time used so far
        # distance used = velocity * time used

        my $time_used = 0;
        $time_used = abs($d_used) / $velocity if $velocity;

        $time_available -= $time_used;

        # store previous point, get next point

        $x_previous = $x_future;
        $y_previous = $y_future;


        ( $x_future, $y_future ) = get_track_location( $data, $current_point
);
        $current_point += $increment_point;

        if( ( $current_point < 0 ) or ( $current_point > $#$data ) )
        {
            $increment_point = - $increment_point;
            $current_point += $increment_point * 2;
        }

        $dx_remaining = abs( $x_future - $x_current );
        $dy_remaining = abs( $y_future - $y_current );
        $d_remaining  = get_hyp( $dx_remaining, $dy_remaining );

        # incrementally accelerate car

        $acceleration = 0;
        $acceleration = $gravity * $dy_remaining / $d_remaining
            if $d_remaining > 0;

#        print "A: v=$velocity ; A = $acceleration\n";

        $velocity += $acceleration * $time_available / 1000;

        # apply negative if going uphill.
        # this is cosmetic only.
        if( $y_future < $y_current )
        {
            $acceleration = -$acceleration;
        }
    }

    # move car.
    # thickness varies from 1 to 10
    # speed of 1 - 20 = thickest
    my $thickness = 10 - abs( $velocity ) * 10 / 120;
    $current_car++;
    $current_car = 0 if( $current_car > $#cars );
    my $car_box = $cars[ $current_car ];
    $main_canvas->coords( 
        $car_box, 
        $x_current-$thickness/2, 
        $y_current-$thickness/2, 
        $x_current+$thickness/2, 
        $y_current+$thickness/2 );

    # accelerate car

    my $dx = $x_future - $x_current;
    my $dy = $y_future - $y_current;
    my $dist = get_hyp( $dx, $dy );

    my $acceleration = 0;
    $acceleration = $gravity * $dy / $dist
        if $dist > 0;

#    print "B: v=$velocity ; A = $acceleration\n";

    $velocity += $acceleration * $car_delay_time / 1000;

    # apply negative if going uphill.
    # this is cosmetic only.
    if( $y_future < $y_current )
    {
        $acceleration = -$acceleration;
    }

# make sure going in the right direction.

    update_stats();

    start_timer();
}




my $x1;
my $y1;
my $x2;
my $y2;

sub add_point
{
    my $canvas = shift;
    $x1 = shift;
    $y1 = shift;

    return unless( $x1 and $y1 );

#    $main_canvas->createRectangle( $x+10, $y+10, $x+15, $y+15, 
#        -outline => 'yellow' );

    if( $x2 or $y2 )
    {
        $main_canvas->createLine(  $x1, $y1, $x2, $y2 );
    }

    $x2 = $x1;
    $y2 = $y1;
}

sub load_data_file
{
    my $fill_me = shift;
    my $file_name = shift;

    open( IN, $file ) or 
        die "cannot open $file \n $! \n ";

    @$fill_me = <IN>;
    chomp( @$fill_me );
    close IN;
}

sub key_in
{
    my $obj = shift;
    my $key_id = shift;
    my $key_name = shift;

#    print "input: $key_id, $key_name\n";

    if( $key_name =~ /^q$/i )
    {
        exit( 0 );
    }

    if( $key_name =~ /^p$/i )
    {
        if( $h_car_timer )
        {
            stop_timer();
        }
        else
        {
            start_timer();
        }
    }

    if( $key_name =~ /^r$/i )
    {
        $velocity = -$velocity;
    }

    if( $key_name =~ /^s$/i )
    {
        $velocity = 0;
    }

    if( $key_name =~ /^plus$/i )
    {
        $velocity++;
    }

    if( $key_name =~ /^minus$/i )
    {
        $velocity--;
    }

    if( $key_name =~ /^u$/i )
    {
        $gravity = -$gravity;
    }

    update_stats();
}

sub get_hyp
{
    my $len1 = shift;
    my $len2 = shift;
    my $hyp = ( $len1 ** 2 + $len2 ** 2 ) ** .5;
    return $hyp;
}

sub get_track_location
{
    my $data = shift;
    my $index = shift;
    my $x;
    my $y;

    my $set = $$data[ $index ];

    ( $x, $y ) = split( ' ', $set );
    $y = $display_height - $y;

    $x += $border;
    $y += $border;

    return ( $x, $y );
}


sub start_timer
{
    if( $h_car_timer == 0 )
    {
        $h_car_timer = $main_window->repeat(
            $car_delay_time,
            [ \&move_car, \@roller_coaster_data ] );
    }
}

sub stop_timer
{
    if( $h_car_timer )
    {
        $h_car_timer->cancel() ;
        $h_car_timer = 0;
    }
}

sub update_stats
{
    if( $vel_text == 0 )
    {
        $acc_text  = $stats_canvas->create( 'text', 20, 15 );
        $vel_text  = $stats_canvas->create( 'text', 20, 27 );
        $xpos_text = $stats_canvas->create( 'text', 20, 39 );
        $ypos_text = $stats_canvas->create( 'text', 20, 51 );
    }

    my ( $a ) = $acceleration =~ /(-?\d+)/;
    my ( $v ) = $velocity =~ /(-?\d+)/;
    my ( $x ) = $x_current =~ /(\d+)/;
    my ( $y ) = $y_current =~ /(\d+)/;

    $stats_canvas->itemconfigure( $acc_text, -text => "a: $a" );
    $stats_canvas->itemconfigure( $vel_text, -text => "v: $v" );
    $stats_canvas->itemconfigure( $xpos_text, -text => "x: $x" ); 
    $stats_canvas->itemconfigure( $ypos_text, -text => "y: $y" ); 

}


<< end of script file <<


-------------------------------------------------------------------------------
This message and any included attachments are from Siemens Medical Solutions 
USA, Inc. and are intended only for the addressee(s).  
The information contained herein may include trade secrets or privileged or 
otherwise confidential information.  Unauthorized review, forwarding, printing, 
copying, distributing, or using such information is strictly prohibited and may 
be unlawful.  If you received this message in error, or have reason to believe 
you are not authorized to receive it, please promptly delete this message and 
notify the sender by e-mail with a copy to Central.SecurityOffice-/v/[email protected] 

Thank you