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

my $motion_flag = 0;
my $count = 0;
my $delay = 100; #adjust for speed of your computer

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

my $zinc = $mw->Zinc(-width => 700, -height => 565,
                -render => 1,
                -backcolor => 'black',
        -borderwidth => 3, 
        -relief => 'sunken',
        )->pack;

   
# Then we create a gray filled rectangle, in which we will display exp
+lain text.
$zinc->add('rectangle', 1 , [100, 400, 590, 490],
       -linewidth => 2,
       -filled => 1,
       -fillcolor => '=radial -20 -20|#ffffff 0|#f700f7 48|#900090 80|
+#ab00ab 100',
       );
       
$zinc->fontCreate("fonta", -family => 'arial',  
                  -size => -30, -weight => 'normal');       

my $text = $zinc->add('text', 1,
              -position => [350, 445],
              -anchor => 'center',
              -font => 'fonta',
              -priority => 2, 
              );

#examine the curves_bezier demo script to play with bezier points
######################################################################
+########
my @posa = my @pos1 =
my ($x1a,$y1a,$x2a,$y2a,$x3a,$y3a,$x4a,$y4a,) = 
     my ($x1,$y1,$x2,$y2,$x3,$y3,$x4,$y4) = 
          (120,100,80,50,50,50,10,100);

my $inchworm = $zinc->add('curve',1,[[$x1, $y1], [$x2, $y2, 'c'], [$x3
+,
$y3, 'c'], [$x4,$y4]],
       -tags => ['bezier1'], -closed => 0, 
       -filled => 1, 
       -fillcolor => '=radial -20 -20|#ffffff 0|#f700f7 48|#900090 80|
+#ab00ab 100',
       -linewidth => 10,
       -smoothrelief => 1
       );

#make a flower
my $petal = $zinc->add('curve',1,[[350, 281], [200,100, 'c'], [500,100
+,
'c'], [350,281]],
               -tags => ['bezier1'], 
           -filled => 1,
           #-fillcolor => 'pink',
           -fillcolor => '=radial -20 -20|#ffffff 0|#f700f7 48|#900090
+ 80|#ab00ab 100',
           -closed => 1, 
#           -linecolor => "orange", 
#           -linewidth => 5 ,
           -smoothrelief => 1
           );

my @petals = ();
push(@petals,$petal);
my $petalcount=1;

my @colors = ('#ff0000', '#00ff00', '#0000ff', '#ffff00', '#ff00ff',
'#00ffff');
for my $color (@colors) {
  my $colortemp = '=radial -20 -20|#ffffff 0|'. $color . ' 48|#900090 
+80|#ab00ab 100';
  my $color = $zinc->clone($petal);
  #print "$color\n";  #prints $zinc's widget identifier
  push(@petals,$color);
  #$zinc->itemconfigure($color,-fillcolor => $colortemp);

  $zinc->itemconfigure($color, -fillcolor => $colortemp);

$zinc->rotate($color,.9*$petalcount,350,281);
$petalcount++;
}


######################################################################
+########


# Display comment
&comment("Hit Enter to begin.");
#set key binding
$mw->Tk::bind('<Return>', \&start); 

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

sub start {
    &comment("Hit Esc to stop, 'r' to reset.
    Up arrow inreases speed
    Down arrow decreases speed");
    $count =0;
    $motion_flag = 1;   
    $mw->Tk::bind('<Return>', sub{}); 
    $mw->Tk::bind('<r>', \&resetpos); 
    &startaction;
}

sub stopaction{
    &comment("Hit Enter to begin");    
    $motion_flag = 0;
    $mw->Tk::bind('<Return>', \&start);
}


sub startaction {
    $mw->Tk::bind('<Escape>', \&stopaction);
    $mw->Tk::bind('<Up>', sub{$delay = ($delay -1) unless $delay <= 1
}); 
    $mw->Tk::bind('<Down>', sub{$delay = ($delay + 1)unless $delay >=
1000} ); 

foreach $petal(@petals){
               if($petal % 2){$zinc->rotate($petal,-1,350,281)}
           else{$zinc->rotate($petal,1,350,281)}
          }

                       for(1..5){
                             $x2 = $x2 + 2;$y2--;

                              $zinc->coords($inchworm,([[$x1, $y1], 
                                                      [$x2, $y2, 'c'],
+ 
                                          [$x3, $y3, 'c'], 
                                          [$x4,$y4]]));
                             }
                     $x4=$x4+10;
             $y3=$y3+ 1 ;
             $count++; 
                            if($count == 5){$x1=$x1+ 50; 
                                $y2=$y2a;
                        $x3 = $x3 + 50;
                        $count =0}
                     

         if($x4 > 725){
          ($x1,$y1,$x2,$y2,$x3,$y3,$x4,$y4) =  
          ($x1a-100,$y1a,$x2a-100,$y2a,$x3a-100,$y3a,$x4a-100,$y4a);
                             $zinc->coords($inchworm,([[$x1, $y1], 
                                                      [$x2, $y2, 'c'],
+ 
                                          [$x3, $y3, 'c'], 
                                          [$x4a,$y4]]));
                                
             }
             

  if($motion_flag == 1){ $zinc->after($delay, sub {startaction()})}
     else {return}
}


sub resetpos{
#  $zinc->coords($inchworm,[[$x1a,$y1a], [$x2a, $y2a, 'c'], [$x3a,$y3a
+,'c'],[$x4a,$y4a]]);
   $zinc->coords($inchworm,[@posa]);
  ($x1,$y1,$x2,$y2,$x3,$y3,$x4,$y4) =
($x1a,$y1a,$x2a,$y2a,$x3a,$y3a,$x4a,$y4a);
 }

# Just display comment 
sub comment {
    my $string = shift;
    $zinc->itemconfigure($text, -text => $string);
}

__END__
[download]