#!/usr/bin/perl
use warnings;
use strict;
use Tk;
use Tk::Zinc;
my %gradset = (# gradients zinc
'logoptshadnew_active' => '=path 0 0|#00bd00;64 0|#e7ffe7;70 78|#e7ffe7;0 100',
'logoptshadnew3' => '=path 0 25|#d7ffd7;25 45|#888899;55 65|#ffffff;70 80',
);
my $dragging = 0;
my $cur_angle = 0;
my $mw = MainWindow->new;
# size of main window
$mw->geometry("600x500");
my $height = $mw->screenheight();
my $width = $mw->screenwidth();
my $zinc = $mw->Zinc( -width => $width, -height => $height,
-backcolor => 'white',
-borderwidth => 3, #
-relief => 'sunken', #
-render => 1
)->pack;
#make main object
my $object = $zinc->add('curve',1, [[-50,-100], [50,-100],[0,100] ],
-filled => 1,
-closed => 1,
-linecolor => "lightblue",
-linewidth => 5);
$zinc->translate($object,300,250);
my $oxc = 300; #center points for rotation
my $oyc = 250;
########################################################################
# make ball ring
my $centergroup2 = $zinc->add('group',1,-visible=> 1);
my ($xc,$yc) = (60,400);
$zinc->translate($centergroup2, $xc ,$yc);
my $outerring2 = $zinc->add('group',$centergroup2,-visible =>1); # for out balls
my $outerring2a = $zinc->add('group',$centergroup2,-visible =>1); # for inner ball
my $inerbal = $zinc->add('arc',$outerring2a, [ [-5,12], [5,22] ],
-filled => 1,
-fillcolor => $gradset{'logoptshadnew3'},
-linewidth => 0,
-priority => 100,
-visible=> 1,
-tags => ['move'],
);
$zinc->bind( $inerbal, '', sub{
$zinc->itemconfigure($inerbal, -fillcolor => $gradset{'logoptshadnew_active'});
$mw->bind('' => \&start_drag);
} );
#account for mouse leaving inerball without starting a drag
$zinc->bind( $inerbal, '', sub{
if( ! $dragging ){
$zinc->itemconfigure($inerbal, -fillcolor => $gradset{'logoptshadnew3'});
$mw->bind('' => sub{ });
}
});
# outer marker balls
my $refitem = $zinc->add('arc',$outerring2, [ [10,20], [20,30] ], # get more like sunken effect, not domes/balls
-filled => 1,
-fillcolor => $gradset{'logoptshadnew3'}, ## $refgrad, $gradset{'roundrect4ed'}, gradset{'roundpolyg'}, $gradset{'roundrect1'}, 2,
-linewidth => 0,
-priority => 100,
-visible => 1,
);
my @cloned_balls;
for (1..11){
my $relement = $zinc->clone($refitem);
$zinc->rotate($relement,.53*$_);
push(@cloned_balls, $relement, );
}
MainLoop;
sub start_drag{
$dragging = 1;
$mw->bind('' => \&stop_drag);
#get center of outerring2 (or use global from initial translate $xc $yc)
#my @center = $zinc->tget($centergroup2);
#print "@center\n";
my $ev = $zinc->XEvent;
my $x1 = $ev->x;
my $y1 = $ev->y;
my $x = $x1 - $xc;
my $y = $y1 - $yc;
#handle case where mouse crosses center
#and causes division by 0
if($x == $y){return}
my $cos = $x/($x**2 + $y**2)**(.5);
#see perldoc -f cos
my $angle = sprintf('%.2d', 180 / 3.1416 * atan2( sqrt(1 - $cos * $cos), $cos ));
$angle = $angle - 90; #adjust for downward starting point
if( $y < 0){ $angle = 180 - $angle } #quadrant adjustments
if( ( $x > 0) and ($y > 0) ){ $angle = 360 + $angle }
# print "$angle\n";
my $diff_angle = $angle - $cur_angle;
$zinc->rotate($inerbal,$diff_angle,'degree',0,0); # around group center
$zinc->rotate($object,$diff_angle,'degree',$oxc,$oyc); # around zinc center
$cur_angle = $angle;
}
###########################################################################
sub stop_drag{
$dragging = 0;
$zinc->itemconfigure($inerbal, -fillcolor => $gradset{'logoptshadnew3'});
$mw->bind('' => sub{ });
}
#########################################################################
perlmonks.org content © perlmonks.org and zentara
prlmnks.org © 2006 edmund von der burg (eccles & toad)
v 0.03