group0
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 my $zinc = $mw->Zinc(-width => 700, -height => 565,
0016 -backcolor => 'black',
0017 -borderwidth => 3,
0018 -relief => 'sunken',
0019 )->pack;
0020
0021 # Then we create a gray filled rectangle, in which we will display explain text.
0022 $zinc->add('rectangle', 1 , [200, 400, 490, 490],
0023 -linewidth => 2,
0024 -filled => 1,
0025 -fillcolor => 'SkyBlue',
0026 );
0027 my $text = $zinc->add('text', 1,
0028 -position => [350, 445],
0029 -anchor => 'center',
0030 -priority => 2
0031 );
0032
0033 #examine the curves_bezier demo script to play with bezier points
0034 ##############################################################################
0035 #make a group for the flower petals
0036 my $flower = $zinc->add('group',1,-visible => 1);
0037 print "flowergroup-> $flower\n";
0038
0039 #make a flower
0040 my $petal = $zinc->add('curve',$flower,[[350, 281], [200,100, 'c'], [500,100, 'c'], [350,281]],
0041 -tags => ['bezier1'],
0042 -filled => 1,
0043 -fillcolor => 'pink',
0044 -closed => 1,
0045 -linecolor => "white",
0046 -linewidth => 5);
0047
0048 print "$petal\n"; #prints $zinc's widget identifier
0049 my $petalcount=1;
0050 for my $color (qw(magenta blue cyan green yellow red)) {
0051 my $colortemp = $color;
0052 my $color = $zinc->clone($petal);
0053 print "$color\n"; #prints $zinc's widget identifier
0054 $zinc->itemconfigure($color,-fillcolor => $colortemp);
0055 $zinc->rotate($color,.9*$petalcount,350,281);
0056 $petalcount++;
0057 }
0058
0059 ##############################################################################
0060 # Display comment
0061 &comment("Hit Enter to begin.");
0062 #set key binding
0063 $mw->Tk::bind('<Return>', \&start);
0064
0065 my $closebutton = $mw->Button(text => 'Exit', -command => sub{Tk::exit(0)})
0066 ->pack;
0067 MainLoop;
0068
0069 sub start {
0070 &comment("Hit Esc to stop, 'r' to reset.
0071 Up arrow inreases speed
0072 Down arrow decreases speed
0073 Left arrow moves left 1 pixel
0074 Right Arrow moves right 1 pixel
0075 'z' zoom out, 'a' zoom in");
0076 $count =0;
0077 $motion_flag = 1;
0078 $mw->Tk::bind('<Return>', sub{});
0079 $mw->Tk::bind('<r>', \&resetpos);
0080 &startaction;
0081 }
0082
0083 sub stopaction{
0084 # &comment("Hit Enter to begin");
0085 $motion_flag = 0;
0086 $mw->Tk::bind('<Return>', \&start);
0087 }
0088
0089
0090 sub startaction {
0091 $mw->Tk::bind('<Escape>', \&stopaction);
0092 $mw->Tk::bind('<Up>', sub{$delay = ($delay -1) unless $delay <= 1 });
0093 $mw->Tk::bind('<Down>', sub{$delay = ($delay + 1)unless $delay >= 1000} );
0094 $mw->Tk::bind('<Right>', sub{$zinc->translate($flower,1,0)});
0095 $mw->Tk::bind('<Left>', sub{$zinc->translate($flower,-1,0)});
0096 $mw->Tk::bind('<a>', sub{$zinc->scale($flower,1.1,1.1)});
0097 $mw->Tk::bind('<z>', sub{$zinc->scale($flower,.9,.9)});
0098 $mw->Tk::bind('<r>', \&resetpos);
0099 $zinc->rotate($flower,.5,350,281);
0100
0101 if($motion_flag == 1){ $zinc->after($delay, sub {startaction()})}
0102 else {return}
0103 }
0104
0105
0106 sub resetpos{
0107 $zinc->treset($flower);
0108 }
0109
0110
0111 # Just display comment
0112 sub comment {
0113 my $string = shift;
0114 $zinc->itemconfigure($text, -text => $string);
0115 }
0116