newtons-cradle
0001 #!/usr/bin/perl
0002 use warnings;
0003 use strict;
0004 use Tk;
0005 use Tk::Zinc;
0006
0007 my $mw = tkinit;
0008
0009 my $heightmw = 260;
0010 my $width = 700;
0011 my $height = $heightmw - 60;
0012
0013 $mw->geometry($width.'x'.$heightmw .'+100+100');
0014
0015 my $zinc = $mw->Zinc(-width => $width,
0016 -height => $height,
0017 -backcolor => 'black')->pack(-fill=>'both',-expand => 1);
0018
0019 my $angle = 0;
0020 my $angle_init = 0;
0021 my $px0 = 0;
0022 my $py0 = 0;
0023 my $px_new = 180;
0024 my $py_new = $height;
0025 my ($dx0,$dy0,$dx1,$dy1,$dx2,$dy2);
0026 my $motion = 0;
0027 my $timer;
0028 my $toggle = -1;
0029 my $selset = 0; #has a number selection been made
0030 my @setleft =();
0031 my @setright =();
0032 my @movers =();
0033 my $drag = undef;
0034 my @tog_left;
0035 my @tog_right;
0036
0037 my %pends;
0038 #make and tag the pendulum groups
0039 my @pends = (0..7);
0040 for(@pends){
0041 $pends{$_}{'pendulum'} = $zinc->add('group',1,-visible=> 1);
0042
0043 # all lines are curves....of course!! it's relativity :-)
0044 $pends{$_}{'line'} = $zinc->add('curve',$pends{$_}{'pendulum'},
0045 [0 ,0, 0 ,$py_new],
0046 -linewidth => 1,
0047 -tags => ['line'],
0048 -fillcolor => 'white',
0049 -linecolor => 'white',
0050 -smoothrelief => 1,
0051 );
0052
0053 $pends{$_}{'ball'} = $zinc->add('arc',$pends{$_}{'pendulum'},
0054 [-15,$py_new,15,$py_new+30],
0055 -tags => ['ball','move'],
0056 -filled=> 1,
0057 -fillcolor => 'orange',
0058 );
0059
0060 $zinc->translate($pends{$_}{'pendulum'}, 245 + $_*30, 0);
0061 $pends{$_}{'center_rot'} = [245 + $_ * 30 ,0];
0062 $zinc->addtag($_,'withtag',$pends{$_}{'ball'}); #add a tag number to group
0063 #save initial matrix settings for zeroing out, compatible with tset
0064 $pends{$_}{'init'} = $zinc->tget( $pends{$_}{'pendulum'} );
0065 }
0066 # for(@pends){ print join ' ',@{$pends{$_}{'init'}},"\n";} }
0067
0068 my $bframe = $mw->Frame()->pack(-fill =>'both');
0069
0070 my $restartbut = $bframe->Button(
0071 -text=>'Restart',
0072 -background => 'lightyellow',
0073 -activebackground => 'yellow',
0074 -command =>sub{
0075 $timer->cancel;
0076 for(@pends){
0077 $zinc->tset($pends{$_}{'pendulum'}, @{ $pends{$_}{'init'}} );
0078 $zinc->dtag($pends{$_}{'ball'},'move'); # prevent double move tags
0079 $zinc->addtag('move','withtag','ball'); # restore move tags
0080 }
0081 $angle = 0;
0082 $angle_init = 0;
0083 $motion = 0;
0084 $toggle = -1;
0085 $selset = 0;
0086 @setleft =();
0087 @setright =();
0088 @movers =();
0089 $drag = undef;
0090 @tog_left = ();
0091 @tog_right = ();
0092
0093 &addbindings;
0094 })->pack(-side => 'left');
0095
0096 $bframe->Label(-text=>'Drag balls left or right with' .
0097 ' left mouse button and release',
0098 -background => 'black',
0099 -foreground => 'lightgreen',
0100
0101 )->pack(-side => 'left',-padx => 0,
0102 -expand => 1,-fill =>'both',);
0103
0104
0105 $bframe->Button(-text=>'Quit',
0106 -background =>'pink',
0107 -activebackground => 'red',
0108 -command =>sub{exit})->pack(-side => 'right');
0109
0110 &addbindings;
0111
0112 MainLoop;
0113 ######################################################
0114 sub addbindings{
0115 $zinc->bind('move', '<1>', sub { &mobileStart(); });
0116 $zinc->bind('move', '<B1-Motion>', sub {&mobileMove();});
0117 $zinc->bind('move', '<ButtonRelease>', sub {&mobileStop();});
0118 }
0119 #########################################################
0120 sub mobileStart {
0121 my $ev = $zinc->XEvent;
0122 ($dx0, $dy0) = ($ev->x,$ev->y);
0123 $zinc->raise('current');
0124 }
0125 ######################################################
0126
0127 sub mobileMove {
0128 return if $selset;
0129 my $ev = $zinc->XEvent;
0130 my ($dx1, $dy1) = ($ev->x ,$ev->y);
0131 ($dx2,$dy2) = ( $dx1 - $dx0, $dy1 - $dy0 );
0132 my @tags = $zinc->gettags('current');
0133 my ($pennum) = grep /\d+/, @tags;
0134
0135 if( !defined $drag ){
0136 my @stats;
0137 if($dx2 > 0){
0138 (@setright) = grep{ $_ >= $pennum} @pends;
0139 (@setleft) = grep{ $_ < $pennum} @pends;
0140 @movers = @setright;
0141 @stats = @setleft;
0142 $drag = 'right';
0143 }else{
0144 (@setleft) = grep{ $_ <= $pennum} @pends;
0145 (@setright) = grep{ $_ > $pennum} @pends;
0146 @movers = @setleft;
0147 @stats = @setright;
0148 $drag = 'left';
0149 }
0150
0151 for(@stats){
0152 $zinc->dtag($pends{$_}{'ball'},'move');
0153 }
0154 }
0155
0156 $angle_init += -$dx2/150; #chosen just as an easy value in the right range
0157
0158 if($drag eq 'right'){
0159 if( $angle_init <= -1.57 ){ $angle_init = -1.57; $dx2 = 0 }
0160 if( $angle_init >= 0 ){$angle_init = 0; $dx2 = 0}
0161 }
0162
0163 if($drag eq 'left'){
0164 if( $angle_init >= 1.57 ){ $angle_init = 1.57; $dx2 = 0 }
0165 if( $angle_init <= 0 ){$angle_init = 0; $dx2 = 0}
0166 }
0167
0168 for(@movers){
0169 $zinc->rotate($pends{$_}{'pendulum'},-$dx2/150,@{$pends{$_}{'center_rot'}});
0170 }
0171
0172 ($dx0, $dy0) = ($dx1, $dy1);
0173
0174 }
0175 #######################################################
0176
0177 sub mobileStop{
0178 $selset = 1;
0179 $zinc->bind('move', '<1>', sub { });
0180 $zinc->bind('move', '<B1-Motion>', sub { });
0181 $zinc->bind('move', '<ButtonRelease>', sub { });
0182 #compute @toggle sets
0183 my $count = scalar @movers;
0184 my @temp = @pends;
0185 @tog_left = splice( @temp, 0, $count );
0186 @temp = @pends;
0187 @tog_right = splice( @temp, -$count);
0188 #print "left->@tog_left\tright->@tog_right\n";
0189 &start;
0190 }
0191 #################################################
0192 ######################################################
0193 sub start{
0194 # print "\t\tangle_init->$angle_init\n";
0195 $angle = $angle_init;
0196 $timer = $zinc->repeat(20,sub{
0197 &swing(.017453); # 1 degree
0198 });
0199 }
0200 ######################################################
0201 sub swing{
0202 my $angle_old = $angle;
0203 my $rads = shift;
0204 $rads = $toggle*$rads;
0205 $angle = $angle - $rads;
0206 $angle = sprintf("%.4f", $angle);
0207
0208 #zero out, removes inaccuracies of rotations and rads
0209 if( abs($angle) < .0174 ){ #fudge factor for zeroing better
0210 # print "zero -> $angle\n";
0211 for(@pends){
0212 $zinc->tset($pends{$_}{'pendulum'}, @{ $pends{$_}{'init'}} );
0213 }
0214 $angle_old = 0;
0215 $angle = 0;
0216 $rads = 0;
0217 return;
0218 }
0219
0220 if($angle < 0){ @movers = @tog_right;}
0221 if($angle > 0){ @movers = @tog_left;}
0222
0223 # print "$angle\t$rads\n";
0224 for(@movers){ # rotate( item, rads, [center of rotation ])
0225 $zinc->rotate($pends{$_}{'pendulum'},
0226 -$rads,
0227 @{$pends{$_}{'center_rot'}});
0228 }
0229
0230 if( abs ($angle) > abs($angle_init) ) {
0231 # print "flip at $angle\n";
0232 $toggle *= -1
0233 }
0234
0235 }