home *** CD-ROM | disk | FTP | other *** search
/ Australian Personal Computer 2004 July / APC0407D2.iso / workshop / apache / files / ActivePerl-5.6.1.638-MSWin32-x86.msi / _f02254d48bbdb3b409666960b8fb361a < prev    next >
Encoding:
Text File  |  2004-04-13  |  3.1 KB  |  92 lines
  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;
  92.