group2
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
0037 #create a group with it's origin at center
0038 my $centergroup= $zinc->add('group',1,-visible=> 1);
0039 $zinc->translate($centergroup,350,281);
0040
0041 #make a group for the flower petals, add it to the $centergroup
0042 my $flower = $zinc->add('group',$centergroup,-visible => 1);
0043
0044 #make a flower
0045 my $petal = $zinc->add('curve',$flower,[[0,0], [-150,-200, 'c'], [150,-200, 'c'], [0,0]],
0046 -tags => ['bezier1'],
0047 -filled => 1,
0048 -fillcolor => 'pink',
0049 -closed => 1,
0050 -linecolor => "white",
0051 -linewidth => 5);
0052
0053 print "$petal\n"; #prints $zinc's widget identifier
0054 my $petalcount=1;
0055 for my $color (qw(magenta blue cyan green yellow red)) {
0056 my $colortemp = $color;
0057 my $color = $zinc->clone($petal);
0058 print "$color\n"; #prints $zinc's widget identifier
0059 $zinc->itemconfigure($color,-fillcolor => $colortemp);
0060 $zinc->rotate($color,.9*$petalcount);
0061 $petalcount++;
0062 }
0063
0064 my $outerring = $zinc->add('group',$centergroup,-visible =>1);
0065 #make a ring
0066 my $ringelement = $zinc->add('curve',$outerring,[[0,-160],[-25,-200],[25,-200]],
0067 -closed => 1,
0068 -filled => 1,
0069 -fillcolor => 'orange'
0070 );
0071
0072 for (1..23){
0073 my $relement = $zinc->clone($ringelement);
0074 $zinc->rotate($relement,.26*$_);
0075 }
0076
0077 ##############################################################################
0078 # Display comment
0079 &comment("Hit Enter to begin.");
0080 #set key binding
0081 $mw->Tk::bind('<Return>', \&start);
0082
0083 my $closebutton = $mw->Button(text => 'Exit', -command => sub{Tk::exit(0)})
0084 ->pack;
0085 MainLoop;
0086
0087 sub start {
0088 &comment("Hit Esc to stop, 'r' to reset.
0089 Up arrow inreases speed
0090 Down arrow decreases speed
0091 Left arrow moves left 1 pixel
0092 Right Arrow moves right 1 pixel
0093 'z' zoom out, 'a' zoom in");
0094 $count =0;
0095 $motion_flag = 1;
0096 $mw->Tk::bind('<Return>', sub{});
0097 $mw->Tk::bind('<r>', \&resetpos);
0098 &startaction;
0099 }
0100
0101 sub stopaction{
0102 $motion_flag = 0;
0103 $mw->Tk::bind('<Return>', \&start);
0104 }
0105
0106
0107 sub startaction {
0108 $mw->Tk::bind('<Escape>', \&stopaction);
0109 $mw->Tk::bind('<Up>', sub{$delay = ($delay -1) unless $delay <= 1 });
0110 $mw->Tk::bind('<Down>', sub{$delay = ($delay + 1)unless $delay >= 1000} );
0111 $mw->Tk::bind('<Right>', sub{$zinc->translate($centergroup,1,0)});
0112 $mw->Tk::bind('<Left>', sub{$zinc->translate($centergroup,-1,0)});
0113 $mw->Tk::bind('<a>', sub{$zinc->scale($centergroup,1.1,1.1)});
0114 $mw->Tk::bind('<z>', sub{$zinc->scale($centergroup,.9,.9)});
0115 $mw->Tk::bind('<r>', \&resetpos);
0116
0117 $zinc->rotate($flower,.5);
0118 $zinc->rotate($outerring,-1);
0119
0120 if($motion_flag == 1){ $zinc->after($delay, sub {startaction()})}
0121 else {return}
0122 }
0123
0124 sub resetpos{
0125 $zinc->treset($flower);
0126 }
0127
0128
0129 # Just display comment
0130 sub comment {
0131 my $string = shift;
0132 $zinc->itemconfigure($text, -text => $string);
0133 }
0134