Beefy Boxes and Bandwidth Generously Provided by pair Networks
XP is just a number
 
PerlMonks  

lyklev's scratchpad

by lyklev (Pilgrim)
on Oct 20, 2006 at 15:27 UTC ( #579607=scratchpad: print w/ replies, xml ) Need Help??

#!/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; }
Log In?
Username:
Password:

What's my password?
Create A New User
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others imbibing at the Monastery: (6)
As of 2014-12-22 05:51 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    Is guessing a good strategy for surviving in the IT business?





    Results (110 votes), past polls