curve1
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 $delay = 50; #adjust for speed of your computer
0009
0010 my $mw = MainWindow->new;
0011 $mw->geometry("700x600");
0012 $mw->resizable(0,0);
0013
0014
0015 my $zinc = $mw->Zinc(-width => 700, -height => 565,
0016 -backcolor => 'grey',
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
0034 #a circle is bounded by a square box, specify 2 diagonal points
0035 my $arc1 = $zinc->add('arc', 1, [5, 65, 65, 5], -fillcolor => "yellow", -filled => 1);
0036
0037 #an ellipse is bounded by a rectangle, specify 2 diagonal points
0038 my $arc2 = $zinc->add('arc', 1, [70, 5, 95, 65], -fillcolor => "green", -filled => 1, -linewidth => 0);
0039
0040 #notice you cannot make a see-thru hole in an arc
0041 #contour only works for curve items
0042 #an ellipse is bounded by a rectangle, specify 2 diagonal points
0043 my $arc3 = $zinc->add('arc', 1, [110, 10, 300, 150], -fillcolor => "orange", -filled => 1);
0044
0045 my $arc3a = $zinc->add('arc', 1, [150, 30, 260, 150],
0046 -filled => 1,
0047 #-visible => 0
0048 );
0049 $zinc->contour($arc3, 'add', 1, $arc3a); # will not produce a see-thru because
0050 # $arc3 is an arc
0051
0052
0053 #
0054 #now a see thru-hole can be formed in the curve $arc3b
0055 my $arc3b = $zinc->add('curve', 1,[ [360, 10], [650,25], [600,200], [350,250], [400,100] ],
0056 -filled => 1,
0057 -fillcolor => "green",
0058 -closed => 1,
0059 -priority => 2);
0060
0061 my $arc3c = $zinc->add('arc', 1, [475,40 , 600, 200],
0062 -visible => 0);
0063 $zinc->contour($arc3b, 'add', 1, $arc3c); # will produce a see-thru because $arc3b
0064 # is a curve
0065
0066
0067 my $arc4 = $zinc->add('arc', 1, [300, 75, 400, 175],
0068 -fillcolor => "white",
0069 -filled => 1,
0070 -priority => 1);
0071
0072 my $arc5 = $zinc->add('arc', 1, [100,250, 300, 400],
0073 -fillcolor => "blue",
0074 -filled => 1,
0075 -visible => 1,
0076 -extent => 90,
0077 -startangle => 270, #starts at "North"
0078 -pieslice => 1,
0079 -priority => 2); # sets it on top layer
0080
0081
0082
0083 # Display comment
0084 &comment("Hit Enter to begin.");
0085 #set key binding
0086 $mw->Tk::bind('<Return>', \&start);
0087
0088 my $closebutton = $mw->Button(text => 'Exit', -command => sub{Tk::exit(0)})
0089 ->pack;
0090 MainLoop;
0091
0092 sub start {
0093 &comment("Hit Esc to stop.");
0094 $motion_flag = 1;
0095 $mw->Tk::bind('<Return>', sub{});
0096 &startaction;
0097 }
0098
0099 sub stopaction{
0100 &comment("Hit Enter to begin");
0101 $motion_flag = 0;
0102 $mw->Tk::bind('<Return>', \&start);
0103 }
0104
0105
0106 sub startaction {
0107 $mw->Tk::bind('<Escape>', \&stopaction);
0108 $mw->Tk::bind('<Up>', sub{$delay = ($delay -1) unless $delay <= 1 });
0109 $mw->Tk::bind('<Down>', sub{$delay = ($delay + 1)unless $delay >= 1000} );
0110
0111 $zinc->rotate($arc4,.15,350,281);
0112 if($motion_flag == 1){ $zinc->after($delay, sub {startaction()})}
0113 else {return}
0114 }
0115
0116
0117 # Just display comment
0118 sub comment {
0119 my $string = shift;
0120 $zinc->itemconfigure($text, -text => $string);
0121 }
0122