group1
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 ##############################################################################
0065 # Display comment
0066 &comment("Hit Enter to begin.");
0067 #set key binding
0068 $mw->Tk::bind('<Return>', \&start);
0069
0070 my $closebutton = $mw->Button(text => 'Exit', -command => sub{Tk::exit(0)})
0071 ->pack;
0072 MainLoop;
0073
0074 sub start {
0075 &comment("Hit Esc to stop, 'r' to reset.
0076 Up arrow inreases speed
0077 Down arrow decreases speed
0078 Left arrow moves left 1 pixel
0079 Right Arrow moves right 1 pixel
0080 'z' zoom out, 'a' zoom in");
0081 $count =0;
0082 $motion_flag = 1;
0083 $mw->Tk::bind('<Return>', sub{});
0084 $mw->Tk::bind('<r>', \&resetpos);
0085 &startaction;
0086 }
0087
0088 sub stopaction{
0089 $motion_flag = 0;
0090 $mw->Tk::bind('<Return>', \&start);
0091 }
0092
0093
0094 sub startaction {
0095 $mw->Tk::bind('<Escape>', \&stopaction);
0096 $mw->Tk::bind('<Up>', sub{$delay = ($delay -1) unless $delay <= 1 });
0097 $mw->Tk::bind('<Down>', sub{$delay = ($delay + 1)unless $delay >= 1000} );
0098 $mw->Tk::bind('<Right>', sub{$zinc->translate($flower,1,0)});
0099 $mw->Tk::bind('<Left>', sub{$zinc->translate($flower,-1,0)});
0100 $mw->Tk::bind('<a>', sub{$zinc->scale($flower,1.1,1.1)});
0101 $mw->Tk::bind('<z>', sub{$zinc->scale($flower,.9,.9)});
0102 $mw->Tk::bind('<r>', \&resetpos);
0103
0104 $zinc->rotate($flower,.5);
0105 #$zinc->rotate($centergroup,.5);
0106
0107 if($motion_flag == 1){ $zinc->after($delay, sub {startaction()})}
0108 else {return}
0109 }
0110
0111 sub resetpos{
0112 $zinc->treset($flower);
0113 }
0114
0115
0116 # Just display comment
0117 sub comment {
0118 my $string = shift;
0119 $zinc->itemconfigure($text, -text => $string);
0120 }
0121