diff options
Diffstat (limited to 'lib/GD/Graph')
| -rw-r--r-- | lib/GD/Graph/Data.pm | 725 | ||||
| -rw-r--r-- | lib/GD/Graph/Error.pm | 346 | ||||
| -rw-r--r-- | lib/GD/Graph/FAQ.pod | 130 | ||||
| -rw-r--r-- | lib/GD/Graph/area.pm | 112 | ||||
| -rw-r--r-- | lib/GD/Graph/axestype3d.pm | 787 | ||||
| -rw-r--r-- | lib/GD/Graph/bars.pm | 372 | ||||
| -rw-r--r-- | lib/GD/Graph/bars3d.pm | 349 | ||||
| -rw-r--r-- | lib/GD/Graph/colour.pm | 371 | ||||
| -rw-r--r-- | lib/GD/Graph/cylinder.pm | 126 | ||||
| -rw-r--r-- | lib/GD/Graph/cylinder3d.pm | 30 | ||||
| -rw-r--r-- | lib/GD/Graph/hbars.pm | 71 | ||||
| -rw-r--r-- | lib/GD/Graph/lines.pm | 182 | ||||
| -rw-r--r-- | lib/GD/Graph/lines3d.pm | 522 | ||||
| -rw-r--r-- | lib/GD/Graph/linespoints.pm | 46 | ||||
| -rw-r--r-- | lib/GD/Graph/mixed.pm | 99 | ||||
| -rw-r--r-- | lib/GD/Graph/pie.pm | 446 | ||||
| -rw-r--r-- | lib/GD/Graph/pie3d.pm | 331 | ||||
| -rw-r--r-- | lib/GD/Graph/points.pm | 183 | ||||
| -rw-r--r-- | lib/GD/Graph/utils.pm | 49 |
19 files changed, 0 insertions, 5277 deletions
diff --git a/lib/GD/Graph/Data.pm b/lib/GD/Graph/Data.pm deleted file mode 100644 index 23f4624..0000000 --- a/lib/GD/Graph/Data.pm +++ /dev/null @@ -1,725 +0,0 @@ -#========================================================================== -# Copyright (c) 1995-2000 Martien Verbruggen -#-------------------------------------------------------------------------- -# -# Name: -# GD::Graph::Data.pm -# -# $Id: Data.pm,v 1.21 2003/06/17 03:28:11 mgjv Exp $ -# -#========================================================================== - -package GD::Graph::Data; - -($GD::Graph::Data::VERSION) = '$Revision: 1.21 $' =~ /\s([\d.]+)/; - -use strict; -use GD::Graph::Error; - -@GD::Graph::Data::ISA = qw( GD::Graph::Error ); - -=head1 NAME - -GD::Graph::Data - Data set encapsulation for GD::Graph - -=head1 SYNOPSIS - -use GD::Graph::Data; - -=head1 DESCRIPTION - -This module encapsulates the data structure that is needed for GD::Graph -and friends. An object of this class contains a list of X values, and a -number of lists of corresponding Y values. This only really makes sense -if the Y values are numerical, but you can basically store anything. -Undefined values have a special meaning to GD::Graph, so they are -treated with care when stored. - -Many of the methods of this module are intended for internal use by -GD::Graph and the module itself, and will most likely not be useful to -you. Many won't even I<seem> useful to you... - -=head1 EXAMPLES - - use GD::Graph::Data; - use GD::Graph::bars; - - my $data = GD::Graph::Data->new(); - - $data->read(file => '/data/sales.dat', delimiter => ','); - $data = $data->copy(wanted => [2, 4, 5]); - - # Add the newer figures from the database - use DBI; - # do DBI things, like connecting to the database, statement - # preparation and execution - - while (@row = $sth->fetchrow_array) - { - $data->add_point(@row); - } - - my $chart = GD::Graph::bars->new(); - my $gd = $chart->plot($data); - -or for quick changes to legacy code - - # Legacy code builds array like this - @data = ( [qw(Jan Feb Mar)], [1, 2, 3], [5, 4, 3], [6, 3, 7] ); - - # And we quickly need to do some manipulations on that - my $data = GD::Graph::Data->new(); - $data->copy_from(\@data); - - # And now do all the new stuff that's wanted. - while (@foo = bar_baz()) - { - $data->add_point(@foo); - } - -=head1 METHODS - -=head2 $data = GD::Graph::Data->new() - -Create a new GD::Graph::Data object. - -=cut - -# Error constants -use constant ERR_ILL_DATASET => 'Illegal dataset number'; -use constant ERR_ILL_POINT => 'Illegal point number'; -use constant ERR_NO_DATASET => 'No data sets set'; -use constant ERR_ARGS_NO_HASH => 'Arguments must be given as a hash list'; - -sub new -{ - my $proto = shift; - my $class = ref($proto) || $proto; - my $self = []; - bless $self => $class; - $self->copy_from(@_) or return $self->_move_errors if (@_); - return $self; -} - -sub DESTROY -{ - my $self = shift; - $self->clear_errors(); -} - -sub _set_value -{ - my $self = shift; - my ($nd, $np, $val) = @_; - - # Make sure we have empty arrays in between - if ($nd > $self->num_sets) - { - # XXX maybe do this with splice - for ($self->num_sets .. $nd - 1) - { - push @{$self}, []; - } - } - $self->[$nd][$np] = $val; - - return $self; -} - -=head2 $data->set_x($np, $value); - -Set the X value of point I<$np> to I<$value>. Points are numbered -starting with 0. You probably will never need this. Returns undef on -failure. - -=cut - -sub set_x -{ - my $self = shift; - $self->_set_value(0, @_); -} - -=head2 $data->get_x($np) - -Get the X value of point I<$np>. See L<"set_x">. - -=cut - -sub get_x -{ - my $self = shift; - my $np = shift; - return $self->_set_error(ERR_ILL_POINT) - unless defined $np && $np >= 0; - - $self->[0][$np]; -} - -=head2 $data->set_y($nd, $np, $value); - -Set the Y value of point I<$np> in data set I<$nd> to I<$value>. Points -are numbered starting with 0, data sets are numbered starting with 1. -You probably will never need this. Returns undef on failure. - -=cut - -sub set_y -{ - my $self = shift; - return $self->_set_error(ERR_ILL_DATASET) - unless defined $_[0] && $_[0] >= 1; - $self->_set_value(@_); -} - -=head2 $data->get_y($nd, $np) - -Get the Y value of point I<$np> in data set I<$nd>. See L<"set_y">. This -will return undef on an error, but the fact that it returns undef does -not mean there was an error (since undefined values can be stored, and -therefore returned). - -=cut - -sub get_y -{ - my $self = shift; - my ($nd, $np) = @_; - return $self->_set_error(ERR_ILL_DATASET) - unless defined $nd && $nd >= 1 && $nd <= $self->num_sets; - return $self->_set_error(ERR_ILL_POINT) - unless defined $np && $np >= 0; - - $self->[$nd][$np]; -} - -=head2 $data->get_y_cumulative($nd, $np) - -Get the cumulative value of point I<$np> in data set<$nd>. The -cumulative value is obtained by adding all the values of the points -I<$np> in the data sets 1 to I<$nd>. - -=cut - -sub get_y_cumulative -{ - my $self = shift; - my ($nd, $np) = @_; - return $self->_set_error(ERR_ILL_DATASET) - unless defined $nd && $nd >= 1 && $nd <= $self->num_sets; - return $self->_set_error(ERR_ILL_POINT) - unless defined $np && $np >= 0; - - my $value; - for (my $i = 1; $i <= $nd; $i++) - { - $value += $self->[$i][$np] || 0; - } - - return $value; -} - -sub _get_min_max -{ - my $self = shift; - my $nd = shift; - my ($min, $max); - - for my $val (@{$self->[$nd]}) - { - next unless defined $val; - $min = $val if !defined $min || $val < $min; - $max = $val if !defined $max || $val > $max; - } - - return $self->_set_error("No (defined) values in " . - ($nd == 0 ? "X list" : "dataset $nd")) - unless defined $min && defined $max; - - return ($min, $max); -} - -=head2 $data->get_min_max_x - -Returns a list of the minimum and maximum x value or the -empty list on failure. - -=cut - -sub get_min_max_x -{ - my $self = shift; - $self->_get_min_max(0); -} - -=head2 $data->get_min_max_y($nd) - -Returns a list of the minimum and maximum y value in data set $nd or the -empty list on failure. - -=cut - -sub get_min_max_y -{ - my $self = shift; - my $nd = shift; - - return $self->_set_error(ERR_ILL_DATASET) - unless defined $nd && $nd >= 1 && $nd <= $self->num_sets; - - $self->_get_min_max($nd); -} - -=head2 $data->get_min_max_y_all() - -Returns a list of the minimum and maximum y value in all data sets or the -empty list on failure. - -=cut - -sub get_min_max_y_all -{ - my $self = shift; - my ($min, $max); - - for (my $ds = 1; $ds <= $self->num_sets; $ds++) - { - my ($ds_min, $ds_max) = $self->get_min_max_y($ds); - next unless defined $ds_min; - $min = $ds_min if !defined $min || $ds_min < $min; - $max = $ds_max if !defined $max || $ds_max > $max; - } - - return $self->_set_error('No (defined) values in any data set') - unless defined $min && defined $max; - - return ($min, $max); -} - -# Undocumented, not part of interface right now. Might expose at later -# point in time. - -sub set_point -{ - my $self = shift; - my $np = shift; - return $self->_set_error(ERR_ILL_POINT) - unless defined $np && $np >= 0; - - for (my $ds = 0; $ds < @_; $ds++) - { - $self->_set_value($ds, $np, $_[$ds]); - } - return $self; -} - -=head2 $data->add_point($X, $Y1, $Y2 ...) - -Adds a point to the data set. The base for the addition is the current -number of X values. This means that if you have a data set with the -contents - - (X1, X2) - (Y11, Y12) - (Y21) - (Y31, Y32, Y33, Y34) - -a $data->add_point(Xx, Y1x, Y2x, Y3x, Y4x) will result in - - (X1, X2, Xx ) - (Y11, Y12, Y1x) - (Y21, undef, Y2x) - (Y31, Y32, Y3x, Y34) - (undef, undef, Y4x) - -In other words: beware how you use this. As long as you make sure that -all data sets are of equal length, this method is safe to use. - -=cut - -sub add_point -{ - my $self = shift; - $self->set_point(scalar $self->num_points, @_); -} - -=head2 $data->num_sets() - -Returns the number of data sets. - -=cut - -sub num_sets -{ - my $self = shift; - @{$self} - 1; -} - -=head2 $data->num_points() - -In list context, returns a list with its first element the number of X -values, and the subsequent elements the number of respective Y values -for each data set. In scalar context returns the number of points -that have an X value set, i.e. the number of data sets that would result -from a call to C<make_strict>. - -=cut - -sub num_points -{ - my $self = shift; - return (0) unless @{$self}; - - wantarray ? - map { scalar @{$_} } @{$self} : - scalar @{$self->[0]} -} - -=head2 $data->x_values() - -Return a list of all the X values. - -=cut - -sub x_values -{ - my $self = shift; - return $self->_set_error(ERR_NO_DATASET) - unless @{$self}; - @{$self->[0]}; -} - -=head2 $data->y_values($nd) - -Return a list of the Y values for data set I<$nd>. Data sets are -numbered from 1. Returns the empty list if $nd is out of range, or if -the data set at $nd is empty. - -=cut - -sub y_values -{ - my $self = shift; - my $nd = shift; - return $self->_set_error(ERR_ILL_DATASET) - unless defined $nd && $nd >= 1 && $nd <= $self->num_sets; - return $self->_set_error(ERR_NO_DATASET) - unless @{$self}; - - @{$self->[$nd]}; -} - -=head2 $data->reset() OR GD::Graph::Data->reset() - -As an object method: Reset the data container, get rid of all data and -error messages. As a class method: get rid of accumulated error messages -and possible other crud. - -=cut - -sub reset -{ - my $self = shift; - @{$self} = () if ref($self); - $self->clear_errors(); - return $self; -} - -=head2 $data->make_strict() - -Make all data set lists the same length as the X list by truncating data -sets that are too long, and filling data sets that are too short with -undef values. always returns a true value. - -=cut - -sub make_strict -{ - my $self = shift; - - for my $ds (1 .. $self->num_sets) - { - my $data_set = $self->[$ds]; - - my $short = $self->num_points - @{$data_set}; - next if $short == 0; - - if ($short > 0) - { - my @fill = (undef) x $short; - push @{$data_set}, @fill; - } - else - { - splice @{$data_set}, $short; - } - } - return $self; -} - -=head2 $data->cumulate(preserve_undef => boolean) - -The B<cumulate> parameter will summarise the Y value sets as follows: -the first Y value list will be unchanged, the second will contain a -sum of the first and second, the third will contain the sum of first, -second and third, and so on. Returns undef on failure. - -if the argument I<preserve_undef> is set to a true value, then the sum -of exclusively undefined values will be preserved as an undefined value. -If it is not present or a false value, undef will be treated as zero. -Note that this still will leave undefined values in the first data set -alone. - -Note: Any non-numerical defined Y values will be treated as 0, but you -really shouldn't be using this to store that sort of Y data. - -=cut - -sub cumulate -{ - my $self = shift; - - return $self->_set_error(ERR_ARGS_NO_HASH) if (@_ && @_ % 2); - my %args = @_; - - # For all the sets, starting at the last one, ending just - # before the first - for (my $ds = $self->num_sets; $ds > 1; $ds--) - { - # For each point in the set - for my $point (0 .. $#{$self->[$ds]}) - { - # Add the value for each point in lower sets to this one - for my $i (1 .. $ds - 1) - { - # If neither are defined, we want to preserve the - # undefinedness of this point. If we don't do this, then - # the mathematical operation will force undef to be a 0. - next if - $args{preserve_undef} && - ! defined $self->[$ds][$point] && - ! defined $self->[$i][$point]; - - $self->[$ds][$point] += $self->[$i][$point] || 0; - } - } - } - return $self; -} - -=head2 $data->wanted(indexes) - -Removes all data sets except the ones in the argument list. It will also -reorder the data sets in the order given. Returns undef on failure. - -To remove all data sets except the first, sixth and second, in that -order: - - $data->wanted(1, 6, 2) or die $data->error; - -=cut - -sub wanted -{ - my $self = shift; - - for my $wanted (@_) - { - return $self->_set_error("Wanted index $wanted out of range 1-" - . $self->num_sets) - if $wanted < 1 || $wanted > $self->num_sets; - } - @{$self} = @{$self}[0, @_]; - return $self; -} - -=head2 $data->reverse - -Reverse the order of the data sets. - -=cut - -sub reverse -{ - my $self = shift; - @{$self} = ($self->[0], reverse @{$self}[1..$#{$self}]); - return $self; -} - -=head2 $data->copy_from($data_ref) - -Copy an 'old' style GD::Graph data structure or another GD::Graph::Data -object into this object. This will remove the current data. Returns undef -on failure. - -=cut - -sub copy_from -{ - my $self = shift; - my $data = shift; - return $self->_set_error('Not a valid source data structure') - unless defined $data && ( - ref($data) eq 'ARRAY' || ref($data) eq __PACKAGE__); - - $self->reset; - - my $i = 0; - for my $data_set (@{$data}) - { - return $self->_set_error("Invalid data set: $i") - unless ref($data_set) eq 'ARRAY'; - - push @{$self}, [@{$data_set}]; - $i++; - } - - return $self; -} - -=head2 $data->copy() - -Returns a copy of the object, or undef on failure. - -=cut - -sub copy -{ - my $self = shift; - - my $new = $self->new(); - $new->copy_from($self); - return $new; -} - -=head2 $data->read(I<arguments>) - -Read a data set from a file. This will remove the current data. returns -undef on failure. This method uses the standard module -Text::ParseWords to parse lines. If you don't have this for some odd -reason, don't use this method, or your program will die. - -B<Data file format>: The default data file format is tab separated data -(which can be changed with the delimiter argument). Comment lines are -any lines that start with a #. In the following example I have replaced -literal tabs with <tab> for clarity - - # This is a comment, and will be ignored - Jan<tab>12<tab>24 - Feb<tab>13<tab>37 - # March is missing - Mar<tab><tab> - Apr<tab>9<tab>18 - -Valid arguments are: - -I<file>, mandatory. The file name of the file to read from, or a -reference to a file handle or glob. - - $data->read(file => '/data/foo.dat') or die $data->error; - $data->read(file => \*DATA) or die $data->error; - $data->read(file => $file_handle) or die $data->error; - -I<no_comment>, optional. Give this a true value if you don't want lines -with an initial # to be skipped. - - $data->read(file => '/data/foo.dat', no_comment => 1); - -I<delimiter>, optional. A regular expression that will become the -delimiter instead of a single tab. - - $data->read(file => '/data/foo.dat', delimiter => '\s+'); - $data->read(file => '/data/foo.dat', delimiter => qr/\s+/); - -=cut - -sub read -{ - my $self = shift; - - return $self->_set_error(ERR_ARGS_NO_HASH) if (@_ && @_ % 2); - my %args = @_; - - return $self->_set_error('Missing required argument: file') - unless $args{file}; - - my $delim = $args{delimiter} || "\t"; - - $self->reset(); - - # The following will die if these modules are not present, as - # documented. - require Text::ParseWords; - - my $fh; - local *FH; - - if (UNIVERSAL::isa($args{file}, "GLOB")) - { - $fh = $args{file}; - } - else - { - # $fh = \do{ local *FH }; # Odd... This dumps core, sometimes in 5.005 - $fh = \*FH; # XXX Need this for perl 5.005 - open($fh, $args{file}) or - return $self->_set_error("open ($args{file}): $!"); - } - - while (my $line = <$fh>) - { - chomp $line; - next if $line =~ /^#/ && !$args{no_comment}; - my @fields = Text::ParseWords::parse_line($delim, 1, $line); - next unless @fields; - $self->add_point(@fields); - } - return $self; -} - -=head2 $data->error() OR GD::Graph::Data->error() - -Returns a list of all the errors that the current object has -accumulated. In scalar context, returns the last error. If called as a -class method it works at a class level. - -This method is inherited, see L<GD::Graph::Error> for more information. - -=cut - -=head2 $data->has_error() OR GD::Graph::Data->has_error() - -Returns true if the object (or class) has errors pending, false if not. -In some cases (see L<"copy">) this is the best way to check for errors. - -This method is inherited, see L<GD::Graph::Error> for more information. - -=cut - -=head1 NOTES - -As with all Modules for Perl: Please stick to using the interface. If -you try to fiddle too much with knowledge of the internals of this -module, you could get burned. I may change them at any time. -Specifically, I probably won't always keep this implemented as an array -reference. - -=head1 AUTHOR - -Martien Verbruggen E<lt>mgjv@tradingpost.com.auE<gt> - -=head2 Copyright - -(c) Martien Verbruggen. - -All rights reserved. This package is free software; you can redistribute -it and/or modify it under the same terms as Perl itself. - -=head1 SEE ALSO - -L<GD::Graph>, L<GD::Graph::Error> - -=cut - -"Just another true value"; - diff --git a/lib/GD/Graph/Error.pm b/lib/GD/Graph/Error.pm deleted file mode 100644 index 0d8e50c..0000000 --- a/lib/GD/Graph/Error.pm +++ /dev/null @@ -1,346 +0,0 @@ -#========================================================================== -# Copyright (c) 1995-2000 Martien Verbruggen -#-------------------------------------------------------------------------- -# -# Name: -# GD::Graph::Error.pm -# -# $Id: Error.pm,v 1.8 2003/02/10 22:12:41 mgjv Exp $ -# -#========================================================================== - -package GD::Graph::Error; - -($GD::Graph::Error::VERSION) = '$Revision: 1.8 $' =~ /\s([\d.]+)/; - -use strict; -use Carp; - -my %Errors; -use vars qw( $Debug $ErrorLevel $CriticalLevel ); - -$Debug = 0; - -# Warnings from 0 to 4, Errors from 5 to 9, and Critical 10 and above. -$ErrorLevel = 5; -$CriticalLevel = 10; - -=head1 NAME - -GD::Graph::Error - Error handling for GD::Graph classes - -=head1 SYNOPSIS - -use GD::Graph::Error_subclass; - -=head1 DESCRIPTION - -This class is a parent for all GD::Graph classes, including -GD::Graph::Data, and offers error and warning handling and some -debugging control. - -Errors are stored in a lexical hash in this package, so the -implementation of the subclass should be irrelevant. - -=head1 PUBLIC METHODS - -These methods can be used by users of any of the subclasses of -GD::Graph::Error to get at the errors of objects or classes. - -=head2 $object->error() OR Class->error() - -Returns a list of all the errors that the current object has -accumulated. In scalar context, returns the last error. If called as a -class method it works at a class level. This is handy when a constructor -fails, for example: - - my $data = GD::Graph::Data->new() - or die GD::Graph::Data->error; - $data->read(file => '/foo/bar.data') - or die $data->error; - -or if you really are only interested in the last error: - - $data->read(file => '/foo/bar.data') - or die scalar $data->error; - -This implementation does not clear the error list, so if you don't die -on errors, you will need to make sure to never ask for anything but the -last error (put this in scalar context) or to call C<clear_error()> now -and again. - -Errors are more verbose about where the errors originated if the -$GD::Graph::Error::Debug variable is set to a true value, and even more -verbose if this value is larger than 5. - -If $Debug is larger than 3, both of these will always return the -full list of errors and warnings (although the meaning of C<has_warning> -and C<has_error> does not change). - -=cut - -sub _error -{ - my $self = shift; - my $min_level = shift || 0; - my $max_level = shift || 1 << 31; - return unless exists $Errors{$self}; - my $error = $Errors{$self}; - - my @return; - - @return = - map { - ($Debug > 3 ? "[$_->{level}] " : '') . - "$_->{msg}" . - ($Debug ? " at $_->{whence}[1] line $_->{whence}[2]" : '') . - ($Debug > 5 ? " => $_->{caller}[0]($_->{caller}[2])" : '') . - "\n" - } - grep { $_->{level} >= $min_level && $_->{level} <= $max_level } - @$error; - - wantarray && @return > 1 and - $return[-1] =~ s/\n/\n\t/ or - $return[-1] =~ s/\n//; - - return wantarray ? @return : $return[-1]; -} - -sub error -{ - my $self = shift; - $Debug > 3 and return $self->_error(); - $self->_error($ErrorLevel); -} - -sub warning -{ - my $self = shift; - $Debug > 3 and return $self->_error(); - $self->_error(0, $ErrorLevel - 1); -} - -=head2 $object->has_error() OR Class->has_error() - -=head2 $object->has_warning() OR Class->has_warning() - -Returns true if there are pending errors (warnings) for the object -(or class). To be more precise, it returns a list of errors in list -context, and the number of errors in scalar context. - -This allows you to check for errors and warnings after a large number of -operations which each might fail: - - $data->read(file => '/foo/bar.data') or die $data->error; - while (my @foo = $sth->fetchrow_array) - { - $data->add_point(@foo); - } - $data->set_x(12, 'Foo'); - $data->has_warning and warn $data->warning; - $data->has_error and die $data->error; - -The reason to call this, instead of just calling C<error()> or -C<warning()> and looking at its return value, is that this method is -much more efficient and fast. - -If you want to count anything as bad, just set $ErrorLevel to 0, after -which you only need to call C<has_error>. - -=cut - -sub has_error -{ - my $self = shift; - return unless exists $Errors{$self}; - grep { $_->{level} >= $ErrorLevel } @{$Errors{$self}}; -} - -sub has_warning -{ - my $self = shift; - return unless exists $Errors{$self}; - grep { $_->{level} < $ErrorLevel } @{$Errors{$self}}; -} - -=head2 $object->clear_errors() or Class->clear_errors() - -Clears all outstanding errors. - -=cut - -sub clear_errors -{ - my $self = shift; - delete $Errors{$self}; -} - -=head1 PROTECTED METHODS - -These methods are only to be called from within this class and its -Subclasses. - -=head2 $object->_set_error(I<arg>) or Class->_set_error(I<arg>) - -=head2 $object->_set_warning(I<arg>) or Class->_set_warning(I<arg>) - -Subclasses call this to set an error. The argument can be a reference -to an array, of which the first element should be the error level, and -the second element the error message. Alternatively, it can just be the -message, in which case the error level will be assumed to be -$ErrorLevel. - -If the error level is >= $CriticalLevel the program will die, using -Carp::croak to display the current message, as well as all the other -error messages pending. - -In the current implementation these are almost identical when called -with a scalar argument, except that the default ewrror level is -different. When called with an array reference, they are identical in -function. This may change in the future. They're mainly here for code -clarity. - -=cut - -# Private, for construction of error hash. This should probably be an -# object, but that's too much work right now. -sub __error_hash -{ - my $caller = shift; - my $default = shift; - my $msg = shift; - - my %error = (caller => $caller); - - if (ref($msg) && ref($msg) eq 'ARRAY' && @{$msg} >= 2) - { - # Array reference - $error{level} = $msg->[0]; - $error{msg} = $msg->[1]; - } - elsif (ref($_[0]) eq '') - { - # simple scalar - $error{level} = $default; - $error{msg} = $msg; - } - else - { - # someting else, which I can't deal with - warn "Did you read the documentation for GD::Graph::Error?"; - return; - } - - my $lvl = 1; - while (my @c = caller($lvl)) - { - $error{whence} = [@c[0..2]]; - $lvl++; - } - - return \%error; -} - -sub _set_error -{ - my $self = shift; - return unless @_; - - while (@_) - { - my $e_h = __error_hash([caller], $ErrorLevel, shift) or return; - push @{$Errors{$self}}, $e_h; - croak $self->error if $e_h->{level} >= $CriticalLevel; - } - return; -} - -sub _set_warning -{ - my $self = shift; - return unless @_; - - while (@_) - { - my $e_h = __error_hash([caller], $ErrorLevel, shift) or return; - push @{$Errors{$self}}, $e_h; - croak $self->error if $e_h->{level} >= $CriticalLevel; - } - return; -} - -=head2 $object->_move_errors - -Move errors from an object into the class it belongs to. This can be -useful if something nasty happens in the constructor, while -instantiating one of these objects, and you need to move these errors -into the class space before returning. (see GD::Graph::Data::new for an -example) - -=cut - -sub _move_errors -{ - my $self = shift; - my $class = ref($self); - push @{$Errors{$class}}, @{$Errors{$self}}; - return; -} - -sub _dump -{ - my $self = shift; - require Data::Dumper; - my $dd = Data::Dumper->new([$self], ['me']); - $dd->Dumpxs; -} - -=head1 VARIABLES - -=head2 $GD::Graph::Error::Debug - -The higher this value, the more verbose error messages will be. At the -moment, any true value will cause the line number and source file of the -caller at the top of the stack to be included, a value of more than 2 -will include the error severity, and a value of more than 5 will also -include the direct caller's (i.e. the spot where the error message was -generated) line number and package. Default: 0. - -=head2 $GD::Graph::Error::ErrorLevel - -Errors levels below this value will be counted as warnings, and error -levels above (and inclusive) up to $CriticalLevel will be counted as -errors. This is also the default error level for the C<_set_error()> -method. This value should be 0 or larger, and smaller than -$CriticalLevel. Default: 5. - -=head2 $GD::Graph::Error::CriticalLevel - -Any errorlevel of or above this level will immediately cause the program -to die with the specified message, using Carp::croak. Default: 10. - -=head1 NOTES - -As with all Modules for Perl: Please stick to using the interface. If -you try to fiddle too much with knowledge of the internals of this -module, you could get burned. I may change them at any time. - -=head1 AUTHOR - -Martien Verbruggen E<lt>mgjv@tradingpost.com.auE<gt> - -=head2 Copyright - -(c) Martien Verbruggen. - -All rights reserved. This package is free software; you can redistribute -it and/or modify it under the same terms as Perl itself. - -=head1 SEE ALSO - -L<GD::Graph>, L<GD::Graph::Data> - -=cut - -"Just another true value"; diff --git a/lib/GD/Graph/FAQ.pod b/lib/GD/Graph/FAQ.pod deleted file mode 100644 index f6ed237..0000000 --- a/lib/GD/Graph/FAQ.pod +++ /dev/null @@ -1,130 +0,0 @@ -=head1 NAME - -GD::Graph::FAQ - Frequently asked questions - -=head1 DESCRIPTION - -=head2 I get errors like "Can't call method METHOD on an undefined value". What gives? - -You probably had an error somewhere, most likely in the plot() method, -and you didn't check for it. See the section on Error Handling in the -documentation for L<GD::Graph> to find out how to deal with this sort -of thing, and how to get more information about what the error was. - -=head2 I am drawing a bar chart, and the chart area is a lot smaller than the image. What is going on? - -As of version 1.30, GD::Graph automatically corrects the width of the -plotting area of a chart if it needs to draw bars (i.e. for bars and -some mixed charts). This is necessary, because rounding errors cause -irregular gaps between or overlaps of bars if the bar is not an exact -integer number of pixels wide. - -If you want the old behaviour back, set the correct_with attribute to a -false value. - - -=head2 I have my data in some format that doesn't look at all like the array that I am supposed to give to GD::Graph's plot method. Do I really need to mess around with array references? - -Not necessarily. Check out the GD::Graph::Data class. - - -=head2 How do I stop those pesky accents appearing around bars or inside area charts? - -You can set the C<accent_treshold> option to a large enough value -(larger than your chart). Alternatively, you may like it better to set -the C<borderclrs> attribute to be the same as the dclrs one. - -I'll probably include an option in a future version that gives better -control over this. - - -=head2 Where is the ActiveState ppm of GD::Graph? - -Ask them. I have asked them, but didn't get an answer. I don't know what -to do to get it included in their set of ppms, and I really do not have -the time to keep asking them. - -I believe that GD::graph has finally made it into ActiveState's ppm -archive. However, I am going to leave this question here in case they -get behind again. - - -=head2 Do you have some example code for me? - -The distribution has a large set of examples in it. If you don't have -the original distribution, please get it from CPAN (http://www.cpan.org/ -or some local mirror). - - -=head2 Will you support X or Y? - -If you send me a patch that (in a decent manner) adds the functionality -to the latest version, I may very well add it for the next release. If -you don't send me a patch, but just a question, you will have to be -patient. - -=head2 Why does export_format give me a weird string, instead of just 'png' or 'gif'? - -As of version 1.31, export_format in a list context returns all formats -that GD can export. If you are only interested in the answer 'gif' or -'png', make sure that you call it in a scalar context. - - $export_format = GD::Graph->export_format; - $export_format = $graph->export_format; - print "Export format is ", scalar $graph->export_format, "\n"; - print "Export format is " . $graph->export_format . "\n"; - @export_formats = $graph->export_format; - - -=head2 TrueType fonts don't work when I use GD::Graph from a CGI program. - -When your programs run as CGI, they typically do not have the same -environment as when you use them from the command line. The Perl FAQ, -section 9, has some information on this. It is also not guaranteed that -your script runs from the directory that it is in. It is probably better -to include something like: - - use GD::Text; - GD::Text->font_path("/path/to/my/font_dir"); - -See the GD::Text documentation for more information about font paths. - -=head2 I'm trying to use GD's builtin fonts, but it's not working. - -Most likely, you are using the font short name, like gdGiantFont or -gdMediumBoldFont, and you have not put a C<use GD> in your program. -This is needed, because these short names need to be exported into -your name space by the GD library: - - use GD; - # ... - $graph->set_x_axis_font(gdMediumBoldFont); - -If you don't want to include the GD library, you can use the -longer alternative names (which is what I'd recommend anyway): - - $graph1->set_x_axis_font(GD::Font->MediumBold); - -If you C<use strict> then you will actually get an error message if -you try to use the short names without including the GD module. - -Also see the L<GD::Text> documentation for this information. - -=head2 When I have many data sets, some end up having the same colour. - -The default number of colours for data sets is seven, so if you use -more than seven data sets, those colours will be re-used for the -higher data sets. - -This is described in the entry for the C<dclrs> attribute in the -L<GD::Graph> documentation. - -=head1 AUTHOR - -Martien Verbruggen E<lt>mgjv@tradingpost.com.auE<gt> - -(c) Martien Verbruggen. - -All rights reserved. This package is free software; you can redistribute -it and/or modify it under the same terms as Perl itself. - diff --git a/lib/GD/Graph/area.pm b/lib/GD/Graph/area.pm deleted file mode 100644 index a06f114..0000000 --- a/lib/GD/Graph/area.pm +++ /dev/null @@ -1,112 +0,0 @@ -#========================================================================== -# Copyright (c) 1995-2000 Martien Verbruggen -#-------------------------------------------------------------------------- -# -# Name: -# GD::Graph::area.pm -# -# $Id: area.pm,v 1.16 2003/02/10 23:33:40 mgjv Exp $ -# -#========================================================================== - -package GD::Graph::area; - -($GD::Graph::area::VERSION) = '$Revision: 1.16 $' =~ /\s([\d.]+)/; - -use strict; - -use GD::Graph::axestype; - -@GD::Graph::area::ISA = qw( GD::Graph::axestype ); - -# PRIVATE -sub draw_data_set -{ - my $self = shift; # object reference - my $ds = shift; # number of the data set - - my @values = $self->{_data}->y_values($ds) or - return $self->_set_error("Impossible illegal data set: $ds", - $self->{_data}->error); - - # Select a data colour - my $dsci = $self->set_clr($self->pick_data_clr($ds)); - my $brci = $self->set_clr($self->pick_border_clr($ds)); - - # Create a new polygon - my $poly = GD::Polygon->new(); - - my @bottom; - - # Add the data points - for (my $i = 0; $i < @values; $i++) - { - my $value = $values[$i]; - next unless defined $value; - - my $bottom = $self->_get_bottom($ds, $i); - $value = $self->{_data}->get_y_cumulative($ds, $i) - if ($self->{overwrite} == 2); - - my ($x, $y) = $self->val_to_pixel($i + 1, $value, $ds); - $poly->addPt($x, $y); - # Need to keep track of this stuff for hotspots, and because - # it's the only reliable way of closing the polygon, without - # making odd assumptions. - push @bottom, [$x, $bottom]; - - # Hotspot stuff - # XXX needs fixing. Not used at the moment. - next unless defined $self->{_hotspots}->[$ds]->[$i]; - if ($i == 0) - { - $self->{_hotspots}->[$ds]->[$i] = ["poly", - $x, $y, - $x , $bottom, - $x - 1, $bottom, - $x - 1, $y, - $x, $y]; - } - else - { - $self->{_hotspots}->[$ds]->[$i] = ["poly", - $poly->getPt($i), - @{$bottom[$i]}, - @{$bottom[$i-1]}, - $poly->getPt($i-1), - $poly->getPt($i)]; - } - } - - foreach my $bottom (reverse @bottom) - { - $poly->addPt($bottom->[0], $bottom->[1]); - } - - # Draw a filled and a line polygon - $self->{graph}->filledPolygon($poly, $dsci) - if defined $dsci; - $self->{graph}->polygon($poly, $brci) - if defined $brci; - - # Draw the accent lines - if (defined $brci && - ($self->{right} - $self->{left})/@values > $self->{accent_treshold}) - { - for (my $i = 1; $i < @values - 1; $i++) - { - my $value = $values[$i]; - ## XXX Why don't I need this line? - ##next unless defined $value; - - my ($x, $y) = $poly->getPt($i); - my $bottom = $bottom[$i]->[1]; - - $self->{graph}->dashedLine($x, $y, $x, $bottom, $brci); - } - } - - return $ds -} - -"Just another true value"; diff --git a/lib/GD/Graph/axestype3d.pm b/lib/GD/Graph/axestype3d.pm deleted file mode 100644 index 7acb7f3..0000000 --- a/lib/GD/Graph/axestype3d.pm +++ /dev/null @@ -1,787 +0,0 @@ -#========================================================================== -# Module: GD::Graph::axestype3d -# -# Copyright (C) 1999,2001 Wadsack-Allen. All Rights Reserved. -# -# Based on axestype.pm,v 1.21 2000/04/15 08:59:36 mgjv -# Copyright (c) 1995-1998 Martien Verbruggen -# -#-------------------------------------------------------------------------- -# Date Modification Author -# ------------------------------------------------------------------------- -# 1999SEP18 Created 3D axestype base class (this JW -# module) changes noted in comments. -# 1999OCT15 Fixed to include all GIFgraph functions JW -# necessary for PNG support. -# 2000JAN19 Converted to GD::Graph sublcass JW -# 2000FEB21 Fixed bug in y-labels' height JW -# 2000APR18 Updated for compatibility with GD::Graph 1.30 JW -# 2000AUG21 Added 3d shading JW -# 2000SEP04 Allowed box_clr without box axis JW -# 06Dec2001 Fixed bug in rendering of x tick when x_tick_number is set JW -#========================================================================== -# TODO -# * Modify to use true 3-d extrusions at any theta and phi -#========================================================================== -package GD::Graph::axestype3d; - -use strict; - -use GD::Graph; -use GD::Graph::axestype; -use GD::Graph::utils qw(:all); -use GD::Graph::colour qw(:colours); -use Carp; - -@GD::Graph::axestype3d::ISA = qw(GD::Graph::axestype); -$GD::Graph::axestype3d::VERSION = '0.63'; - -# Commented inheritance from GD::Graph::axestype unless otherwise noted. - -use constant PI => 4 * atan2(1,1); - -my %Defaults = ( - depth_3d => 20, - '3d_shading' => 1, - - # the rest are inherited -); - -# Inherit _has_default - - -# Can't inherit initialise, because %Defaults is referenced file- -# specific, not class specific. -sub initialise -{ - my $self = shift; - - my $rc = $self->SUPER::initialise(); - - while( my($key, $val) = each %Defaults ) { - $self->{$key} = $val - } # end while - - return $rc; -} # end initialise - -# PUBLIC -# Inherit plot -# Inherit set -# Inherit setup_text -# Inherit set_x_label_font -# Inherit set_y_label_font -# Inherit set_x_axis_font -# Inherit set_y_axis_font -# Inherit set_legend -# Inherit set_legend_font - - - -# ---------------------------------------------------------- -# Sub: init_graph -# -# Args: (None) -# -# Description: -# Override GD::Graph::init_graph to add 3d shading colors, -# if requested -# -# [From GD::Graph] -# Initialise the graph output canvas, setting colours (and -# getting back index numbers for them) setting the graph to -# transparent, and interlaced, putting a logo (if defined) -# on there. -# ---------------------------------------------------------- -# Date Modification Author -# ---------------------------------------------------------- -# 20Aug2000 Added to support 3d graph extensions JW -# ---------------------------------------------------------- -sub init_graph { - my $self = shift; - - # Sets up the canvas and color palette - $self->SUPER::init_graph( @_ ); - - # Now create highlights and showdows for each color - # in the palette - if( $self->{'3d_shading'} ) { - $self->{'3d_highlights'} = []; - $self->{'3d_shadows'} = []; - $self->{'3d_highlights'}[$self->{bgci}] = $self->set_clr( $self->_brighten( _rgb($self->{bgclr}) ) ); - $self->{'3d_shadows'}[$self->{bgci}] = $self->set_clr( $self->_darken( _rgb($self->{bgclr}) ) ); - - $self->{'3d_highlights'}[$self->{fgci}] = $self->set_clr( $self->_brighten( _rgb($self->{fgclr}) ) ); - $self->{'3d_shadows'}[$self->{fgci}] = $self->set_clr( $self->_darken( _rgb($self->{fgclr}) ) ); - - $self->{'3d_highlights'}[$self->{tci}] = $self->set_clr( $self->_brighten( _rgb($self->{textclr}) ) ); - $self->{'3d_shadows'}[$self->{tci}] = $self->set_clr( $self->_darken( _rgb($self->{textclr}) ) ); - - $self->{'3d_highlights'}[$self->{lci}] = $self->set_clr( $self->_brighten( _rgb($self->{labelclr}) ) ); - $self->{'3d_shadows'}[$self->{lci}] = $self->set_clr( $self->_darken( _rgb($self->{labelclr}) ) ); - - $self->{'3d_highlights'}[$self->{alci}] = $self->set_clr( $self->_brighten( _rgb($self->{axislabelclr}) ) ); - $self->{'3d_shadows'}[$self->{alci}] = $self->set_clr( $self->_darken( _rgb($self->{axislabelclr}) ) ); - - $self->{'3d_highlights'}[$self->{acci}] = $self->set_clr( $self->_brighten( _rgb($self->{accentclr}) ) ); - $self->{'3d_shadows'}[$self->{acci}] = $self->set_clr( $self->_darken( _rgb($self->{accentclr}) ) ); - - $self->{'3d_highlights'}[$self->{valuesci}] = $self->set_clr( $self->_brighten( _rgb($self->{valuesclr}) ) ); - $self->{'3d_shadows'}[$self->{valuesci}] = $self->set_clr( $self->_darken( _rgb($self->{valuesclr}) ) ); - - $self->{'3d_highlights'}[$self->{legendci}] = $self->set_clr( $self->_brighten( _rgb($self->{legendclr}) ) ); - $self->{'3d_shadows'}[$self->{legendci}] = $self->set_clr( $self->_darken( _rgb($self->{legendclr}) ) ); - - if( $self->{boxclr} ) { - $self->{'3d_highlights'}[$self->{boxci}] = $self->set_clr( $self->_brighten( _rgb($self->{boxclr}) ) ); - $self->{'3d_shadows'}[$self->{boxci}] = $self->set_clr( $self->_darken( _rgb($self->{boxclr}) ) ); - } # end if - } # end if - - return $self; -} # end init_graph - - -# PRIVATE - -# ---------------------------------------------------------- -# Sub: _brighten -# -# Args: $r, $g, $b -# $r, $g, $b The Red, Green, and Blue components of a color -# -# Description: Brightens the color by adding white -# ---------------------------------------------------------- -# Date Modification Author -# ---------------------------------------------------------- -# 21AUG2000 Created to build 3d highlights table JW -# ---------------------------------------------------------- -sub _brighten { - my $self = shift; - my( $r, $g, $b ) = @_; - my $p = ($r + $g + $b) / 70; - $p = 3 if $p < 3; - my $f = _max( $r / $p, _max( $g / $p, $b / $p ) ); - $r = _min( 255, int( $r + $f ) ); - $g = _min( 255, int( $g + $f ) ); - $b = _min( 255, int( $b + $f ) ); - return( $r, $g, $b ); -} # end _brighten - -# ---------------------------------------------------------- -# Sub: _darken -# -# Args: $r, $g, $b -# $r, $g, $b The Red, Green, and Blue components of a color -# -# Description: Darkens the color by adding black -# ---------------------------------------------------------- -# Date Modification Author -# ---------------------------------------------------------- -# 21AUG2000 Created to build 3d shadows table JW -# ---------------------------------------------------------- -sub _darken { - my $self = shift; - my( $r, $g, $b ) = @_; - my $p = ($r + $g + $b) / 70; - $p = 3 if $p < 3; - my $f = _max( $r / $p, _max( $g / $p, $b / $p) ); - $r = _max( 0, int( $r - $f ) ); - $g = _max( 0, int( $g - $f ) ); - $b = _max( 0, int( $b - $f ) ); - return( $r, $g, $b ); -} # end _darken - - -# inherit check_data from GD::Graph - -# [JAW] Setup boundaries as parent, the adjust for 3d extrusion -sub _setup_boundaries -{ - my $self = shift; - - $self->SUPER::_setup_boundaries(); - - # adjust for top of 3-d extrusion - $self->{top} += $self->{depth_3d}; - - return $self->_set_error('Vertical size too small') - if $self->{bottom} <= $self->{top}; - - # adjust for right of 3-d extrusion - $self->{right} -= $self->{depth_3d}; - - return $self->_set_error('Horizontal size too small') - if $self->{right} <= $self->{left}; - - return $self; -} # end _setup_boundaries - -# [JAW] Determine 3d-extrusion depth, then call parent -sub setup_coords -{ - my $self = shift; - - # Calculate the 3d-depth of the graph - # Note this sets a minimum depth of ~20 pixels -# if (!defined $self->{x_tick_number}) { - my $depth = _max( $self->{bar_depth}, $self->{line_depth} ); - if( $self->{overwrite} == 1 ) { - $depth *= $self->{_data}->num_sets(); - } # end if - $self->{depth_3d} = _max( $depth, $self->{depth_3d} ); -# } # end if - - $self->SUPER::setup_coords(); - - return $self; -} # end setup_coords - -# Inherit create_y_labels -# Inherit get_x_axis_label_height -# Inherit create_x_labels -# inherit open_graph from GD::Graph -# Inherit draw_text - -# [JAW] Draws entire bounding cube for 3-d extrusion -sub draw_axes -{ - my $s = shift; - my $g = $s->{graph}; - - my ($l, $r, $b, $t) = - ( $s->{left}, $s->{right}, $s->{bottom}, $s->{top} ); - my $depth = $s->{depth_3d}; - - if ( $s->{box_axis} ) { - # -- Draw a bounding box - if( $s->{boxci} ) { - # -- Fill the box with color - # Back box - $g->filledRectangle($l+$depth+1, $t-$depth+1, $r+$depth-1, $b-$depth-1, $s->{boxci}); - - # Left side - my $poly = new GD::Polygon; - $poly->addPt( $l, $t ); - $poly->addPt( $l + $depth, $t - $depth ); - $poly->addPt( $l + $depth, $b - $depth ); - $poly->addPt( $l, $b ); - if( $s->{'3d_shading'} ) { - $g->filledPolygon( $poly, $s->{'3d_shadows'}[$s->{boxci}] ); - } else { - $g->filledPolygon( $poly, $s->{boxci} ); - } # end if - - # Bottom - $poly = new GD::Polygon; - $poly->addPt( $l, $b ); - $poly->addPt( $l + $depth, $b - $depth ); - $poly->addPt( $r + $depth, $b - $depth ); - $poly->addPt( $r, $b ); - if( $s->{'3d_shading'} ) { - $g->filledPolygon( $poly, $s->{'3d_highlights'}[$s->{boxci}] ); - } else { - $g->filledPolygon( $poly, $s->{boxci} ); - } # end if - } # end if - - # -- Draw the box frame - - # Back box - $g->rectangle($l+$depth, $t-$depth, $r+$depth, $b-$depth, $s->{fgci}); - - # Connecting frame - $g->line($l, $t, $l + $depth, $t - $depth, $s->{fgci}); - $g->line($r, $t, $r + $depth, $t - $depth, $s->{fgci}); - $g->line($l, $b, $l + $depth, $b - $depth, $s->{fgci}); - $g->line($r, $b, $r + $depth, $b - $depth, $s->{fgci}); - - # Front box - $g->rectangle($l, $t, $r, $b, $s->{fgci}); - - } else { - if( $s->{boxci} ) { - # -- Fill the background box with color - # Back box - $g->filledRectangle($l+$depth+1, $t-$depth+1, $r+$depth-1, $b-$depth-1, $s->{boxci}); - - # Left side - my $poly = new GD::Polygon; - $poly->addPt( $l, $t ); - $poly->addPt( $l + $depth, $t - $depth ); - $poly->addPt( $l + $depth, $b - $depth ); - $poly->addPt( $l, $b ); - if( $s->{'3d_shading'} ) { - $g->filledPolygon( $poly, $s->{'3d_shadows'}[$s->{boxci}] ); - } else { - $g->filledPolygon( $poly, $s->{boxci} ); - } # end if - - # Bottom - $poly = new GD::Polygon; - $poly->addPt( $l, $b ); - $poly->addPt( $l + $depth, $b - $depth ); - $poly->addPt( $r + $depth, $b - $depth ); - $poly->addPt( $r, $b ); - if( $s->{'3d_shading'} ) { - $g->filledPolygon( $poly, $s->{'3d_highlights'}[$s->{boxci}] ); - } else { - $g->filledPolygon( $poly, $s->{boxci} ); - } # end if - } # end if - # -- Draw the frame only for back & sides - - # Back box - $g->rectangle($l + $depth, $t - $depth, $r + $depth, $b - $depth, $s->{fgci}); - - # Y axis - my $poly = new GD::Polygon; - $poly->addPt( $l, $t ); - $poly->addPt( $l, $b ); - $poly->addPt( $l + $depth, $b - $depth ); - $poly->addPt( $l + $depth, $t - $depth ); - $g->polygon( $poly, $s->{fgci} ); - - # X axis - if( !$s->{zero_axis_only} ) { - $poly = new GD::Polygon; - $poly->addPt( $l, $b ); - $poly->addPt( $r, $b ); - $poly->addPt( $r + $depth, $b - $depth ); - $poly->addPt( $l + $depth, $b - $depth ); - $g->polygon( $poly, $s->{fgci} ); - } # end if - - # Second Y axis - if( $s->{two_axes} ){ - $poly = new GD::Polygon; - $poly->addPt( $r, $b ); - $poly->addPt( $r, $t ); - $poly->addPt( $r + $depth, $t - $depth ); - $poly->addPt( $r + $depth, $b - $depth ); - $g->polygon( $poly, $s->{fgci} ); - } # end if - } # end if - - # Zero axis - if ($s->{zero_axis} or $s->{zero_axis_only}) { - my ($x, $y) = $s->val_to_pixel(0, 0, 1); - my $poly = new GD::Polygon; - $poly->addPt( $l, $y ); - $poly->addPt( $r, $y ); - $poly->addPt( $r + $depth, $y - $depth ); - $poly->addPt( $l + $depth, $y - $depth); - $g->polygon( $poly, $s->{fgci} ); - } # end if - -} # end draw_axes - -# [JAW] Draws ticks and values for y axes in 3d extrusion -# Modified from MVERB source -sub draw_y_ticks -{ - my $self = shift; - - for my $t (0 .. $self->{y_tick_number}) - { - for my $a (1 .. ($self->{two_axes} + 1)) - { - my $value = $self->{y_values}[$a][$t]; - my $label = $self->{y_labels}[$a][$t]; - - my ($x, $y) = $self->val_to_pixel(0, $value, $a); - $x = ($a == 1) ? $self->{left} : $self->{right}; - - # CONTRIB Jeremy Wadsack - # Draw on the back of the extrusion - $x += $self->{depth_3d}; - $y -= $self->{depth_3d}; - - if ($self->{y_long_ticks}) - { - $self->{graph}->line( - $x, $y, - $x + $self->{right} - $self->{left}, $y, - $self->{fgci} - ) unless ($a-1); - # CONTRIB Jeremy Wadsack - # Draw conector ticks - $self->{graph}->line( $x - $self->{depth_3d}, - $y + $self->{depth_3d}, - $x, - $y, - $self->{fgci} - ) unless ($a-1); - } - else - { - $self->{graph}->line( - $x, $y, - $x + (3 - 2 * $a) * $self->{y_tick_length}, $y, - $self->{fgci} - ); - # CONTRIB Jeremy Wadsack - # Draw conector ticks - $self->{graph}->line( $x - $self->{depth_3d}, - $y + $self->{depth_3d}, - $x - $self->{depth_3d} + (3 - 2 * $a) * $self->{y_tick_length}, - $y + $self->{depth_3d} - (3 - 2 * $a) * $self->{y_tick_length}, - $self->{fgci} - ); - } - - next - if $t % ($self->{y_label_skip}) || ! $self->{y_plot_values}; - - $self->{gdta_y_axis}->set_text($label); - $self->{gdta_y_axis}->set_align('center', - $a == 1 ? 'right' : 'left'); - $x -= (3 - 2 * $a) * $self->{axis_space}; - - # CONTRIB Jeremy Wadsack - # Subtract 3-d extrusion width from left axis label - # (it was added for ticks) - $x -= (2 - $a) * $self->{depth_3d}; - - # CONTRIB Jeremy Wadsack - # Add 3-d extrusion height to label - # (it was subtracted for ticks) - $y += $self->{depth_3d}; - - $self->{gdta_y_axis}->draw($x, $y); - - } # end foreach - } # end foreach - - return $self; - -} # end draw_y_ticks - -# [JAW] Darws ticks and values for x axes wih 3d extrusion -# Modified from MVERB source -sub draw_x_ticks -{ - my $self = shift; - - for (my $i = 0; $i < $self->{_data}->num_points; $i++) - { - my ($x, $y) = $self->val_to_pixel($i + 1, 0, 1); - - $y = $self->{bottom} unless $self->{zero_axis_only}; - - # CONTRIB Damon Brodie for x_tick_offset - next if (!$self->{x_all_ticks} and - ($i - $self->{x_tick_offset}) % $self->{x_label_skip} and - $i != $self->{_data}->num_points - 1 - ); - - # CONTRIB Jeremy Wadsack - # Draw on the back of the extrusion - $x += $self->{depth_3d}; - $y -= $self->{depth_3d}; - - if ($self->{x_ticks}) - { - if ($self->{x_long_ticks}) - { - # CONTRIB Jeremy Wadsack - # Move up by 3d depth - $self->{graph}->line( $x, - $self->{bottom} - $self->{depth_3d}, - $x, - $self->{top} - $self->{depth_3d}, - $self->{fgci}); - # CONTRIB Jeremy Wadsack - # Draw conector ticks - $self->{graph}->line( $x - $self->{depth_3d}, - $y + $self->{depth_3d}, - $x, - $y, - $self->{fgci} - ); - } - else - { - $self->{graph}->line( $x, $y, $x, $y - $self->{x_tick_length}, $self->{fgci} ); - # CONTRIB Jeremy Wadsack - # Draw conector ticks - $self->{graph}->line( $x - $self->{depth_3d}, - $y + $self->{depth_3d}, - $x - $self->{depth_3d} + $self->{x_tick_length}, - $y + $self->{depth_3d} - $self->{x_tick_length}, - $self->{fgci} - ); - } - } - - # CONTRIB Damon Brodie for x_tick_offset - next if - ($i - $self->{x_tick_offset}) % ($self->{x_label_skip}) and - $i != $self->{_data}->num_points - 1; - - $self->{gdta_x_axis}->set_text($self->{_data}->get_x($i)); - - # CONTRIB Jeremy Wadsack - # Subtract 3-d extrusion width from left label - # Add 3-d extrusion height to left label - # (they were changed for ticks) - $x -= $self->{depth_3d}; - $y += $self->{depth_3d}; - - my $yt = $y + $self->{axis_space}; - - if ($self->{x_labels_vertical}) - { - $self->{gdta_x_axis}->set_align('center', 'right'); - $self->{gdta_x_axis}->draw($x, $yt, PI/2); - } - else - { - $self->{gdta_x_axis}->set_align('top', 'center'); - $self->{gdta_x_axis}->draw($x, $yt); - } - - } # end for - - return $self; - -} # end draw_x_ticks - - -# CONTRIB Scott Prahl -# Assume x array contains equally spaced x-values -# and generate an appropriate axis -# -#### -# 'True' numerical X axis addition -# From: Gary Deschaines -# -# These modification to draw_x_ticks_number pass x-tick values to the -# val_to_pixel subroutine instead of x-tick indices when ture[sic] numerical -# x-axis mode is detected. Also, x_tick_offset and x_label_skip are -# processed differently when true numerical x-axis mode is detected to -# allow labeled major x-tick marks and un-labeled minor x-tick marks. -# -# For example: -# -# x_tick_number => 14, -# x_ticks => 1, -# x_long_ticks => 1, -# x_tick_length => -4, -# x_min_value => 100, -# x_max_value => 800, -# x_tick_offset => 2, -# x_label_skip => 2, -# -# -# ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ -# | | | | | | | | | | | | | -# 1 -| | | | | | | | | | | | | -# | | | | | | | | | | | | | -# 0 _|_________|____|____|____|____|____|____|____|____|____|____|_________| -# | | | | | | | | | | | -# 200 300 400 500 600 700 -#### -# [JAW] Added commented items for 3d rendering -# Based on MVERB source -sub draw_x_ticks_number -{ - my $self = shift; - - for my $i (0 .. $self->{x_tick_number}) - { - my ($value, $x, $y); - - if (defined($self->{x_min_value}) && defined($self->{x_max_value})) - { - next if ($i - $self->{x_tick_offset}) < 0; - next if ($i + $self->{x_tick_offset}) > $self->{x_tick_number}; - $value = $self->{x_values}[$i]; - ($x, $y) = $self->val_to_pixel($value, 0, 1); - } - else - { - $value = ($self->{_data}->num_points - 1) - * ($self->{x_values}[$i] - $self->{true_x_min}) - / ($self->{true_x_max} - $self->{true_x_min}); - ($x, $y) = $self->val_to_pixel($value + 1, 0, 1); - } - - $y = $self->{bottom} unless $self->{zero_axis_only}; - - # Draw on the back of the extrusion - $x += $self->{depth_3d}; - $y -= $self->{depth_3d}; - - if ($self->{x_ticks}) - { - if ($self->{x_long_ticks}) - { - # XXX This mod needs to be done everywhere ticks are - # drawn - if ( $self->{x_tick_length} >= 0 ) - { - # Move up by 3d depth - $self->{graph}->line( $x, - $self->{bottom} - $self->{depth_3d}, - $x, - $self->{top} - $self->{depth_3d}, - $self->{fgci}); - } - else - { - $self->{graph}->line( - $x, $self->{bottom} - $self->{x_tick_length}, - $x, $self->{top}, $self->{fgci}); - } - # CONTRIB Jeremy Wadsack - # Draw conector ticks - $self->{graph}->line( $x - $self->{depth_3d}, - $y + $self->{depth_3d}, - $x, - $y, - $self->{fgci} - ); - } - else - { - $self->{graph}->line($x, $y, - $x, $y - $self->{x_tick_length}, $self->{fgci} ); - # CONTRIB Jeremy Wadsack - # Draw conector ticks - $self->{graph}->line( $x - $self->{depth_3d}, - $y + $self->{depth_3d}, - $x, - $self->{depth_3d} + $self->{tick_length}, - $y, + $self->{depth_3d} - $self->{tick_length}, - $self->{fgci} - ); - } # end if -- x_long_ticks - } # end if -- x_ticks - - # If we have to skip labels, we'll do it here. - # Make sure to always draw the last one. - next if $i % $self->{x_label_skip} && $i != $self->{x_tick_number}; - - $self->{gdta_x_axis}->set_text($self->{x_labels}[$i]); - - # CONTRIB Jeremy Wadsack - # Subtract 3-d extrusion width from left label - # Add 3-d extrusion height to left label - # (they were changed for ticks) - $x -= $self->{depth_3d}; - $y += $self->{depth_3d}; - - if ($self->{x_labels_vertical}) - { - $self->{gdta_x_axis}->set_align('center', 'right'); - my $yt = $y + $self->{text_space}/2; - $self->{gdta_x_axis}->draw($x, $yt, PI/2); - } - else - { - $self->{gdta_x_axis}->set_align('top', 'center'); - my $yt = $y + $self->{text_space}/2; - $self->{gdta_x_axis}->draw($x, $yt); - } # end if - } # end for - - return $self; - -} # end draw_x_tick_number - -# Inherit draw_ticks -# Inherit draw_data -# Inherit draw_data_set -# Inherit set_max_min -# Inherit get_max_y -# Inherit get_min_y -# Inherit get_max_min_y_all -# Inherit _get_bottom -# Inherit val_to_pixel -# Inherit setup_legend - - -# [JW] Override draw_legend and reverse the drawing order -# if cumulate is enabled so legend matches data on chart -sub draw_legend -{ - my $self = shift; - - return unless defined $self->{legend}; - - my $xl = $self->{lg_xs} + $self->{legend_spacing}; - my $y = $self->{lg_ys} + $self->{legend_spacing} - 1; - - # If there's a frame, offset by the size and margin - $xl += $self->{legend_frame_margin} + $self->{legend_frame_size} if $self->{legend_frame_size}; - $y += $self->{legend_frame_margin} + $self->{legend_frame_size} if $self->{legend_frame_size}; - - my $i = 0; - my $row = 1; - my $x = $xl; # start position of current element - my @legends = @{$self->{legend}}; - my $i_step = 1; - - # If we are working in cumulate mode, then reverse the drawing order - if( $self->{cumulate} ) { - @legends = reverse @legends; - $i = scalar(@legends); - $i = $self->{_data}->num_sets if $self->{_data}->num_sets < $i; - $i++; - $i_step = -1; - } # end if - - foreach my $legend (@legends) - { - $i += $i_step; - - # Legend for Pie goes over first set, and all points - # Works in either direction - last if $i > $self->{_data}->num_sets; - last if $i < 1; - - my $xe = $x; # position within an element - - next unless defined($legend) && $legend ne ""; - - $self->draw_legend_marker($i, $xe, $y); - - $xe += $self->{legend_marker_width} + $self->{legend_spacing}; - my $ys = int($y + $self->{lg_el_height}/2 - $self->{lgfh}/2); - - $self->{gdta_legend}->set_text($legend); - $self->{gdta_legend}->draw($xe, $ys); - - $x += $self->{lg_el_width}; - - if (++$row > $self->{lg_cols}) - { - $row = 1; - $y += $self->{lg_el_height}; - $x = $xl; - } - } - - # If there's a frame, draw it now - if( $self->{legend_frame_size} ) { - $x = $self->{lg_xs} + $self->{legend_spacing}; - $y = $self->{lg_ys} + $self->{legend_spacing} - 1; - - for $i ( 0 .. $self->{legend_frame_size} - 1 ) { - $self->{graph}->rectangle( - $x + $i, - $y + $i, - $x + $self->{lg_x_size} + 2 * $self->{legend_frame_margin} - $i - 1, - $y + $self->{lg_y_size} + 2 * $self->{legend_frame_margin} - $i - 1, - $self->{acci}, - ); - } # end for - } # end if - -} - - - -# Inherit draw_legend_marker - -1; diff --git a/lib/GD/Graph/bars.pm b/lib/GD/Graph/bars.pm deleted file mode 100644 index 2650351..0000000 --- a/lib/GD/Graph/bars.pm +++ /dev/null @@ -1,372 +0,0 @@ -#========================================================================== -# Copyright (c) 1995-1998 Martien Verbruggen -#-------------------------------------------------------------------------- -# -# Name: -# GD::Graph::bars.pm -# -# $Id: bars.pm,v 1.25 2003/06/11 00:43:49 mgjv Exp $ -# -#========================================================================== - -package GD::Graph::bars; - -($GD::Graph::bars::VERSION) = '$Revision: 1.25 $' =~ /\s([\d.]+)/; - -use strict; - -use GD::Graph::axestype; -use GD::Graph::utils qw(:all); -use GD::Graph::colour qw(:colours); - -@GD::Graph::bars::ISA = qw(GD::Graph::axestype); - -use constant PI => 4 * atan2(1,1); - -sub initialise -{ - my $self = shift; - $self->SUPER::initialise(); - $self->set(correct_width => 1); -} - -sub draw_data -{ - my $self = shift; - - $self->SUPER::draw_data() or return; - - unless ($self->{no_axes}) - { - # redraw the 'zero' axis - if ($self->{rotate_chart}) - { - $self->{graph}->line( - $self->{zeropoint}, $self->{top}, - $self->{zeropoint}, $self->{bottom}, - $self->{fgci} ); - } - else - { - $self->{graph}->line( - $self->{left}, $self->{zeropoint}, - $self->{right}, $self->{zeropoint}, - $self->{fgci} ); - } - } - - return $self; -} - -sub _top_values -{ - my $self = shift; - my @topvalues; - - if ($self->{cumulate}) - { - my $data = $self->{_data}; - for my $i (0 .. $data->num_points - 1) - { - push @topvalues, $data->get_y_cumulative($data->num_sets, $i); - } - } - - return \@topvalues; -} - -# -# Draw the shadow -# -sub _draw_shadow -{ - my $self = shift; - my ($ds, $i, $value, $topvalues, $l, $t, $r, $b) = @_; - my $bsd = $self->{shadow_depth} or return; - my $bsci = $self->set_clr(_rgb($self->{shadowclr})); - - if ($self->{cumulate}) - { - return if $ds > 1; - $value = $topvalues->[$i]; - if ($self->{rotate_chart}) - { - $r = ($self->val_to_pixel($i + 1, $value, $ds))[0]; - } - else - { - $t = ($self->val_to_pixel($i + 1, $value, $ds))[1]; - } - } - - # XXX Clean this up - if ($value >= 0) - { - if ($self->{rotate_chart}) - { - $self->{graph}->filledRectangle( - $l, $t + $bsd, $r - $bsd, $b + $bsd, $bsci); - } - else - { - $self->{graph}->filledRectangle( - $l + $bsd, $t + $bsd, $r + $bsd, $b, $bsci); - } - } - else - { - if ($self->{rotate_chart}) - { - $self->{graph}->filledRectangle( - $l + $bsd, $t, $r + $bsd, $b, $bsci); - } - else - { - $self->{graph}->filledRectangle( - $l + $bsd, $b, $r + $bsd, $t + $bsd, $bsci); - } - } -} - -sub draw_data_set_h -{ - my $self = shift; - my $ds = shift; - - my $bar_s = $self->{bar_spacing}/2; - - # Pick a data colour - my $dsci = $self->set_clr($self->pick_data_clr($ds)); - # contrib "Bremford, Mike" <mike.bremford@gs.com> - my $brci = $self->set_clr($self->pick_border_clr($ds)); - - my @values = $self->{_data}->y_values($ds) or - return $self->_set_error("Impossible illegal data set: $ds", - $self->{_data}->error); - - my $topvalues = $self->_top_values; - - for my $i (0 .. $#values) - { - my $value = $values[$i]; - next unless defined $value; - - my $l = $self->_get_bottom($ds, $i); - $value = $self->{_data}->get_y_cumulative($ds, $i) - if ($self->{cumulate}); - - # CONTRIB Jeremy Wadsack - # - # cycle_clrs option sets the color based on the point, - # not the dataset. - $dsci = $self->set_clr($self->pick_data_clr($i + 1)) - if $self->{cycle_clrs}; - $brci = $self->set_clr($self->pick_data_clr($i + 1)) - if $self->{cycle_clrs} > 1; - - # get coordinates of right and center of bar - my ($r, $xp) = $self->val_to_pixel($i + 1, $value, $ds); - - # calculate top and bottom of bar - my ($t, $b); - - if (ref $self eq 'GD::Graph::mixed' || $self->{overwrite}) - { - $t = $xp - $self->{x_step}/2 + $bar_s + 1; - $b = $xp + $self->{x_step}/2 - $bar_s; - } - else - { - $t = $xp - - $self->{x_step}/2 - + ($ds - 1) * $self->{x_step}/$self->{_data}->num_sets - + $bar_s + 1; - $b = $xp - - $self->{x_step}/2 - + $ds * $self->{x_step}/$self->{_data}->num_sets - - $bar_s; - } - - # draw the bar - $self->_draw_shadow($ds, $i, $value, $topvalues, $l, $t, $r, $b); - if ($value >= 0) - { - # positive value - $self->{graph}->filledRectangle($l, $t, $r, $b, $dsci) - if defined $dsci; - $self->{graph}->rectangle($l, $t, $r, $b, $brci) - if defined $brci && $b - $t > $self->{accent_treshold}; - - $self->{_hotspots}->[$ds]->[$i] = ['rect', $t, $l, $r, $b] - } - else - { - # negative value - $self->{graph}->filledRectangle($r, $t, $l, $b, $dsci) - if defined $dsci; - $self->{graph}->rectangle($l, $t, $r, $b, $brci) - if defined $brci && $b - $t > $self->{accent_treshold}; - - $self->{_hotspots}->[$ds]->[$i] = ['rect', $t, $l, $b, $r] - } - } - - return $ds; -} - -sub draw_data_set_v -{ - my $self = shift; - my $ds = shift; - - my $bar_s = $self->{bar_spacing}/2; - - # Pick a data colour - my $dsci = $self->set_clr($self->pick_data_clr($ds)); - # contrib "Bremford, Mike" <mike.bremford@gs.com> - my $brci = $self->set_clr($self->pick_border_clr($ds)); - - my @values = $self->{_data}->y_values($ds) or - return $self->_set_error("Impossible illegal data set: $ds", - $self->{_data}->error); - - my $topvalues = $self->_top_values; - - for (my $i = 0; $i < @values; $i++) - { - my $value = $values[$i]; - next unless defined $value; - - my $bottom = $self->_get_bottom($ds, $i); - $value = $self->{_data}->get_y_cumulative($ds, $i) - if ($self->{cumulate}); - - # CONTRIB Jeremy Wadsack - # - # cycle_clrs option sets the color based on the point, - # not the dataset. - $dsci = $self->set_clr($self->pick_data_clr($i + 1)) - if $self->{cycle_clrs}; - $brci = $self->set_clr($self->pick_data_clr($i + 1)) - if $self->{cycle_clrs} > 1; - - # get coordinates of top and center of bar - my ($xp, $t) = $self->val_to_pixel($i + 1, $value, $ds); - - # calculate left and right of bar - my ($l, $r); - - if (ref $self eq 'GD::Graph::mixed' || $self->{overwrite}) - { - $l = $xp - $self->{x_step}/2 + $bar_s + 1; - $r = $xp + $self->{x_step}/2 - $bar_s; - } - else - { - $l = $xp - - $self->{x_step}/2 - + ($ds - 1) * $self->{x_step}/$self->{_data}->num_sets - + $bar_s + 1; - $r = $xp - - $self->{x_step}/2 - + $ds * $self->{x_step}/$self->{_data}->num_sets - - $bar_s; - } - - # draw the bar - $self->_draw_shadow($ds, $i, $value, $topvalues, $l, $t, $r, $bottom); - if ($value >= 0) - { - # positive value - $self->{graph}->filledRectangle($l, $t, $r, $bottom, $dsci) - if defined $dsci; - $self->{graph}->rectangle($l, $t, $r, $bottom, $brci) - if defined $brci && $r - $l > $self->{accent_treshold}; - - $self->{_hotspots}->[$ds]->[$i] = ['rect', $l, $t, $r, $bottom] - } - else - { - # negative value - $self->{graph}->filledRectangle($l, $bottom, $r, $t, $dsci) - if defined $dsci; - $self->{graph}->rectangle($l, $bottom, $r, $t, $brci) - if defined $brci && $r - $l > $self->{accent_treshold}; - - $self->{_hotspots}->[$ds]->[$i] = ['rect', $l, $bottom, $r, $t] - } - } - - return $ds; -} - -sub draw_data_set -{ - $_[0]->{rotate_chart} ? goto &draw_data_set_h : goto &draw_data_set_v; -} - -sub draw_values -{ - my $self = shift; - - return $self unless $self->{show_values}; - - my $text_angle = $self->{values_vertical} ? PI/2 : 0; - - for (my $dsn = 1; $dsn <= $self->{_data}->num_sets; $dsn++) - { - my @values = $self->{_data}->y_values($dsn) or - return $self->_set_error("Impossible illegal data set: $dsn", - $self->{_data}->error); - my @display = $self->{show_values}->y_values($dsn) or next; - - for (my $i = 0; $i < @values; $i++) - { - next unless defined $display[$i]; - - my $value = $display[$i]; - if (defined $self->{values_format}) - { - $value = ref $self->{values_format} eq 'CODE' ? - &{$self->{values_format}}($value) : - sprintf($self->{values_format}, $value); - } - - my ($xp, $yp); - if (defined($self->{x_min_value}) && defined($self->{x_max_value})) - { - ($xp, $yp) = $self->val_to_pixel( - $self->{_data}->get_x($i), $values[$i], $dsn); - } - else - { - ($xp, $yp) = $self->val_to_pixel($i+1, $values[$i], $dsn); - } - if ($self->{rotate_chart}) - { - $xp += $self->{values_space}; - unless ($self->{overwrite}) - { - $yp -= $self->{x_step}/2 - ($dsn - 0.5) - * $self->{x_step}/$self->{_data}->num_sets; - } - } - else - { - $yp -= $self->{values_space}; - unless ($self->{overwrite}) - { - $xp -= $self->{x_step}/2 - ($dsn - 0.5) - * $self->{x_step}/$self->{_data}->num_sets; - } - } - - $self->{gdta_values}->set_text($value); - $self->{gdta_values}->draw($xp, $yp, $text_angle); - } - } - - return $self -} - -"Just another true value"; diff --git a/lib/GD/Graph/bars3d.pm b/lib/GD/Graph/bars3d.pm deleted file mode 100644 index 5344976..0000000 --- a/lib/GD/Graph/bars3d.pm +++ /dev/null @@ -1,349 +0,0 @@ -#========================================================================== -# Module: GD::Graph::bars3d -# -# Copyright (C) 1999,2001 Wadsack-Allen. All Rights Reserved. -# -# Based on GD::Graph::bars.pm,v 1.16 2000/03/18 10:58:39 mgjv -# Copyright (c) 1995-1998 Martien Verbruggen -# -#-------------------------------------------------------------------------- -# Date Modification Author -# ------------------------------------------------------------------------- -# 1999SEP18 Created 3D bar chart class (this module) JAW -# 1999SEP19 Rewrote to include a single bar-drawing JAW -# function and process all bars in series -# 1999SEP19 Implemented support for overwrite 2 style JAW -# 1999SEP19 Fixed a bug in color cycler (colors were off by 1) JAW -# 2000JAN19 Converted to GD::Graph class JAW -# 2000MAR10 Fixed bug where bars ran off bottom of chart JAW -# 2000APR18 Modified to be compatible with GD::Graph 1.30 JAW -# 2000APR24 Fixed a lot of rendering bugs and added shading JAW -# 2000AUG21 Added 3d shading JAW -# 2000AUG24 Fixed shading on cycle_clrs option JAW -# 06Dec2002 Fixed on-bar rendering with bars.pm draw_values JW -#========================================================================== -package GD::Graph::bars3d; - -use strict; - -use GD::Graph::axestype3d; -use GD::Graph::bars; -use GD::Graph::utils qw(:all); -use GD::Graph::colour qw(:colours); - -@GD::Graph::bars3d::ISA = qw(GD::Graph::axestype3d); -$GD::Graph::bars3d::VERSION = '0.63'; - -use constant PI => 4 * atan2(1,1); - - -my %Defaults = ( - # Spacing between the bars - bar_spacing => 0, - - # The 3-d extrusion depth of the bars - bar_depth => 10, -); - -sub initialise -{ - my $self = shift; - - my $rc = $self->SUPER::initialise(); - $self->set(correct_width => 1); - - while( my($key, $val) = each %Defaults ) { - $self->{$key} = $val - } # end while - - return $rc; -} # end initialise - -sub set -{ - my $s = shift; - my %args = @_; - - $s->{_set_error} = 0; - - for (keys %args) - { - /^bar_depth$/ and do - { - $s->{bar_depth} = $args{$_}; - delete $args{$_}; - next; - }; - } - - return $s->SUPER::set(%args); -} - - -# CONTRIB Jeremy Wadsack -# This is a complete overhaul of the original GD::Graph::bars -# design, because all versions (overwrite = 0, 1, 2) -# require that the bars be drawn in a loop of point over sets -sub draw_data -{ - my $self = shift; - my $g = $self->{graph}; - - my $bar_s = _round($self->{bar_spacing}/2); - - my $zero = $self->{zeropoint}; - - my $i; - my @iterate = (0 .. $self->{_data}->num_points()); - for $i ($self->{rotate_chart} ? reverse(@iterate) : @iterate) { - my ($xp, $t); - my $overwrite = 0; - $overwrite = $self->{overwrite} if defined $self->{overwrite}; - - my $j; - my @iterate = (1 .. $self->{_data}->num_sets()); - for $j (($self->{rotate_chart} && $self->{cumulate} == 0) ? reverse(@iterate) : @iterate) { - my $value = $self->{_data}->get_y( $j, $i ); - next unless defined $value; - - my $bottom = $self->_get_bottom($j, $i); - $value = $self->{_data}->get_y_cumulative($j, $i) - if ($self->{cumulate}); - - # Pick a data colour, calc shading colors too, if requested - # cycle_clrs option sets the color based on the point, not the dataset. - my @rgb; - if( $self->{cycle_clrs} ) { - @rgb = $self->pick_data_clr( $i + 1 ); - } else { - @rgb = $self->pick_data_clr( $j ); - } # end if - my $dsci = $self->set_clr( @rgb ); - if( $self->{'3d_shading'} ) { - $self->{'3d_highlights'}[$dsci] = $self->set_clr( $self->_brighten( @rgb ) ); - $self->{'3d_shadows'}[$dsci] = $self->set_clr( $self->_darken( @rgb ) ); - } # end if - - # contrib "Bremford, Mike" <mike.bremford@gs.com> - my $brci; - if( $self->{cycle_clrs} > 1 ) { - $brci = $self->set_clr($self->pick_data_clr($i + 1)); - } else { - $brci = $self->set_clr($self->pick_border_clr($j)); - } # end if - - - # get coordinates of top and center of bar - ($xp, $t) = $self->val_to_pixel($i + 1, $value, $j); - - # calculate offsets of this bar - my $x_offset = 0; - my $y_offset = 0; - if( $overwrite == 1 ) { - $x_offset = $self->{bar_depth} * ($self->{_data}->num_sets() - $j); - $y_offset = $self->{bar_depth} * ($self->{_data}->num_sets() - $j); - } - $t -= $y_offset; - - - # calculate left and right of bar - my ($l, $r); - if ($self->{rotate_chart}) { - $l = $bottom; - ($r) = $self->val_to_pixel($i + 1, $value, $j); - } - - if( (ref $self eq 'GD::Graph::mixed') || ($overwrite >= 1) ) - { - if ($self->{rotate_chart}) { - $bottom = $t + $self->{x_step}/2 - $bar_s + $x_offset; - $t = $t - $self->{x_step}/2 + $bar_s + $x_offset; - } - else - { - $l = $xp - $self->{x_step}/2 + $bar_s + $x_offset; - $r = $xp + $self->{x_step}/2 - $bar_s + $x_offset; - } - } - else - { - if ($self->{rotate_chart}) { - warn "base is $t"; - $bottom = $t - $self->{x_step}/2 - + ($j) * $self->{x_step}/$self->{_data}->num_sets() - + $bar_s + $x_offset; - $t = $t - $self->{x_step}/2 - + ($j-1) * $self->{x_step}/$self->{_data}->num_sets() - - $bar_s + $x_offset; - warn "top bottom is ($t, $bottom)"; - } - else - { - $l = $xp - - $self->{x_step}/2 - + ($j - 1) * $self->{x_step}/$self->{_data}->num_sets() - + $bar_s + $x_offset; - $r = $xp - - $self->{x_step}/2 - + $j * $self->{x_step}/$self->{_data}->num_sets() - - $bar_s + $x_offset; - } - } - - if ($value >= 0) { - # draw the positive bar - $self->draw_bar( $g, $l, $t, $r, $bottom-$y_offset, $dsci, $brci, 0 ) - } else { - # draw the negative bar - $self->draw_bar( $g, $l, $bottom-$y_offset, $r, $t, $dsci, $brci, -1 ) - } # end if - - } # end for - } # end for - - - # redraw the 'zero' axis, front and right - if( $self->{zero_axis} ) { - $g->line( - $self->{left}, $self->{zeropoint}, - $self->{right}, $self->{zeropoint}, - $self->{fgci} ); - $g->line( - $self->{right}, $self->{zeropoint}, - $self->{right}+$self->{depth_3d}, $self->{zeropoint}-$self->{depth_3d}, - $self->{fgci} ); - } # end if - - # redraw the box face - if ( $self->{box_axis} ) { - # Axes box - $g->rectangle($self->{left}, $self->{top}, $self->{right}, $self->{bottom}, $self->{fgci}); - $g->line($self->{right}, $self->{top}, $self->{right} + $self->{depth_3d}, $self->{top} - $self->{depth_3d}, $self->{fgci}); - $g->line($self->{right}, $self->{bottom}, $self->{right} + $self->{depth_3d}, $self->{bottom} - $self->{depth_3d}, $self->{fgci}); - } # end if - - return $self; - -} # end draw_data - -# CONTRIB Jeremy Wadsack -# This function draws a bar at the given -# coordinates. This is called in all three -# overwrite modes. -sub draw_bar { - my $self = shift; - my $g = shift; - my( $l, $t, $r, $b, $dsci, $brci, $neg ) = @_; - - # get depth of the bar - my $depth = $self->{bar_depth}; - - # get the bar shadow depth and color - my $bsd = $self->{shadow_depth}; - my $bsci = $self->set_clr(_rgb($self->{shadowclr})); - - my( $xi ); - - # shadow - if( $bsd > 0 ) { - my $sb = $b - $depth; - my $st = $t - $depth + $bsd; - - if( $neg != 0 ) { - $st -= $bsd; - if( $self->{zero_axis_only} ) { - $sb += $bsd; - } else { - $sb = _min($b-$depth+$bsd, $self->{bottom}-$depth); - } # end if - } # end if - - # ** If this isn't the back bar, then no side shadow should be - # drawn or else the top should be lowered by - # ($bsd * dataset_num), it should be drawn on the back surface, - # and a shadow should be drawn behind the front bar if the - # bar is positive and the back is negative. - - $g->filledRectangle($l+$depth+$bsd, - $st, - $r+$depth+$bsd, - $sb, - $bsci); - - # Only draw bottom shadow if at the bottom and has bottom - # axis. Always draw top shadow - if( ($neg == 0) || ($sb >= $self->{bottom}-$depth) ) { - my $poly = new GD::Polygon; - $poly->addPt( $r, $b ); - $poly->addPt( $r+$bsd, $b ); - $poly->addPt( $r+$depth+$bsd, $b-$depth ); - $poly->addPt( $r+$depth, $b-$depth ); - $g->filledPolygon( $poly, $bsci ); - } # end if - - } # end if - - # side - my $poly = new GD::Polygon; - $poly->addPt( $r, $t ); - $poly->addPt( $r+$depth, $t-$depth ); - $poly->addPt( $r+$depth, $b-$depth ); - $poly->addPt( $r, $b ); - if( $self->{'3d_shading'} ) { - $g->filledPolygon( $poly, $self->{'3d_shadows'}[$dsci] ); - } else { - $g->filledPolygon( $poly, $dsci ); - } # end if - $g->polygon( $poly, $brci ); - - # top - # -- only draw negative tops if the bar starts at zero - if( ($neg == 0) || ($t <= $self->{zeropoint}) ) { - $poly = new GD::Polygon; - $poly->addPt( $l, $t ); - $poly->addPt( $l+$depth, $t-$depth ); - $poly->addPt( $r+$depth, $t-$depth ); - $poly->addPt( $r, $t ); - if( $self->{'3d_shading'} ) { - $g->filledPolygon( $poly, $self->{'3d_highlights'}[$dsci] ); - } else { - $g->filledPolygon( $poly, $dsci ); - } # end if - $g->polygon( $poly, $brci ); - } # end if - - # face - $g->filledRectangle( $l, $t, $r, $b, $dsci ); - $g->rectangle( $l, $t, $r, $b, $brci ); - -} # end draw_bar - -# [JAW] Overrides axestype's set_max_min. -# Go through the parent's process then adjust the baseline to 0 for bar graphs. -sub set_max_min { - my $self = shift; - - $self->SUPER::set_max_min( @_ ); - - # This code is taken from Martien's axestype.pm - for my $i (1..($self->{two_axes} ? 2 : 1)) { - # If at the same side of the zero axis - if( $self->{y_max}[$i] && $self->{y_min}[$i]/$self->{y_max}[$i] > 0 ) { - $self->{y_min}[$i] > 0 ? - $self->{y_min}[$i] = 0 : - $self->{y_max}[$i] = 0 ; - } # end if - } # end for - - return $self; -} # end set_max_min - - -# [JW] Just use the one in GD::Graph::bars -sub draw_values -{ - return &GD::Graph::bars::draw_values( @_ ); -} - - -1; diff --git a/lib/GD/Graph/colour.pm b/lib/GD/Graph/colour.pm deleted file mode 100644 index 8b25059..0000000 --- a/lib/GD/Graph/colour.pm +++ /dev/null @@ -1,371 +0,0 @@ -#========================================================================== -# Copyright (c) 1995-1998 Martien Verbruggen -#-------------------------------------------------------------------------- -# -# Name: -# GD::Graph::colour.pm -# -# Description: -# Package of colour manipulation routines, to be used -# with GD::Graph. -# -# $Id: colour.pm,v 1.10 2003/02/11 05:38:46 mgjv Exp $ -# -#========================================================================== - - -package GD::Graph::colour; - -($GD::Graph::colour::VERSION) = '$Revision: 1.10 $' =~ /\s([\d.]+)/; - -=head1 NAME - -GD::Graph::colour - Colour manipulation routines for use with GD::Graph - -=head1 SYNOPSIS - -use GD::Graph::colour qw(:colours :lists :files :convert); - -=head1 DESCRIPTION - -The B<GD::Graph::colour> package provides a few routines to work with -colours. The functionality of this package is mainly defined by what is -needed, now and historically, by the GD::Graph modules. - -=cut - -use vars qw( @EXPORT_OK %EXPORT_TAGS ); -use strict; -require Exporter; -use Carp; - -@GD::Graph::colour::ISA = qw( Exporter ); - -@EXPORT_OK = qw( - _rgb _luminance _hue add_colour - colour_list sorted_colour_list - read_rgb - hex2rgb rgb2hex -); -%EXPORT_TAGS = ( - colours => [qw( add_colour _rgb _luminance _hue )], - lists => [qw( colour_list sorted_colour_list )], - files => [qw( read_rgb )], - convert => [qw( hex2rgb rgb2hex )], -); - -my %RGB = ( - white => [0xFF,0xFF,0xFF], - lgray => [0xBF,0xBF,0xBF], - gray => [0x7F,0x7F,0x7F], - dgray => [0x3F,0x3F,0x3F], - black => [0x00,0x00,0x00], - lblue => [0x00,0x00,0xFF], - blue => [0x00,0x00,0xBF], - dblue => [0x00,0x00,0x7F], - gold => [0xFF,0xD7,0x00], - lyellow => [0xFF,0xFF,0x00], - yellow => [0xBF,0xBF,0x00], - dyellow => [0x7F,0x7F,0x00], - lgreen => [0x00,0xFF,0x00], - green => [0x00,0xBF,0x00], - dgreen => [0x00,0x7F,0x00], - lred => [0xFF,0x00,0x00], - red => [0xBF,0x00,0x00], - dred => [0x7F,0x00,0x00], - lpurple => [0xFF,0x00,0xFF], - purple => [0xBF,0x00,0xBF], - dpurple => [0x7F,0x00,0x7F], - lorange => [0xFF,0xB7,0x00], - orange => [0xFF,0x7F,0x00], - pink => [0xFF,0xB7,0xC1], - dpink => [0xFF,0x69,0xB4], - marine => [0x7F,0x7F,0xFF], - cyan => [0x00,0xFF,0xFF], - lbrown => [0xD2,0xB4,0x8C], - dbrown => [0xA5,0x2A,0x2A], -); - -=head1 FUNCTIONS - -=head2 colour_list( I<number of colours> ) - -Returns a list of I<number of colours> colour names known to the package. -Exported with the :lists tag. - -=cut - -sub colour_list -{ - my $n = ( $_[0] ) ? $_[0] : keys %RGB; - return (keys %RGB)[0 .. $n-1]; -} - -=head2 sorted_colour_list( I<number of colours> ) - -Returns a list of I<number of colours> colour names known to the package, -sorted by luminance or hue. -B<NB.> Right now it always sorts by luminance. Will add an option in a later -stage to decide sorting method at run time. -Exported with the :lists tag. - -=cut - -sub sorted_colour_list -{ - my $n = $_[0] ? $_[0] : keys %RGB; - return (sort by_luminance keys %RGB)[0 .. $n-1]; - # return (sort by_hue keys %rgb)[0..$n-1]; - - sub by_luminance { _luminance(@{$RGB{$b}}) <=> _luminance(@{$RGB{$a}}) } - sub by_hue { _hue(@{$RGB{$b}}) <=> _hue(@{$RGB{$a}}) } -} - -=head2 _rgb( I<colour name> ) - -Returns a list of the RGB values of I<colour name>. if the colour name -is a string of the form that is acceptable to the hex2rgb sub, then the -colour will be added to the list dynamically. -Exported with the :colours tag. - -=cut - -my %warned_clrs = (); - -# return the RGB values of the colour name -sub _rgb -{ - my $clr = shift or return; - - # Try adding the colour if it doesn't exist yet. It may be of a - # parseable form - add_colour($clr) unless exists $RGB{$clr}; - - my $rgb_ref = $RGB{$clr}; - if (!defined $rgb_ref) - { - $rgb_ref = $RGB{'black'}; - unless ($warned_clrs{$clr}) - { - $warned_clrs{$clr}++; - carp "Colour $clr is not defined, reverting to black"; - } - }; - - @{$rgb_ref}; -} - -=head2 _hue( I<R,G,B> ) - -Returns the hue of the colour with the specified RGB values. -Exported with the :colours tag. - -=head2 _luminance( I<R,G,B> ) - -Returns the luminance of the colour with the specified RGB values. -Exported with the :colours tag. - -=cut - -# return the luminance of the colour (RGB) -sub _luminance -{ - (0.212671 * $_[0] + 0.715160 * $_[1] + 0.072169 * $_[2])/0xFF -} - -# return the hue of the colour (RGB) -sub _hue -{ - ($_[0] + $_[1] + $_[2])/(3 * 0xFF) -} - -=head2 add_colour(colourname => [$r, $g, $b]) or -add_colour('#7fe310') - -Self-explanatory. -Exported with the :colours tag. - -=cut - -sub add_colour -{ - my $name = shift; - my $val = shift; - - if (!defined $val) - { - my @rgb = hex2rgb($name) or return; - $val = [@rgb]; - } - - if (ref $val && ref $val eq 'ARRAY') - { - $RGB{$name} = [@{$val}]; - return $name; - } - - return; -} - -=head2 rgb2hex($red, $green, $blue) - -=head2 hex2rgb('#7fe310') - -These functions translate a list of RGB values into a hexadecimal -string, as is commonly used in HTML and the Image::Magick API, and vice -versa. -Exported with the :convert tag. - -=cut - -# Color translation -sub rgb2hex -{ - return unless @_ == 3; - my $color = '#'; - foreach my $cc (@_) - { - $color .= sprintf("%02x", $cc); - } - return $color; -} - -sub hex2rgb -{ - my $clr = shift; - my @rgb = $clr =~ /^#([a-f0-9]{2})([a-f0-9]{2})([a-f0-9]{2})$/i; - return unless @rgb; - return map { hex $_ } @rgb; -} - -=head2 read_rgb( F<file name> ) - -Reads in colours from a rgb file as used by the X11 system. - -Doing something like: - - use GD::Graph::bars; - use GD::Graph::colour; - - GD::Graph::colour::read_rgb("rgb.txt") or die "cannot read colours"; - -Will allow you to use any colours defined in rgb.txt in your graph. -Exported with the :files tag. - -=cut - -# -# Read a rgb.txt file (X11) -# -# Expected format of the file: -# -# R G B colour name -# -# Fields can be separated by any number of whitespace -# Lines starting with an exclamation mark (!) are comment and -# will be ignored. -# -# returns number of colours read - -sub read_rgb($) # (filename) -{ - my $fn = shift; - my $n = 0; - my $line; - - open(RGB, $fn) or return 0; - - while (defined($line = <RGB>)) - { - next if ($line =~ /\s*!/); - chomp($line); - - # remove leading white space - $line =~ s/^\s+//; - - # get the colours - my ($r, $g, $b, $name) = split(/\s+/, $line, 4); - - # Ignore bad lines - next unless (defined $name); - - $RGB{$name} = [$r, $g, $b]; - $n++; - } - - close(RGB); - - return $n; -} - -sub version { $GD::Graph::colour::VERSION } - -sub dump_colours -{ - my $max = $_[0] ? $_[0] : keys %RGB; - my $n = 0; - - my $clr; - foreach $clr (sorted_colour_list($max)) - { - last if $n > $max; - print "colour: $clr, " . - "${$RGB{$clr}}[0], ${$RGB{$clr}}[1], ${$RGB{$clr}}[2]\n" - } -} - - -"Just another true value"; - -__END__ - -=head1 PREDEFINED COLOUR NAMES - -white, -lgray, -gray, -dgray, -black, -lblue, -blue, -dblue, -gold, -lyellow, -yellow, -dyellow, -lgreen, -green, -dgreen, -lred, -red, -dred, -lpurple, -purple, -dpurple, -lorange, -orange, -pink, -dpink, -marine, -cyan, -lbrown, -dbrown. - -=head1 AUTHOR - -Martien Verbruggen E<lt>mgjv@tradingpost.com.auE<gt> - -=head2 Copyright - -GIFgraph: Copyright (c) 1995-1999 Martien Verbruggen. -Chart::PNGgraph: Copyright (c) 1999 Steve Bonds. -GD::Graph: Copyright (c) 1999 Martien Verbruggen. - -All rights reserved. This package is free software; you can redistribute -it and/or modify it under the same terms as Perl itself. - -=head1 SEE ALSO - -L<GD::Graph>, -L<GD::Graph::FAQ> - diff --git a/lib/GD/Graph/cylinder.pm b/lib/GD/Graph/cylinder.pm deleted file mode 100644 index ba8ab86..0000000 --- a/lib/GD/Graph/cylinder.pm +++ /dev/null @@ -1,126 +0,0 @@ -# $File: //depot/RG/rg/lib/RG/lib/GD/Graph/cylinder.pm $ $Author: autrijus $
-# $Revision: #3 $ $Change: 370 $ $DateTime: 2002/07/17 20:38:38 $
-
-package GD::Graph::cylinder;
-
-use strict;
-
-use GD::Graph::axestype3d;
-use GD::Graph::utils qw(:all);
-use GD::Graph::colour qw(:colours);
-
-use base qw/GD::Graph::bars3d/;
-$GD::Graph::cylinder::VERSION = '0.63';
-
-my %Defaults = (
- # Spacing between the bars
- bar_spacing => 0,
-
- # The 3-d extrusion depth of the bars
- bar_depth => 10,
-);
-
-sub initialise
-{
- my $self = shift;
-
- my $rc = $self->SUPER::initialise();
- $self->set(correct_width => 1);
-
- while( my($key, $val) = each %Defaults ) {
- $self->{$key} = $val
- } # end while
-
- return $rc;
-} # end initialise
-
-sub draw_bar_h {
- my $self = shift;
- my $g = shift;
- my( $l, $t, $r, $b, $dsci, $brci, $neg ) = @_;
- my $fnord = $g->colorAllocate(0,0,0);
-
- my $depth = $self->{bar_depth};
-
- my ($lighter, $darker) = ($dsci, $dsci);
- if ($self->{'3d_shading'}) {
- $lighter = $self->{'3d_highlights'}[$dsci];
- $darker = $self->{'3d_shadows'}[$dsci];
- }
- $g->line($l+$depth, $t+1, $r+$depth, $t+1, $dsci);
- $g->line($l+$depth, $b, $r+$depth, $b, $dsci);
- $g->arc($r+$depth, ($t+$b)/2, $depth*2, ($b-$t), 270, 90, $dsci);
- $g->arc($l+$depth, ($t+$b)/2, $depth*2, ($b-$t), 90, 270, $dsci);
- # find border
- my $foo = $l+$depth;
- --$foo
- until $foo == $l || $g->getPixel($foo, $t+($b-$t)/5) == $dsci;
- my $bar = $foo+1;
- ++$bar
- until $bar == $foo || $g->getPixel($bar, $t+($b-$t)/5) == $dsci;
- $g->line($foo, $t+($b-$t)/5, $bar, $t+($b-$t)/5, $dsci);
- $g->line($foo, $b-($b-$t)/5, $bar, $b-($b-$t)/5, $dsci);
- $g->fillToBorder($l+$depth, ($t+$b)/2, $dsci, $dsci);
- $g->arc($l+$depth, ($b+$t)/2, $depth*2, ($b-$t), 90, 270, $dsci);
- if ($foo < $bar + 3) {
- $g->fillToBorder(($l+$r)/2+$depth, $t+($b-$t)/5-1, $dsci, $lighter)
- unless $g->getPixel(($l+$r)/2+$depth, $t+($b-$t)/5-1) == $dsci;
- $g->fillToBorder(($l+$r)/2+$depth, $b-($b-$t)/5+1, $dsci, $darker)
- unless $g->getPixel(($l+$r)/2+$depth, $b-($b-$t)/5+1) == $dsci;
- $g->fillToBorder(($l+$r)/2, ($t+$b)/2, $dsci, $dsci);
- }
- $g->arc($l+$depth, ($b+$t)/2, $depth*2, ($b-$t), 90, 270, $brci);
- $g->arc($r+$depth, ($b+$t)/2, $depth*2, ($b-$t), 0, 360, $brci);
- $g->line($l+$depth, $t+1, $r+$depth, $t+1, $brci);
- $g->line($l+$depth, $b, $r+$depth, $b, $brci);
- $g->fillToBorder($r+$depth, ($b+$t)/2, $brci, $dsci);
-}
-
-sub draw_bar {
- my $self = shift;
- return $self->draw_bar_h(@_) if $self->{rotate_chart};
- my $g = shift;
- my( $l, $t, $r, $b, $dsci, $brci, $neg ) = @_;
- my $fnord = $g->colorAllocate(0,0,0);
-
- my $depth = $self->{bar_depth};
-
- my ($lighter, $darker) = ($dsci, $dsci);
- if ($self->{'3d_shading'}) {
- $lighter = $self->{'3d_highlights'}[$dsci];
- $darker = $self->{'3d_shadows'}[$dsci];
- }
-
- $g->line($l+1, $t-$depth, $l+1, $b-$depth, $dsci);
- $g->line($r, $t-$depth, $r, $b-$depth, $dsci);
-
- $g->arc(($l+$r)/2, $t-$depth, ($r-$l), $depth*2, 180, 360, $dsci);
- $g->arc(($l+$r)/2, $b-$depth, ($r-$l), $depth*2, 0, 180, $dsci);
- # find border
- my $foo = $b-$depth+1;
- ++$foo
- until $foo == $b || $g->getPixel($l+($r-$l)/5,$foo) == $dsci;
- my $bar = $foo-1;
- --$bar
- until $bar == $foo || $g->getPixel($l+($r-$l)/5,$bar) == $dsci;
- $g->line($l+($r-$l)/5, $bar, $l+($r-$l)/5, $foo, $dsci);
- $g->line($r-($r-$l)/5, $bar, $r-($r-$l)/5, $foo, $dsci);
- $g->fillToBorder(($l+$r)/2, $t-$depth, $dsci, $dsci);
- $g->arc(($l+$r)/2, $b-$depth, ($r-$l), $depth*2, 0, 180, $dsci);
- if ($foo > $bar + 3) {
- $g->fillToBorder($l+($r-$l)/5-1, ($foo+$bar)/2, $dsci, $lighter)
- unless $g->getPixel($l+($r-$l)/5-1, ($foo+$bar)/2) == $dsci;
- $g->fillToBorder($r-($r-$l)/5+1, ($foo+$bar)/2, $dsci, $darker)
- unless $g->getPixel($r-($r-$l)/5+1, ($foo+$bar)/2) == $dsci;
- $g->fillToBorder(($l+$r)/2, ($t+$b)/2, $dsci, $dsci);
- }
- $g->arc(($l+$r)/2, $b-$depth, ($r-$l), $depth*2, 0, 180, $brci);
- $g->arc(($l+$r)/2, $t-$depth, ($r-$l), $depth*2, 0, 360, $brci);
- $g->line($l+1, $t-$depth, $l+1, $b-$depth, $brci);
- $g->line($r, $t-$depth, $r, $b-$depth, $brci);
- $g->fillToBorder(($l+$r)/2, $t-$depth, $brci, $dsci);
-}
-
-1;
-
-
diff --git a/lib/GD/Graph/cylinder3d.pm b/lib/GD/Graph/cylinder3d.pm deleted file mode 100644 index 7bc2490..0000000 --- a/lib/GD/Graph/cylinder3d.pm +++ /dev/null @@ -1,30 +0,0 @@ -############################################################
-#
-# Module: GD::Graph::cylinder3d
-#
-# Description:
-# This is merely a wrapper around GD::Graph::cylinder
-# to be used as an alias
-#
-# Created: 16 October 2002 by Jeremy Wadsack for Wadsack-Allen Digital Group
-# Copyright (C) 2002 Wadsack-Allen. All rights reserved.
-############################################################
-# Date Modification Author
-# ----------------------------------------------------------
-# #
-############################################################
-package GD::Graph::cylinder3d;
-
-use strict;
-use GD;
-use GD::Graph;
-use GD::Graph::cylinder;
-use Carp;
-
-@GD::Graph::cylinder3d::ISA = qw( GD::Graph::cylinder );
-$GD::Graph::cylinder3d::VERSION = '0.63';
-
-# Inherit everything from GD::Graph::cylinder
-
-
-1;
diff --git a/lib/GD/Graph/hbars.pm b/lib/GD/Graph/hbars.pm deleted file mode 100644 index e2268b5..0000000 --- a/lib/GD/Graph/hbars.pm +++ /dev/null @@ -1,71 +0,0 @@ -#========================================================================== -# Copyright (c) 1995-1998 Martien Verbruggen -#-------------------------------------------------------------------------- -# -# Name: -# GD::Graph::hbars.pm -# -# $Id: hbars.pm,v 1.3 2003/02/10 22:12:41 mgjv Exp $ -# -#========================================================================== - -package GD::Graph::hbars; - -($GD::Graph::hbars::VERSION) = '$Revision: 1.3 $' =~ /\s([.\d]+)/; - -use strict; - -use GD::Graph::bars; -use GD::Graph::utils qw(:all); -use GD::Graph::colour qw(:colours); - -@GD::Graph::hbars::ISA = qw(GD::Graph::bars); - -sub initialise -{ - my $self = shift; - $self->SUPER::initialise(); - $self->set(rotate_chart => 1); -} - -"Just another true value"; - -__END__ - -=head1 NAME - -GD::Graph::hbars - make bar graphs with horizontal bars - -=head1 SYNOPSIS - -use GD::Graph::hbars; - -=head1 DESCRIPTION - -This is a wrapper module which is completely identical to creating a -GD::Graph::bars object with the C<rotate_chart> attribute set to a true -value. - -=head1 SEE ALSO - -L<GD::Graph> - -=head1 AUTHOR - -Martien Verbruggen E<lt>mgjv@tradingpost.com.auE<gt> - -=head2 Copyright - -(c) Martien Verbruggen - -=head2 Acknowledgements - -The original author of most of the code needed to implement this was -brian d foy, who sent this module to me after I complained I didn't have -the time to implement horizontal bar charts. I took the code that lived -in here, and distributed it over axestype.pm and bars.pm, to allow for a -better integration all around. His code, in turn, was mainly based on an -earlier version of bars.pm and axestype.pm. - -=cut - diff --git a/lib/GD/Graph/lines.pm b/lib/GD/Graph/lines.pm deleted file mode 100644 index 2dac4dd..0000000 --- a/lib/GD/Graph/lines.pm +++ /dev/null @@ -1,182 +0,0 @@ -#========================================================================== -# Copyright (c) 1995-1998 Martien Verbruggen -#-------------------------------------------------------------------------- -# -# Name: -# GD::Graph::lines.pm -# -# $Id: lines.pm,v 1.15 2003/02/10 22:12:41 mgjv Exp $ -# -#========================================================================== - -package GD::Graph::lines; - -($GD::Graph::lines::VERSION) = '$Revision: 1.15 $' =~ /\s([\d.]+)/; - -use strict; - -use GD; -use GD::Graph::axestype; - -@GD::Graph::lines::ISA = qw( GD::Graph::axestype ); - -# PRIVATE - -sub draw_data_set -{ - my $self = shift; - my $ds = shift; - - my @values = $self->{_data}->y_values($ds) or - return $self->_set_error("Impossible illegal data set: $ds", - $self->{_data}->error); - - my $dsci = $self->set_clr($self->pick_data_clr($ds) ); - my $type = $self->pick_line_type($ds); - - my ($xb, $yb); - if (defined $values[0]) - { - if (defined($self->{x_min_value}) && defined($self->{x_max_value})) - { - ($xb, $yb) = - $self->val_to_pixel($self->{_data}->get_x(0), $values[0], $ds); - } - else - { - ($xb, $yb) = $self->val_to_pixel(1, $values[0], $ds); - } - } - - for (my $i = 0; $i < @values; $i++) - { - if (!defined $values[$i]) - { - ($xb, $yb) = () if $self->{skip_undef}; - next; - } - - my ($xe, $ye); - - if (defined($self->{x_min_value}) && defined($self->{x_max_value})) - { - ($xe, $ye) = $self->val_to_pixel( - $self->{_data}->get_x($i), $values[$i], $ds); - } - else - { - ($xe, $ye) = $self->val_to_pixel($i+1, $values[$i], $ds); - } - - if (defined $xb) - { - $self->draw_line($xb, $yb, $xe, $ye, $type, $dsci) - if defined $dsci; - $self->{_hotspots}->[$ds]->[$i] = - ['line', $xb, $yb, $xe, $ye, $self->{line_width}]; - } - ($xb, $yb) = ($xe, $ye); - } - - return $ds; -} - -sub pick_line_type -{ - my $self = shift; - my $num = shift; - - ref $self->{line_types} ? - $self->{line_types}[ $num % (1 + $#{$self->{line_types}}) - 1 ] : - $num % 4 ? $num % 4 : 4 -} - -sub draw_line # ($xs, $ys, $xe, $ye, $type, $colour_index) -{ - my $self = shift; - my ($xs, $ys, $xe, $ye, $type, $clr) = @_; - - my $lw = $self->{line_width}; - my $lts = $self->{line_type_scale}; - - my $style = gdStyled; - my @pattern = (); - - LINE: { - - ($type == 2) && do { - # dashed - - for (1 .. $lts) { push @pattern, $clr } - for (1 .. $lts) { push @pattern, gdTransparent } - - $self->{graph}->setStyle(@pattern); - - last LINE; - }; - - ($type == 3) && do { - # dotted, - - for (1 .. 2) { push @pattern, $clr } - for (1 .. 2) { push @pattern, gdTransparent } - - $self->{graph}->setStyle(@pattern); - - last LINE; - }; - - ($type == 4) && do { - # dashed and dotted - - for (1 .. $lts) { push @pattern, $clr } - for (1 .. 2) { push @pattern, gdTransparent } - for (1 .. 2) { push @pattern, $clr } - for (1 .. 2) { push @pattern, gdTransparent } - - $self->{graph}->setStyle(@pattern); - - last LINE; - }; - - # default: solid - $style = $clr; - } - - # Tried the line_width thing with setBrush, ugly results - # TODO: This loop probably should be around the datasets - # for nicer results - my $i; - for $i (1..$lw) - { - my $yslw = $ys + int($lw/2) - $i; - my $yelw = $ye + int($lw/2) - $i; - - # Need the setstyle to reset - $self->{graph}->setStyle(@pattern) if (@pattern); - $self->{graph}->line( $xs, $yslw, $xe, $yelw, $style ); - } -} - -sub draw_legend_marker # (data_set_number, x, y) -{ - my $self = shift; - my ($n, $x, $y) = @_; - - my $ci = $self->set_clr($self->pick_data_clr($n)); - return unless defined $ci; - my $type = $self->pick_line_type($n); - - $y += int($self->{lg_el_height}/2); - - # Joe Smith <jms@tardis.Tymnet.COM> - local($self->{line_width}) = 2; # Make these show up better - - $self->draw_line( - $x, $y, - $x + $self->{legend_marker_width}, $y, - $type, $ci - ); -} - -"Just another true value"; diff --git a/lib/GD/Graph/lines3d.pm b/lib/GD/Graph/lines3d.pm deleted file mode 100644 index dfd60c7..0000000 --- a/lib/GD/Graph/lines3d.pm +++ /dev/null @@ -1,522 +0,0 @@ -#========================================================================== -# Module: GD::Graph::lines3d -# -# Copyright (C) 1999,2001 Wadsack-Allen. All Rights Reserved. -# -# Based on GD::Graph::lines.pm,v 1.10 2000/04/15 mgjv -# Copyright (c) 1995-1998 Martien Verbruggen -# -#-------------------------------------------------------------------------- -# Date Modification Author -# ------------------------------------------------------------------------- -# 1999SEP18 Created 3D line chart class (this module) JAW -# 1999SEP19 Finished overwrite 1 style JAW -# 1999SEP19 Polygon'd linewidth rendering JAW -# 2000SEP19 Converted to a GD::Graph class JAW -# 2000APR18 Modified for compatibility with GD::Graph 1.30 JAW -# 2000APR24 Fixed a lot of rendering bugs JAW -# 2000AUG19 Changed render code so lines have consitent width JAW -# 2000AUG21 Added 3d shading JAW -# 2000AUG24 Fixed shading top/botttom vs. postive/negative slope JAW -# 2000SEP04 For single point "lines" made a short segment JAW -# 2000OCT09 Fixed bug in rendering of legend JAW -#========================================================================== -# TODO -# ** The new mitred corners don't work well at data anomlies. Like -# the set (0,0,1,0,0,0,1,0,1) Looks really wrong! -# * Write a draw_data_set that draws the line so they appear to pass -# through one another. This means drawing a border edge at each -# intersection of the data lines so the points of pass-through show. -# Probably want to draw all filled polygons, then run through the data -# again finding intersections of line segments and drawing those edges. -#========================================================================== -package GD::Graph::lines3d; - -use strict; - -use GD; -use GD::Graph::axestype3d; -use Data::Dumper; - -@GD::Graph::lines3d::ISA = qw( GD::Graph::axestype3d ); -$GD::Graph::lines3d::VERSION = '0.63'; - -my $PI = 4 * atan2(1, 1); - -my %Defaults = ( - # The depth of the line in their extrusion - - line_depth => 10, -); - -sub initialise() -{ - my $self = shift; - - my $rc = $self->SUPER::initialise(); - - while( my($key, $val) = each %Defaults ) { - $self->{$key} = $val - - # *** [JAW] - # Should we reset the depth_3d param based on the - # line_depth, numsets and overwrite parameters, here? - # - } # end while - - return $rc; - -} # end initialize - -sub set -{ - my $s = shift; - my %args = @_; - - $s->{_set_error} = 0; - - for (keys %args) - { - /^line_depth$/ and do - { - $s->{line_depth} = $args{$_}; - delete $args{$_}; - next; - }; - } - - return $s->SUPER::set(%args); -} # end set - -# PRIVATE - -# [JAW] Changed to draw_data intead of -# draw_data_set to allow better control -# of multiple set rendering -sub draw_data -{ - my $self = shift; - my $d = $self->{_data}; - my $g = $self->{graph}; - - $self->draw_data_overwrite( $g, $d ); - - # redraw the 'zero' axis, front and right - if( $self->{zero_axis} ) { - $g->line( - $self->{left}, $self->{zeropoint}, - $self->{right}, $self->{zeropoint}, - $self->{fgci} ); - $g->line( - $self->{right}, $self->{zeropoint}, - $self->{right} + $self->{depth_3d}, $self->{zeropoint} - $self->{depth_3d}, - $self->{fgci} ); - } # end if - - # redraw the box face - if ( $self->{box_axis} ) { - # Axes box - $g->rectangle($self->{left}, $self->{top}, $self->{right}, $self->{bottom}, $self->{fgci}); - $g->line($self->{right}, $self->{top}, $self->{right} + $self->{depth_3d}, $self->{top} - $self->{depth_3d}, $self->{fgci}); - $g->line($self->{right}, $self->{bottom}, $self->{right} + $self->{depth_3d}, $self->{bottom} - $self->{depth_3d}, $self->{fgci}); - } # end if - - return $self; - -} # end draw_data - -# Copied from MVERB source -sub pick_line_type -{ - my $self = shift; - my $num = shift; - - ref $self->{line_types} ? - $self->{line_types}[ $num % (1 + $#{$self->{line_types}}) - 1 ] : - $num % 4 ? $num % 4 : 4 -} - -# ---------------------------------------------------------- -# Sub: draw_data_overwrite -# -# Args: $gd -# $gd The GD object to draw on -# -# Description: Draws each line segment for each set. Runs -# over sets, then points so that the appearance is better. -# ---------------------------------------------------------- -# Date Modification Author -# ---------------------------------------------------------- -# 19SEP1999 Added this for overwrite support. JW -# 20AUG2000 Changed structure to use points 'objects' JW -# ---------------------------------------------------------- -sub draw_data_overwrite { - my $self = shift; - my $g = shift; - my @points_cache; - - my $i; - for $i (0 .. $self->{_data}->num_points()) - { - my $j; - for $j (1 .. $self->{_data}->num_sets()) - { - my @values = $self->{_data}->y_values($j) or - return $self->_set_error( "Impossible illegal data set: $j", $self->{_data}->error ); - - if( $self->{_data}->num_points() == 1 && $i == 1 ) { - # Copy the first point to the "second" - $values[$i] = $values[0]; - } # end if - - next unless defined $values[$i]; - - # calculate offset of this line - # *** Should offset be the max of line_depth - # and depth_3d/numsets? [JAW] - # - my $offset = $self->{line_depth} * ($self->{_data}->num_sets() - $j); - - # Get the coordinates of the previous point, if this is the first - # point make a point object and start over (i.e. next;) - unless( $i ) { - my( $xb, $yb ); - if (defined($self->{x_min_value}) && defined($self->{x_max_value})) { - ($xb, $yb) = $self->val_to_pixel( $self->{_data}->get_x($i), $values[$i], $j ); - } else { - ($xb, $yb) = $self->val_to_pixel( $i + 1, $values[$i], $j ); - } # end if - $xb += $offset; - $yb -= $offset; - $points_cache[$i][$j] = { coords => [$xb, $yb] }; - next; - } # end unless - - # Pick a data colour, calc shading colors too, if requested - my( @rgb ) = $self->pick_data_clr( $j ); - my $dsci = $self->set_clr( @rgb ); - if( $self->{'3d_shading'} ) { - $self->{'3d_highlights'}[$dsci] = $self->set_clr( $self->_brighten( @rgb ) ); - $self->{'3d_shadows'}[$dsci] = $self->set_clr( $self->_darken( @rgb ) ); - } # end if - - # Get the type - my $type = $self->pick_line_type($j); - - # Get the coordinates of the this point - unless( ref $points_cache[$i][$j] ) { - my( $xe, $ye ); - if( defined($self->{x_min_value}) && defined($self->{x_max_value}) ) { - ( $xe, $ye ) = $self->val_to_pixel( $self->{_data}->get_x($i), $values[$i], $j ); - } else { - ( $xe, $ye ) = $self->val_to_pixel($i + 1, $values[$i], $j); - } # end if - $xe += $offset; - $ye -= $offset; - $points_cache[$i][$j] = { coords => [$xe, $ye] }; - } # end if - - # Find the coordinates of the next point - if( defined $values[$i + 1] ) { - my( $xe, $ye ); - if( defined($self->{x_min_value}) && defined($self->{x_max_value}) ) { - ( $xe, $ye ) = $self->val_to_pixel( $self->{_data}->get_x($i + 1), $values[$i + 1], $j ); - } else { - ( $xe, $ye ) = $self->val_to_pixel($i + 2, $values[$i + 1], $j); - } # end if - $xe += $offset; - $ye -= $offset; - $points_cache[$i + 1][$j] = { coords => [$xe, $ye] }; - } # end if - - if( $self->{_data}->num_points() == 1 && $i == 1 ) { - # Nudge the x coords back- and forwards - my $n = int(($self->{right} - $self->{left}) / 30); - $n = 2 if $n < 2; - $points_cache[$i][$j]{coords}[0] = $points_cache[$i - 1][$j]{coords}[0] + $n; - $points_cache[$i - 1][$j]{coords}[0] -= $n; - } # end if - - # Draw the line segment - $self->draw_line( $points_cache[$i - 1][$j], - $points_cache[$i][$j], - $points_cache[$i + 1][$j], - $type, - $dsci ); - - # Draw the end cap if last segment - if( $i >= $self->{_data}->num_points() - 1 ) { - my $poly = new GD::Polygon; - $poly->addPt( $points_cache[$i][$j]{face}[0], $points_cache[$i][$j]{face}[1] ); - $poly->addPt( $points_cache[$i][$j]{face}[2], $points_cache[$i][$j]{face}[3] ); - $poly->addPt( $points_cache[$i][$j]{face}[2] + $self->{line_depth}, $points_cache[$i][$j]{face}[3] - $self->{line_depth} ); - $poly->addPt( $points_cache[$i][$j]{face}[0] + $self->{line_depth}, $points_cache[$i][$j]{face}[1] - $self->{line_depth} ); - if( $self->{'3d_shading'} ) { - $g->filledPolygon( $poly, $self->{'3d_shadows'}[$dsci] ); - } else { - $g->filledPolygon( $poly, $dsci ); - } # end if - $g->polygon( $poly, $self->{fgci} ); - } # end if - - } # end for -- $self->{_data}->num_sets() - } # end for -- $self->{_data}->num_points() - -} # end sub draw_data_overwrite - -# ---------------------------------------------------------- -# Sub: draw_line -# -# Args: $prev, $this, $next, $type, $clr -# $prev A hash ref for the prev point's object -# $this A hash ref for this point's object -# $next A hash ref for the next point's object -# $type A predefined line type (2..4) = (dashed, dotted, dashed & dotted) -# $clr The color (colour) index to use for the fill -# -# Point "Object" has these properties: -# coords A 2 element array of the coordinates for the line -# (this should be filled in before calling) -# face An 4 element array of end points for the face -# polygon. This will be populated by this method. -# -# Description: Draws a line segment in 3d extrusion that -# connects the prev point the the this point. The next point -# is used to calculate the mitre at the joint. -# ---------------------------------------------------------- -# Date Modification Author -# ---------------------------------------------------------- -# 18SEP1999 Modified MVERB source to work on data -# point, not data set for better rendering JAW -# 19SEP1999 Ploygon'd line rendering for better effect JAW -# 19AUG2000 Made line width perpendicular JAW -# 19AUG2000 Changed parameters to use %line_seg hash/obj JAW -# 20AUG2000 Mitred joints of line segments JAW -# ---------------------------------------------------------- -sub draw_line -{ - my $self = shift; - my( $prev, $this, $next, $type, $clr ) = @_; - my $xs = $prev->{coords}[0]; - my $ys = $prev->{coords}[1]; - my $xe = $this->{coords}[0]; - my $ye = $this->{coords}[1]; - - my $lw = $self->{line_width}; - my $lts = $self->{line_type_scale}; - - my $style = gdStyled; - my @pattern = (); - - LINE: { - - ($type == 2) && do { - # dashed - - for (1 .. $lts) { push @pattern, $clr } - for (1 .. $lts) { push @pattern, gdTransparent } - - $self->{graph}->setStyle(@pattern); - - last LINE; - }; - - ($type == 3) && do { - # dotted, - - for (1 .. 2) { push @pattern, $clr } - for (1 .. 2) { push @pattern, gdTransparent } - - $self->{graph}->setStyle(@pattern); - - last LINE; - }; - - ($type == 4) && do { - # dashed and dotted - - for (1 .. $lts) { push @pattern, $clr } - for (1 .. 2) { push @pattern, gdTransparent } - for (1 .. 2) { push @pattern, $clr } - for (1 .. 2) { push @pattern, gdTransparent } - - $self->{graph}->setStyle(@pattern); - - last LINE; - }; - - # default: solid - $style = $clr; - } - - # [JAW] Removed the dataset loop for better results. - - # Need the setstyle to reset - $self->{graph}->setStyle(@pattern) if (@pattern); - - # - # Find the x and y offsets for the edge of the front face - # Do this by adjusting them perpendicularly from the line - # half the line width in front and in back. - # - my( $lwyoff, $lwxoff ); - if( $xe == $xs ) { - $lwxoff = $lw / 2; - $lwyoff = 0; - } elsif( $ye == $ys ) { - $lwxoff = 0; - $lwyoff = $lw / 2; - } else { - my $ln = sqrt( ($ys-$ye)**2 + ($xe-$xs)**2 ); - $lwyoff = ($xe-$xs) / $ln * $lw / 2; - $lwxoff = ($ys-$ye) / $ln * $lw / 2; - } # end if - - # For first line, figure beginning point - unless( defined $prev->{face}[0] ) { - $prev->{face} = []; - $prev->{face}[0] = $xs - $lwxoff; - $prev->{face}[1] = $ys - $lwyoff; - $prev->{face}[2] = $xs + $lwxoff; - $prev->{face}[3] = $ys + $lwyoff; - } # end unless - - # Calc and store this point's face coords - unless( defined $this->{face}[0] ) { - $this->{face} = []; - $this->{face}[0] = $xe - $lwxoff; - $this->{face}[1] = $ye - $lwyoff; - $this->{face}[2] = $xe + $lwxoff; - $this->{face}[3] = $ye + $lwyoff; - } # end if - - # Now find next point and nudge these coords to mitre - if( ref $next->{coords} eq 'ARRAY' ) { - my( $lwyo2, $lwxo2 ); - my( $x2, $y2 ) = @{$next->{coords}}; - if( $x2 == $xe ) { - $lwxo2 = $lw / 2; - $lwyo2 = 0; - } elsif( $y2 == $ye ) { - $lwxo2 = 0; - $lwyo2 = $lw / 2; - } else { - my $ln2 = sqrt( ($ye-$y2)**2 + ($x2-$xe)**2 ); - $lwyo2 = ($x2-$xe) / $ln2 * $lw / 2; - $lwxo2 = ($ye-$y2) / $ln2 * $lw / 2; - } # end if - $next->{face} = []; - $next->{face}[0] = $x2 - $lwxo2; - $next->{face}[1] = $y2 - $lwyo2; - $next->{face}[2] = $x2 + $lwxo2; - $next->{face}[3] = $y2 + $lwyo2; - - # Now get the intersecting coordinates - my $mt = ($ye - $ys)/($xe - $xs); - my $mn = ($y2 - $ye)/($x2 - $xe); - my $bt = $this->{face}[1] - $this->{face}[0] * $mt; - my $bn = $next->{face}[1] - $next->{face}[0] * $mn; - if( $mt != $mn ) { - $this->{face}[0] = ($bn - $bt) / ($mt - $mn); - } # end if - $this->{face}[1] = $mt * $this->{face}[0] + $bt; - $bt = $this->{face}[3] - $this->{face}[2] * $mt; - $bn = $next->{face}[3] - $next->{face}[2] * $mn; - if( $mt != $mn ) { - $this->{face}[2] = ($bn - $bt) / ($mt - $mn); - } # end if - $this->{face}[3] = $mt * $this->{face}[2] + $bt; - } # end if - - - # Make the top/bottom polygon - my $poly = new GD::Polygon; - if( ($ys-$ye)/($xe-$xs) > 1 ) { - $poly->addPt( $prev->{face}[2], $prev->{face}[3] ); - $poly->addPt( $this->{face}[2], $this->{face}[3] ); - $poly->addPt( $this->{face}[2] + $self->{line_depth}, $this->{face}[3] - $self->{line_depth} ); - $poly->addPt( $prev->{face}[2] + $self->{line_depth}, $prev->{face}[3] - $self->{line_depth} ); - if( $self->{'3d_shading'} && $style == $clr ) { - if( ($ys-$ye)/($xe-$xs) > 0 ) { - $self->{graph}->filledPolygon( $poly, $self->{'3d_shadows'}[$clr] ); - } else { - $self->{graph}->filledPolygon( $poly, $self->{'3d_highlights'}[$clr] ); - } # end if - } else { - $self->{graph}->filledPolygon( $poly, $style ); - } # end if - } else { - $poly->addPt( $prev->{face}[0], $prev->{face}[1] ); - $poly->addPt( $this->{face}[0], $this->{face}[1] ); - $poly->addPt( $this->{face}[0] + $self->{line_depth}, $this->{face}[1] - $self->{line_depth} ); - $poly->addPt( $prev->{face}[0] + $self->{line_depth}, $prev->{face}[1] - $self->{line_depth} ); - if( $self->{'3d_shading'} && $style == $clr ) { - if( ($ys-$ye)/($xe-$xs) < 0 ) { - $self->{graph}->filledPolygon( $poly, $self->{'3d_shadows'}[$clr] ); - } else { - $self->{graph}->filledPolygon( $poly, $self->{'3d_highlights'}[$clr] ); - } # end if - } else { - $self->{graph}->filledPolygon( $poly, $style ); - } # end if - } # end if - $self->{graph}->polygon( $poly, $self->{fgci} ); - - # *** This paints dashed and dotted patterns on the faces of - # the polygons. They don't look very good though. Would it - # be better to extrude the style as well as the lines? - # Otherwise could also be improved by using gdTiled instead of - # gdStyled and making the tile a transform of the line style - # for each face. [JAW] - - # Make the face polygon - $poly = new GD::Polygon; - $poly->addPt( $prev->{face}[0], $prev->{face}[1] ); - $poly->addPt( $this->{face}[0], $this->{face}[1] ); - $poly->addPt( $this->{face}[2], $this->{face}[3] ); - $poly->addPt( $prev->{face}[2], $prev->{face}[3] ); - - $self->{graph}->filledPolygon( $poly, $style ); - $self->{graph}->polygon( $poly, $self->{fgci} ); - -} # end draw line - -# ---------------------------------------------------------- -# Sub: draw_legend_marker -# -# Args: $dsn, $x, $y -# $dsn The dataset number to draw the marker for -# $x The x position of the marker -# $y The y position of the marker -# -# Description: Draws the legend marker for the specified -# dataset number at the given coordinates -# ---------------------------------------------------------- -# Date Modification Author -# ---------------------------------------------------------- -# 2000OCT06 Fixed rendering bugs JW -# ---------------------------------------------------------- -sub draw_legend_marker -{ - my $self = shift; - my ($n, $x, $y) = @_; - - my $ci = $self->set_clr($self->pick_data_clr($n)); - my $type = $self->pick_line_type($n); - - $y += int($self->{lg_el_height}/2); - - # Joe Smith <jms@tardis.Tymnet.COM> - local($self->{line_width}) = 2; # Make these show up better - - $self->draw_line( - { coords => [$x, $y] }, - { coords => [$x + $self->{legend_marker_width}, $y] }, - undef, - $type, - $ci - ); - -} # end draw_legend_marker - -1; diff --git a/lib/GD/Graph/linespoints.pm b/lib/GD/Graph/linespoints.pm deleted file mode 100644 index d913e2c..0000000 --- a/lib/GD/Graph/linespoints.pm +++ /dev/null @@ -1,46 +0,0 @@ -#========================================================================== -# Copyright (c) 1995-1998 Martien Verbruggen -#-------------------------------------------------------------------------- -# -# Name: -# GD::Graph::linespoints.pm -# -# $Id: linespoints.pm,v 1.8 2003/02/10 22:12:41 mgjv Exp $ -# -#========================================================================== - -package GD::Graph::linespoints; - -($GD::Graph::linespoints::VERSION) = '$Revision: 1.8 $' =~ /\s([\d.]+)/; - -use strict; - -use GD::Graph::axestype; -use GD::Graph::lines; -use GD::Graph::points; - -# Even though multiple inheritance is not really a good idea, -# since lines and points have the same parent class, I will do it here, -# because I need the functionality of the markers and the line types - -@GD::Graph::linespoints::ISA = qw(GD::Graph::lines GD::Graph::points); - -# PRIVATE - -sub draw_data_set -{ - my $self = shift; - - $self->GD::Graph::points::draw_data_set(@_) or return; - $self->GD::Graph::lines::draw_data_set(@_); -} - -sub draw_legend_marker -{ - my $self = shift; - - $self->GD::Graph::points::draw_legend_marker(@_); - $self->GD::Graph::lines::draw_legend_marker(@_); -} - -"Just another true value"; diff --git a/lib/GD/Graph/mixed.pm b/lib/GD/Graph/mixed.pm deleted file mode 100644 index daf192f..0000000 --- a/lib/GD/Graph/mixed.pm +++ /dev/null @@ -1,99 +0,0 @@ -#========================================================================== -# Copyright (c) 1995-1998 Martien Verbruggen -#-------------------------------------------------------------------------- -# -# Name: -# GD::Graph::mixed.pm -# -# $Id: mixed.pm,v 1.12 2003/02/10 22:12:41 mgjv Exp $ -# -#========================================================================== - -package GD::Graph::mixed; - -($GD::Graph::mixed::VERSION) = '$Revision: 1.12 $' =~ /\s([\d.]+)/; - -use strict; - -use GD::Graph::axestype; -use GD::Graph::lines; -use GD::Graph::points; -use GD::Graph::linespoints; -use GD::Graph::bars; -use GD::Graph::area; -use Carp; - -# Even though multiple inheritance is not really a good idea, I will -# do it here, because I need the functionality of the markers and the -# line types We'll include axestype as the first one, to make sure -# that's where we look first for methods. - -@GD::Graph::mixed::ISA = qw( - GD::Graph::axestype - GD::Graph::bars - GD::Graph::lines - GD::Graph::points -); - -sub initialise -{ - my $self = shift; - $self->SUPER::initialise(); -} - -sub correct_width -{ - my $self = shift; - - return $self->{correct_width} if defined $self->{correct_width}; - - for my $type ($self->{default_type}, @{$self->{types}}) - { - return 1 if $type eq 'bars'; - } -} - -sub draw_data_set -{ - my $self = shift; - my $ds = $_[0]; - - my $rc; - - my $type = $self->{types}->[$ds-1] || $self->{default_type}; - - # Try to execute the draw_data_set function in the package - # specified by type - $rc = eval '$self->GD::Graph::'.$type.'::draw_data_set(@_)'; - - # If we fail, we try it in the package specified by the - # default_type, and warn the user - if ($@) - { - carp "Set $ds, unknown type $type, assuming $self->{default_type}"; - #carp "Error message: $@"; - - $rc = eval '$self->GD::Graph::'. - $self->{default_type}.'::draw_data_set(@_)'; - } - - # If even that fails, we bail out - croak "Set $ds: unknown default type $self->{default_type}" if $@; - - return $rc; -} - -sub draw_legend_marker -{ - my $self = shift; - my $ds = $_[0]; - - my $type = $self->{types}->[$ds-1] || $self->{default_type}; - - eval '$self->GD::Graph::'.$type.'::draw_legend_marker(@_)'; - - eval '$self->GD::Graph::'. - $self->{default_type}.'::draw_legend_marker(@_)' if $@; -} - -"Just another true value"; diff --git a/lib/GD/Graph/pie.pm b/lib/GD/Graph/pie.pm deleted file mode 100644 index a945ba0..0000000 --- a/lib/GD/Graph/pie.pm +++ /dev/null @@ -1,446 +0,0 @@ -#========================================================================== -# Copyright (c) 1995-1998 Martien Verbruggen -#-------------------------------------------------------------------------- -# -# Name: -# GD::Graph::pie.pm -# -# $Id: pie.pm,v 1.20 2003/02/10 22:12:41 mgjv Exp $ -# -#========================================================================== - -package GD::Graph::pie; - -($GD::Graph::pie::VERSION) = '$Revision: 1.20 $' =~ /\s([\d.]+)/; - -use strict; - -use constant PI => 4 * atan2(1,1); - -use GD; -use GD::Graph; -use GD::Graph::utils qw(:all); -use GD::Graph::colour qw(:colours :lists); -use GD::Text::Align; -use Carp; - -@GD::Graph::pie::ISA = qw( GD::Graph ); - -my $ANGLE_OFFSET = 90; - -my %Defaults = ( - - # Set the height of the pie. - # Because of the dependency of this on runtime information, this - # is being set in GD::Graph::pie::initialise - - # pie_height => _round(0.1*${'width'}), - pie_height => undef, - - # Do you want a 3D pie? - '3d' => 1, - - # The angle at which to start the first data set - # 0 is at the front/bottom - start_angle => 0, - - # Angle below which a label on a pie slice is suppressed. - suppress_angle => 0, # CONTRIB idea ryan <xomina@bitstream.net> - - # and some public attributes without defaults - label => undef, - - # This misnamed attribute is used for pie marker colours - axislabelclr => 'black', -); - -# PRIVATE -sub _has_default { - my $self = shift; - my $attr = shift || return; - exists $Defaults{$attr} || $self->SUPER::_has_default($attr); -} - -sub initialise -{ - my $self = shift; - $self->SUPER::initialise(); - while (my($key, $val) = each %Defaults) - { $self->{$key} = $val } - $self->set( pie_height => _round(0.1 * $self->{height}) ); - $self->set_value_font(gdTinyFont); - $self->set_label_font(gdSmallFont); -} - -# PUBLIC methods, documented in pod -sub plot -{ - my $self = shift; - my $data = shift; - - $self->check_data($data) or return; - $self->init_graph() or return; - $self->setup_text() or return; - $self->setup_coords() or return; - $self->draw_text() or return; - $self->draw_pie() or return; - $self->draw_data() or return; - - return $self->{graph}; -} - -sub set_label_font # (fontname) -{ - my $self = shift; - $self->_set_font('gdta_label', @_) or return; - $self->{gdta_label}->set_align('bottom', 'center'); -} - -sub set_value_font # (fontname) -{ - my $self = shift; - $self->_set_font('gdta_value', @_) or return; - $self->{gdta_value}->set_align('center', 'center'); -} - -# Inherit defaults() from GD::Graph - -# inherit checkdata from GD::Graph - -# Setup the coordinate system and colours, calculate the -# relative axis coordinates in respect to the canvas size. - -sub setup_coords() -{ - my $self = shift; - - # Make sure we're not reserving space we don't need. - $self->{'3d'} = 0 if $self->{pie_height} <= 0; - $self->set(pie_height => 0) unless $self->{'3d'}; - - my $tfh = $self->{title} ? $self->{gdta_title}->get('height') : 0; - my $lfh = $self->{label} ? $self->{gdta_label}->get('height') : 0; - - # Calculate the bounding box for the pie, and - # some width, height, and centre parameters - $self->{bottom} = - $self->{height} - $self->{pie_height} - $self->{b_margin} - - ( $lfh ? $lfh + $self->{text_space} : 0 ); - $self->{top} = - $self->{t_margin} + ( $tfh ? $tfh + $self->{text_space} : 0 ); - - return $self->_set_error('Vertical size too small') - if $self->{bottom} - $self->{top} <= 0; - - $self->{left} = $self->{l_margin}; - $self->{right} = $self->{width} - $self->{r_margin}; - - return $self->_set_error('Horizontal size too small') - if $self->{right} - $self->{left} <= 0; - - $self->{w} = $self->{right} - $self->{left}; - $self->{h} = $self->{bottom} - $self->{top}; - - $self->{xc} = ($self->{right} + $self->{left})/2; - $self->{yc} = ($self->{bottom} + $self->{top})/2; - - return $self; -} - -# inherit open_graph from GD::Graph - -# Setup the parameters for the text elements -sub setup_text -{ - my $self = shift; - - if ( $self->{title} ) - { - #print "'$s->{title}' at ($s->{xc},$s->{t_margin})\n"; - $self->{gdta_title}->set(colour => $self->{tci}); - $self->{gdta_title}->set_text($self->{title}); - } - - if ( $self->{label} ) - { - $self->{gdta_label}->set(colour => $self->{lci}); - $self->{gdta_label}->set_text($self->{label}); - } - - $self->{gdta_value}->set(colour => $self->{alci}); - - return $self; -} - -# Put the text on the canvas. -sub draw_text -{ - my $self = shift; - - $self->{gdta_title}->draw($self->{xc}, $self->{t_margin}) - if $self->{title}; - $self->{gdta_label}->draw($self->{xc}, $self->{height} - $self->{b_margin}) - if $self->{label}; - - return $self; -} - -# draw the pie, without the data slices -sub draw_pie -{ - my $self = shift; - - my $left = $self->{xc} - $self->{w}/2; - - $self->{graph}->arc( - $self->{xc}, $self->{yc}, - $self->{w}, $self->{h}, - 0, 360, $self->{acci} - ); - - $self->{graph}->arc( - $self->{xc}, $self->{yc} + $self->{pie_height}, - $self->{w}, $self->{h}, - 0, 180, $self->{acci} - ) if ( $self->{'3d'} ); - - $self->{graph}->line( - $left, $self->{yc}, - $left, $self->{yc} + $self->{pie_height}, - $self->{acci} - ); - - $self->{graph}->line( - $left + $self->{w}, $self->{yc}, - $left + $self->{w}, $self->{yc} + $self->{pie_height}, - $self->{acci} - ); - - return $self; -} - -# Draw the data slices - -sub draw_data -{ - my $self = shift; - - my $total = 0; - my @values = $self->{_data}->y_values(1); # for now, only one pie.. - for (@values) - { - $total += $_ - } - - return $self->_set_error("Pie data total is <= 0") - unless $total > 0; - - my $ac = $self->{acci}; # Accent colour - my $pb = $self->{start_angle}; - - for (my $i = 0; $i < @values; $i++) - { - # Set the data colour - my $dc = $self->set_clr_uniq($self->pick_data_clr($i + 1)); - - # Set the angles of the pie slice - # Angle 0 faces down, positive angles are clockwise - # from there. - # --- - # / \ - # | | - # \ | / - # --- - # 0 - # $pa/$pb include the start_angle (so if start_angle - # is 90, there will be no pa/pb < 90. - my $pa = $pb; - $pb += my $slice_angle = 360 * $values[$i]/$total; - - # Calculate the end points of the lines at the boundaries of - # the pie slice - my ($xe, $ye) = cartesian( - $self->{w}/2, $pa, - $self->{xc}, $self->{yc}, $self->{h}/$self->{w} - ); - - $self->{graph}->line($self->{xc}, $self->{yc}, $xe, $ye, $ac); - - # Draw the lines on the front of the pie - $self->{graph}->line($xe, $ye, $xe, $ye + $self->{pie_height}, $ac) - if in_front($pa) && $self->{'3d'}; - - # Make an estimate of a point in the middle of the pie slice - # And fill it - ($xe, $ye) = cartesian( - 3 * $self->{w}/8, ($pa+$pb)/2, - $self->{xc}, $self->{yc}, $self->{h}/$self->{w} - ); - - $self->{graph}->fillToBorder($xe, $ye, $ac, $dc); - - # If it's 3d, colour the front ones as well - # - # if one slice is very large (>180 deg) then we will need to - # fill it twice. sbonds. - # - # Independently noted and fixed by Jeremy Wadsack, in a slightly - # different way. - if ($self->{'3d'}) - { - foreach my $fill ($self->_get_pie_front_coords($pa, $pb)) - { - $self->{graph}->fillToBorder( - $fill->[0], $fill->[1] + $self->{pie_height}/2, - $ac, $dc); - } - } - } - - # CONTRIB Jeremy Wadsack - # - # Large text, sticking out over the pie edge, could cause 3D pies to - # fill improperly: Drawing the text for a given slice before the - # next slice was drawn and filled could make the slice boundary - # disappear, causing the fill colour to flow out. With this - # implementation, all the text is on top of the pie. - - $pb = $self->{start_angle}; - for (my $i = 0; $i < @values; $i++) - { - next unless $values[$i]; - - my $pa = $pb; - $pb += my $slice_angle = 360 * $values[$i]/$total; - - next if $slice_angle <= $self->{suppress_angle}; - - my ($xe, $ye) = - cartesian( - 3 * $self->{w}/8, ($pa+$pb)/2, - $self->{xc}, $self->{yc}, $self->{h}/$self->{w} - ); - - $self->put_slice_label($xe, $ye, $self->{_data}->get_x($i)); - } - - return $self; - -} #GD::Graph::pie::draw_data - -sub _get_pie_front_coords # (angle 1, angle 2) -{ - my $self = shift; - my $pa = level_angle(shift); - my $pb = level_angle(shift); - my @fills = (); - - if (in_front($pa)) - { - if (in_front($pb)) - { - # both in front - # don't do anything - # Ah, but if this wraps all the way around the back - # then both pieces of the front need to be filled. - # sbonds. - if ($pa > $pb ) - { - # This takes care of the left bit on the front - # Since we know exactly where we are, and in which - # direction this works, we can just get the coordinates - # for $pa. - my ($x, $y) = cartesian( - $self->{w}/2, $pa, - $self->{xc}, $self->{yc}, $self->{h}/$self->{w} - ); - - # and move one pixel to the left, but only if we don't - # fall out of the pie!. - push @fills, [$x - 1, $y] - if $x - 1 > $self->{xc} - $self->{w}/2; - - # Reset $pa to the right edge of the front arc, to do - # the right bit on the front. - $pa = level_angle(-$ANGLE_OFFSET); - } - } - else - { - # start in front, end in back - $pb = $ANGLE_OFFSET; - } - } - else - { - if (in_front($pb)) - { - # start in back, end in front - $pa = $ANGLE_OFFSET - 180; - } - else - { - # both in back - return; - } - } - - my ($x, $y) = cartesian( - $self->{w}/2, ($pa + $pb)/2, - $self->{xc}, $self->{yc}, $self->{h}/$self->{w} - ); - - push @fills, [$x, $y]; - - return @fills; -} - -# return true if this angle is on the front of the pie -# XXX UGLY! We need to leave a slight room for error because of rounding -# problems -sub in_front -{ - my $a = level_angle(shift); - return - $a > ($ANGLE_OFFSET - 180 + 0.00000001) && - $a < $ANGLE_OFFSET - 0.000000001; -} - -# XXX Ugh! I need to fix this. See the GD::Text module for better ways -# of doing this. -# return a value for angle between -180 and 180 -sub level_angle # (angle) -{ - my $a = shift; - return level_angle($a-360) if ( $a > 180 ); - return level_angle($a+360) if ( $a <= -180 ); - return $a; -} - -# put the slice label on the pie -sub put_slice_label -{ - my $self = shift; - my ($x, $y, $label) = @_; - - return unless defined $label; - - $self->{gdta_value}->set_text($label); - $self->{gdta_value}->draw($x, $y); -} - -# return x, y coordinates from input -# radius, angle, center x and y and a scaling factor (height/width) -# -# $ANGLE_OFFSET is used to define where 0 is meant to be -sub cartesian -{ - my ($r, $phi, $xi, $yi, $cr) = @_; - - return ( - $xi + $r * cos(PI * ($phi + $ANGLE_OFFSET)/180), - $yi + $cr * $r * sin(PI * ($phi + $ANGLE_OFFSET)/180) - ) -} - -"Just another true value"; diff --git a/lib/GD/Graph/pie3d.pm b/lib/GD/Graph/pie3d.pm deleted file mode 100644 index f1b0a76..0000000 --- a/lib/GD/Graph/pie3d.pm +++ /dev/null @@ -1,331 +0,0 @@ -############################################################ -# -# Module: GD::Graph::pie3d -# -# Description: -# This is merely a wrapper around GD::Graph::pie that forces -# the 3d option for pie charts. -# -# Created: 2000.Jan.19 by Jeremy Wadsack for Wadsack-Allen Digital Group -# Copyright (C) 2000,2001 Wadsack-Allen. All rights reserved. -############################################################ -# Date Modification Author -# ---------------------------------------------------------- -# 2000APR18 Modified to be compatible w/ GD::Graph 1.30 JW -# 2000APR24 Set default slice label color to black JW -# 2001Feb16 Added support for a legend JW -############################################################ -package GD::Graph::pie3d; - -use strict; -use GD; -use GD::Graph; -use GD::Graph::pie; -use GD::Graph::utils qw(:all); -use Carp; - -@GD::Graph::pie3d::ISA = qw( GD::Graph::pie ); -$GD::Graph::pie3d::VERSION = '0.63'; - -my %Defaults = ( - '3d' => 1, - axislabelclr => 'black', # values on slices. black because default colors use dblue - - # Size of the legend markers - legend_marker_height => 8, - legend_marker_width => 12, - legend_spacing => 4, - legend_placement => 'BC', # '[BR][LCR]' - lg_cols => undef, - legend_frame_margin => 4, - legend_frame_size => undef, -); - -# PRIVATE -# Have to include because this is a different %Defaults hash -sub _has_default { - my $self = shift; - my $attr = shift || return; - exists $Defaults{$attr} || $self->SUPER::_has_default($attr); -} - -sub initialise { - my $self = shift; - my $rc = $self->SUPER::initialise(); - - while( my($key, $val) = each %Defaults ) { - $self->{$key} = $val; - } # end while - - $self->set_legend_font(GD::gdTinyFont); - return $rc; -} # end initialise - -# Add lengend calc and draw code -sub plot -{ - my $self = shift; - my $data = shift; - - $self->check_data($data) or return; - $self->init_graph() or return; - $self->setup_text() or return; - $self->setup_legend(); - $self->setup_coords() or return; - $self->{b_margin} += 4 if $self->{label}; # Kludge for descenders - $self->draw_text() or return; - $self->draw_pie() or return; - $self->draw_data() or return; - $self->draw_legend(); - - return $self->{graph}; -} - -# Added legend stuff -sub setup_text -{ - my $self = shift; - - my $rc = $self->SUPER::setup_text( @_ ); - - $self->{gdta_legend}->set(colour => $self->{legendci}); - $self->{gdta_legend}->set_align('top', 'left'); - $self->{lgfh} = $self->{gdta_legend}->get('height'); - - return $rc -} # end setup_text - -# Inherit everything else from GD::Graph::pie - - -# Legend Support. Added 16.Feb.2001 - JW/WADG - -sub set_legend # List of legend keys -{ - my $self = shift; - $self->{legend} = [@_]; -} - -sub set_legend_font # (font name) -{ - my $self = shift; - $self->_set_font('gdta_legend', @_); -} - - - -# -# Legend -# -sub setup_legend -{ - my $self = shift; - - return unless defined $self->{legend}; - - my $maxlen = 0; - my $num = 0; - - # Save some variables - $self->{r_margin_abs} = $self->{r_margin}; - $self->{b_margin_abs} = $self->{b_margin}; - - foreach my $legend (@{$self->{legend}}) - { - if (defined($legend) and $legend ne "") - { - $self->{gdta_legend}->set_text($legend); - my $len = $self->{gdta_legend}->get('width'); - $maxlen = ($maxlen > $len) ? $maxlen : $len; - $num++; - } - # Legend for Pie goes over first set, and all points - last if $num >= $self->{_data}->num_points; - } - - $self->{lg_num} = $num; - - # calculate the height and width of each element - my $legend_height = _max($self->{lgfh}, $self->{legend_marker_height}); - - $self->{lg_el_width} = - $maxlen + $self->{legend_marker_width} + 3 * $self->{legend_spacing}; - $self->{lg_el_height} = $legend_height + 2 * $self->{legend_spacing}; - - my ($lg_pos, $lg_align) = split(//, $self->{legend_placement}); - - if ($lg_pos eq 'R') - { - # Always work in one column - $self->{lg_cols} = 1; - $self->{lg_rows} = $num; - - # Just for completeness, might use this in later versions - $self->{lg_x_size} = $self->{lg_cols} * $self->{lg_el_width}; - $self->{lg_y_size} = $self->{lg_rows} * $self->{lg_el_height}; - - # Adjust the right margin for the rest of the graph - $self->{r_margin} += $self->{lg_x_size}; - - # Adjust for frame if defined - if( $self->{legend_frame_size} ) { - $self->{r_margin} += 2 * ($self->{legend_frame_margin} + $self->{legend_frame_size}); - } # end if; - - # Set the x starting point - $self->{lg_xs} = $self->{width} - $self->{r_margin}; - - # Set the y starting point, depending on alignment - if ($lg_align eq 'T') - { - $self->{lg_ys} = $self->{t_margin}; - } - elsif ($lg_align eq 'B') - { - $self->{lg_ys} = $self->{height} - $self->{b_margin} - - $self->{lg_y_size}; - } - else # default 'C' - { - my $height = $self->{height} - $self->{t_margin} - - $self->{b_margin}; - - $self->{lg_ys} = - int($self->{t_margin} + $height/2 - $self->{lg_y_size}/2) ; - } - } - else # 'B' is the default - { - # What width can we use - my $width = $self->{width} - $self->{l_margin} - $self->{r_margin}; - - (!defined($self->{lg_cols})) and - $self->{lg_cols} = int($width/$self->{lg_el_width}); - - $self->{lg_cols} = _min($self->{lg_cols}, $num); - - $self->{lg_rows} = - int($num / $self->{lg_cols}) + (($num % $self->{lg_cols}) ? 1 : 0); - - $self->{lg_x_size} = $self->{lg_cols} * $self->{lg_el_width}; - $self->{lg_y_size} = $self->{lg_rows} * $self->{lg_el_height}; - - # Adjust the bottom margin for the rest of the graph - $self->{b_margin} += $self->{lg_y_size}; - # Adjust for frame if defined - if( $self->{legend_frame_size} ) { - $self->{b_margin} += 2 * ($self->{legend_frame_margin} + $self->{legend_frame_size}); - } # end if; - - # Set the y starting point - $self->{lg_ys} = $self->{height} - $self->{b_margin}; - - # Set the x starting point, depending on alignment - if ($lg_align eq 'R') - { - $self->{lg_xs} = $self->{width} - $self->{r_margin} - - $self->{lg_x_size}; - } - elsif ($lg_align eq 'L') - { - $self->{lg_xs} = $self->{l_margin}; - } - else # default 'C' - { - $self->{lg_xs} = - int($self->{l_margin} + $width/2 - $self->{lg_x_size}/2); - } - } -} - -sub draw_legend -{ - my $self = shift; - - return unless defined $self->{legend}; - - my $xl = $self->{lg_xs} + $self->{legend_spacing}; - my $y = $self->{lg_ys} + $self->{legend_spacing} - 1; - - # If there's a frame, offset by the size and margin - $xl += $self->{legend_frame_margin} + $self->{legend_frame_size} if $self->{legend_frame_size}; - $y += $self->{legend_frame_margin} + $self->{legend_frame_size} if $self->{legend_frame_size}; - - my $i = 0; - my $row = 1; - my $x = $xl; # start position of current element - - foreach my $legend (@{$self->{legend}}) - { - $i++; - # Legend for Pie goes over first set, and all points - last if $i > $self->{_data}->num_points; - - my $xe = $x; # position within an element - - next unless defined($legend) && $legend ne ""; - - $self->draw_legend_marker($i, $xe, $y); - - $xe += $self->{legend_marker_width} + $self->{legend_spacing}; - my $ys = int($y + $self->{lg_el_height}/2 - $self->{lgfh}/2); - - $self->{gdta_legend}->set_text($legend); - $self->{gdta_legend}->draw($xe, $ys); - - $x += $self->{lg_el_width}; - - if (++$row > $self->{lg_cols}) - { - $row = 1; - $y += $self->{lg_el_height}; - $x = $xl; - } - } - - # If there's a frame, draw it now - if( $self->{legend_frame_size} ) { - $x = $self->{lg_xs} + $self->{legend_spacing}; - $y = $self->{lg_ys} + $self->{legend_spacing} - 1; - - for $i ( 0 .. $self->{legend_frame_size} - 1 ) { - $self->{graph}->rectangle( - $x + $i, - $y + $i, - $x + $self->{lg_x_size} + 2 * $self->{legend_frame_margin} - $i - 1, - $y + $self->{lg_y_size} + 2 * $self->{legend_frame_margin} - $i - 1, - $self->{acci}, - ); - } # end for - } # end if - -} - -sub draw_legend_marker # data_set_number, x, y -{ - my $s = shift; - my $n = shift; - my $x = shift; - my $y = shift; - - my $g = $s->{graph}; - - my $ci = $s->set_clr($s->pick_data_clr($n)); - - $y += int($s->{lg_el_height}/2 - $s->{legend_marker_height}/2); - - $g->filledRectangle( - $x, $y, - $x + $s->{legend_marker_width}, $y + $s->{legend_marker_height}, - $ci - ); - - $g->rectangle( - $x, $y, - $x + $s->{legend_marker_width}, $y + $s->{legend_marker_height}, - $s->{acci} - ); -} - - -1; diff --git a/lib/GD/Graph/points.pm b/lib/GD/Graph/points.pm deleted file mode 100644 index 43b6825..0000000 --- a/lib/GD/Graph/points.pm +++ /dev/null @@ -1,183 +0,0 @@ -#========================================================================== -# Copyright (c) 1995-1998 Martien Verbruggen -#-------------------------------------------------------------------------- -# -# Name: -# GD::Graph::points.pm -# -# $Id: points.pm,v 1.13 2003/02/10 22:12:41 mgjv Exp $ -# -#========================================================================== - -package GD::Graph::points; - -($GD::Graph::points::VERSION) = '$Revision: 1.13 $' =~ /\s([\d.]+)/; - -use strict; - -use GD::Graph::axestype; -use GD::Graph::utils qw(:all); - -@GD::Graph::points::ISA = qw( GD::Graph::axestype ); - -# PRIVATE -sub draw_data_set -{ - my $self = shift; - my $ds = shift; - - my @values = $self->{_data}->y_values($ds) or - return $self->_set_error("Impossible illegal data set: $ds", - $self->{_data}->error); - - # Pick a colour - my $dsci = $self->set_clr($self->pick_data_clr($ds)); - my $type = $self->pick_marker($ds); - - for (my $i = 0; $i < @values; $i++) - { - next unless defined $values[$i]; - my ($xp, $yp); - if (defined($self->{x_min_value}) && defined($self->{x_max_value})) - { - ($xp, $yp) = $self->val_to_pixel( - $self->{_data}->get_x($i), $values[$i], $ds); - } - else - { - ($xp, $yp) = $self->val_to_pixel($i+1, $values[$i], $ds); - } - $self->marker($xp, $yp, $type, $dsci ); - $self->{_hotspots}->[$ds]->[$i] = - ['rect', $self->marker_coordinates($xp, $yp)]; - } - - return $ds; -} - -# Pick a marker type - -sub pick_marker # number -{ - my $self = shift; - my $num = shift; - - ref $self->{markers} ? - $self->{markers}[ $num % (1 + $#{$self->{markers}}) - 1 ] : - ($num % 8) || 8; -} - -# Draw a marker - -sub marker_coordinates -{ - my $self = shift; - my ($xp, $yp) = @_; - return ( - $xp - $self->{marker_size}, - $xp + $self->{marker_size}, - $yp + $self->{marker_size}, - $yp - $self->{marker_size}, - ); -} - -sub marker # $xp, $yp, $type, $colourindex -{ - my $self = shift; - my ($xp, $yp, $mtype, $mclr) = @_; - return unless defined $mclr; - - my ($l, $r, $b, $t) = $self->marker_coordinates($xp, $yp); - - MARKER: { - - ($mtype == 1) && do - { # Square, filled - $self->{graph}->filledRectangle($l, $t, $r, $b, $mclr); - last MARKER; - }; - ($mtype == 2) && do - { # Square, open - $self->{graph}->rectangle($l, $t, $r, $b, $mclr); - last MARKER; - }; - ($mtype == 3) && do - { # Cross, horizontal - $self->{graph}->line($l, $yp, $r, $yp, $mclr); - $self->{graph}->line($xp, $t, $xp, $b, $mclr); - last MARKER; - }; - ($mtype == 4) && do - { # Cross, diagonal - $self->{graph}->line($l, $b, $r, $t, $mclr); - $self->{graph}->line($l, $t, $r, $b, $mclr); - last MARKER; - }; - ($mtype == 5) && do - { # Diamond, filled - $self->{graph}->line($l, $yp, $xp, $t, $mclr); - $self->{graph}->line($xp, $t, $r, $yp, $mclr); - $self->{graph}->line($r, $yp, $xp, $b, $mclr); - $self->{graph}->line($xp, $b, $l, $yp, $mclr); - $self->{graph}->fillToBorder($xp, $yp, $mclr, $mclr); - last MARKER; - }; - ($mtype == 6) && do - { # Diamond, open - $self->{graph}->line($l, $yp, $xp, $t, $mclr); - $self->{graph}->line($xp, $t, $r, $yp, $mclr); - $self->{graph}->line($r, $yp, $xp, $b, $mclr); - $self->{graph}->line($xp, $b, $l, $yp, $mclr); - last MARKER; - }; - ($mtype == 7) && do - { # Circle, filled - $self->{graph}->arc($xp, $yp, 2 * $self->{marker_size}, - 2 * $self->{marker_size}, 0, 360, $mclr); - $self->{graph}->fillToBorder($xp, $yp, $mclr, $mclr); - last MARKER; - }; - ($mtype == 8) && do - { # Circle, open - $self->{graph}->arc($xp, $yp, 2 * $self->{marker_size}, - 2 * $self->{marker_size}, 0, 360, $mclr); - last MARKER; - }; - ($mtype == 9) && do - { # Horizontal line - $self->{graph}->line($l, $yp, $r, $yp, $mclr); - last MARKER; - }; - ($mtype == 10) && do - { # vertical line - $self->{graph}->line($xp, $t, $xp, $b, $mclr); - last MARKER; - }; - } -} - -sub draw_legend_marker -{ - my $self = shift; - my $n = shift; - my $x = shift; - my $y = shift; - - my $ci = $self->set_clr($self->pick_data_clr($n)); - - my $old_ms = $self->{marker_size}; - my $ms = _min($self->{legend_marker_height}, $self->{legend_marker_width}); - - ($self->{marker_size} > $ms/2) and $self->{marker_size} = $ms/2; - - $x += int($self->{legend_marker_width}/2); - $y += int($self->{lg_el_height}/2); - - $n = $self->pick_marker($n); - - $self->marker($x, $y, $n, $ci); - - $self->{marker_size} = $old_ms; -} - -"Just another true value"; diff --git a/lib/GD/Graph/utils.pm b/lib/GD/Graph/utils.pm deleted file mode 100644 index b24fc26..0000000 --- a/lib/GD/Graph/utils.pm +++ /dev/null @@ -1,49 +0,0 @@ -#========================================================================== -# Copyright (c) 1995-1999 Martien Verbruggen -#-------------------------------------------------------------------------- -# -# Name: -# GD::Graph::utils.pm -# -# Description: -# Package of general utilities. -# -# $Id: utils.pm,v 1.7 2003/02/10 22:12:41 mgjv Exp $ -# -#========================================================================== - -package GD::Graph::utils; - -($GD::Graph::utils::VERSION) = '$Revision: 1.7 $' =~ /\s([\d.]+)/; - -use strict; - -use vars qw( @EXPORT_OK %EXPORT_TAGS ); -require Exporter; - -@GD::Graph::utils::ISA = qw( Exporter ); - -@EXPORT_OK = qw(_max _min _round); -%EXPORT_TAGS = (all => [qw(_max _min _round)]); - -sub _max { - my ($a, $b) = @_; - return undef if (!defined($a) and !defined($b)); - return $a if (!defined($b)); - return $b if (!defined($a)); - ( $a >= $b ) ? $a : $b; -} - -sub _min { - my ($a, $b) = @_; - return undef if (!defined($a) and !defined($b)); - return $a if (!defined($b)); - return $b if (!defined($a)); - ( $a <= $b ) ? $a : $b; -} - -sub _round { sprintf "%.0f", shift } - -sub version { $GD::Graph::utils::VERSION } - -"Just another true value"; |