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

# parts ripped from the testGraphics Zinc demo
# and shown by themselves for clarity

print "$$\n";

my $dx;
my $dy;

my $mw = MainWindow->new;
$mw->geometry("700x600");

my $canvas = $mw->Canvas(-width => 700, -height => 565,
                -bg => 'black',
        -borderwidth => 3, 
        -relief => 'sunken',
           )->pack;

my $closebutton = $mw->Button(-text => 'Exit', -command => sub{Tk::exi
+t(0)})
               ->pack; 

my $dragster = $canvas->createRectangle(0, 20, 50, 75, 
                             -fill => 'red',
                 -tags => ['move'],
                 
                 );

$canvas->bind('move', '<1>', sub {&mobileStart();});
$canvas->bind('move', '<B1-Motion>', sub {&mobileMove();});
$canvas->bind('move', '<ButtonRelease>', sub {&mobileStop();});

MainLoop;

sub mobileStart {
      my $ev = $canvas->XEvent;
      ($dx, $dy) = (0 - $ev->x, 0 - $ev->y);
      $canvas->raise('current');
#      print "START MOVE->  $dx  $dy\n";
}


sub mobileMove {
      my $ev = $canvas->XEvent;
      $canvas->move('current', $ev->x + $dx, $ev->y +$dy);
      ($dx, $dy) = (0 - $ev->x, 0 - $ev->y);
#      print "MOVING->  $dx  $dy\n";
}
sub mobileStop{&mobileMove;}
__END__
[download]

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

print "$$\n";

my %gradset = (# gradients zinc
        'logoptshadnew_active' => '=path 0 0|#00bd00;64 0|#e7ffe7;70 7
+8|#e7ffe7;0 100',
    'logoptshadnew3' => '=path 0 25|#d7ffd7;25 45|#888899;55 65|#fffff
+f;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);  # fo
+r out balls
my $outerring2a = $zinc->add('group',$centergroup2,-visible =>1); # fo
+r 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, '<Enter>', sub{
               $zinc->itemconfigure($inerbal, -fillcolor => $gradset{'
+logoptshadnew_active'}); 
               $mw->bind('<B1-Motion>' => \&start_drag);
                  } );

#account for mouse leaving inerball without starting a drag
$zinc->bind( $inerbal, '<Leave>', sub{
          if( ! $dragging ){
               $zinc->itemconfigure($inerbal, -fillcolor => $gradset{'
+logoptshadnew3'}); 
               $mw->bind('<B1-Motion>' => 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'}, $gr
+adset{'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('<ButtonRelease-1>' => \&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 cen
+ter
  $zinc->rotate($object,$diff_angle,'degree',$oxc,$oyc); # around zinc
+ center

  $cur_angle = $angle;
}
####################################
sub stop_drag{
  $dragging = 0;
  $zinc->itemconfigure($inerbal, -fillcolor => $gradset{'logoptshadnew
+3'}); 
  $mw->bind('<B1-Motion>' => sub{ });
}
######################################
[download]