| 1 | |
| 2 | # use subs qw(plot_down plot_move); |
| 3 | |
| 4 | |
| 5 | $mkPlot::plot{'lastX'} = 0; |
| 6 | $mkPlot::plot{'lastY'} = 0; |
| 7 | |
| 8 | |
| 9 | sub plot_down { |
| 10 | |
| 11 | my($w) = @_; |
| 12 | |
| 13 | my $e = $w->XEvent; |
| 14 | my($x, $y) = ($e->x, $e->y); |
| 15 | $w->dtag('selected'); |
| 16 | $w->addtag('selected', 'withtag', 'current'); |
| 17 | $w->raise('current'); |
| 18 | $mkPlot::plot{'lastX'} = $x; |
| 19 | $mkPlot::plot{'lastY'} = $y; |
| 20 | |
| 21 | } # end plot_down |
| 22 | |
| 23 | |
| 24 | sub plot_move { |
| 25 | |
| 26 | my($w) = @_; |
| 27 | |
| 28 | my $e = $w->XEvent; |
| 29 | my($x, $y) = ($e->x, $e->y); |
| 30 | $w->move('selected', $x-$mkPlot::plot{'lastX'}, $y-$mkPlot::plot{'lastY'}); |
| 31 | $mkPlot::plot{'lastX'} = $x; |
| 32 | $mkPlot::plot{'lastY'} = $y; |
| 33 | |
| 34 | } # end plot_move |
| 35 | |
| 36 | sub mkPlot { |
| 37 | |
| 38 | # Create a top-level window containing a canvas displaying a simple graph with data points that can be moved interactively. |
| 39 | |
| 40 | $mkPlot->destroy if Exists($mkPlot); |
| 41 | $mkPlot = $top->Toplevel(); |
| 42 | my $w = $mkPlot; |
| 43 | dpos $w; |
| 44 | $w->title('Plot Demonstration'); |
| 45 | $w->iconname('Plot'); |
| 46 | |
| 47 | my $w_msg = $w->Label(-font => '-Adobe-Times-Medium-R-Normal--*-180-*-*-*-*-*-*', -wraplength => '4i', |
| 48 | -justify => 'left', -text => 'This window displays a canvas widget containing a simple ' . |
| 49 | '2-dimensional plot. You can doctor the data by dragging any of the points with mouse ' . |
| 50 | 'button 1.'); |
| 51 | my $c = $w->Canvas(-relief => 'raised', -width => '450', -height => '300'); |
| 52 | my $w_ok = $w->Button(-text => 'OK', -width => 8, -command => ['destroy', $w]); |
| 53 | $w_msg->pack(-side => 'top', -fill => 'x'); |
| 54 | $c->pack(-side => 'top', -fill => 'x'); |
| 55 | $w_ok->pack(-side => 'bottom', -pady => '5'); |
| 56 | |
| 57 | my $font = '-Adobe-helvetica-medium-r-Normal--*-180-*-*-*-*-*-*'; |
| 58 | |
| 59 | $c->create('line', 100, 250, 400, 250, -width => 2); |
| 60 | $c->create('line', 100, 250, 100, 50, -width => 2); |
| 61 | $c->create('text', 225, 20, -text => 'A Simple Plot', -font => $font, -fill => 'brown'); |
| 62 | |
| 63 | my($i, $x, $y, $point, $item); |
| 64 | for($i = 0; $i <= 10; $i++) { |
| 65 | $x = 100 + ($i * 30); |
| 66 | $c->create('line', $x, 250, $x, 245, -width => 2); |
| 67 | $c->create('text', $x, 254, -text => 10 * $i, -anchor => 'n', -font => $font); |
| 68 | } # forend |
| 69 | for ($i = 0; $i <= 5; $i++) { |
| 70 | $y = 250 - ($i * 40); |
| 71 | $c->create('line', 100, $y, 105, $y, -width => 2); |
| 72 | $c->create('text', 96, $y, -text => $i * 50.0, -anchor => 'e', -font => $font); |
| 73 | } # forend |
| 74 | |
| 75 | foreach $point ([12, 56], [20, 94], [33, 98], [32, 120], [61, 180], [75, 160], [98, 223]) { |
| 76 | $x = 100 + (3 * ${$point}[0]); |
| 77 | $y = 250 - (4 * ${$point}[1]) / 5; |
| 78 | $item = $c->create('oval', $x-6, $y-6, $x+6, $y+6, -width => 1, -outline => 'black', -fill => 'SkyBlue2'); |
| 79 | $c->addtag('point', 'withtag', $item); |
| 80 | } |
| 81 | |
| 82 | $c->bind('point', '<Any-Enter>' => [sub{shift->itemconfigure(@_)}, qw(current -fill red)]); |
| 83 | $c->bind('point', '<Any-Leave>' => [sub{shift->itemconfigure(@_)}, qw(current -fill SkyBlue2)]); |
| 84 | $c->bind('point', '<1>' => sub{plot_down(@_)}); |
| 85 | $c->bind('point', '<ButtonRelease-1>' => sub {shift->dtag('selected')}); |
| 86 | $c->Tk::bind('<B1-Motion>' => sub {plot_move(@_)}); |
| 87 | |
| 88 | } # end mkPlot |
| 89 | |
| 90 | |
| 91 | 1; |