package Tk::Axis;
=head1 NAME
Tk::Axis - Canvas with Axes
=for category Derived Widgets
=head1 SYNOPSIS
use Tk::Axis;
$widget = $parent->Axis(
-height => $height,
-margin => $margin,
-tick => $tick,
-tickfont => $tickfont,
-tst => $tst,
-width => $width,
-xmin => $xmin,
-xmax => $xmax,
-ymin => $ymin,
-ymax => $ymax,
);
# $height - height of the window
# $width - width ......
# $xmin - lowest x value we will display
# $xmax - highest .....
# $ymin - lowest y value .....
# $ymax - highest .....
# $margin - the number of pixels used as a margin around the plot
# $tick - the length (in pixels) of the tickmarks
# $tst - the step size for the tick marks
# $tst[x|y]- step size for tick marks on the x (or y) axis
# (if not specified tst is used)
# $tickfont - for for the lables
=head1 DESCRIPTION
This is an improved version of the axis widget. Changes with respect to the
previous version are :
=over 4
=item *
the 'pack' has been moved out the widget. One has to do his own packing
=item *
it is now possible to work in the coordinates of the axis. The following
piece of code draws a line between the points (2 , 3.1) (4 , 4).
$t->create('line',$t->plx(2),$t->ply(3.1),$t->plx(4),$t->ply(4));
=back
=head1 AUTHOR
Kris Boulez (Kris.Boulez@rug.ac.be)
Biomolecular NMR unit <http://bionmr1.rug.ac.be/~kris>
University of Ghent, Belgium
=cut
use strict;
require Tk::Canvas;
use Carp;
use vars qw($VERSION @ISA);
$VERSION = substr(q$Revision: 1.5 $, 10) + 1;
@ISA = qw(Tk::Derived Tk::Canvas);
Construct Tk::Widget 'Axis';
# Added since v 0.1
# -----------------
# - plx en ply allow you to work in axis coordinates
# (eg. $t->create('line', $t->plx(.3), $t->ply(.4), $t->plx(3.2),
# $t->ply(5.3)); )
# - pack is moved out.
#
# This is an Axis widget. It draws an XY axis on the screen and draws
# tickmarks. This is the first public version (v 0.2), all comments,
# crticism, ... are welcome (kris@bionmr1.rug.ac.be).
#
# I would like to thank the following people :
# - Ton Rullmann (rull@nmr.chem.ruu.nl) who started my quest for a way to
# draw 2D plot from within Perl
# - Stephen O. Lidie (lusol@Turkey.CC.Lehigh.edu) who provided me with a
# 2D plot script. He also asked the question "why don't you write a new
# widget for it ?"
# - Nick Ing-Simmons (nik@tiuk.ti.com) without who there would be no ptk
# and whose advice was invaluable while trying to create this widget
#
# It is used as follows
#
# require Axis;
#
sub Populate #using Populate from Tk::Derived
{
my ($w,$args) = @_;
$w->SUPER::Populate($args);
$w->ConfigSpecs(
'-xmin' => ['PASSIVE',undef,undef,0],
'-xmax' => ['PASSIVE',undef,undef,100], #undef],
'-ymin' => ['PASSIVE',undef,undef,0],
'-ymax' => ['PASSIVE',undef,undef,100], #undef],
'-margin' => ['PASSIVE',undef,undef,25],
'-tick' => ['PASSIVE',undef,undef,10],
'-tst' => ['PASSIVE',undef,undef,5],
'-tstx' => ['PASSIVE',undef,undef,undef],
'-tsty' => ['PASSIVE',undef,undef,undef],
'-tickfont' => ['PASSIVE',undef,undef,'fixed']
); # these options are new for the widget, the last value is
# the default.
} #end of Populate
sub ConfigChanged {
my ($w,$args)= @_;;
my $xmin = $w->cget(-xmin); # how expensive is a ->cget ?
my $xmax = $w->cget(-xmax);
my $cx = $w->cget(-width);
my $mar = $w->cget(-margin);
my $ymin = $w->cget(-ymin);
my $ymax = $w->cget(-ymax);
my $cy = $w->cget(-height);
my $tick = $w->cget(-tick);
my $tst = $w->cget(-tst);
my $tstx = $w->cget(-tstx);
my $tsty = $w->cget(-tsty);
my $tickfont = $w->cget(-tickfont);
if (!defined ($xmax) || !defined ($ymax)) { # at least xmax and ymax needed
croak "Axis: `Show' method requires xmax and ymax";
}
if (!defined ($tstx)) {$tstx = $tst;}
if (!defined ($tsty)) {$tsty = $tst;}
if (!defined ($tickfont)) {$tickfont = "fixed";}
my ($zx,$zy,$t); # zx (zy) is the value (in window coordinates) where
# x (y) is 0 on the X (Y) axis
if (abs($xmin+$xmax) > abs($xmin-$xmax)) { # both values pos/neg
$zx=$mar;
}
else {
$zx = $w->plx(0);
}
if (abs($ymin+$ymax) > abs($ymin-$ymax)) {
$zy=$cy-$mar;
}
else { # $cy - $mar is lowest point where we will draw
$zy = $w->ply(0);
}
# X-axis
# ------
$w->create('line',
$mar, $zy, $cx-$mar, $zy);
my (@t) = (); # @t contains the points where to draw tick marks
if ($zx == 0) {
for ($t=$xmin; $t<=$xmax; $t+=$tstx) { push (@t,$t); }
}
else {
for ($t=0; $t<=$xmax; $t+=$tstx) { push (@t,$t); }
for ($t=-$tstx; $t>=$xmin; $t-=$tstx) { push(@t,$t);}
}
for $t (@t) {
my $x = ($cx-2*$mar)*($t-$xmin)/abs($xmax-$xmin) + $mar;
$w->create('line',
$x, $zy, $x, $zy+$tick);
$w->create('text',
$x+5,$zy+20, text => $t, -font => $tickfont,-anchor => 'sw');
}
# Y-axis
# ------
$w->create('line',
$zx, $mar, $zx, $cy-$mar);
@t = ();
if ($zy == $cy-$mar) { # only pos/neg values
for ($t=$ymin; $t<=$ymax; $t+=$tsty) { push (@t,$t); }
}
else {
for ($t=$tsty; $t<=$ymax; $t+=$tsty) { push (@t,$t); }
for ($t=-$tsty; $t>=$ymin; $t-=$tsty) { push(@t,$t);}
}
for $t (@t) {
my $y = ($cy - $mar) - ($cy-2*$mar)*($t-$ymin)/abs($ymax-$ymin);
$w->create('line',
$zx, $y, $zx-$tick, $y);
$w->create('text',
$zx -15,$y+20, text => $t, -font => $tickfont,-anchor => 'sw');
}
} # end ConfigChanged
sub Show { # all the drawing is allready done in ConfigChanged. Show is only
# supplied for compatibility with other widgets.
} #end Show
sub plx {
my ($w,$args) = @_;
my $xmin = $w->cget(-xmin); # how expensive is a ->cget ?
my $xmax = $w->cget(-xmax);
if (($args < $xmin)||($args>$xmax))
{die "PLX: Out of limits\nXmin: $xmin\t\tValue: $args\nXmax: $xmax\n\n";}
my $wi = $w->cget(-width);
my $ma = $w->cget(-margin);
return ((($wi-2*$ma)/abs($xmax-$xmin))*abs($args-$xmin) + $ma);
} #end plx
sub ply {
my ($w,$args) = @_;
my $ymin = $w->cget(-ymin); # how expensive is a ->cget ?
my $ymax = $w->cget(-ymax);
if (($args < $ymin)||($args>$ymax))
{die "PLY: Out of limits\nYmin: $ymin\t\tValue: $args\nYmax: $ymax\n\n";}
my $he = $w->cget(-height);
my $ma = $w->cget(-margin);
return ($he - $ma -(($he-2*$ma)/abs($ymax-$ymin))*abs($args-$ymin));
} #end plx
1;
__END__