#!/usr/bin/perl
use warnings;
use strict;
use Tk;
use Tk::Zinc;
my $mw = tkinit;
my $heightmw = 260;
my $width = 700;
my $height = $heightmw - 60;
$mw->geometry($width.'x'.$heightmw .'+100+100');
my $zinc = $mw->Zinc(-width => $width,
-height => $height,
-backcolor => 'black')->pack(-fill=>'both',-expand => 1);
my $angle = 0;
my $angle_init = 0;
my $px0 = 0;
my $py0 = 0;
my $px_new = 180;
my $py_new = $height;
my ($dx0,$dy0,$dx1,$dy1,$dx2,$dy2);
my $motion = 0;
my $timer;
my $toggle = -1;
my $selset = 0; #has a number selection been made
my @setleft =();
my @setright =();
my @movers =();
my $drag = undef;
my @tog_left;
my @tog_right;
my %pends;
#make and tag the pendulum groups
my @pends = (0..7);
for(@pends){
$pends{$_}{'pendulum'} = $zinc->add('group',1,-visible=> 1);
# all lines are curves....of course!! it's relativity :-)
$pends{$_}{'line'} = $zinc->add('curve',$pends{$_}{'pendulum'},
[0 ,0, 0 ,$py_new],
-linewidth => 1,
-tags => ['line'],
-fillcolor => 'white',
-linecolor => 'white',
-smoothrelief => 1,
);
$pends{$_}{'ball'} = $zinc->add('arc',$pends{$_}{'pendulum'},
[-15,$py_new,15,$py_new+30],
-tags => ['ball','move'],
-filled=> 1,
-fillcolor => 'orange',
);
$zinc->translate($pends{$_}{'pendulum'}, 245 + $_*30, 0);
$pends{$_}{'center_rot'} = [245 + $_ * 30 ,0];
$zinc->addtag($_,'withtag',$pends{$_}{'ball'}); #add a tag number to group
#save initial matrix settings for zeroing out, compatible with tset
$pends{$_}{'init'} = $zinc->tget( $pends{$_}{'pendulum'} );
}
# for(@pends){ print join ' ',@{$pends{$_}{'init'}},"\n";} }
my $bframe = $mw->Frame()->pack(-fill =>'both');
my $restartbut = $bframe->Button(
-text=>'Restart',
-background => 'lightyellow',
-activebackground => 'yellow',
-command =>sub{
$timer->cancel;
for(@pends){
$zinc->tset($pends{$_}{'pendulum'}, @{ $pends{$_}{'init'}} );
$zinc->dtag($pends{$_}{'ball'},'move'); # prevent double move tags
$zinc->addtag('move','withtag','ball'); # restore move tags
}
$angle = 0;
$angle_init = 0;
$motion = 0;
$toggle = -1;
$selset = 0;
@setleft =();
@setright =();
@movers =();
$drag = undef;
@tog_left = ();
@tog_right = ();
&addbindings;
})->pack(-side => 'left');
$bframe->Label(-text=>'Drag balls left or right with' .
' left mouse button and release',
-background => 'black',
-foreground => 'lightgreen',
)->pack(-side => 'left',-padx => 0,
-expand => 1,-fill =>'both',);
$bframe->Button(-text=>'Quit',
-background =>'pink',
-activebackground => 'red',
-command =>sub{exit})->pack(-side => 'right');
&addbindings;
MainLoop;
######################################################
sub addbindings{
$zinc->bind('move', '<1>', sub { &mobileStart(); });
$zinc->bind('move', '<B1-Motion>', sub {&mobileMove();});
$zinc->bind('move', '<ButtonRelease>', sub {&mobileStop();});
}
#########################################################
sub mobileStart {
my $ev = $zinc->XEvent;
($dx0, $dy0) = ($ev->x,$ev->y);
$zinc->raise('current');
}
######################################################
sub mobileMove {
return if $selset;
my $ev = $zinc->XEvent;
my ($dx1, $dy1) = ($ev->x ,$ev->y);
($dx2,$dy2) = ( $dx1 - $dx0, $dy1 - $dy0 );
my @tags = $zinc->gettags('current');
my ($pennum) = grep /\d+/, @tags;
if( !defined $drag ){
my @stats;
if($dx2 > 0){
(@setright) = grep{ $_ >= $pennum} @pends;
(@setleft) = grep{ $_ < $pennum} @pends;
@movers = @setright;
@stats = @setleft;
$drag = 'right';
}else{
(@setleft) = grep{ $_ <= $pennum} @pends;
(@setright) = grep{ $_ > $pennum} @pends;
@movers = @setleft;
@stats = @setright;
$drag = 'left';
}
for(@stats){
$zinc->dtag($pends{$_}{'ball'},'move');
}
}
$angle_init += -$dx2/150; #chosen just as an easy value in the right range
if($drag eq 'right'){
if( $angle_init <= -1.57 ){ $angle_init = -1.57; $dx2 = 0 }
if( $angle_init >= 0 ){$angle_init = 0; $dx2 = 0}
}
if($drag eq 'left'){
if( $angle_init >= 1.57 ){ $angle_init = 1.57; $dx2 = 0 }
if( $angle_init <= 0 ){$angle_init = 0; $dx2 = 0}
}
for(@movers){
$zinc->rotate($pends{$_}{'pendulum'},-$dx2/150,@{$pends{$_}{'center_rot'}});
}
($dx0, $dy0) = ($dx1, $dy1);
}
#######################################################
sub mobileStop{
$selset = 1;
$zinc->bind('move', '<1>', sub { });
$zinc->bind('move', '<B1-Motion>', sub { });
$zinc->bind('move', '<ButtonRelease>', sub { });
#compute @toggle sets
my $count = scalar @movers;
my @temp = @pends;
@tog_left = splice( @temp, 0, $count );
@temp = @pends;
@tog_right = splice( @temp, -$count);
#print "left->@tog_left\tright->@tog_right\n";
&start;
}
#################################################
######################################################
sub start{
# print "\t\tangle_init->$angle_init\n";
$angle = $angle_init;
$timer = $zinc->repeat(20,sub{
&swing(.017453); # 1 degree
});
}
######################################################
sub swing{
my $angle_old = $angle;
my $rads = shift;
$rads = $toggle*$rads;
$angle = $angle - $rads;
$angle = sprintf("%.4f", $angle);
#zero out, removes inaccuracies of rotations and rads
if( abs($angle) < .0174 ){ #fudge factor for zeroing better
# print "zero -> $angle\n";
for(@pends){
$zinc->tset($pends{$_}{'pendulum'}, @{ $pends{$_}{'init'}} );
}
$angle_old = 0;
$angle = 0;
$rads = 0;
return;
}
if($angle < 0){ @movers = @tog_right;}
if($angle > 0){ @movers = @tog_left;}
# print "$angle\t$rads\n";
for(@movers){ # rotate( item, rads, [center of rotation ])
$zinc->rotate($pends{$_}{'pendulum'},
-$rads,
@{$pends{$_}{'center_rot'}});
}
if( abs ($angle) > abs($angle_init) ) {
# print "flip at $angle\n";
$toggle *= -1
}
}
#################################################################
|