ztriangle4
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 $control = 'neutral';
0009
0010 my $mw = MainWindow->new;
0011 $mw->geometry("700x600");
0012 $mw->resizable(0,0);
0013
0014 my $zinc = $mw->Zinc(-width => 700, -height => 565,
0015 -backcolor => 'black',
0016 -borderwidth => 3, -relief => 'sunken')->pack;
0017
0018 # Then we create a gray filled rectangle, in which we will display explain text.
0019 $zinc->add('rectangle', 1 , [200, 400, 490, 490],
0020 -linewidth => 2,
0021 -filled => 1,
0022 -fillcolor => 'SkyBlue',
0023 );
0024 my $text = $zinc->add('text', 1,
0025 -position => [350, 445],
0026 -anchor => 'center',
0027 );
0028
0029 $zinc->add('rectangle', 1 , [250,275,450,325], #corners (xpos1,ypos1,xpos2,ypos2)
0030 -linewidth => 2,
0031 -filled => 1,
0032 -fillcolor => 'Orange',
0033 );
0034
0035 my $wintext = $zinc->add('text', 1,
0036 -position => [350, 300],
0037 -anchor => 'center',
0038 );
0039
0040 #create triangles
0041 #create first triangle, then clone and translate
0042 #maintain an array of positions
0043
0044 my ($x1,$y1,$x2,$y2,$x3,$y3) = my @initcoords = (0,0,20,0,10,40);
0045
0046 my @pos1 = (130,20); #initial positions to translate to
0047 my @pos2 = (340,20);
0048 my @pos3 = (550,20);
0049
0050 my $tr1 = $zinc->add('triangles', 1,
0051 [@initcoords], #(x1,y1,x2,y2,x3,y3)
0052 -fan => 1,
0053 -colors => 'Orange',
0054 -visible => 1,
0055 );
0056 my $tr2 = $zinc->clone($tr1);
0057 my $tr3 = $zinc->clone($tr1);
0058 $zinc->translate($tr1,@pos1);
0059 $zinc->translate($tr2,@pos2);
0060 $zinc->translate($tr3,@pos3);
0061
0062 #redefine center positions to account for translations
0063 @pos1 = (($pos1[0]+($x2-$x1)/2), ($pos1[1]+($y3-$x3)/2)); #(140,35)
0064 @pos2 = (($pos2[0]+($x2-$x1)/2), ($pos2[1]+($y3-$x3)/2)); #(350,35)
0065 @pos3 = (($pos3[0]+($x2-$x1)/2), ($pos3[1]+($y3-$x3)/2)); #(560,35)
0066
0067
0068 # Display comment
0069 &comment("Hit Tab to begin");
0070 &wincomment("READY");
0071
0072 # Create Tk binding
0073 $mw->Tk::bind('<Tab>', \&start);
0074
0075 my $closebutton = $mw->Button(text => 'Exit', -command => sub{Tk::exit(0)})
0076 ->pack;
0077 MainLoop;
0078
0079 sub start {
0080 # set binding to stop and exit
0081 $mw->Tk::bind('<Escape>', \&stopaction);
0082 $mw->Tk::bind('<1>', sub{$control = 'up'});
0083 $mw->Tk::bind('<3>', sub{$control = 'down'});
0084 $mw->Tk::bind('<2>', sub{$control = 'neutral'});
0085 $mw->Tk::bind('<Up>', sub{$control = 'up'});
0086 $mw->Tk::bind('<Down>', sub{$control = 'down'});
0087 $mw->Tk::bind('<Left>', sub{$control = 'neutral'});
0088 $mw->Tk::bind('<Right>', sub{$control = 'neutral'});
0089
0090 $motion_flag = 1;
0091 &comment("Hit Escape to stop.\nMouseButton1->up
0092 MouseButton3->down\nMouseButton2->neutral");
0093 &startaction();
0094 }
0095
0096 sub stopaction{
0097 $motion_flag = 0;
0098 &comment("Hit Tab to begin");
0099 &wincomment("READY");
0100 # Callback bound to '<Key>' event when pressed
0101 $mw->Tk::bind('<Tab>', \&start);
0102 }
0103
0104
0105 sub startaction {
0106 # move triangles
0107 &wincomment("$control");
0108
0109 $zinc->rotate($tr1,.1416,$pos1[0],$pos1[1]);
0110 $zinc->rotate($tr2,.1416,$pos2[0],$pos2[1]);
0111 $zinc->rotate($tr3,.1416,$pos3[0],$pos3[1]);
0112
0113 $zinc->translate($tr1,0,10); #increases radius of turn
0114 $zinc->translate($tr2,0,10); #try commenting them out
0115 $zinc->translate($tr3,0,10); #try changing values
0116
0117
0118 if($control eq 'down'){
0119 $pos1[1]++; #causes downward drift
0120 $pos2[1]++;
0121 $pos3[1]++;
0122 }
0123 if($control eq 'up'){
0124 $pos1[1]--; #causes upward drift
0125 $pos2[1]--;
0126 $pos3[1]--;
0127 }
0128
0129
0130 if($motion_flag == 1){ $zinc->after(1, sub {startaction()})}
0131 else {return}
0132
0133 }
0134
0135 # Just display comment
0136 sub comment {
0137 my $string = shift;
0138 $zinc->itemconfigure($text, -text => $string);
0139 }
0140
0141 # display winning comment
0142 sub wincomment {
0143 my $string = shift;
0144 $zinc->itemconfigure($wintext, -text => $string);
0145 }