Re: Perl 'Expert' Quiz of the Week #26 (Tk roller coaster simulation) zentara's SOLUTION

On Thu, 21 Oct 2004 08:09:53 -0400
Xavier Noria <[email protected]> wrote:

Here is my solution. It has inspired alot of possible future
Tk related questions.

#!/usr/bin/perl
use warnings;
use strict;
use Tk;

# by [email protected]
# This approach is a very simple method to simulate
# the roller-coaster motion. I didn't waste any time
# on actually computing the velocities or positions,
# rather I relied on the Law of Conservation of Energy,
# which says that the sum of the Kinetic and Potential
# Energies will remain constant. The initial total energy 
# is the potential energy at the highest point, and that
# is released into kinetic energy( i.e. velocity) as the
# coaster drops.  So as the coaster drops, 
# it's KE increases, and as the coaster climbs it's KE
# decreases, and stalls if it climbs past it's start height.
# 
# I figured this was the best approach, since we don't have 
# an actual equation to differentiate to get the instantaneous
# values. So this is not mathematically exact, it ignores the
# constants in favor of better animation.
# After all, it's just a visual simulation,  

# tested on the loop.rc and quad.rc files
# and a hacked loop.rc, removing the first 20 lines
# to test "thrust needed" situations
#
# built and tested with loop.rc so YMMV


$|++;
my $file = shift || 'loops.rc';
open (FH,"<$file") or die "$!\n";

my %segs =();
my $count = 0;       # holds how many segments there are
my $action = 0;      # action flag
my $cur_loc = 1;     # holds current segment in case of stop run
my $cur_ke  = 0;     # initial kinetic energy
my $g  = 10;         # gravitational acceleration
my $m = 1;           # mass of coaster 
                     # (left in for possible future Lorentz transforms :-))

my $velocity = 0;    # speedometer  :-)

while(<FH>){
    $count++;
    chomp;
    next if /^\s*#/ || /^\s*$/; #skip comments and blank lines 
    my ($x, $y) = split(/\s+/, $_); 
    $segs{$count} = [$x, (400 - $y) ]; #inverse coords  
}
close FH;
 
my $mw = tkinit;
$mw->geometry("650x450+100+100");

my $canvas = $mw->Canvas(-width => 620, -height => 420,
                         -bg => 'black')->pack();

my @s;
 foreach (1..$count){
   my @str = ( ${$segs{$_}}[0], ${$segs{$_}}[1] );
   push @s, @str;
}

my $curve = $canvas->createLine( @s,
                          -width => 5,
                          -smooth => 1,
			  -fill => 'lightgreen');

my $coaster = $canvas->createOval(${$segs{1}}[0] - 5,${$segs{1}}[1] - 5,
                                  ${$segs{1}}[0] + 5 ,${$segs{1}}[1] + 5, 
				  -fill => 'yellow'); 

my $group = $canvas->createGroup([${$segs{1}}[0],${$segs{1}}[1]], 
                                          -members => [$coaster]);

my $subframe = $mw->Frame(-background =>'gray50')->pack(-fill => 'x');

$subframe->Button(-text =>'Exit',
            -background => 'hotpink',
            -activebackground => 'red',
	    -command => sub{ exit }
            )->pack(-side=>'left',-padx=>40);

$subframe->Button(-text =>'Slower',
            -background => 'lightyellow',
	    -activebackground => 'yellow',
            -command => sub{ if($g < 3)
	                 { print chr(07);return}
	                 else{$g *= .8; print "$g\n"; } } #not too slow :-)
            )->pack(-side=>'left',-padx=>40);

$subframe->Label(-text =>'Velocity ',
            -background => 'black',
	    -foreground => 'green',
            )->pack(-side=>'left');

$subframe->Label(-textvariable => \$velocity,
            -width => 5,
            -background => 'black',
	    -foreground => 'green',
            )->pack(-side=>'left');

$subframe->Button(-text =>'Faster',
            -background => 'lightgreen',
	    -activebackground => 'green',
            -command => sub{ $g *= 1.25; print "$g\n"; }
            )->pack(-side=>'left',-padx=>40);

my $actbut;
$actbut = $subframe->Button(-text =>'Start',
              -background =>'lightsteelblue',
	      -activebackground =>'lightskyblue',
              -command => sub { &action($cur_loc,$cur_ke) },
             )->pack(-side=>'right',-padx=>40);

MainLoop;

#######################################################################
sub action {

  if( $actbut->cget(-text) eq 'Start'){
            $actbut->configure(-text=>'Stop');
            $action = 1; 
    }else{ 
            $actbut->configure(-text=>'Start');
            $action = 0; 
    }

my ($cur_seg,$cur_ke,) = @_;
my $dt;    

#   potential energy at start
  my $pe_max = $m*$g*(${$segs{1}}[1]);

#Energy is conserved so at any point
# pe_max = pe_current + ke_current 
# so 
# ke_current = pe_max - pe_current (both directly proportion to y)

while( $action ){      

    my $cur = $cur_seg;
    my $cur_next = $cur_seg + 1;
     if($cur_next > $count ){ $action = 0; 
                              $actbut->configure(-text=>'Start');
                              $cur_next = 1;       
                             }
      
    my $x1 = ${$segs{$cur}}[0]; 
    my $y1 = ${$segs{$cur}}[1];
      
    my $x2 = ${$segs{$cur_next}}[0]; 
    my $y2 = ${$segs{$cur_next}}[1];
    
     my $dx = $x2 - $x1;
     my $dy = $y2 - $y1;
     my $distance = sqrt( $dx**2 + $dy**2);

# compute average y of segment
     my $y_ave = ($y2 + $y1)/2;

    $cur_ke = $m*$g*$y_ave - $pe_max;  

#print "dy->$dy\tcur_ke->$cur_ke\n";
 
$canvas->move($group, $dx,$dy);
$canvas->update;    
   
   if($cur_next > $count ){ $cur_seg = 1}  
         else {$cur_seg++}
   
# velocity is proportional to the sqrt of ke
# and time is inverse to velocity        
# $v = $distance/$seconds 
# $seconds = $distance/$v 

  if($cur_ke >= 0){  
     my $v = sqrt(2*$cur_ke/$m);
     $dt =  $distance/$v;  # constant 2 added for visual effect 
         if($cur_loc >= $count){
              $cur_loc = 1; 
              $cur_ke = 0; 
              $dt = .001;
              $velocity = 0;
	     } 
       $velocity = sprintf('%.1f',$v);      
      
       #select(undef,undef,undef,$dt);   
       $mw->after($dt*1000,$canvas->update);
       #it's not the best to use a blocking select in Tk
       #but it's all in microseconds....so no problem
       #select takes seconds , after takes microseconds
     }else{ 
         my $message = 
        'Uh oh, Out of KE, Get out and push. Hit Start to get moving.' ; 
          $mw->messageBox(
             -background => 'lightyellow',
             -icon       => 'error',
             -message    => $message,
             -type       => 'OK'
              );
      &restart;
      } 

$cur_loc = $cur_seg;
} #end of while loop

if($cur_loc >= $count){
      $cur_loc = 1; 
      $cur_ke = 0; 
      $dt = .001;
      $velocity = 0;
  } 
}
######################################################
sub restart{
  $actbut->configure(-text=>'Start');
        
$action = 0;      # action flag
$cur_loc = 1;     # holds current segment in case of stop run
$cur_ke  = 0;     # initial kinetic energy
$g = 10;
 
}
####################################################

__END__

-- 
I'm not really a human, but I play one on earth.
http://zentara.net/japh.html