http://qs321.pair.com?node_id=482340
Category: GUI Programming
Author/Contact Info zentara@zentara.net
Description: There was an "advanced perl programming" weekly contest awhile back( now defunct I think". One I entered was a roller coaster simulation. The original contest had various *.rc files to make any kind of coaster track design. I just included a nice one in DATA, to make the script self-contained.
#!/usr/bin/perl
use warnings;
use strict;
use Tk;

# by zentara@zentara.net 
# There was an advanced perl programming contest awhile 
# back to simulate a roller coaster. This was my entry. 

# 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,   


$|++;

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(<DATA>){
    $count++;
    chomp;
    next if /^\s*#/ || /^\s*$/; #skip comments and blank lines  
    my ($x, $y) = split(/\s+/, $_);
    $segs{$count} = [$x, (400 - $y) ]; #inverse coords   
}


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 slo
+w :-) 
            )->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);
       $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;

}
#################################################### 

__DATA__
0 394
2.3575158001877 384.281866472832
4.71503160037539 374.563732945664
6.06061 369.017
8.64383766277946 359.356413328257
11.2270653255589 349.695826656515
12.1212 346.352
14.9606189063128 336.763585101046
17.8000378126256 327.175170202093
18.1818 325.886
21.3125696733328 316.388722429425
24.2424 307.501
27.7057926640821 298.119906713267
30.303 291.085
34.1461008917288 281.852959297317
36.3636 276.526
40.6402587824946 267.486631125011
42.4242 263.716
47.1938854848266 254.926796374197
48.4848 252.548
53.8116714994823 244.084877643092
54.5455 242.919
60.4934607710689 234.880233759723
60.6061 234.728
66.6667 227.877
72.7273 222.27
78.7879 217.814
84.8485 214.419
90.9091 211.996
96.9697 210.461
103.03 209.73
109.091 209.724
115.152 210.365
121.212 211.578
127.273 213.29
133.333 215.432
139.394 217.937
145.455 220.74
151.515 223.779
157.576 226.994
163.636 230.329
169.697 233.73
175.758 237.145
181.818 240.524
187.879 243.822
193.939 246.994
200 250
206.061 252.8
212.121 255.359
218.182 257.642
224.242 259.62
230.303 261.263
236.364 262.546
242.424 263.445
248.485 263.941
254.545 264.015
260.606 263.652
266.667 262.84
272.727 261.566
278.788 259.826
284.848 257.612
290.909 254.923
296.97 251.759
303.03 248.123
309.091 244.02
315.152 239.458
321.212 234.447
327.273 229.001
333.333 223.136
339.394 216.869
345.455 210.221
352.643002659968 203.268833592304
354.481768427949 201.490397188131
362.484429036145 195.493946305314
364.531592772057 193.959991862849
373.222704590131 189.013824117439
375.445981298941 187.74854301458
384.688480301704 183.930662426619
387.052807581594 182.954008902201
396.700934038571 180.324625729254
399.169025035956 179.652002192781
409.070622229409 178.252583378201
411.603553674894 177.894597504649
421.602467502155 177.747212719114
424.160293553745 177.70951015956
434.098835170697 178.816483749183
436.641217383587 179.099659095513
446.362650051933 181.44353342551
448.84949353988 182.043120833352
458.200504459138 185.586931605377
460.59259021477 186.493475223133
469.425708356719 191.181334424342
471.685311758706 192.380537517617
479.861233573601 198.138514808014
481.952719326472 199.611465227658
489.342505643231 206.348753865726
491.23288976727 208.072222303723
497.719999241234 215.682571222978
499.379469249544 217.62937755251
504.861596289098 225.992767004293
506.26398134833 228.132208926579
510.654669535195 237.116743263189
511.777853195219 239.415080501073
515.007858753819 248.879068248921
515.83412773736 251.300054651201
517.852511550524 261.094243069991
518.368835102122 263.599698234877
519.143766051391 273.56962712248
519.342001440201 276.120038525336
518.738279337106 288.663622276907
516.567189851047 301.032629680655
512.862972360167 313.031994100935
507.684044587088 324.472478392768
501.112081316534 335.173659284657
493.250726335181 344.966772761361
484.223957907231 353.69737557323
474.174133563124 361.227780898512
463.25974503624 367.439229746781
451.652918753587 372.23376385916
439.536701299225 375.53577056858
427.102172660287 377.293175256712
414.545432781436 377.478262601801
402.064508951594 376.088113665848
389.856232795301 373.144651928009
378.113136120411 368.694297538228
367.020414576475 362.807235243744
356.753007008709 355.576307533703
347.472836567911 347.115550457639
339.326257085636 337.558395208851
332.441744986851 327.055563834782
326.927873139962 315.772692260288
322.871598597821 303.88771811016
320.336891233059 291.588074526484
319.363724894979 279.067734236025
319.844467933595 269.079296613913
319.967446998075 266.524150484454
321.696282419674 256.674727755937
322.138536484133 254.155143080706
325.088199521363 244.600066525973
325.842753975014 242.155778660426
329.966726679732 233.045737544671
331.021681748093 230.715294368593
336.254926607204 222.193959482286
337.593645018647 220.014113476704
343.974841901801 212.314741662171
350.356038784956 204.615369847639
351.515 203.217
357.576 195.881
363.636 188.244
369.697 180.335
375.666385374612 172.312130298368
375.758 172.189
381.633028197966 164.096778817092
381.818 163.842
387.61969231521 155.697040437201
387.879 155.333
393.626601717571 147.149780920923
393.939 146.705
399.653041916071 138.498312179607
400 138
404.640414267479 129.141865014227
405.81598125221 126.89781298884
408.107679782248 117.163948502038
408.688241123453 114.698045876763
408.436304962584 102.167254899028
405.076002845147 90.0927957377904
398.818474911509 79.2333510689053
390.056904655316 70.2712597391627
379.341813758568 63.7696429070766
367.346470789654 60.137021069481
354.824587263097 59.6016452162806
342.562959173137 62.1971549813068
331.33202970778 67.7604649404056
321.837479469802 75.9420118684241
314.675885969171 86.2277190822502
310.297238464027 97.971297769454
308.97666348066 110.434855691257
310.429170584783 120.328804504166
310.797137602009 122.835261665674
314.66453653838 132.057150055096
315.644273743794 134.393352579828
321.683561613942 142.363735382522
323.213508515707 144.382891073898
331.045214651804 150.600959825354
333.029239059331 152.176197705349
342.161268561844 156.251248277456
344.474706924877 157.283590356751
354.33326079491 158.959572335074
356.830751272868 159.384152764138
366.796380313541 158.55575803715
369.320996394566 158.345898866128
378.767523482234 155.065178521148
381.160634253068 154.234065973563
389.494499348916 148.707159735512
391.605736858581 147.307015669346
397.858607118376 139.503067084548
404.111477378172 131.69911849975
406.061 129.266
411.770871873657 121.056410291225
412.121 120.553
417.86299660093 112.365846951784
418.182 111.911
423.980344212755 103.763656605346
424.242 103.396
430.125275198168 95.3097726384533
430.303 95.0655
436.30021327201 87.0634107121933
436.364 86.9783
442.424 79.1971
448.485 71.7868
454.545 64.8148
460.606 58.3514
466.667 52.4691
472.727 47.2434
478.788 42.7519
484.848 39.0753
490.909 36.2966
496.97 34.5013
503.03 33.7778
509.091 34.2169
515.152 35.912
521.212 38.9591
527.273 43.4567
533.333 49.5062
539.394 57.2112
544.785915229373 65.6330317579525
545.455 66.6781
550.168858249756 75.497370967671
551.515 78.0159
555.656632956219 87.1179259533778
557.576 91.3361
561.234281192232 100.642924308998
563.636 106.753
566.88712748787 116.20975261692
569.697 124.383
572.602168703062 133.951698699758
575.507337406125 143.520397399516
575.758 144.346
578.367632568624 153.999487341722
580.977265137247 163.652974683443
581.818 166.763
584.174501002549 176.481379650177
586.531002005099 186.199759300355
587.879 191.759
590.015958271494 201.528002474454
592.152916542988 211.297004948909
593.939 219.462
595.885767200493 229.270674602977
597.832534400985 239.079349205954
599.779301601478 248.888023808931
600 250
Replies are listed 'Best First'.
Re: ztk-roller-coaster-simulation
by chanio (Priest) on Aug 10, 2005 at 04:40 UTC
    Nice!

    Let me contribute by pollishing up the look of your script (you deserve this):

    (just replace your comments and the

    use Tk;
    before them with this...)

    use Getopt::Long; use Pod::Usage; use Tk; my $VERSION='1.00'; =pod =head1 NAME [ TkRollerCoaster.pl ] =head1 DESCRIPTION There was an "advanced perl programming" weekly contest awhile back( +now defunct I think". One I entered was a roller coaster simulation. The original contest h +ad various *.rc files to make any kind of coaster track design. I just included a nice one +in DATA, to make the script self-contained. 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, =head2 OPTIONS AND ARGUMENTS (-)-h(elp) Help: shows these options (-)-m(an) man : shows this pod (-)-v(ersion) print Modules, Perl, OS, Program info =item B<--version o -v> Prints module && script versions =item B<man> Man: shows these options =item B<help> Help: shows this pod =back =head1 SYNOPSIS Roller Coaster =head1 SCRIPT CATEGORIES fun =head1 OSNAMES any =head1 AUTHOR zentara #http://perlmonks.org/index.pl?node_id=131741# << zentara@zen +tara.net >> ~ Aug 09, 2005 at 15:03 ART (#482340)~ =cut my ($opt_help, $opt_man, $opt_versions); GetOptions( ## EXPECTED GETOPT: ! JUST MENTION THE WORD 'help!' => \$opt_help, 'man!' => \$opt_man, 'versions!' => \$opt_versions, ) or pod2usage(-verbose => 1 ) && exit; ## EXIT WITH SOME INFO pod2usage(-verbose => 1) && exit if defined $opt_help; pod2usage(-verbose => 2) && exit if defined $opt_man; if(defined $opt_versions) { print "\nModules, Perl, OS, Program info:\n", " Pod::Usage $Pod::Usage::VERSION\n", " Getopt::Long $Getopt::Long::VERSION\n", " strict $strict::VERSION\n", " Perl $]\n", " OS $^O\n", " TkRolerCoaster.pl $VERSION\n", " $0\n", "\n\n"; exit; }
    Then it looks more professional, don't you think so?

    Thank you!

    { \ ( ' v ' ) / }
    ( \ _ / ) _ _ _ _ ` ( ) ' _ _ _ _
    ( = ( ^ Y ^ ) = ( _ _ ^ ^ ^ ^
    _ _ _ _ \ _ ( m _ _ _ m ) _ _ _ _ _ _ _ _ _ ) c h i a n o , a l b e r t o
    Wherever I lay my KNOPPIX disk, a new FREE LINUX nation could be established
      Thanks. I'll update it later. Maybe this is the "nudge" I need to get over my "pod-o-phobia". :-)

      I'm not really a human, but I play one on earth. flash japh