package Tk::PlotDataset;

=head1 NAME

PlotDataset - An extended version of the canvas widget for plotting 2D line
              graphs. Plots have a legend and zooming capabilities.

=head1 SYNOPSIS

 use Tk;
 use Tk::PlotDataset;
 use Tk::LineGraphDataset;

 my $main_window = MainWindow -> new;

 my @data1 = (0..25);
 my $dataset1 = LineGraphDataset -> new
 (
   -name => 'Data Set One',
   -yData => \@data1,
   -yAxis => 'Y',
   -color => 'purple'
 );

 my @data2x = (0..25);
 my @data2y = ();
 foreach my $xValue (@data2x)
 {
   push (@data2y, $xValue ** 2);
 }
 my $dataset2 = LineGraphDataset -> new
 (
   -name => 'Data Set Two',
   -xData => \@data2x,
   -yData => \@data2y,
   -yAxis => 'Y1',
   -color => 'blue'
 );

 my $graph = $main_window -> PlotDataset
 (
   -width => 500,
   -height => 500,
   -background => 'snow'
 ) -> pack(-fill => 'both', -expand => 1);

 $graph -> addDatasets($dataset1, $dataset2);

 $graph -> plot;

 MainLoop;

=head1 STANDARD OPTIONS

 -background  -highlightthickness  -takefocus        -selectborderwidth
 -borderwidth -insertbackground    -relief           -tile
 -cursor      -insertborderwidth   -selectbackground -xscrollcommand
 -insertwidth -highlightbackground -insertofftime    -yscrollcommand
 -state       -highlightcolor      -insertontime     -selectforeground

=head1 WIDGET-SPECIFIC OPTIONS

In addition to all the Canvas options, the following option/value pairs are
supported. All of these options can be set in the new() function when the
PlotDataset object is created or by using the configure method:

=over 4

=item -colors

An array of colours to use for the display of the datasets. If there are more
datasets than colours in the array then the colours will cycle. This option
will be overwritten if the LineGraphDataset object already has a colour
assigned to it.

This option only has an effect when datasets are plotted and therefore changing
the array will not change the colour of the plots already on the graph. To
change existing plots the colour must be set in the LineGraphDataset object or
the dataset re-added to the graph.

=item -pointShapes

An array of point shapes to use for the display of the datasets. If there are
more datasets than shapes in the array then the shapes will cycle. These shapes
will be overwritten if the LineGraphDataset object already has a point shape
assigned to it. Valid shapes are none, circle, square, triangle and diamond.

Like the -colors, this option only has an effect when datasets are plotted and
therefore changing the array will not change the point shapes of the plots
already on the graph.

=item -border

An array of four numbers which are the width of the border between the plot area
and the canvas. The order is North (top), East (right), South (bottom) and West
(left).

=item -scale

A nine element array of the minimum, maximum and step values of scales on each
of the three axes - x, y, and y1. The order of the nine values is xMin, xMax,
xStep, yMin, yMax, yStep, y1Min, y1Max and y1Step. The default values for all
the axis are 0 to 100 with a step size of 10. This option will only affect axes
where the auto-scale option has been turned off.

=item -plotTitle

A two element array. The first element is the plot title, the second element is
the vertical offset of the title above the top of the graph. The title is centered
in the x direction.

=item -xlabel

The text label for the x-axis. The text is centered on the X-axis.

=item -ylabel

The text label for the y-axis. The text is centered on the Y-axis.

=item -y1label

The text label for the y1-axis, which is the optional axis to the right of the
plot. The text is centered on the y1-axis. The label will only be displayed if
there are datasets using the y1-axis.

=item -xlabelPos

The vertical position of the x-axis label, relative to the bottom of the plot area.

=item -ylabelPos

The vertical position of the y-axis label, relative to the left of the plot area.

=item -y1labelPos

The vertical position of the y1-axis label, relative to the right of the plot area.

=item -xTickFormat

This option can be used to override the default format strings, as used by
sprintf, to generate the tick labels on the x-axis. In linear mode the default
is '%.3g', in log mode '1e%3.2d' will be used for values less than zero and
'1e+%2.2d' will be used for values of zero or more. If you override this
format, it will apply to all values in all modes of the x-axis.

=item -yTickFormat

This option can be used to override the default format strings, as used by
sprintf, to generate the tick labels on the y-axis. In linear mode the default
is '%.3g', in log mode '1e%3.2d' will be used for values less than zero and
'1e+%2.2d' will be used for values of zero or more. If you override this
format, it will apply to all values in all modes of the y-axis.

=item -y1TickFormat

This option can be used to override the default format strings, as used by
sprintf, to generate the tick labels on the y1-axis. In linear mode the default
is '%.3g', in log mode '1e%3.2d' will be used for values less than zero and
'1e+%2.2d' will be used for values of zero or more. If you override this
format, it will apply to all values in all modes of the y1-axis. The y1-axis
ticks will only be displayed if there are datasets using the y1-axis.

=item -balloons

Should be set to a true value (eg. 1) in order to enable coordinate balloons,
or a false value (eg. 0) to disable them. Coordinate balloons are enabled by
default.

=item -legendPos

A two element array which specifies the position of the legend. The first element
specifies where the legend should be, either 'bottom' for below the chart, and
'side' for the right side of the chart. The second element is the distance from
the edge of the chart to the legend.

=item -xType

The scale type of the x-axis. Can be linear or log. The default type is
linear.

=item -yType

The scale type of the y-axis. Can be linear or log. The default type is
linear.

=item -y1Type

The scale type of the y1 axis. Can be linear or log. The default type is
linear.

=item -logMin

Applies to all logarithmic axes. A replacement value for zero or negative values
that cannot be plotted on a logarithmic axis. The default value is 1e-3.

=item -fonts

A four element array with the font names for the various labels in the plot.
The first element is the font of the numbers at the axes ticks, the second is
the font for the axes labels (all of them), the third is the plot title font
and fourth is the font for the legend.

 $graph -> configure
 (
   -fonts =>
   [
     'Times 8 bold',
     'Courier 8 italic',
     'Arial 12 bold',
     'Arial 10'
   ]
 );

The format for each font string is; the name of the font, followed by its size
and then whether it should be in bold, italic or underlined.

=item -autoScaleX

When set to "On" the x-axis will be scaled to the values to be plotted. Default
is "On". "Off" is the other possible value.

=item -autoScaleY

When set to "On" the y-axis will be scaled to the values to be plotted. Default
is "On". "Off" is the other possible value.

=item -autoScaleY1

When set to "On" the y1-axis will be scaled to the values to be plotted.
Default is "On". "Off" is the other possible value.

=item -redraw

A subroutine that is called when the graph is redrawn. It can be used to redraw
widgets, such as buttons, that have been added to the graph's canvas. Without
the subroutine anything on the graph would be overwritten.

 $graph -> configure
 (
   -redraw => sub
   {
     my $button = $graph -> Button(-text => 'Button');
     $graph -> createWindow
     (
       $graph -> cget(-width) - 8, $graph -> cget(-height) - 8,
       -anchor => 'se', -height => 18, -width => 100,
       -window => $button
     );
   }
 );

=back

=head2 Tk::LineGraphDataset Options

In addition to the standard options of the LineGraphDataset module, it is also
possible to use additional options for use with PlotDataset. Please note that
these options will only have an effect on PlotDataset and no other module and
hence are not documented in LineGraphDataset.

=over 4

=item -pointSize

Sets the size of the points in the dataset's plot. The value can be any
positive integer.

=item -pointStyle

A string which sets the shape of the point for the dataset's plot. Setting this
option will override Tk::PlotDataset's -pointShapes option for the dataset.
Like the -pointShapes option, valid shapes are none, circle, square, triangle
and diamond.

=item -lineStyle

A string which sets the pattern of the line for the dataset's plot. Valid
patterns are normal (solid line), dot, dash, dotdash and none.

=item -fillPoint

A boolean value which determines the appearance of the dataset's points. If the
value is true (eg. 1), the point is a solid colour, otherwise (eg. 0) only an
outline of the point is shown.

=back

=head1 DESCRIPTION

PlotDataset is a quick and easy way to build an interactive plot widget into a
Perl application. The module is written entirely in Perl/Tk.

The widget is an extension of the Canvas widget that will plot LineGraphDataset
objects as lines onto a 2D graph. The axes can be automatically scaled or set by
the code. The axes can have linear or logarithmic scales and there is also an
option of an additional y-axis (y1).

=head2 Behaviour

When the mouse cursor passes over a plotted line or its entry in the legend,
the line and its entry will turn red to help identify it. Holding the cursor
over a point on the graph will display the point's coordinates in a help
balloon (unless disabled). Individual points are not shown when there are more
than 20 points in the plot.

The left button (button-1) is used to zoom a graph. Move the cursor to one of
the corners of the box into which you want the graph to zoom. Hold down the
left button and move to the opposite corner. Release the left button and the
graph will zoom into the box. To undo one level of zoom click the left button
without moving the mouse.

=head1 WIDGET METHODS

=over 4

The PlotDataset (or new) method creates a widget object. This object supports
the configure and cget methods described in the Tk::options manpage, which can
be used to enquire and modify the options described above (except -colors and
-pointShapes). The widget also inherits all the methods provided by the
Tk::Canvas class.

In addition, the module provides its own methods, described below:

=item $plot_dataset -> addDatasets ( dataset1 , dataset2 , ... )

Adds one or more dataset objects to the plot. Call the plot() method afterwards
to see the newly added datasets.

=item $plot_dataset -> clearDatasets

Removes all the datasets from the plot. Call the plot() method afterwards to
clear the graph.

=item $plot_dataset -> plot ( rescale )

Updates the graph to include changes to the graph's configuration or datasets.
The parameter rescale can be one of three options:

=over 4

=item Z<>

'always' to always rescale plot. This is the default.

'never' to never rescale plot.

'not_zoomed' to only rescale when the plot is not zoomed in.

=back

B<Note:> Changes to the graph's configuration or datasets will also be applied
when the graph is rescaled when zooming in or out.

=back

=head1 HISTORY

This Tk widget is based on the Tk::LineGraph module by Tom Clifford. Due to
trouble with overriding methods that call methods using SUPER:: LineGraph could
not be used as a base class.

The main difference between this module and the original is that the graph is
created as a widget and not in a separate window. It therefore does not have
the drop down menus used to configure the graph in the original.

Other additions/alterations are:

=over 4

=item Z<>

- Used Tk::Balloon to add optional coordinate pop-ups to data points.

- Running the cursor over a line name in the legend will highlight the curve on
the graph.

- Added a clearDatasets method for removing all datasets from a plot.

- Added support for a -noLegend option for datasets, allowing them to be
excluded from the legend.

- Added support for the -pointSize, -pointStyle, -lineStyle and -fillPoint
LineGraphDataset options.

- Added -redraw option to allow a callback to be added to draw additional items
onto the canvas when it is redrawn.

- Option for a logarithmic scale on the x-axis (previously this was only
available on the y-axis).

- Changed the legend so that it displays an example line and point. This legend
can be either at the bottom or side of the chart.

- Added -xTickFormat, -yTickFormat and -y1TickFormat options to configure the
format of the number labels on each axis.

- Removed all bindings for buttons 2 and 3.

=back

A number of bugs in the original code have also been found and fixed:

=over 4

=item Z<>

- Plots could be dragged using button 3 - this is not useful.

