ztriangle2
0001 #!/usr/bin/perl
0002 use warnings;
0003 use Tk;
0004 use Tk::Zinc;
0005 use strict;
0006
0007 my $motion_flag = 0;
0008 my $mw = MainWindow->new;
0009 $mw->geometry("700x600");
0010 $mw->resizable(0,0);
0011
0012 my $zinc = $mw->Zinc(-width => 700, -height => 565,
0013 -backcolor => 'black',
0014 -borderwidth => 3, -relief => 'sunken')->pack;
0015
0016 # Then we create a gray filled rectangle, in which we will display explain text.
0017 $zinc->add('rectangle', 1 , [200, 400, 490, 490],
0018 -linewidth => 2,
0019 -filled => 1,
0020 -fillcolor => 'SkyBlue',
0021 );
0022 my $text = $zinc->add('text', 1,
0023 -position => [350, 445],
0024 -anchor => 'center',
0025 );
0026
0027 $zinc->add('rectangle', 1 , [250,275,450,325], #corners (xpos1,ypos1,xpos2,ypos2)
0028 -linewidth => 2,
0029 -filled => 1,
0030 -fillcolor => 'Orange',
0031 );
0032
0033 my $wintext = $zinc->add('text', 1,
0034 -position => [350, 300],
0035 -anchor => 'center',
0036 );
0037
0038 #create triangles
0039 #create first triangle, then clone and translate
0040 #maintain an array of positions
0041
0042 my ($x1,$y1,$x2,$y2,$x3,$y3) = my @initcoords = (0,0,20,0,10,40);
0043
0044 my @pos1 = (130,20); #initial positions to translate to
0045 my @pos2 = (340,20);
0046 my @pos3 = (550,20);
0047
0048 my $tr1 = $zinc->add('triangles', 1,
0049 [@initcoords], #(x1,y1,x2,y2,x3,y3)
0050 -fan => 1,
0051 -colors => 'Orange',
0052 -visible => 1,
0053 );
0054 my $tr2 = $zinc->clone($tr1);
0055 my $tr3 = $zinc->clone($tr1);
0056 $zinc->translate($tr1,@pos1);
0057 $zinc->translate($tr2,@pos2);
0058 $zinc->translate($tr3,@pos3);
0059
0060 #redefine center positions to account for translations
0061 @pos1 = (($pos1[0]+($x2-$x1)/2), ($pos1[1]+($y3-$x3)/2)); #(140,35)
0062 @pos2 = (($pos2[0]+($x2-$x1)/2), ($pos2[1]+($y3-$x3)/2)); #(350,35)
0063 @pos3 = (($pos3[0]+($x2-$x1)/2), ($pos3[1]+($y3-$x3)/2)); #(560,35)
0064
0065
0066 # Display comment
0067 &comment("Strike any key to begin");
0068 &wincomment("READY");
0069
0070 # Create Tk binding
0071 $mw->Tk::bind('<Key>', \&start);
0072
0073 my $closebutton = $mw->Button(text => 'Exit', -command => sub{Tk::exit(0)})
0074 ->pack;
0075 MainLoop;
0076
0077 sub start {
0078 # set binding to stop and exit
0079 $mw->Tk::bind('<Key>', \&stopaction);
0080 $motion_flag = 1;
0081 &comment("Strike any key to stop.");
0082 &startaction();
0083 }
0084
0085 sub stopaction{
0086 $motion_flag = 0;
0087 &comment("Strike any key to begin");
0088 &wincomment("READY");
0089 # Callback bound to '<Key>' event when pressed
0090 $mw->Tk::bind('<Key>', \&start);
0091
0092 }
0093
0094
0095 sub startaction {
0096 # move triangles
0097
0098 $zinc->rotate($tr1,.1416); #rotates around the default (0,0)
0099 #$zinc->rotate($tr2,.1416); #rotates around the default (0,0)
0100 $zinc->rotate($tr3,.1416); #rotates around the default (0,0)
0101
0102 #change the 50 in the following line: lower number speeds things up
0103 if($motion_flag == 1){ $zinc->after(50, sub {startaction()})}
0104 else {return}
0105
0106 }
0107
0108 # Just display comment
0109 sub comment {
0110 my $string = shift;
0111 $zinc->itemconfigure($text, -text => $string);
0112 }
0113
0114 # display winning comment
0115 sub wincomment {
0116 my $string = shift;
0117 $zinc->itemconfigure($wintext, -text => $string);
0118 }