diff options
| author | Andreas Brachold <vdr07@deltab.de> | 2007-08-13 18:41:27 +0000 |
|---|---|---|
| committer | Andreas Brachold <vdr07@deltab.de> | 2007-08-13 18:41:27 +0000 |
| commit | bcbf441e09fb502cf64924ff2530fa144bdf52c5 (patch) | |
| tree | f377707a2dac078db8cd0c7d7abfe69ac1006d71 /lib/GD | |
| download | xxv-bcbf441e09fb502cf64924ff2530fa144bdf52c5.tar.gz xxv-bcbf441e09fb502cf64924ff2530fa144bdf52c5.tar.bz2 | |
* Move files to trunk
Diffstat (limited to 'lib/GD')
| -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 | ||||
| -rw-r--r-- | lib/GD/Graph3d.pm | 157 |
20 files changed, 5434 insertions, 0 deletions
diff --git a/lib/GD/Graph/Data.pm b/lib/GD/Graph/Data.pm new file mode 100644 index 0000000..23f4624 --- /dev/null +++ b/lib/GD/Graph/Data.pm @@ -0,0 +1,725 @@ +#========================================================================== +# 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 new file mode 100644 index 0000000..0d8e50c --- /dev/null +++ b/lib/GD/Graph/Error.pm @@ -0,0 +1,346 @@ +#========================================================================== +# 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 new file mode 100644 index 0000000..f6ed237 --- /dev/null +++ b/lib/GD/Graph/FAQ.pod @@ -0,0 +1,130 @@ +=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 new file mode 100644 index 0000000..a06f114 --- /dev/null +++ b/lib/GD/Graph/area.pm @@ -0,0 +1,112 @@ +#========================================================================== +# 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 new file mode 100644 index 0000000..7acb7f3 --- /dev/null +++ b/lib/GD/Graph/axestype3d.pm @@ -0,0 +1,787 @@ +#========================================================================== +# 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 new file mode 100644 index 0000000..2650351 --- /dev/null +++ b/lib/GD/Graph/bars.pm @@ -0,0 +1,372 @@ +#========================================================================== +# 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 new file mode 100644 index 0000000..5344976 --- /dev/null +++ b/lib/GD/Graph/bars3d.pm @@ -0,0 +1,349 @@ +#========================================================================== +# 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 new file mode 100644 index 0000000..8b25059 --- /dev/null +++ b/lib/GD/Graph/colour.pm @@ -0,0 +1,371 @@ +#========================================================================== +# 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 new file mode 100644 index 0000000..ba8ab86 --- /dev/null +++ b/lib/GD/Graph/cylinder.pm @@ -0,0 +1,126 @@ +# $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 new file mode 100644 index 0000000..7bc2490 --- /dev/null +++ b/lib/GD/Graph/cylinder3d.pm @@ -0,0 +1,30 @@ +############################################################
+#
+# 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 new file mode 100644 index 0000000..e2268b5 --- /dev/null +++ b/lib/GD/Graph/hbars.pm @@ -0,0 +1,71 @@ +#========================================================================== +# 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 new file mode 100644 index 0000000..2dac4dd --- /dev/null +++ b/lib/GD/Graph/lines.pm @@ -0,0 +1,182 @@ +#========================================================================== +# 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 new file mode 100644 index 0000000..dfd60c7 --- /dev/null +++ b/lib/GD/Graph/lines3d.pm @@ -0,0 +1,522 @@ +#========================================================================== +# 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 new file mode 100644 index 0000000..d913e2c --- /dev/null +++ b/lib/GD/Graph/linespoints.pm @@ -0,0 +1,46 @@ +#========================================================================== +# 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 new file mode 100644 index 0000000..daf192f --- /dev/null +++ b/lib/GD/Graph/mixed.pm @@ -0,0 +1,99 @@ +#========================================================================== +# 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 new file mode 100644 index 0000000..a945ba0 --- /dev/null +++ b/lib/GD/Graph/pie.pm @@ -0,0 +1,446 @@ +#========================================================================== +# 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 new file mode 100644 index 0000000..f1b0a76 --- /dev/null +++ b/lib/GD/Graph/pie3d.pm @@ -0,0 +1,331 @@ +############################################################ +# +# 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 new file mode 100644 index 0000000..43b6825 --- /dev/null +++ b/lib/GD/Graph/points.pm @@ -0,0 +1,183 @@ +#========================================================================== +# 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 new file mode 100644 index 0000000..b24fc26 --- /dev/null +++ b/lib/GD/Graph/utils.pm @@ -0,0 +1,49 @@ +#========================================================================== +# 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"; diff --git a/lib/GD/Graph3d.pm b/lib/GD/Graph3d.pm new file mode 100644 index 0000000..3795689 --- /dev/null +++ b/lib/GD/Graph3d.pm @@ -0,0 +1,157 @@ +#==========================================================================
+# Module: GD::Graph3d
+#
+# Copyright (C) 2000 Wadsack-Allen. All Rights Reserved.
+#
+#--------------------------------------------------------------------------
+# Date Modification Author
+# -------------------------------------------------------------------------
+# 08Nov2001 Re-sourced to use standard module files and structure.
+# The package is now GD-Graph3d which us what people expect JW
+#==========================================================================
+package GD::Graph3d;
+$GD::Graph3d::VERSION = '0.63';
+1;
+
+=head1 NAME
+
+GD::Graph3D - Create 3D Graphs with GD and GD::Graph
+
+=head1 SYNOPSIS
+
+ use GD::Graph::moduleName;
+ my @data = (
+ ["Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"],
+ [ 1203, 3500, 3973, 2859, 3012, 3423, 1230]
+ );
+ my $graph = new GD::Graph::moduleName( 400, 300 );
+ $graph->set(
+ x_label => 'Day of the week',
+ y_label => 'Number of hits',
+ title => 'Daily Summary of Web Site',
+ );
+ my $gd = $graph->plot( \@data );
+
+Where I<moduleName> is one of C<bars3d>, C<lines3d> or C<pie3d>.
+
+=head1 DESCRIPTION
+
+This is the GD::Graph3d extensions module. It provides 3D graphs for the
+GD::Graph module by Martien Verbruggen, which in turn generates graph
+using Lincoln Stein's GD.pm.
+
+You use these modules just as you would any of the GD::Graph modules, except
+that they generate 3d-looking graphs. Each graph type is described below
+with only the options that are unique to the 3d version. The modules are
+based on their 2d versions (e.g. GD::Graph::bars3d works like
+GD::Graph::bars), and support all the options in those. Make sure to read
+the documentation on GD::Graph.
+
+=over 4
+
+=item GD::Graph::pie3d
+
+This is merely a wrapper around GD::Graph::pie for consistency. It also
+sets 3d pie mode by default (which GD::Graph does as of version 1.22).
+All options are exactly as in GD::Graph::pie.
+
+=item GD::Graph::bars3d
+
+This works like GD::Graph::bars, but draws 3d bars. The following settings
+are new or changed in GD::Graph::bars3d.
+
+=over 4
+
+=item bar_depth
+
+Sets the z-direction depth of the bars. This defaults to 10. If you have a
+large number of bars or a small chart width, you may want to change this.
+A visually good value for this is approximately
+width_of_chart / number_of_bars.
+
+=item overwrite
+
+In GD::Graph::bars, multiple series of bars are normally drawn side-by-side.
+You can set overwrite to 1 to tell it to draw each series behind the
+previous one. By setting overwrite to 2 you can have them drawn on top of
+each other, that is the series are stacked.
+
+=item shading
+
+By default this is set to '1' and will shade and highlight the bars (and axes).
+The light source is at top-left-center which scan well for most computer
+users. You can disable the shading of bars and axes by specifying a false
+value for this option.
+
+=back
+
+=item GD::Graph::lines3d
+
+This works like GD::Graph::lines, but draws 3d line. The following settings
+are new or changed in GD::Graph::line3d.
+
+=over 4
+
+=item line_depth
+
+Sets the z-direction depth of the lines. This defaults to 10. If you have a
+large number of bars or a small chart width, you may want to change this.
+A visually good value for this is approximately
+width_of_chart / number_of_bars.
+
+=item shading
+
+By default this is set to '1' and will shade and highlight the line (and axes).
+The light source is at top-left-center which scan well for most computer
+users. You can disable the shading of lines and axes by specifiying a false
+value for this option.
+
+=back
+
+=back
+
+=head1 VERSION
+
+0.63 (6 December 2002)
+
+=head1 INSTALLATION
+
+You will need to have the GD::Graph version 1.30 or later installed. You should also
+have Perl version 5.005 or 5.6 installed.
+
+To install, just do the normal:
+
+ perl Makefile.PL
+ make
+ make install
+
+The documentation is in GD::Graph::Graph3d.pod.
+
+=head1 AUTHOR
+
+Jeremy Wadsack for Wadsack-Allen Digital Group.
+<F<dgsupport at wadsack-allen dot com>>
+
+Most of the modules are based on the GD::Graph modules by Martien Verbruggen.
+
+=head1 LATEST RELEASE
+
+The latest release is available from CPAN: http://www.cpan.org/.
+
+=head1 COPYRIGHT
+
+Copyright (c) 1999-2001 Wadsack-Allen. All rights reserved.
+
+Much of the original code is from GD::Graph:
+
+GIFgraph: Copyright (c) 1995-1999 Martien Verbruggen.
+
+Chart::PNGgraph: Copyright (c) 1999 Steve Bonds.
+
+GD::Graph: Copyright (c) 1999 Martien Verbruggen.
+
+This package is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+=cut
+
|