- If less than ten colours were provided, then the colour usage failed to cycle
and caused an error.

- If the user zooms beyond a range of approximately 1e-15, then it hangs.

- Scale values of 0 were frequently displayed as very small numbers
(approximately 1e-17).

- Small grey boxes were sometimes left behind when zooming out.

- In places, -tags was passed a string instead of an array reference, which
caused problems especially in the legends method.

- Corrected an issue with the positioning of the y1 axis label.

- Corrected a divide by zero error occurring when a vertical data line passes
through a zoomed plot.

- Fixed a memory leak that occurred when the value passed to the configure
method was an array reference.

=back

=head1 BUGS

Currently there are no known bugs, but there are a couple of the limitations to
the module:

=over 4

=item Z<>

- If no data on the graph is plotted on the y-axis, i.e. the y1-axis is used
instead, then it is not possible to zoom the graph. It will also not be
possible to zoom the graph if y1-axis has a log scale but no data.

- In the case where the number of points in the x and y axes are different the
points with missing values are not plotted.

- Currently, if zero or negative numbers are plotted on a logarithmic scale
their values are set to the value of -logMin. This can produce strange looking
graphs when using mixed type axes. A future improvement would be to provide an
option to omit non-valid points from the graph.

- The widget does not work with the Tk::Scrolled module.

=back

=head1 COPYRIGHT

Copyright 2007 I.T. Dev Ltd.

This library is free software; you can redistribute it and/or modify it under
the same terms as Perl itself.

Any code from the original Tk::LineGraph module is the copyright of Tom
Clifford.

=head1 AUTHOR

Andy Culmer, Tim Culmer and Stephen Spain. Contact via website -
http://www.itdev.co.uk

Original code for the Tk::LineGraph module by Tom Clifford.

=head1 SEE ALSO

Tk::LineGraph Tk::LineGraphDataset

=head1 KEYWORDS

Plot 2D Axis

=cut

# Internal Revision History
#
# Filename : PlotDataset.pm
# Authors  : ac - Andy Culmer, I.T. Dev Limited
#            tc - Tim Culmer, I.T. Dev Limited
#            ss - Stephen Spain, I.T. Dev Limited
#
# Version 1 by ac on 19/12/2006
# Initial Version, modified from Tk::LineGraph.
#
# Version 2 by ac on 05/01/2007
# Changed the resize behaviour to allow the graph to be used with other widgets
# in the same window. This makes this widget more consistent with other Tk
# widgets.
#
# Version 3 by ac on 10/01/2007
# Added clearDatasets method to remove all datasets from a plot.
# Added support for a -noLine option for datasets, allowing them to be plotted
# points only.
# Added support for a noLegend option for datasets, allowing them to be excluded
# from the legend.
#
# Version 4 by ac on 23/01/2007
# Added -redraw option to allow a callback to be added to draw additional items
# onto the canvas when it is redrawn. Also corrected an issue with the
# positioning of the Y1 axis label.
#
# Version 5 by ac on 06/03/2007
# Corrected a divide by zero error occurring when a vertical data line passes
# through a zoomed plot.
#
# Version 6 by tc on 04/04/2007
# Prepared the module for submitting to CPAN.
#  * Removed unused code.
#  * Renamed the variables that use the reserved $a and $b variable names.
#  * Attempted to make the original TK::LineGraph source code conform to the
#    I.T. Dev coding standard.
#  * Added an option for a logarithmic scale on the x-axis.
#  * Added to original POD documentation.
#
# Version 7 by tc on 14/05/2007
# Fixed a couple of issues that occur when using log axes:
#  * When using autoscale a log axis will always include an extra set of ticks
#    than is needed.
#  * If the y or y1 axis is longer than the x axis then the axis ticks are
#    labelled with the font information.
#  * The y1 axis has no log ticks.
#
# Version 8 by ss on 16/05/2007
# Added some extra functionality
#  * Added -lineStyle dataset option to set the style of a line.
#  * Added -pointStyle dataset option to set the style of a point.
#  * Added -pointSize dataset option to set the size of a point
#  * Added -fillPoint dataset option to set whether a point should be filled.
#  * Added -xlabelPos, -ylabelPos, and -y1labelPos plot options to specify
#    the distance these labels should be from the plot area.
#  * Added extra information to the legend, to show the line style and point
#     style for each line.
#  * Added -legendPos plot option to allow the legend to be placed either at
#    the side or bottom of the plot area, and specify the distance between the
#    legend and the plot area.
# Fixed some issues:
#  * When no x data was specified _data_sets_min_max() assumed there was one
#    extra data point on the x axis, so scaled wrongly.
#  * Graphs with '-noLine' set, but less than 20 points on the screen are not
#    visible until the user zooms.
#  * Fixed a problem with the alignment of the x-axis label.
#  * Fixed a problem with the alignment of the title.
#
# Version 9 by ss on 23/05/2007
# Fixed a problem with legend where a line was shown when -lineStyle was set to
# none.
#
# Version 10 by tc on 01/06/2007
# Modified code to meet I.T. Dev Perl Coding Standard and to comply more with
# the perlstyle documentation. Functionality not changed.
#
# Version 11 by ac on 06/11/2007
# New features:
#  * Added -xTickFormat, -yTickFormat and -y1TickFormat options to configure
#    the format of the number labels on each axis.
#  * Added -balloons option to enable/disable the coordinates balloons.
# Bug fixes:
#  * Fixed a memory leak that occurred when the value passed to the configure
#    method was an array reference.
#
# Version 12 by tc on 09/11/2007
# Documented the additional LineGraphDataset options supported by the module.
# Removed support for the -noLine option in LineGraphDataset - its
# functionality is now incorporated in the -lineStyle option.

use strict;
use warnings;

use 5.005_03;

use Carp;
use POSIX;
use base qw/Tk::Derived Tk::Canvas/;
use Tk::Balloon;
use vars qw($VERSION);

$VERSION = '2.01';

Construct Tk::Widget 'PlotDataset';

sub ClassInit  ## no critic (NamingConventions::ProhibitMixedCaseSubs)
{
  my ($class, $mw ) = @_;
  $class -> SUPER::ClassInit($mw);

  return (1);
}

# Class data to track mega-item items. Not used as yet.
my $id = 0;
my %ids = ();

sub Populate  ## no critic (NamingConventions::ProhibitMixedCaseSubs)
{
  my ($self, $args) = @_;

  my @def_colors =
  qw/
    gray SlateBlue1 blue1 DodgerBlue4 DeepSkyBlue2 SeaGreen3
    green4 khaki4 gold3 gold1 firebrick1 brown4 magenta1 purple1 HotPink1
    chocolate1 black
  /;
  my @def_point_shapes = qw/circle square triangle diamond/;
  $self -> ConfigSpecs
  (
    -colors       => ['PASSIVE', 'colors',       'Colors',       \@def_colors],
    -pointShapes  => ['PASSIVE', 'pointShapes',  'PointShapes',  \@def_point_shapes],
    -border       => ['PASSIVE', 'border',       'Border',       [25, 50, 100, 50]],
    -scale        => ['PASSIVE', 'scale',        'Scale',        [0, 100, 10, 0, 100, 10, 0, 100, 10]],
    -zoom         => ['PASSIVE', 'zoom',         'Zoom',         [0, 0, 0, 0, 0]],
    -plotTitle    => ['PASSIVE', 'plottitle',    'PlotTitle',    ['Default Plot Title', 25 ]],
    -xlabel       => ['PASSIVE', 'xlabel',       'Xlabel',       'X Axis Default Label'],
    -ylabel       => ['PASSIVE', 'ylabel',       'Ylabel',       'Y Axis Default Label'],
    -y1label      => ['PASSIVE', 'Y1label',      'Y1label',      'Y1 Axis Default Label'],
    -xlabelPos    => ['PASSIVE', 'xlabelPos',    'XlabelPos',    40],
    -ylabelPos    => ['PASSIVE', 'ylabelPos',    'YlabelPos',    40],
    -y1labelPos   => ['PASSIVE', 'Y1labelPos',   'Y1labelPos',   40],
    -xTickLabel   => ['PASSIVE', 'xticklabel',   'Xticklabel',   undef],
    -yTickLabel   => ['PASSIVE', 'yticklabel',   'Yticklabel',   undef],
    -y1TickLabel  => ['PASSIVE', 'y1ticklabel',  'Y1ticklabel',  undef],
    -xTickFormat  => ['PASSIVE', 'xtickformat',  'Xtickformat',  undef],
    -yTickFormat  => ['PASSIVE', 'ytickformat',  'Ytickformat',  undef],
    -y1TickFormat => ['PASSIVE', 'y1tickformat', 'Y1tickformat', undef],
    -balloons     => ['PASSIVE', 'balloons',     'Balloons',     1],
    -legendPos    => ['PASSIVE', 'legendPos',    'LegendPos',    ['bottom', 80]],
    -xType        => ['PASSIVE', 'xtype',        'Xtype',        'linear'],  # could be log
    -yType        => ['PASSIVE', 'ytype',        'Ytype',        'linear'],  # could be log
    -y1Type       => ['PASSIVE', 'y1type',       'Y1type',       'linear'],  # could be log
    -fonts        => ['PASSIVE', 'fonts',        'Fonts',        ['Arial 8', 'Arial 8', 'Arial 10 bold', 'Arial 10']],
    -autoScaleY   => ['PASSIVE', 'autoscaley',   'AutoScaleY',   'On'],
    -autoScaleX   => ['PASSIVE', 'autoscalex',   'AutoScaleX',   'On'],
    -autoScaleY1  => ['PASSIVE', 'autoscaley1',  'AutoScaleY1',  'On'],
    -logMin       => ['PASSIVE', 'logMin',       'LogMin',       0.001],
    -redraw       => ['PASSIVE', 'redraw',       'Redraw',       undef]
  );

  $self -> SUPER::Populate($args);

  #helvetica Bookman Schumacher
  # The four fonts are axis ticks[0], axis lables[1], plot title[2], and legend[3]
  $self -> {-logCheck} = 0; # false, don't need to check on range of log data
  # OK, setup the dataSets list
  $self -> {-datasets}  = []; # empty array, will be added to
  $self -> {-zoomStack} = []; # empty array which will get the zoom stack
  #Some bindings here
  # use button 1 for zoom
  $self -> Tk::bind('<Button-1>' ,        [\&_zoom, 0]);
  $self -> Tk::bind('<ButtonRelease-1>' , [\&_zoom, 1]);
  $self -> Tk::bind('<B1-Motion>' ,       [\&_zoom, 2]);

  # Add ballon help for the data points...
  my $parent = $self -> parent; # ANDY
  $self -> {Balloon} = $parent -> Balloon;
  $self -> {BalloonPoints} = {};
  $self -> {Balloon}
    -> attach($self, -balloonposition => 'mouse', -msg => $self -> {BalloonPoints});

  # Must use Tk:: here to avoid calling the canvas::bind method
  $self -> Tk::bind('<Configure>' => [\&_resize]);

  return (1);
} # end Populate

# When using the inherited configure method, array items cause
# memory leaks, so these will be handled by this method instead.
sub configure ## no critic (RequireFinalReturn) - Does not recognise return statement at end of method
{
  my ($self, %args) = @_;

  foreach my $array_item qw/-scale -xTickLabel -yTickLabel -y1TickLabel
    -border -zoom -plotTitle -fonts -colors -legendPos/
  {
    if (my $value = delete $args{$array_item})
    {
      $self -> {'Configure'}{$array_item} = $value;
    }
  }
  if (my @args = %args)
  {
    return ($self -> SUPER::configure(@args));
  }

  return (1);
}

