http://qs1969.pair.com?node_id=579607

Public Scratchpad

Download, Select Code To D/L

---

#!/usr/bin/perl

use strict;
use warnings;

use Tk;
use Tk::Canvas;

my $self = { };

# configuration
my $n_circles = 500;
my $c_width  = 600;
my $c_height = 400;

my $r = 3;

# initialise data
my @circles;
for (1..$n_circles) {
   my $x = rand;
   my $y = rand;
   push (@circles, [$x, $y]);
}

$self -> {'circles'} = \@circles;

# initial zoom
$self -> {'max_x'} = 1.0;
$self -> {'min_x'} = 0.0;
$self -> {'max_y'} = 1.0;
$self -> {'min_y'} = 0.0;
$self -> {'can_w'} = $c_width;
$self -> {'can_h'} = $c_height;

$self -> {'mode'}  = '';

&compute_transform($self);

# draw the main window and the canvas
my $mw = Tk::MainWindow -> new();
my $can = $mw -> Canvas(-width  => $c_width,
                        -height => $c_height,
                       );

my $butcan = $mw -> Canvas();
$self -> {'button_zoom'} = 
    $butcan -> Button (-text    => 'Zoom',
                       -command => [\&zoom, $self]);
$self -> {'button_zoomall'} =
    $butcan -> Button (-text => 'Zoom all',
                       -command => [\&zoomall, $self] );

$self -> {'button_zoom'} -> pack(-side => 'left');
$self -> {'button_zoomall'} -> pack(-after => $self -> {'button_zoom'}
+,
                                    -side  => 'left');

$butcan -> pack (-side => 'top',
                 -fill => 'x');

$can -> pack(-side    => 'bottom',
             -expand  => 1,
             -fill    => 'both');

$self -> {'can'} = $can;

$can -> Tk::bind ('<1>' => [\&mouse1, Ev('x'), Ev('y'), $self]);
$can -> Tk::bind ('<2>' => [\&mouse2, Ev('x'), Ev('y'), $self]);
$can -> Tk::bind ('<Motion>' => [\&motion, Ev('x'), Ev('y'), $self]);
 
&draw ($self);


MainLoop();



sub draw {
   my ($self) = @_;
   foreach (@{$self -> {'circles'}}) {
      my ($x_c, $y_c) = &real_to_screen ($self, @$_);
      $self -> {'can'} -> createOval($x_c - 2, $y_c - 2, $x_c + 2, $y_
+c + 2);
   }
   return;
}
   



sub real_to_screen {
   my ($self, $x_r, $y_r) = @_;
   my $x_s = $self -> {'can_w'} / 2.0 +
             $self -> {'sca_x'} * ($x_r - $self -> {'mid_x'});
   my $y_s = $self -> {'can_h'} / 2.0 - 
             $self -> {'sca_y'} * ($y_r - $self -> {'mid_y'});
   return ($x_s, $y_s);
}

sub screen_to_real {
   my ($self, $x_s, $y_s) = @_;
   my $x_r = ($x_s - $self -> {'can_w'} / 2.0) / $self -> {'sca_x'} +
              $self -> {'mid_x'};
   my $y_r = ($self -> {'can_h'} / 2.0 - $y_s) / $self -> {'sca_y'} +
              $self -> {'mid_y'};

   return ($x_r, $y_r);
}

sub compute_transform {
   my $self = shift;
   $self -> {'sca_x'} =
      $self -> {'can_w'} / ($self -> {'max_x'} - $self -> {'min_x'});
   $self -> {'sca_y'} = 
      $self -> {'can_h'} / ($self -> {'max_y'} - $self -> {'min_y'});

   $self -> {'mid_x'} = ($self -> {'max_x'} + $self -> {'min_x'}) / 2.
+0;
   $self -> {'mid_y'} = ($self -> {'max_y'} + $self -> {'min_y'}) / 2.
+0;

   return;
}
   
sub zoom {
   my ($self) = @_;
   $self -> {'button_zoom'} -> configure(-state => 'active');
   $self -> {'mode'} = 'zoom0';
   return;
}

sub zoomall {
   my $self = shift;
   $self -> {'min_x'} = 0;
   $self -> {'max_x'} = 1;
   $self -> {'min_y'} = 0;
   $self -> {'max_y'} = 1;
   $self -> {'can'} -> delete('all');

   &compute_transform ($self);
   &draw ($self);
   return;
}


sub mouse1 {
   my (undef, $x, $y, $self) = @_;
   if ($self -> {'mode'} eq 'zoom0') {
      $self -> {'window'} = [$x, $y, $x, $y];
      $self -> {'window_id'} =
         $self -> {'can'} -> createRectangle(@{$self -> {'window'}},
                                            -dash => '-');
      $self -> {'mode'}  = 'zoom1';
      print "Window created.\n";
   }
   elsif ($self -> {'mode'} eq 'zoom1') {
      print "zooming to $x, $y\n";
      $self -> {'can'} -> delete ($self -> {'window_id'});
      ($self -> {'min_x'}, $self -> {'min_y'}) =
         &screen_to_real ($self, $self -> {'window'} -> [0],
                                 $self -> {'window'} -> [1]);
      ($self -> {'max_x'}, $self -> {'max_y'}) =
         &screen_to_real ($self, $self -> {'window'} -> [2],
                                 $self -> {'window'} -> [3]);

      &compute_transform($self);

      $self -> {'can'} -> delete('all');
      &draw ($self);

      $self -> {'mode'} = '';
   }

   return;
}

sub motion {
   my (undef, $x, $y, $self) = @_;
   if ($self -> {'mode'} eq 'zoom1') {
      $self -> {'can'} -> delete ($self -> {'window_id'});
      $self -> {'window'} -> [2] = $x;
      $self -> {'window'} -> [3] = $y;
      $self -> {'window_id'} = 
         $self -> {'can'} -> createRectangle(@{$self -> {'window'}},
                                            -dash => '-');
   }
   return;
}
[download]