Zinc-rotating dial demo
zentara
created: 2006-05-01 14:26:52
Here is a not-so-obvious snippet, to demonstrate how to control a Tk::Zinc object's rotation, by rotating a separate group. It was in reference to [id:// 546597]. To rotate the vane, put the mouse over the inner circle in the circle-dial ring, and drag like you are turning the dial.
#!/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