sub _resize  # called when the window changes size (configured)
{
  my ($self) = @_;  # This is the canvas (Plot)

  my $w = $self -> width;     # Get the current size
  my $h = $self -> height;
  # print "_resize: mw size is ($h, $w)\n";
  $self -> _rescale;

  return (1);
}

sub _rescale  # all, active, not
{
  # _rescale the plot and redraw. Scale to  all or just active as per argument
  my ($self, $how, %args)  = @_;
  $self -> delete('all');  # empty the canvas, erase
  $self -> _scale_plot($how) if (defined($how) and $how ne 'not');  # Get max and min for scalling
  $self -> _draw_axis;       # both x and y for now
  $self -> _titles;
  $self -> _draw_datasets(%args);
  $self -> _legends(%args);
  $self -> _call_redraw_callback;

  return (1);
}

sub _call_redraw_callback
{
  my ($self) = @_;
  if (my $callback = $self -> cget(-redraw))
  {
    $callback = [$callback] if (ref($callback) eq 'CODE');
    die "You must pass a list reference when using -redraw.\n"
      unless ref($callback) eq 'ARRAY';
    my ($sub, @args) = @$callback;
    die "The array passed with the -redraw option must have a code reference as it's first element.\n"
      unless ref($sub) eq 'CODE';
    &$sub($self, @args);
  }
  return (1);
}

sub _zoom
{
  # start to do the zoom
  my ($self, $which) = @_;
  my $z;
  # print "_zoom: which is <$which> self <$self> \n"if ($which == 1  or $which == 3);
  if ($which == 0)  # button 1 down
  {
    my $e = $self -> XEvent;
    $z = $self -> cget('-zoom');
    $z -> [0] = $e -> x; $z -> [1] = $e -> y;
    $self -> configure('-zoom' => $z);
  }
  elsif ($which == 1)  # button 1 release, that is do zoom
  {
    my $e = $self -> XEvent;
    $z = $self -> cget('-zoom');
    $z -> [2] = $e -> x; $z -> [3] = $e -> y;
    $self -> configure('-zoom' => $z);
    # OK, we can now do the zoom
    # print "_zoom: $z -> [0], $z -> [1] $z -> [2], $z -> [3] \n";

    # If the box is small we undo one level of zoom
    if ((abs($z -> [0]-$z -> [2]) < 3) and (abs($z -> [1]-$z -> [3]) < 3))
    {
      # try to undo one level of zoom
      if (@{$self -> {'-zoomStack'}} == 0)  # no zooms to undo
      {
        $z = $self -> cget('-zoom');
        $self -> delete($z -> [4])if ($z -> [4] != 0);
        return;
      }

      my $s = pop(@{$self -> {'-zoomStack'}});
      # print "_zoom: off stack $s -> [3], $s -> [4] \n";
      $self -> configure(-scale => $s);
      if ($self -> cget('-xType') eq 'log')
      {
        my ($aa, $bb) = (10**$s -> [0], 10**$s -> [1]);
        # print "_zoom: a $aa b $bb \n";
        my ($x_min_p, $x_max_p, $x_intervals, $tick_labels) = $self -> _log_range
        (
          $aa, $bb,
          -tickFormat => $self -> cget('-xTickFormat')
        );
        # print "_zoom: $tick_labels \n";
        $self -> configure(-xTickLabel => $tick_labels);
      }
      if ($self -> cget('-yType') eq 'log')
      {
        my ($aa, $bb) = (10**$s -> [3], 10**$s -> [4]);
        # print "_zoom: a $aa b $bb \n";
        my ($y_min_p, $y_max_p, $y_intervals, $tick_labels) = $self -> _log_range
        (
          $aa, $bb,
          -tickFormat => $self -> cget('-yTickFormat')
        );
        # print "_zoom: $tick_labels \n";
        $self -> configure(-yTickLabel => $tick_labels);
      }
      if ($self -> cget('-y1Type') eq 'log')
      {
        my ($aa, $bb) = (10**$s -> [6], 10**$s -> [7]);
        # print "_zoom: for y1 log  $aa b $bb \n";
        my ($y_min_p, $y_max_p, $y_intervals, $tick_labels) = $self -> _log_range
        (
          $aa, $bb,
          -tickFormat => $self -> cget('-y1TickFormat')
        );
        # print "_zoom: y1 $tick_labels \n";
        $self -> configure(-y1TickLabel => $tick_labels);
      }
    }
    else  # box not small, time to zoom
    {
      my ($x1w, $y1w, $y11w) = $self -> _to_world_points($z -> [0], $z -> [1]);
      my ($x2w, $y2w, $y12w) = $self -> _to_world_points($z -> [2], $z -> [3]);
      my $z; #holdem
      if ($x1w > $x2w)
      {
        $z = $x1w;
        $x1w = $x2w;
        $x2w = $z;
      }
      if ($y1w > $y2w)
      {
        $z = $y1w;
        $y1w = $y2w;
        $y2w = $z;
      }
      if ($y11w > $y12w)
      {
        $z = $y11w;
        $y11w = $y12w;
        $y12w = $z;
      }

      # We've had trouble with extreme zooms, so trap that here...
      if (($x2w - $x1w < 1e-12) or ($y2w - $y1w < 1e-12) or ($y12w - $y11w < 1e-12))
      {
        $z = $self -> cget('-zoom');
        $self -> delete($z -> [4]) if ($z -> [4] != 0);
        return;
      }

      # push the old scale values on the zoom stack
      push(@{$self -> {'-zoomStack'}}, $self -> cget(-scale));
      # now _rescale
      # print "_zoom: Rescale ($y1w, $y2w)  ($x1w, $x2w)  \n";
      my ($y_min_p, $y_max_p, $y_intervals) = _nice_range($y1w, $y2w);
      my ($y1min_p, $y1max_p, $y1intervals) = _nice_range($y11w, $y12w);
      my ($x_min_p, $x_max_p, $x_intervals) = _nice_range($x1w, $x2w);
      my ($x_tick_labels, $y_tick_labels, $y1_tick_labels);
      if ($self -> cget('-xType') eq 'log')
      {
        ($x_min_p, $x_max_p, $x_intervals, $x_tick_labels) = $self -> _log_range
        (
          $x1w, $x2w,
          -tickFormat => $self -> cget('-xTickFormat')
        );
      }
      if ($self -> cget('-yType') eq 'log')
      {
        ($y_min_p, $y_max_p, $y_intervals, $y_tick_labels) = $self -> _log_range
        (
          $y1w, $y2w,
          -tickFormat => $self -> cget('-yTickFormat')
        );
      }
      if ($self -> cget('-y1Type') eq 'log')
      {
        ($y1min_p, $y1max_p, $y1intervals, $y1_tick_labels) = $self -> _log_range
        (
          $y11w, $y12w,
          -tickFormat => $self -> cget('-y1TickFormat')
        );
      }
      # print "_zoom: ($x_min_p, $x_max_p, $x_intervals)  xTickLabels <$x_tick_labels> \n";
      $self -> configure(-xTickLabel => $x_tick_labels);
      $self -> configure(-yTickLabel => $y_tick_labels);
      # print "($x_min_p, $x_max_p, $x_intervals), ($y_min_p, $y_max_p, $y_intervals), ($y1min_p, $y1max_p, $y1intervals)\n";
      $self -> configure
      (
        -scale =>
        [
          $x_min_p, $x_max_p, $x_intervals,
          $y_min_p, $y_max_p, $y_intervals,
          $y1min_p, $y1max_p, $y1intervals
        ]
      );
    }

    $self -> delete('all');
    # draw again
    $self -> _draw_axis;     # both x and y for now
    $self -> _titles;
    $self -> _draw_datasets;
    $self -> _legends;
    $self -> _call_redraw_callback;
  }
  elsif ($which == 2)  # motion, draw box
  {
    my $e = $self -> XEvent;
    $z = $self -> cget('-zoom');
    $self -> delete($z -> [4])if ($z -> [4] != 0);
    $z -> [4] = $self
      -> createRectangle($z -> [0], $z -> [1], $e -> x, $e -> y, '-outline' => 'gray');
    $self -> configure('-zoom' => $z);
  }
  return (1);
}

sub _create_plot_axis  # start and end point of the axis, other args a => b
{
  # Optional args  -tick
  # Optional args  -label
  #   An array containing colour, font and a list of text to display next to
  #   each tick.
  # Optional args  -tickFormat
  #   The sprintf format to use if -label is not provided.
  #
  # end points are in Canvas pixels
  my ($self, $x1, $y1, $x2, $y2, %args) = @_;
  my $y_axis = 0;
  if ($x1 == $x2)
  {
    $y_axis = 1;
  }
  elsif ($y1 != $y2)
  {
    die 'Cannot determine if X or Y axis desired.'
  }

  my $tick = delete $args{-tick};
  my $label = delete $args{-label};
  my $tick_format = delete $args{-tickFormat};
  $tick_format = '%.3g' unless $tick_format;
  my ($do_tick, $do_label) = map {ref $_ eq 'ARRAY'} ($tick, $label);

  $self -> createLine($x1, $y1, $x2, $y2, %args);

  if ($do_tick)
  {
    my ($tcolor, $tfont, $side, $start, $stop, $incr, $delta, $type) = @$tick;
    # start, stop are in the world system
    # $incr is space between ticks in world coordinates   $delta is the number of pixels between ticks
    # If type is log then a log axis maybe not
    my ($lcolor, $lfont, @labels);
    ($lcolor, $lfont, @labels) = @$label if $do_label;
    # print "t font <$tfont> l font <$lfont> \n";
    my $l;
    my $z = 0;  # will get $delta added to it, not x direction!
    my $tl;
    my $an;
    if ($y_axis)
    {
      $tl = $side eq 'w' ? 5 : -6; # tick length
      $an = $side eq 'w' ? 'e' : 'w' if $y_axis;  #anchor
    }
    else
    {
      $tl = $side eq 's' ? 5 : -6; # tick length
      $an = $side eq 's' ? 'n' : 's' if not $y_axis;
    }
    # do the ticks
    $incr = 1 if (($stop - $start) < 1e-15); # AC: Rounding errors can cause an infinite loop when range is zero!
    # This line above fixes this by detecting this case and fixing the increment to 1. (Of course, range should not be zero anyway!)
    #   print "ticks for loop $l = $start; $l <= $stop; $l += $incr\n"; # DEBUG
    for (my $l = $start; $l <= $stop; $l += $incr)
    {
      if ($y_axis)
      {
        $self -> createLine
        (
          $x1 - $tl, $y2 - $z, $x1, $y2 - $z,
          %args, -fill => $tcolor,
        );
      }
      else
      {
        $self -> createLine
        (
          $z + $x1, $y1 + $tl, $z + $x1, $y2,
          %args, -fill => $tcolor,
        );
      }
      if ($do_label)
      {
        my $lbl = shift(@labels);
        if ($y_axis)
        {
          $self -> createText
          (
            $x1 - $tl, $y2 - $z, -text => $lbl,
            %args, -fill => $lcolor,
            -font => $lfont, -anchor => $an,
          ) if $lbl;
        }
        else
        {
          $self -> createText
          (
            $z + $x1, $y1 + $tl, -text => $lbl,
            %args, -fill => $lcolor,
            -font => $lfont, -anchor => $an,
          ) if $lbl;
        }
      }
      else  # default label uses tfont
      {
        $l = 0 if (($l < 1e-15) and ($l > -1e-15)); # Fix rounding errors at zero.
        if ($y_axis)
        {
          $self -> createText
          (
            $x1 - $tl, $y2 - $z, -text => sprintf($tick_format, $l),
            %args, -fill => $tcolor,
            -font => $tfont, -anchor => $an,
          );
        }
        else
        {
          $self -> createText
          (
            $z + $x1, $y1 + $tl, -text => sprintf($tick_format, $l),
            %args, -fill => $tcolor,
            -font => $tfont, -anchor => $an,
          );
        }
      }
      $z += $delta;  # only use of delta
    }
  } # ifend label this axis

  return (1);
} # end _create_plot_axis

