curve0
0001 #!/usr/bin/perl
0002 use warnings;
0003 use strict;
0004 use Tk;
0005 use Tk::Zinc;
0006
0007 my $mw = MainWindow->new;
0008 $mw->geometry("700x600");
0009 $mw->resizable(0,0);
0010
0011 #lets add some backgrounds :-)
0012 #if you want jpgs, you must install the Tk::JPEG
0013 my $bak1 = $mw -> Photo (-format => 'gif', -file => '../images/bubbles.gif');
0014 my $bak2 = $mw -> Photo (-format => 'gif', -file => '../images/distorted.gif');
0015 my $bak3 = $mw -> Photo (-format => 'gif', -file => '../images/circuits.gif');
0016 $mw -> configure (-tile => $bak2);
0017
0018
0019 my $zinc = $mw->Zinc(-width => 700, -height => 565,
0020 -backcolor => 'black',
0021 -borderwidth => 3,
0022 -relief => 'sunken',
0023 -tile => $bak1)->pack;
0024
0025 # Then we create a gray filled rectangle, in which we will display explain text.
0026 $zinc->add('rectangle', 1 , [200, 400, 490, 490],
0027 -linewidth => 2,
0028 -filled => 1,
0029 -fillcolor => 'SkyBlue',
0030 );
0031 my $text = $zinc->add('text', 1,
0032 -position => [350, 445],
0033 -anchor => 'center',
0034 );
0035
0036 $zinc->add('rectangle', 1 , [250,275,450,325], #corners (xpos1,ypos1,xpos2,ypos2)
0037 -linewidth => 2,
0038 -filled => 1,
0039 -fillcolor => 'Orange',
0040 );
0041
0042 my $wintext = $zinc->add('text', 1,
0043 -position => [350, 300],
0044 -anchor => 'center',
0045 );
0046
0047 #the old triangle from the triangle tutorial, properly made as a curve
0048 my $tr1 = $zinc->add('curve', 1,
0049 [10,10,30,10,20,40], #(x1,y1,x2,y2,x3,y3)
0050 -closed => 1,
0051 -filled => 1, #will be transparent without this line
0052 -fillcolor => 'Orange',
0053 -visible => 1,
0054 );
0055
0056 #simplist line
0057 my $line1 = $zinc-> add('curve', 1, [20, 100, 320, 100]); # default options
0058
0059 my $line2 = $zinc-> add('curve', 1, [20, 120, 320, 120],
0060 -linewidth => 20,
0061 );
0062
0063 my $line3 = $zinc-> add('curve', 1, [20, 160, 320, 160],
0064 -linewidth => 20,
0065 -capstyle => "butt",
0066 );
0067
0068 my $line4 = $zinc-> add('curve', 1, [20, 200, 320, 200],
0069 -linewidth => 20,
0070 -linepattern => "AlphaStipple7",
0071 -linecolor => "red",
0072 );
0073 my ($xo, $yo, $xc, $yc) = $zinc->bbox($line4);
0074 print "$xo,$yo,$xc,$yc\n";
0075
0076
0077 my $line5 = $zinc-> add('curve', 1, [20, 240, 320, 240],
0078 -linewidth => 20,
0079 -linecolor => "red",
0080 );
0081
0082 #complex polygon
0083 $zinc->add('curve', 1, [20, 350, 140, 410, 320, 350, 180, 310],
0084 -closed => 1,
0085 -filled => 1,
0086 -fillpattern => "Tk",
0087 -fillcolor => "white",
0088 -linecolor => "red",
0089 -marker => "AtcSymbol7",
0090 -markercolor => "blue",
0091
0092 );
0093
0094 #complex polygon
0095 #start at 1 (x,y) point and go clockwise around the curve
0096 $zinc->add('curve', 1, [400,50,500,25,600,50,550,100,425,75],
0097
0098 -closed => 1,
0099 -linewidth => 10,
0100 -joinstyle => "round", # "bevel" | "miter"
0101 -tile => $bak3,
0102 -fillcolor => "grey60",
0103 -filled => 1,
0104 -linecolor => "red",
0105 );
0106
0107 # Display comment
0108 comment("Each Down moves line4 down 10 pixels.
0109 Up will move it up. Mouse button(1) will rotate
0110 it around the zinc canvas center
0111 Mouse button(3) will translate line4 to the center.
0112 Key r will return it to last translated position.
0113 Key q will return to original position.");
0114 wincomment("READY");
0115
0116 start();
0117
0118 my $closebutton = $mw->Button(text => 'Exit', -command => sub{Tk::exit(0)})
0119 ->pack;
0120 MainLoop;
0121
0122 sub start {
0123 # set binding
0124 $mw->Tk::bind('<Up>', \&upaction);
0125 $mw->Tk::bind('<Down>', \&downaction);
0126 $mw->Tk::bind('<1>', \&dorotate);
0127 $mw->Tk::bind('<3>', \&docenter);
0128 $mw->Tk::bind('<r>', \&resetpos);
0129 $mw->Tk::bind('<q>', \&resetpos_orig);
0130 }
0131
0132
0133 sub upaction{
0134 wincomment("READY");
0135 $zinc->translate($line4,0,-10); #moves up 10 pixels
0136 my($x1,$y1,$xc1,$yc1) = $zinc->bbox($line4);
0137 print "$x1 $y1 $xc1 $yc1\n";
0138 }
0139
0140 sub downaction {
0141 # move $line4
0142 $zinc->translate($line4,0,10); #moves down 10 pixels
0143 my($x1,$y1,$xc1,$yc1) = $zinc->bbox($line4);
0144 print "$x1 $y1 $xc1 $yc1\n";
0145 }
0146
0147 sub dorotate {
0148 # rotate $line4
0149 $zinc->rotate($line4,.3,350,281); #rotate around center of zinc canvas
0150 my($x1,$y1,$xc1,$yc1) = $zinc->bbox($line4);
0151 print "$x1 $y1 $xc1 $yc1\n";
0152 }
0153
0154 sub docenter {
0155 #move $line4 to center
0156 $zinc->coords($line4,[50,281,350,281]); #center is at (350,281), line length = 300
0157 my($x1,$y1,$xc1,$yc1) = $zinc->bbox($line4);
0158 print "$x1 $y1 $xc1 $yc1\n";
0159 }
0160
0161 sub resetpos {
0162 #move $line4 to last translated to position
0163 $zinc->treset($line4);
0164 my($x1,$y1,$xc1,$yc1) = $zinc->bbox($line4);
0165 print "$x1 $y1 $xc1 $yc1\n";
0166 }
0167
0168 sub resetpos_orig {
0169 #move $line4 to original position
0170 $zinc->treset($line4);
0171 my($x1,$y1,$xc1,$yc1) = $zinc->bbox($line4);
0172 print "$x1 $y1 $xc1 $yc1\n";
0173 $zinc->translate($line4,-$x1+$xo,-$y1+$yo); #translate to (0,0)then back into position
0174 ($x1,$y1,$xc1,$yc1) = $zinc->bbox($line4);
0175 print "$x1 $y1 $xc1 $yc1\n";
0176 }
0177
0178
0179 # Just display comment
0180 sub comment {
0181 my $string = shift;
0182 $zinc->itemconfigure($text, -text => $string);
0183 }
0184
0185 # display winning comment
0186 sub wincomment {
0187 my $string = shift;
0188 $zinc->itemconfigure($wintext, -text => $string);
0189 }