curve2
0001 #!/usr/bin/perl
0002 use warnings;
0003 use strict;
0004 use Tk;
0005 use Tk::Zinc;
0006
0007 my $motion_flag = 0;
0008 my $count = 0;
0009 my $delay = 100; #adjust for speed of your computer
0010
0011 my $mw = MainWindow->new;
0012 $mw->geometry("700x600");
0013 $mw->resizable(0,0);
0014
0015
0016 my $zinc = $mw->Zinc(-width => 700, -height => 565,
0017 -backcolor => 'black',
0018 -borderwidth => 3,
0019 -relief => 'sunken',
0020 )->pack;
0021
0022 # Then we create a gray filled rectangle, in which we will display explain text.
0023 $zinc->add('rectangle', 1 , [200, 400, 490, 490],
0024 -linewidth => 2,
0025 -filled => 1,
0026 -fillcolor => 'SkyBlue',
0027 );
0028 my $text = $zinc->add('text', 1,
0029 -position => [350, 445],
0030 -anchor => 'center',
0031 -priority => 2
0032 );
0033
0034 #examine the curves_bezier demo script to play with bezier points
0035 ##############################################################################
0036 my @posa = my @pos1 =
0037 my ($x1a,$y1a,$x2a,$y2a,$x3a,$y3a,$x4a,$y4a,) =
0038 my ($x1,$y1,$x2,$y2,$x3,$y3,$x4,$y4) =
0039 (120,100,80,50,50,50,10,100);
0040
0041 my $inchworm = $zinc->add('curve',1,[[$x1, $y1], [$x2, $y2, 'c'], [$x3, $y3, 'c'], [$x4,$y4]],
0042 -tags => ['bezier1'], -closed => 0, -linecolor => "orange", -linewidth => 10);
0043
0044 #make a flower
0045 my $petal = $zinc->add('curve',1,[[350, 281], [200,100, 'c'], [500,100, 'c'], [350,281]],
0046 -tags => ['bezier1'],
0047 -filled => 1,
0048 -fillcolor => 'pink',
0049 -closed => 1,
0050 -linecolor => "orange",
0051 -linewidth => 5);
0052
0053 my @petals = ();
0054 push(@petals,$petal);
0055 my $petalcount=1;
0056
0057 my @colors = qw(magenta blue cyan green yellow red);
0058 for my $color (@colors) {
0059 my $colortemp = $color;
0060 my $color = $zinc->clone($petal);
0061 #print "$color\n"; #prints $zinc's widget identifier
0062 push(@petals,$color);
0063 $zinc->itemconfigure($color,-fillcolor => $colortemp);
0064 $zinc->rotate($color,.9*$petalcount,350,281);
0065 $petalcount++;
0066 }
0067
0068
0069 ##############################################################################
0070
0071
0072 # Display comment
0073 &comment("Hit Enter to begin.");
0074 #set key binding
0075 $mw->Tk::bind('<Return>', \&start);
0076
0077 my $closebutton = $mw->Button(text => 'Exit', -command => sub{Tk::exit(0)})
0078 ->pack;
0079 MainLoop;
0080
0081 sub start {
0082 &comment("Hit Esc to stop, 'r' to reset.
0083 Up arrow inreases speed
0084 Down arrow decreases speed");
0085 $count =0;
0086 $motion_flag = 1;
0087 $mw->Tk::bind('<Return>', sub{});
0088 $mw->Tk::bind('<r>', \&resetpos);
0089 &startaction;
0090 }
0091
0092 sub stopaction{
0093 &comment("Hit Enter to begin");
0094 $motion_flag = 0;
0095 $mw->Tk::bind('<Return>', \&start);
0096 }
0097
0098
0099 sub startaction {
0100 $mw->Tk::bind('<Escape>', \&stopaction);
0101 $mw->Tk::bind('<Up>', sub{$delay = ($delay -1) unless $delay <= 1 });
0102 $mw->Tk::bind('<Down>', sub{$delay = ($delay + 1)unless $delay >= 1000} );
0103
0104 foreach $petal(@petals){
0105 if($petal % 2){$zinc->rotate($petal,-1,350,281)}
0106 else{$zinc->rotate($petal,1,350,281)}
0107 }
0108
0109 for(1..5){
0110 $x2 = $x2 + 2;$y2--;
0111
0112 $zinc->coords($inchworm,([[$x1, $y1],
0113 [$x2, $y2, 'c'],
0114 [$x3, $y3, 'c'],
0115 [$x4,$y4]]));
0116 }
0117 $x4=$x4+10;
0118 $y3=$y3+ 1 ;
0119 $count++;
0120 if($count == 5){$x1=$x1+ 50;
0121 $y2=$y2a;
0122 $x3 = $x3 + 50;
0123 $count =0}
0124
0125
0126 if($x4 > 725){
0127 ($x1,$y1,$x2,$y2,$x3,$y3,$x4,$y4) =
0128 ($x1a-100,$y1a,$x2a-100,$y2a,$x3a-100,$y3a,$x4a-100,$y4a);
0129 $zinc->coords($inchworm,([[$x1, $y1],
0130 [$x2, $y2, 'c'],
0131 [$x3, $y3, 'c'],
0132 [$x4a,$y4]]));
0133
0134 }
0135
0136
0137 if($motion_flag == 1){ $zinc->after($delay, sub {startaction()})}
0138 else {return}
0139 }
0140
0141
0142 sub resetpos{
0143 # $zinc->coords($inchworm,[[$x1a,$y1a], [$x2a, $y2a, 'c'], [$x3a, $y3a,'c'],[$x4a,$y4a]]);
0144 $zinc->coords($inchworm,[@posa]);
0145 ($x1,$y1,$x2,$y2,$x3,$y3,$x4,$y4) = ($x1a,$y1a,$x2a,$y2a,$x3a,$y3a,$x4a,$y4a);
0146 }
0147
0148
0149 # Just display comment
0150 sub comment {
0151 my $string = shift;
0152 $zinc->itemconfigure($text, -text => $string);
0153 }
0154