sub _titles
{
  # put axis titles and plot title on the plot
  # x, y, y1, plot all at once for now
  my ($self) = @_;
  my $borders = $self -> cget(-border);
  my $fonts = $self -> cget('-fonts');
  my $w = $self -> width;
  my $h = $self -> height;
  # y axis
  my $y_label = $self -> cget('-ylabel');
  my $y_label_pos = $self -> cget('-ylabelPos');
  my $y_start = $self -> _center_text_v($borders -> [0], $h - $borders -> [2], $fonts -> [1], $y_label);
  $self -> _create_text_v
  (
    $self -> _to_canvas_pixels('canvas', $borders -> [3] - $y_label_pos, $h - $y_start),
    -text => $y_label, -anchor => 's', -font => $fonts -> [1], -tag => 'aaaaa',
  );

  # Is y1 axis used for active datasets?

  # y1 axis
  my $y1label = $self -> cget('-y1label');
  my $y1label_pos = $self -> cget('-y1labelPos');
  my $y1start = $self -> _center_text_v($borders -> [0], $h - $borders -> [2], $fonts -> [1], $y1label);
  $self -> _create_text_v
  (
    $self -> _to_canvas_pixels('canvas', $w - $borders -> [1] + $y1label_pos, $h - $y1start),
    -text => $y1label, -anchor => 'sw', -font => $fonts -> [1], -tag => 'y1y1y1y1'
  ) if ($self -> _count_y1);

  #   x axis
  my $x_label = $self -> cget('-xlabel');
  my $x_label_pos = $self -> cget('-xlabelPos');
  my $x_start = $self -> _center_text($borders -> [3], $w - $borders -> [1], $fonts -> [1], $x_label);
  $self -> createText
  (
    $self -> _to_canvas_pixels('canvas', $x_start, $borders -> [2] - $x_label_pos),
    -text => $x_label, -anchor => 'sw', -font => $fonts -> [1]
  );

  # add a plot title
  my $title = $self -> cget('-plotTitle');
  $x_start = $self -> _center_text($borders -> [3], $w - $borders -> [1], $fonts -> [2], $title -> [0]);
  $self -> createText
  (
    $self -> _to_canvas_pixels('canvas', $x_start, $h - $borders -> [0] + $title -> [1]),
    text => $title -> [0], -anchor => 'nw', -font => $fonts -> [2], -tags => ['title']
  );
  return (1);
}

sub _create_text_v  # canvas widget, x, y, then all the text arguments plus -scale => number
{
  # Writes text from top to bottom.
  # For now argument -anchor is removed
  # scale is set to 0.75.  It the fraction of the previous letter's height that the
  # current letter is lowered.
  my ($self, $x, $y, %args) = @_;
  my $text = delete($args{-text});
  my $anchor = delete($args{-anchor});
  my $tag = delete($args{-tag});
  my @letters = split(//, $text);
  # print "args",  %args, "\n";;
  # OK we know that we have some short and some long letters
  # a, c, e, g, m, m, o, p, r, s, t, u, v, w, x, y, z are all short.  They could be moved up a tad
  # also g, j, q, and y hang down, the next letter has to be lower
  my $th = 0;
  my $lc = 0;

  my ($font_width) = $self -> fontMeasure($args{-font}, 'M'); # Measure a wide character to determine the x offset
  $x -= $font_width if $anchor =~ /w/; # AC: Implement missing functionality!

  # sorry to say, the height of all the letters as returned by bbox is the same for a given font.
  # same is true for the text widget.  Nov 2005!
  my $letter = shift(@letters);
  $self -> createText($x, $y + $th, -text => $letter, -tags => [$tag], %args, -anchor => 'c');  # first letter
  my ($min_x, $min_y, $max_x, $max_y) = $self -> bbox($tag);
  my $h = $max_y - $min_y;
  my $w = $max_x - $min_x;
  my $step = 0.80;
  $th = $step * $h + $th;
  foreach my $letter (@letters)
  {
    # print "_create_text_v: letter <$letter>\n";
    # If the letter is short, move it up a bit.
    $th = $th - 0.10 * $h if ($letter =~ /[acegmnoprstuvwxyz.;, :]/);  # move up a little
    $th = $th - 0.40 * $h if ($letter =~ /[ ]/);                       # move up a lot
    # now write the letter
    $self -> createText($x, $y + $th, -text => $letter, -tags => [$tag], %args, -anchor => 'c');
    # space for the next letter
    $th = $step * $h + $th;
    $th = $th + 0.10 * $h if ($letter =~ /[gjpqy.]/);  # move down a bit if the letter hangs down
    $lc++;
  }
  return (1);
}

sub _legends
{
  # For all the (active) plots, put a legend
  my ($self, %args) = @_;
  my $count = 0;
  # count the (active) data sets
  foreach my $ds (@{$self -> {-datasets}})
  {
    unless ($ds -> get(-noLegend))
    {
      $count++ if ($ds -> get('-active') == 1);
    }
  }
  # print "_legends have $count legends to do\n";
  my $fonts = $self -> cget('-fonts');

  # Calculate the starting point
  my $x_start = 0;
  my $y_start = 0;
  my $legend_info = $self -> cget('-legendPos');
  my $borders = $self -> cget('-border');
  unless (defined($legend_info) and $legend_info -> [0] ne 'bottom')
  {
    $x_start = $borders -> [3];
    $y_start = $borders -> [2] - $legend_info -> [1];
  }
  elsif ($legend_info -> [0] eq 'side')
  {
    # Find out how big text is
    my $test_tag = 'dfjcnjdbnc';
    $self -> createText
    (
      0, 10_000, -text => 'test', -anchor => 'sw', -fill => 'black',
      -font => $fonts -> [3], -tags => [$test_tag]
    );
    my ($text_min_x, $text_min_y, $text_max_x, $text_max_y) = $self -> bbox($test_tag);
    my $text_height = $text_max_y - $text_min_y;
    $self -> delete($test_tag);

    $x_start = $self -> width - $borders -> [1] + $legend_info -> [1];
    $y_start = $self -> height - $borders -> [0] - $text_height;
  }
  else
  {
    warn 'Legend position ' . $legend_info -> [0] . "is not valid\n";
  }

  my $x_pos = $x_start;
  my $y_pos = $y_start;
  foreach my $ds (@{$self -> {-datasets}})
  {
    unless ($ds -> get(-noLegend))
    {
      if ($ds -> get('-active') != 99)  # do them all, not just active
      {
        my ($x, $y) = $self -> _to_canvas_pixels('canvas', $x_pos, $y_pos);
        my $line_tag = $ds -> get('-name');
        my $point_tag = $line_tag.'point';
        my $tag = $line_tag . 'legend';

        my $fill = $ds -> get('-color');
        my $fill_point = $ds -> get('-fillPoint');
        my $point_style = $ds -> get('-pointStyle');
        my $point_size = $ds -> get('-pointSize');
        my $dash = $ds -> get('-dash');
        my $text = $ds -> get('-name');

        my $no_line = 0;
        if (defined $ds -> get('-lineStyle'))
        {
          if ($ds -> get('-lineStyle') eq 'none')
          {
            $no_line = 1;
          }
        }

        $text = ($ds -> get('-yAxis') eq 'Y1') ? $text . '(Y1) ' : $text . ' ';

        my ($textX, $textY) = $self -> _to_canvas_pixels('canvas', $x_pos + 50, $y_pos);
        $self -> createText
        (
          $textX, $textY,
          -text => $text, -anchor => 'sw', -fill => $ds->get('-color'),
          -font=>$fonts->[3],-tags=>[$tag]
        );

        # Find out how big text is
        my ($text_min_x, $text_min_y, $text_max_x, $text_max_y) = $self -> bbox($tag);
        my $text_height = $text_max_y - $text_min_y;

        # Print line if necessery
        if (!$no_line)
        {
          $self -> createLine
          (
            $x, $y - $text_height / 2, $x + 40, $y - $text_height / 2, -fill => $fill,
            -dash => $dash, -tags => [$tag]
          );
        }
        $self -> _draw_point
        (
          $x + 20, $y - $text_height / 2,
          -fill => $fill, -pointStyle => $point_style, -pointSize => $point_size,
          -fillPoint => $fill_point, -tags => [$tag, $point_tag]
        );

        # If multiple curves, turn the line and the plot name red when we enter it with the cursor in the legend
        if (scalar(@{$self -> {-datasets}}) > 1)
        {
          $self -> bind
          (
            $tag, '<Enter>' => sub
            {
              # print "Highlighting <$line_tag> and <$tag>.\n";
              $self -> itemconfigure($point_tag, -fill => 'red');
              $self -> itemconfigure($line_tag, -fill => 'red');
              $self -> itemconfigure($tag, -fill => 'red');
            }
          );
          $self -> bind
          (
            $tag, '<Leave>' => sub
            {
              $self -> itemconfigure($line_tag, -fill => $fill);
              $self -> itemconfigure($tag, -fill => $fill);
              if ($fill_point)
              {
                $self -> itemconfigure($point_tag, -fill => $fill);
              }
              else
              {
                $self -> itemconfigure($point_tag, -fill => '');
              }
            }
          );
        }
        my ($x1, $y1, $x2, $y2) = $self -> bbox($tag);
        unless (defined($legend_info) and $legend_info -> [0] ne 'bottom')
        {
          if ($x2)
          {
            $x_pos = $x2 + 10;
          }
          else
          {
            $x_pos += 100;
          }
        }
        else
        {
          if ($y2)
          {
            $y_pos -= ($y2 - $y1) + 10;
          }
          else
          {
            $y_pos -= 100;
          }
        }
        # print "_legends location of last character p1($x1, $y1), p2($x2, $y2)\n";
      }
    }
  }
  return (1);
}

sub addDatasets  ## no critic (NamingConventions::ProhibitMixedCaseSubs)
{
  # add data sets to the plot object
  my ($self, @datasets) = @_;
  foreach my $dataset (@datasets)
  {
    unless (ref($dataset) eq 'LineGraphDataset')
    {
      warn 'addDatasets: Dataset must be a Tk::LineGraphDataset object'
    }
    else
    {
      push @{$self -> {-datasets}}, $dataset;
    }
  }
  return (1);
}

sub clearDatasets  ## no critic (NamingConventions::ProhibitMixedCaseSubs)
{
  # removes all data sets from the plot object
  my ($self) = @_;
  @{$self -> {-datasets}} = ();
  return (1);
}

sub _count_y1
{
  # count how many datasets are using y1
  my ($self) = @_;
  my $count = 0;
  foreach my $ds (@{$self -> {-datasets}})
  {
    $count++ if ($ds -> get('-yAxis') eq 'Y1');
  }
  # print "_count_y1 <$count>\n";
  return ($count);
}

sub _data_sets_min_max  # one argument, all or active
{
  # Get the min and max of the datasets
  # could be done for all datasets or just the active datasets
  # return xmin, xmax, ymin, ymax, y1min, y1max
  my ($self, $rescale) = @_;
  my $all = 0;
  $all = 1 if ($rescale and $rescale eq 'all');
  my ($first, $first1) = (0, 0);
  my ($y_max, $y_min, $x_max, $x_min, $y_max1, $y_min1) = (0, 0, 0, 0, 0, 0);
  my ($x_data, $y_data);
  # Do x then y and y1
  foreach my $ds (@{$self -> {-datasets}})
  {
    if ($all or ($ds -> get('-active') == 1))
    {
      $y_data = $ds -> get('-yData');
      $x_data = $ds -> get('-xData');
      $x_data = [0..scalar(@$y_data) - 1]  unless (defined($x_data));
      if ($first == 0)
      {
        $x_max = $x_min = $x_data -> [0];
        $first = 1;
      }
      foreach my $e (@{$x_data})
      {
        $x_max = $e if ($e > $x_max );
        $x_min = $e if ($e < $x_min );
      }
    }
  }
  $first = $first1 = 0;
  foreach my $ds (@{$self -> {-datasets}})
  {
    if ($all or ($ds -> get('-active') == 1))
    {
      $y_data = $ds -> get('-yData');
      if ($ds -> get('-yAxis') eq 'Y1')
      {
        if ($first1 == 0)
        {
          $y_max1 = $y_min1 = $y_data -> [0];
          $first1 = 1;
        }
        foreach my $e (@{$y_data})
        {
          $y_max1 = $e if ($e > $y_max1);
          $y_min1 = $e if ($e < $y_min1);
        }
      }
      else
      {  # for y axis
        if ($first == 0)
        {
          $y_max = $y_min = $y_data -> [0];
          $first = 1;
        }
        foreach my $e (@{$y_data})
        {
          $y_max = $e if ($e > $y_max);
          $y_min = $e if ($e < $y_min);
        }
      }
    }
  }
  # print "_data_sets_min_max: X($x_min, $x_max), Y($y_min, $y_max), Y1($y_min1, $y_max1)\n";
  return ($x_min, $x_max, $y_min, $y_max, $y_min1, $y_max1);
}

sub _scale_plot  # 'all'  or 'active'
{
  # scale either all the data sets or just the active ones
  my ($self, $how) = @_;
  my ($x_min, $x_max, $y_min, $y_max, $y1min, $y1max) = $self -> _data_sets_min_max($how);
  # print "_scale_plot:  min and max  ($x_min, $x_max), ($y_min, $y_max),  ($y1min, $y1max)\n";
  my ($x_tick_labels, $y_tick_labels, $y1_tick_labels);
  my ($y_min_p,  $y_max_p,  $y_intervals);
  my $scale = $self -> cget(-scale);
  if ($self -> cget(-autoScaleY) eq 'On')
  {
    ($y_min_p, $y_max_p, $y_intervals) = _nice_range($y_min, $y_max);
    if ($self -> cget('-yType') eq 'log')
    {
      ($y_min_p, $y_max_p, $y_intervals, $y_tick_labels) = $self -> _log_range
      (
        $y_min, $y_max,
        -tickFormat => $self -> cget('-yTickFormat')
      );
    }
  }
  else
  {
    ($y_min_p, $y_max_p, $y_intervals) = ($scale -> [3], $scale -> [4], $scale -> [5]);
  }
  my ($y1min_p, $y1max_p, $y1intervals);
  if ($self -> cget(-autoScaleY1) eq 'On')
  {
    ($y1min_p, $y1max_p, $y1intervals) = _nice_range($y1min, $y1max);
    if ($self -> cget('-y1Type') eq 'log')
    {
      ($y1min_p, $y1max_p, $y1intervals, $y1_tick_labels) = $self -> _log_range
      (
        $y1min, $y1max,
        -tickFormat => $self -> cget('-y1TickFormat')
      );
    }
  }
  else
  {
    ($y1min_p, $y1max_p, $y1intervals) = ($scale -> [6], $scale -> [7], $scale -> [8]);
  }
  my ($x_min_p,  $x_max_p,  $x_intervals);
  if ($self -> cget(-autoScaleX) eq 'On')
  {
    ($x_min_p, $x_max_p, $x_intervals) = _nice_range($x_min, $x_max);
    if ($self -> cget('-xType') eq 'log')
    {
      ($x_min_p, $x_max_p, $x_intervals, $x_tick_labels) = $self -> _log_range
      (
        $x_min, $x_max,
        -tickFormat => $self -> cget('-xTickFormat')
      );
    }
  }
  else
  {
    ($x_min_p, $x_max_p, $x_intervals) = ($scale -> [0], $scale -> [1], $scale -> [2]);
  }
  # print "_scale_plot: $y_min_p,  $y_max_p,  $y_intervals, @$y_tick_labels\n";
  # print "($x_min_p, $x_max_p, $x_intervals)  tickLabels <$x_tick_labels> \n";
  $self -> configure(-xTickLabel => $x_tick_labels);
  $self -> configure(-yTickLabel => $y_tick_labels);
  $self -> configure(-y1TickLabel => $y1_tick_labels);
  # print "_scale_plot: Y $y_min_p, $y_max_p, $y_intervals  X  $x_min_p, $x_max_p, $x_intervals \n";
  # put these scale values into the plot widget
  $self -> configure
  (
    -scale =>
    [
      $x_min_p, $x_max_p, $x_intervals,
      $y_min_p, $y_max_p, $y_intervals,
      $y1min_p, $y1max_p, $y1intervals
    ]
  );
  # print "in scale $y_min_p, $y_max_p, $y_intervals \n";
  # reset the zoom stack!
  $self -> {-zoomStack} = [];
  return (1);
}

sub plot
{
  # plot all the active data sets
  # 'always' (Default), 'never' or 'not_zoomed'
  my ($self, $rescale) = @_;
  $rescale = 'always' unless defined($rescale); # Default to Always

  if ($rescale eq 'always')   # Always Rescale
  {
    $self -> _rescale('all');
  }
  elsif ($rescale eq 'never') # Never Rescale
  {
    $self -> _rescale('not');
  }
  elsif ($rescale eq 'not_zoomed') # Only Rescale if not Zoomed in
  {
    if (@{$self -> {-zoomStack}} == 0)
    {
      $self -> _rescale('all');
    }
    else
    {
      $self -> _rescale('not');
    }
  }

  return (1);
}

sub _draw_axis
{
  # do both of the axis
  my ($self) = @_;
  my $s = $self -> cget(-scale);  # get the scale factors
  my ($nb, $eb, $sb, $wb) = @{$self -> cget(-border)};
  # for now, figure this will fit
  my $h = $self -> height;
  my $w = $self -> width;
  my $x_tick_label = $self -> cget('-xTickLabel');
  my $fonts = $self -> cget('-fonts');
  # print "_draw_axis: xTickLabel <$x_tick_label>\n";
  my $lab = [];
  if ($x_tick_label)
  {
    # print "draw axis: making tick labels\n";
    push (@{$lab}, 'black', $fonts -> [0]);
    foreach my $tl (@{$x_tick_label})
    {
      push @{$lab}, $tl;
      # print "_draw_axis: @{$lab} \n";
    }
  }
  else
  {
    $lab = undef;
  }

  # xAxis first
  # tick stuff
  my ($t_start, $t_stop, $interval) = ($s -> [0], $s -> [1], $s -> [2]);
  my $ticks = ($t_stop - $t_start) / $interval;
  my $a_length = $w - $wb - $eb;
  my $d = $a_length / $ticks;
  my ($x_start, $y_start, $x_end, $y_end) = ($wb, $h - $sb, $w - $eb, $h - $sb);
  my $result = $self -> _create_plot_axis
  (
    $x_start, $y_start, $x_end, $y_end,
    -fill => 'black',
    # $tcolor, $tfont,  $side, $start, $stop, $incr, $delta)
    # incr step size - used in lable in PIXELS, delta is the PIXELS  between ticks
    # have to start at the start of the "axis".  Not good!
    -tick => ['black', $fonts -> [0], 's', $t_start, $t_stop, $interval, $d],
    -tickFormat => $self -> cget('-xTickFormat'),
    -label => $lab,
  );

  # box x axis
  ($x_start, $y_start, $x_end, $y_end) = ($wb, $nb, $w - $eb, $nb);
  $result = $self -> _create_plot_axis
  (
    $x_start, $y_start, $x_end, $y_end,
    -fill => 'black'
  );

  # setup the tick labels if they have been set
  my $y_tick_label = $self -> cget('-yTickLabel');
  $lab = [];
  if ($y_tick_label)
  {
    # print "_draw_axis: making tick labels for y\n";
    push @{$lab}, 'black', $fonts -> [0] ;
    foreach my $tl (@{$y_tick_label})
    {
      push @{$lab}, $tl;
      # print "_draw_axis: @{$lab} \n";
    }
  }
  else
  {
    $lab = undef;
  }
  # print "y axis label <$lab> \n";
  #YAxis now
  ($x_start, $y_start, $x_end, $y_end) = ($wb, $nb, $wb, $h-$sb);
  ($t_start, $t_stop, $interval) = ($s -> [3], $s -> [4], $s -> [5]);
  $interval = 10 if ($interval <= 0);
  $ticks = ($t_stop - $t_start) / $interval;
  $a_length = $h - $nb - $sb;
  $d = $a_length / $ticks;
  $result = $self -> _create_plot_axis
  (
    $x_start, $y_start, $x_end, $y_end,
    -fill => 'black',
    # $tcolor, $tfont,  $side, $start, $stop, $incr, $delta)
    # incr step size - used in lable in PIXELS, delta is the PIXELS  between ticks
    # have to start at the start of the "axis".  Not good!
    -tickFormat => $self -> cget('-yTickFormat'),
    -tick => ['black', $fonts -> [0], 'w', $t_start, $t_stop, $interval, $d],
    -label => $lab,
  );

  #Y1Axis now if needed
  if ($self -> _count_y1)
  {
    # setup the tick labels if they have been set
    my $y1_tick_label  = $self -> cget('-y1TickLabel');
    $lab = [];
    if ($y1_tick_label)
    {
      # print "_draw_axis: making tick labels for y\n";
      push (@{$lab}, 'black', $fonts -> [0]);
      foreach my $tl (@{$y1_tick_label})
      {
        push (@{$lab}, $tl);
        # print "_draw_axis: @{$lab} \n";
      }
    }
    else
    {
      $lab = undef;
    }
    ($x_start, $y_start, $x_end, $y_end) = ($w-$eb, $nb, $w-$eb, $h-$sb);
    ($t_start, $t_stop, $interval) = ($s -> [6], $s -> [7], $s -> [8]);
    $interval = 10 if ($interval <= 0);
    $ticks = ($t_stop - $t_start) / $interval;
    $a_length = $h - $nb - $sb;
    $d = ($ticks != 0) ? $a_length / $ticks : 1;
    $result = $self -> _create_plot_axis
    (
      $x_start, $y_start, $x_end, $y_end,
      -fill => 'black',
      # $tcolor, $tfont,  $side, $start, $stop, $incr, $delta)
      # incr step size - used in lable in PIXELS, delta is the PIXELS  between ticks
      # have to start at the start of the "axis".  Not good!
      -tick => ['black', $fonts -> [0], 'e', $t_start, $t_stop, $interval, $d],
      -tickFormat => $self -> cget('-y1TickFormat'),
      -label => $lab,
    );
  }
  # box    y axis
  ($x_start, $y_start, $x_end, $y_end) = ($w-$eb, $nb, $w-$eb, $h-$sb);
  $result = $self -> _create_plot_axis
  (
    $x_start, $y_start, $x_end, $y_end,
    -fill => 'black',
  );
  $self -> _log_ticks;
  return (1);
}

sub _log_ticks
{
  # put the 2, 3, 4, ..., 9 ticks on a log axis
  my ($self) = @_;
  my $s = $self -> cget('-scale');
  my ($h, $w) = ($self -> height, $self -> width);
  my $borders = $self -> cget('-border');
  # do x axis
  if ($self -> cget('-xType') eq 'log')
  {
    my ($min_p, $max_p, $delta_p) = ($s -> [0], $s -> [1], $s -> [2]);
    my $dec = ($max_p - $min_p);
    unless ($dec > 5)  # only if there are less than four decades
    {
      my $axis_length = $w - $borders -> [1] - $borders -> [3];
      my $d_length = $axis_length / ($max_p - $min_p);
      my $delta;
      my $y = $h - $borders -> [2];
      foreach my $ii (1..$dec)
      {
        foreach my $i (2..9)
        {
          my $delta = (log10 $i) * $d_length;
          my $x = ($borders -> [3]) + $delta + $d_length * ($ii - 1);
          # print "_log_ticks: $ii $i delta $delta  y $y \n";
          $self -> createLine($x, $y, $x, $y + 6, -fill => 'black');
        }
      } # end each decade
    }
  }
  # do y axis
  if ($self -> cget('-yType') eq 'log')
  {
    my ($min_p, $max_p, $delta_p) = ($s -> [3], $s -> [4], $s -> [5]);
    my $dec = ($max_p - $min_p);
    unless ($dec > 5)  # only if there are less than four decades
    {
      my $axis_length = $h - $borders -> [0] - $borders -> [2];
      my $d_length = $axis_length / ($max_p - $min_p);
      my $delta;
      foreach my $ii (1..$dec)
      {
        foreach my $i (2..9)
        {
          my $delta = (log10 $i) * $d_length;
          my $y = $h - ($borders -> [2]) - $delta - $d_length * ($ii - 1);;
          # print "_log_ticks: $ii $i delta $delta  y $y \n";
          $self -> createLine($borders -> [3], $y, $borders -> [3] + 6, $y, -fill => 'black');
        }
      } # end each decade
    }
  }
  # do y1 axis
  if ($self -> cget('-y1Type') eq 'log')
  {
    my ($min_p, $max_p, $delta_p) = ($s -> [6], $s -> [7], $s -> [8]);
    my $dec = ($max_p - $min_p);
    unless ($dec > 5)  # only if there are less than four decades
    {
      my $axis_length = $h - $borders -> [0] - $borders -> [2];
      my $d_length = $axis_length / ($max_p - $min_p);
      my $delta;
      foreach my $ii (1..$dec)
      {
        foreach my $i (2..9)
        {
          my $delta = (log10 $i) * $d_length;
          my $x = $self -> width - $borders -> [1];
          my $y = $h - ($borders -> [2]) - $delta - $d_length * ($ii - 1);
          # print "_log_ticks: $ii $i delta $delta  y $y \n";
          $self -> createLine($x, $y, $x - 6, $y, -fill => 'black');
        }
      } # end each decade
    }
  }
  return (1);
}

sub _draw_datasets
{
  # draw the line(s) for all active datasets
  my ($self, @args) = @_;
  %{$self -> {BalloonPoints}} = (); # Clear the balloon help hash before drawing.
  foreach my $ds (@{$self -> {-datasets}})
  {
    if ($ds -> get('-active') == 1)
    {
      $self -> _draw_one_dataset($ds);
    }
  }
  return (1);
}

sub _draw_one_dataset  # index of the dataset to draw, widget args
{
  # draw even if not active ?
  my ($self, $ds, %args) = @_;
  # %args seems not to be used here.
  my ($nb, $eb, $sb, $wb) = @{$self -> cget(-border)};
  my $tag = $ds -> get('-name');
  my $fill;
  my $index  = $ds -> get('-index');
  if ($ds -> get('-color') eq 'none')
  {
    my $colors = $self -> cget(-colors);
    $fill = $self -> cget('-colors') -> [$index % @$colors];
    $ds -> set('-color' => $fill);
  }
  else
  {
    $fill = $ds -> get('-color');
  }

  my $line_style = $ds -> get('-lineStyle'); #SS - added option to set line style
  my $no_line = 0;
  my $dash = '';
  if ($line_style)
  {
    if ($line_style eq 'none')
    {
      $no_line = 1;
    }
    elsif ($line_style eq 'normal')
    {
      $dash = '';
    }
    elsif ($line_style eq 'dot')
    {
      $dash = '.';
    }
    elsif ($line_style eq 'dash')
    {
      $dash = '-';
    }
    elsif ($line_style eq 'dotdash')
    {
      $dash = '.-';
    }
    else
    {
      warn "Invalid -lineStyle setting ($line_style) on line $tag, defaulting to normal\n";
      $ds -> set('-lineStyle' => 'normal');
    }
    $ds -> set('-dash' => $dash);
  }
  else
  {
    $dash = '';
    $ds -> set('-dash' => $dash);
    $ds -> set('-lineStyle' => 'normal');
  }

  my $point_style; #SS - added option to set point style
  if (!$ds -> get('-pointStyle'))
  {
    my $point_styles = $self -> cget('-pointShapes');
    $point_style = $point_styles -> [$index % @$point_styles];
    $ds -> set('-pointStyle' => $point_style);
  }
  else
  {
    $point_style = $ds -> get('-pointStyle');
  }

  my $point_size = $ds -> get('-pointSize'); #SS - added option to set point style
  if (!$point_size)
  {
    $point_size = 3;
    $ds -> set('-pointSize' => $point_size);
  }

  my $fill_point = $ds -> get('-fillPoint'); #SS - added option to set whether point should be filled
  if (! defined $fill_point)
  {
    $fill_point = 1;
    $ds -> set('-fillPoint' => $fill_point);
  }

  my $yax  = $ds -> get('-yAxis');  # does this dataset use y or y1 axis
  # print "_draw_one_dataset: index <$index> color  <$fill> y axis <$yax>\n";
  my $y_data = $ds -> get('-yData');
  my $x_data = $ds -> get('-xData');
  $x_data = [0..(scalar(@$y_data)-1)]  unless (defined($x_data));
  my $log_min = $self -> cget(-logMin);
  my $x = [];
  # if x-axis uses a log scale convert x data
  if ($self -> cget('-xType') eq 'log')
  {
    foreach my $e (@{$x_data})
    {
      $e = $log_min if ($e <= 0);
      push @{$x}, log10($e);
    } # end foreach
  }
  else  # not log at all
  {
    $x = $x_data;
  }
  my $y = [];
  # just maybe we have a log plot to do.  In that case must take the log of each point
  if
  (
    (($yax eq 'Y1') and ($self -> cget('-y1Type') eq 'log'))
    or (($yax eq 'Y') and ($self -> cget('-yType') eq 'log'))
  )
  {
    foreach my $e (@{$y_data})
    {
      $e = $log_min if ($e <= 0);
      push @{$y}, log10($e);
    } # end foreach
  }
  else  # not log at all
  {
    $y = $y_data;
  }

  # need to make one array out of two
  my @xy_points;
  # right here we need to go from data set coordinates to plot PIXEL coordinates

  my ($xReady, $yReady) = $self -> _ds_to_plot_pixels($x, $y, $yax);
  @xy_points =  $self -> _arrays_to_canvas_pixels('axis', $xReady, $yReady);
  # got to take care of the case where the data set is empty or just one point.
  return if (@xy_points == 0);
  if (@xy_points == 2)
  {
    # print "one point, draw a dot!\n";
    my ($xa, $ya) = ($xy_points[0], $xy_points[1]);
    $self -> _draw_point
    (
      $xa, $ya, -pointStyle => $point_style, -pointSize => $point_size,
      -fillPoint => $fill_point, -fill => $fill, -tags => [$tag, $tag . 'point']
    );
  }
  else
  {
    $self -> _draw_one_dataset_b
    (
      -data => \@xy_points,
      -fill => $fill,
      -dash => $dash,
      -tags => [$tag],
      -xData => $x_data,
      -yData => $y_data,
      -noLine => $no_line,
      -pointStyle => $point_style,
      -pointSize => $point_size,
      -fillPoint => $fill_point
    );
  }

  # If multiple curves, turn the plot name in the legend and the line red when we enter the line with the cursor
  if (scalar(@{$self -> {-datasets}}) > 1)
  {
    $self -> bind
    (
      $tag, '<Enter>' => sub
      {
        $self -> itemconfigure($tag, -fill => 'red');
        $self -> itemconfigure($tag . 'legend', -fill => 'red');
        $self -> itemconfigure($tag . 'point', -fill => 'red');
      }
    );
    $self -> bind
    (
      $tag, '<Leave>' => sub
      {
        $self -> itemconfigure($tag, -fill => $fill);
        $self -> itemconfigure($tag . 'legend', -fill => $fill);
        if ($fill_point)
        {
          $self -> itemconfigure($tag . 'point', -fill => $fill);
        }
        else
        {
          $self -> itemconfigure($tag . 'point', -fill => '');
        }
      }
    );
  }
  return (1);
}

sub _center_text_v  # given y1, y2, a font and a string
{
  # return a y value for the start of the text
  # The system is in canvas, that is 0, 0 is top right.
  # return -1 if the text will just not fit
  my ($self, $y1, $y2, $f, $s) = @_;
  return (-1) if ($y1 > $y2);
  my $g = 'gowawyVVV';
  $self -> _create_text_v
  (
    0, 10_000,  -text => $s, -anchor => 'sw',
    -font => $f, -tag => $g
  );
  my ($min_x, $min_y, $max_x, $max_y) = $self -> bbox($g);
  # print "_center_text_v: ($min_x, $min_y, $max_x, $max_y)\n";
  $self -> delete($g);
  my $space = $y2 - $y1;
  my $str_length = $max_y - $min_y;
  return (-1) if ($str_length > $space);
  # print "_center_text_v: $y1, $y2, space $space, strLen $str_length\n";
  return (($y1 + $y2 - $str_length) / 2);
}

sub _center_text  # x1, x2 a font and a string
{
  # return the x value fo where to start the text to center it
  # forget about leading and trailing blanks!!!!
  # Return -1 if the text will not fit
  my ($self, $x1, $x2, $f, $s) = @_;
  return (-1) if ($x1 > $x2);
  my $g = 'gowawy';
  $self -> createText
  (
    0, 10_000,  -text => $s, -anchor => 'sw',
    -font => $f, -tags => [$g]
  );
  my ($min_x, $min_y, $max_x, $max_y) = $self -> bbox($g);
  $self -> delete($g);
  my $space = $x2-$x1;
  my $str_length = $max_x - $min_x;
  return (-1) if ($str_length > $space);
  return (($x1 + $x2 - $str_length) / 2);
}

sub _draw_one_dataset_b  # takes same arguments as createLinePlot confused
{
  # do clipping if needed
  # do plot with dots if needed
  my ($self, %args) = @_;
  my $xy_points = delete($args{'-data'});
  my $x_data = delete($args{'-xData'});           # Take the original data for use
  my $y_data = delete($args{'-yData'});           # in the balloon popups.
  my $no_line = delete($args{'-noLine'});          # Add a switch to allow points-only plots
  my $point_style = delete($args{'-pointStyle'});  # Add a switch to set point style
  my $point_size = delete($args{'-pointSize'});    # Add a switch to set point size
  my $fill_point = delete($args{'-fillPoint'});    # Add a switch to specify points as not filled
  # $self -> createLinePlot(-data => $xy_points, %args);
  $self -> _clip_plot(-data => $xy_points, %args) unless $no_line;
  my $h = $self -> height;
  my $w = $self -> width;
  my $borders = $self -> cget(-border);
  # How many points are inside of the plot window.
  # mark the points if there are less that 20 points
  my $points = @{$xy_points} / 2;
  my $inPoints = $self -> _count_in_points($xy_points);
  if (($inPoints < 20) or $no_line)
  {
    my $tags = $args{'-tags'};
    my $mainTag = $$tags[0];
    for (my $i = 0; $i < $points; $i++)
    {
      my $specificPointTag = $mainTag . "($i)";
      my $generalPointTag = $mainTag . 'point';
      # print "Point tag = $point_tag\n"; # DEBUG
      my @pointTags = (@$tags, $specificPointTag, $generalPointTag);
      my ($x, $y) = ($xy_points -> [$i * 2], $xy_points -> [$i * 2 + 1]);
      if ($self -> cget('-balloons'))
      {
        $self -> {BalloonPoints} -> {$specificPointTag}
          = sprintf('%.3g, %.3g', $$x_data[$i], $$y_data[$i]);
      }
      if
      (
        ($x >= $borders -> [3])
        and ($x <= ($w - $borders -> [1]))
        and ($y >= $borders -> [0])
        and ($y <= ($h - $borders -> [2]))
      )
      {
        $self -> _draw_point
        (
          $x, $y, %args, -pointStyle => $point_style, -pointSize => $point_size,
          -fillPoint => $fill_point, -tags => \@pointTags
        )
      }
    }
  }
  return (1);
}

sub _draw_point
{
  # Draw a point
  my ($self, $x, $y, %args) = @_;

  my $point_style = delete($args{-pointStyle});
  my $point_size = delete($args{-pointSize});
  my $fill_point = delete($args{-fillPoint});

  unless ($point_style)
  {
    $point_style = '';
  }

  unless ($point_size)
  {
    warn "_draw_point: No point size specified for $args{-tags} -> [0]\n";
    $point_size = 3;
  }

  $args{-outline} = $args{-fill};
  unless ($fill_point)
  {
    $args{-fill} = '';
  }

  if ($point_style eq 'none')
  {
  }
  elsif ($point_style eq 'circle' or $point_style eq '')
  {
    $self -> createOval
    (
      $x - $point_size, $y - $point_size,
      $x + $point_size, $y + $point_size, %args
    );
  }
  elsif ($point_style eq 'square')
  {
    $self -> createRectangle
    (
      $x - $point_size, $y - $point_size,
      $x + $point_size, $y + $point_size, %args
    );
  }
  elsif ($point_style eq 'triangle')
  {
    $self -> createPolygon
    (
      $x - $point_size, $y - $point_size,
      $x + $point_size, $y - $point_size,
      $x, $y + $point_size, %args
    );
  }
  elsif ($point_style eq 'diamond')
  {
    $self -> createPolygon
    (
      $x - $point_size, $y,
      $x, $y + $point_size,
      $x + $point_size, $y,
      $x, $y - $point_size, %args
    );
  }
  else
  {
    warn "_draw_point: Point style $point_style is invalid, line = $args{-tags} -> [0]\n";
    $self -> createOval
    (
      $x - $point_size, $y - $point_size,
      $x + $point_size, $y + $point_size, %args
    );
  }
  return (1);
}

sub _count_in_points  # array of x, y points
{
  # count the points inside the plot box.
  my ($self, $xy_points) = @_;
  my $points = @{$xy_points} / 2;
  my $count = 0;
  my $h = $self -> height;
  my $w = $self -> width;
  my $borders = $self -> cget(-border);

  for (my $i = 0; $i < $points; $i++)
  {
    my ($x, $y) = ($xy_points -> [$i * 2], $xy_points -> [$i * 2 + 1]);
    if
    (
      ($x >= $borders -> [3])
      and ($x <= ($w - $borders -> [1]))
      and ($y >= $borders -> [0])
      and ($y <= ($h - $borders -> [2]))
    )
    {
      $count++;
    }
  }
  return ($count);
}

sub _clip_plot  # -data => array ref which contains x, y points in Canvas pixels
{
  # draw a multi point line but cliped at the borders
  my ($self, %args) = @_;
  my $xy_points = delete($args{'-data'});
  my $point_count = (@{$xy_points})/2;
  my $h = $self -> height;
  my $w = $self -> width;
  my $last_point = 1; # last pointed plotted is flaged as being out of the plot box
  my $borders = $self -> cget(-border);
  my @p;  # a new array with points for line segment to be plotted
  my ($x, $y);
  my ($xp, $yp) = ($xy_points -> [0], $xy_points -> [1]); # get the first point
  if
  (
    ($xp >= $borders -> [3])
    and ($xp <= ($w - $borders -> [1]))
    and ($yp >= $borders -> [0])
    and ($yp <= ($h - $borders -> [2]))
  )
  {
    # first point is in, put points in the new array
    push @p, ($xp, $yp);  # push the x, y pair
    $last_point = 0; # flag the last point as in
  }
  for (my $i = 1; $i < $point_count; $i++)
  {
    ($x, $y) = ($xy_points -> [$i * 2], $xy_points -> [$i * 2 + 1]);
    # print "_clip_plot: $i ($x $borders -> [3]) and ($x $w $borders -> [1]) ($y $borders -> [0]) ($y ($h - $borders -> [2])) lastPoint  $last_point\n";
    if
    (
      ($x >= $borders -> [3])
      and ($x <= ($w - $borders -> [1]))
      and ($y >= $borders -> [0])
      and ($y <= ($h - $borders -> [2]))
    )
    {
      # OK, this point is in, if the last one was out then we have work to do
      if ($last_point == 1)  # out
      {
        $last_point = 0;   # in
        my ($xn, $yn) = $self -> _clip_line_in_out
        (
          $x, $y, $xp, $yp,
          $borders -> [3], $borders -> [0],
          $w - $borders -> [1], $h - $borders -> [2]
        );
        push (@p, ($xn, $yn));
        push (@p, ($x, $y));
        ($xp, $yp) = ($x, $y);
      }
      else  # last point was in, this  in  so we just add a point to the line and carry on
      {
        push (@p, ($x, $y));
        ($xp, $yp) =  ($x, $y);
      } # end else
    }
    else  # this point out
    {
      my @args = %args;
      if ($last_point == 0)  # in
      {
        # this point is out, last one was in, need to draw a line
        my ($x_edge, $y_edge) = $self -> _clip_line_in_out
        (
          $xp, $yp, $x, $y,
          $borders -> [3], $borders -> [0],
          $w - $borders -> [1], $h - $borders -> [2]
        );
        push @p, $x_edge, $y_edge;
        $self -> createLine(\@p, %args);
        splice(@p, 0);  # empty the array?
        $last_point = 1;   # out
        ($xp, $yp) =  ($x, $y );
      }
      else  # two points in a row out but maybe the lies goes thru the active area
      {
        # print "clip two points in a row out of box.\n";
        my $p = $self -> _clip_line_out_out
        (
          $xp, $yp, $x, $y,
          $borders -> [3], $borders -> [0],
          $w - $borders -> [1], $h - $borders -> [2]
        );
        $self -> createLine($p, %args)if (@$p >= 4);
        $last_point = 1; # out!
        ($xp, $yp) = ($x, $y );
      } # end else
    }
  } # end loop
  # now when we get out of the loop if there are any points in the @p array, make a line
  $self -> createLine(\@p, %args) if (@p >= 4);
  return (1);
}

sub _clip_line_out_out ## no critic (Subroutines::ProhibitManyArgs)
{ # x, y  ,  x, y  and x, y corners of the box

  # see if the line goes thru the box
  # If so, draw the line
  # else do nothing
  my ($self, $x1, $y1, $x2, $y2, $xb1, $yb1, $xb2, $yb2) = @_;
  my (@p, $x, $y);
  # print "_clip_line_out_out: ($x1, $y1) , ($x2, $y2), ($xb1, $yb1) , ($xb2, $yb2)\n";
  return (\@p) if (($x1 < $xb1) and ($x2 < $xb1));  # line not in the box
  return (\@p) if (($x1 > $xb2) and ($x2 > $xb2));
  return (\@p) if (($y1 > $yb2) and ($y2 > $yb2));
  return (\@p) if (($y1 < $yb1) and ($y2 < $yb1));
  # get here the line might pass thru the plot box
  # print "_clip_line_out_out: p1($x1, $y1), p2($x2, $y2), box1($xb1, $yb1), box2($xb2, $yb2)\n";
  if ($x1 != $x2)
  {
    my $m = ($y1 - $y2) / ($x1 - $x2);    # as in y = mx + c
    my $c = $y1 - $m * $x1;
    # print "_clip_line_out_out: line m $m c $c\n";
    $x = ($m != 0) ? ($yb1 - $c) / $m : $x1; #   print "$x $yb1\n";
    push @p, ($x, $yb1) if (($x >= $xb1) and ($x <= $xb2));
    $x = ($m != 0) ? ($yb2 - $c) / $m : $x1;
    push @p, ($x, $yb2) if (($x >= $xb1) and ($x <= $xb2));
    $y = $m * $xb1 + $c;
    push @p, ($xb1, $y) if (($y >= $yb1) and ($y <= $yb2));
    $y = $m * $xb2 + $c;
    push @p, ($xb2, $y) if (($y >= $yb1) and ($y <= $yb2));
  }
  else  # Handle vertical lines...
  {
    $x = $x1; # This is also $x2 of course!
    push @p, ($x, $yb1) if (($x >= $xb1) and ($x <= $xb2));
    $x = $x1;
    push @p, ($x, $yb2) if (($x >= $xb1) and ($x <= $xb2));
  }
  # print "_clip_line_out_out: @p", "\n";
  return (\@p)
}

sub _clip_line_in_out ## no critic (Subroutines::ProhibitManyArgs)
{ # x, y (1 in), x, y (2 out)   and x, y corners of the box

  # We have two points, one in the box, one outside of the box
  # Find where the line between the two points intersects the edges of the box
  # returns that point
  # Notebook page 106
  my ($self, $x1, $y1, $x2, $y2, $xb1, $yb1, $xb2, $yb2) = @_; ## no critic (Subroutines::ProhibitManyArgs)
  # print "_clip_line_in_out: ($x1, $y1) , ($x2, $y2), ($xb1, $yb1) , ($xb2, $yb2)\n";
  my ($xi, $yi);
  if ($x1 == $x2)  # line par to y axis
  {
    # print "_clip_line_in_out: Line parallel to y axis\n";
    $xi = $x1;
    $yi = ($y2 < $yb1) ? $yb1  : $yb2;
    return ($xi, $yi);
  }
  if ($y1 == $y2)  # line par to x axis
  {
    # print "_clip_line_in_out: Line parallel to y axis\n";
    $yi = $y1;
    $xi = ($x2 < $xb1) ? $xb1 : $xb2;
    return ($xi, $yi);
  }
  # y = mx + b; m = dy / dx   b = y1 - m * x1  x = (y - b) / m
  if (($x1 - $x2) != 0)
  {
    my $m = ($y1 - $y2) / ($x1 - $x2);
    my $c = $y1 - $m * $x1;
    if ($y2 <= $y1)  # north border
    {
      $xi = ($yb1 - $c) / $m;
      return ($xi, $yb1) if (($xi >= $xb1) and ($xi <= $xb2));
    }
    else  # south border
    {
      $xi = ($yb2-$c) / $m;
      return ($xi, $yb2) if (($xi >= $xb1) and ($xi <= $xb2));
    }
    if ($x2 <= $x1)  # west border
    {
      $yi = $m * $xb1 + $c;
      return ($xb1, $yi) if (($yi >= $yb1) and ($yi <= $yb2));
    }
    # only one remaining is east border
    $yi = $m * $xb2 + $c;
    return ($xb2, $yi) if (($yi >= $yb1) and ($yi <= $yb2));
  }
  else  # dx == 0, vertical line, north or south border
  {
    return ($x1, $yb1) if ($y2 <= $yb1);
    return ($x1, $yb2) if ($y2 >= $yb2);
  }
  warn '_clip_line_in_out() reach this point in the code';
  return (0, 0);
}

# There are three coordinate systems in use.
# 1. World  - Units are the physical system being plotted. Amps, DJ Average, dollars, etc
# 2. Plot   - Units are pixels. The (0, 0) point is the lower left corner of the canvas
# 3. Canvas - Units are pixels. The (0, 0) point is the upper left corner of the canvas.

sub _to_world_points  # x, y in the Canvas system
{
  # convert to World points
  # get points on canvas from system in pixels, need to change them into units in the plot
  my ($self, $xp, $yp)  = @_;
  my $borders = $self -> cget(-border);   # north, east, south, west
  my $s = $self -> cget(-scale);     # min X, max X, interval, min y, max y,
  my $h = $self -> height;
  my $w = $self -> width;
  my $x = ($xp - $borders -> [3]) * ($s -> [1] - $s -> [0])
    / ($w - $borders -> [1] - $borders -> [3]) + $s -> [0];
  my $y = (($h-$yp) - $borders -> [2]) * ($s -> [4] - $s -> [3])
    / ($h - $borders -> [0] - $borders -> [2]) + $s -> [3];
  # but if the axes are log some more work to do.
  my $y1 = (($h - $yp) - $borders -> [2]) * ($s -> [7] - $s -> [6])
    / ($h - $borders -> [0] - $borders -> [2]) + $s -> [6];
  $x = 10 ** $x   if ($self -> cget('-xType')  eq 'log');
  $y = 10 ** $y   if ($self -> cget('-yType')  eq 'log');
  $y1 = 10 ** $y1 if ($self -> cget('-y1Type') eq 'log');
  # print "_to_world_points: ($xp, $yp) to ($x, $y, $y1\n";
  return ($x, $y, $y1);
}

sub _to_canvas_pixels  # which, x, y
{
  # given an x, y value in axis or canvas system return x, y in Canvas pixels.
  # axis => x, y are pixels relative to where the border is
  # canvas => x, y are pixels in the canvas system.
  # more to follow ?
  my ($self, $which, $x, $y) = @_;
  my ($x_out, $y_out);
  if ($which eq 'axis')
  {
    my $borders = $self -> cget(-border);
    return ($x + $borders -> [3], $self -> height - ($y + $borders -> [2]));
  }
  if ($which eq 'canvas')
  {
    return ($x, $self -> height - $y);
  }
} # end _to_canvas_pixels

sub _arrays_to_canvas_pixels  # which, x array ref, y array ref
{
  # given x array ref and y aray ref generate the one array, xy in canvas pixels
  my ($self, $which, $xa, $ya) = @_;
  my @xy_out;
  my $h = $self -> height;
  my $borders = $self -> cget(-border);
  if ($which eq 'axis')
  {
    for (my $i = 0; $i < @$ya; $i++)
    {
      $xy_out[$i * 2]   = $xa -> [$i] + $borders -> [3];
      $xy_out[$i * 2 + 1] = $h - ($ya -> [$i] + $borders -> [2]);
    }
    return (@xy_out);
  }
}

sub _ds_to_plot_pixels  # ref to xArray and yArray with ds values, which y axis
{
  # ds is dataSet.  They are in world system
  # convert to Plot pixels, return ref to converted x array and y array
  my ($self, $xa, $ya, $y_axis) = @_;
  my $s = $self -> cget(-scale);
  my ($x_min, $x_max, $y_min, $y_max);
  ($x_min, $x_max, $y_min, $y_max) = ($s -> [0], $s -> [1], $s -> [3], $s -> [4]);
  ($x_min, $x_max, $y_min, $y_max) = ($s -> [0], $s -> [1], $s -> [6], $s -> [7]) if ($y_axis eq 'Y1');
  # print "_ds_to_plot_pixels: X($x_min, $x_max), Y($y_min, $y_max)\n";
  my $borders = $self -> cget(-border);
  my ($nb, $eb, $sb, $wb) = ($borders -> [0], $borders -> [1], $borders -> [2], $borders -> [3]);
  my $h = $self -> height;
  my $w = $self -> width;
  my (@xR, @yR);  # converted values to be returned
  my $sfX = ($w-$eb-$wb) / ($x_max - $x_min);
  my $sfY = ($h-$nb-$sb) / ($y_max - $y_min);
  my ($x, $y);
  for (my $i = 0; $i < @{$xa}; $i++)
  {
    push @xR, ($xa -> [$i] - $x_min) * $sfX if (defined($xa -> [$i]));
    push @yR, ($ya -> [$i] - $y_min) * $sfY if (defined($ya -> [$i]));
  }
  return (\@xR, \@yR);
}

sub _nice_range # input is min, max,
{
  # return is a new min, max and an interval for the tick marks
  # interval is not the number of intervals but the size of the interval
  # find a good min, max and interval for the axis
  # if min > max return min 0, max 100, interval of 10.
  my ($min, $max) = @_;
  my $delta = $max - $min;
  return (0, 100, 10) if ($delta < 0);                                       # AC: Set standard scale for negative ranges
  return (int($min + 0.5) - 1, int($min + 0.5) + 1, 1) if ($delta <= 1e-15); # AC: Set special scale for zero, or v. small ranges (v. small is usually caused by rounding errors!)
  my $r = ($max != 0) ? $delta/$max : $delta;
  $r = -$delta / $min if ($max < 0);
  my $spaces = 10; # number
  # don't want a lot of ticks if the size of the space is very small compaired to values
  $spaces = 2 if ($r < 1e-2);

  while (1)  # do this until a return
  {
    # print "ratio <$r> \n";
    # $spaces = 2 if ($r < 1e-08);
    my $interval = $delta / $spaces;
    my $power = floor(log10($delta));
    # print "min, max $min, $max  delta $delta  power $power interval $interval $spaces\n";
    # find a good interval for the ticks
    $interval = $interval * (10 ** -$power) * 10;
    # print "min, max $min, $max  delta $delta  power $power interval $interval\n";
    # now round this up the next whole number but not 3 or 6, 7 or 9.
    # leaves 1, 2, 4, 5, 8
    $interval = ceil($interval);
    $interval = 8  if (($interval == 7) or ($interval == 6));
    $interval = 10 if ($interval == 9);
    $interval = 4  if ($interval == 3);
    #print "min, max $min, $max  delta $delta  power $power interval $interval\n";
    $interval = $interval * (10 ** (+$power - 1));
    #print "min, max $min, $max  delta $delta  power $power interval $interval\n";
    # find the new min
    my ($new_max, $new_min);
    my $new_delta = $interval * $spaces;
    if ($new_delta == $delta)
    {
      $new_max = $max;
      $new_min = $min;
    }
    else
    {
      my $n = $min / $interval;
      my $n_floor = floor($n);
      # print "n $n floor of n is $n_floor \n";
      $new_min = $n_floor * $interval;
      $new_max = $new_min + $new_delta;
      if ($new_max <= $max)
      {
        # Add an extra space to include data missed off by reducing the minimum value
        $new_delta += $interval;
        $spaces++;
        $new_max = $new_min + $new_delta;
      }
    }
    # print "_nice_range: min, max $min, $max  delta $delta  power $power interval $interval newMin $new_min newMax $new_max \n";

    # now see how much of the space has been used.  If there is a lot empty, increase the number of spaces (ticks)
    return ($new_min, $new_max, $interval) if ($spaces <= 3);
    return ($new_min, $new_max, $interval) if ((($new_delta / $delta) < 1.4) and ($new_max >= $max));
    $spaces++;
  }

  die '_nice_range() should not reach this point in the code';
}

sub _log_range  # min, max
{
  # for scaling a log axis
  #returns a max and min, intervals  and an array ref that contains labels for the ticks
  # Optional args  -tickFormat
  #   The sprintf format to use. If not specified, then '1e%3.2d' will be used
  #   for values less than zero and '1e+%2.2d' will be used for values of zero
  #   or more.
  my ($self, $min, $max, %args) = @_;
  my $tick_format = delete $args{-tickFormat};

  unless (defined($min) and defined($max))
  {
    $min = 0.1;
    $max = 1000;
  }

  if ($min <= 0)
  {
    my $t = $self -> cget(-logMin);
    # print "Can't log plot data that contains numbers less than or equal to zero.\n";
    # print "Data min is: <$min>.  Changed to $t\n";
    $min = $self -> cget(-logMin);
    # set a flag to indicate the log data must be checked for min!
    $self -> {-logCheck} = 1; # true
  }
  my $delta = $max - $min;
  my $first;
  my @t_label;

  my $max_p = ceil(log10($max));
  $max_p = $max_p + 1 if ($max_p < 0);
  my $min_p = floor(log10($min));
  my $f;
  # print "_log_range: max $max, min $min,  $max_p, $min_p)\n";
  foreach my $t ($min_p..$max_p)
  {
    my $n = 10.0 ** $t;
    # print "_log_range: <$n> <$t>\n";
    if ($tick_format)
    {
      $f = sprintf($tick_format, $t);
    }
    elsif ($t < 0)
    {
      $f = sprintf('1e%3.2d', $t);
    }
    else
    {
      $f = sprintf('1e+%2.2d', $t);
    }
    # print "_log_range: $f \n";
    push @t_label, $f;
  }
  return ($min_p, $max_p, 1, \@t_label);
  # look returning min Power and the max Power.  Note the power step is always 1 this might not be good
  # used  1e-10, 1e-11 and so on.  Looks good to me!
}

1;

