File Coverage

blib/lib/Chart/Base.pm
Criterion Covered Total %
statement 1 3 33.3
branch n/a
condition n/a
subroutine 1 1 100.0
pod n/a
total 2 4 50.0


line stmt bran cond sub pod time code
1             ## @file
2             # Implementation of Chart::Base
3             #
4             # written by
5             # @author david bonner (dbonner@cs.bu.edu)
6             #
7             # maintained by the
8             # @author Chart Group at Geodetic Fundamental Station Wettzell (Chart@fs.wettzell.de)
9             # @date 2015-03-01
10             # @version 2.4.10
11              
12             ## @mainpage Chart::Base
13             #
14             # Basic Class of Chart from which all the other classes are derived.
15              
16             ## @class Chart::Base
17             # @brief Base class for Chart; all other classes derived from here
18             #
19             # Base class from which all other classes are derived.
20             # This class provides all functions which are common for
21             # all classes
22             package Chart::Base;
23              
24             # Uses
25             # GD
26             # Carp
27             # FileHandle
28 85     85   97975 use GD;
  0            
  0            
29             use Carp;
30             use FileHandle;
31             use Chart::Constants;
32             use GD::Image;
33              
34             $Chart::Base::VERSION = '2.4.10';
35              
36             use vars qw(%named_colors);
37             use strict;
38              
39             #>>>>>>>>>>>>>>>>>>>>>>>>>>#
40             # public methods go here #
41             #<<<<<<<<<<<<<<<<<<<<<<<<<<#
42              
43             ## @cmethod object new()
44             # @return A new object.
45             #
46             # @brief
47             # Standard normal constructor.\n
48             # Calls
49             # @see _init
50             sub new
51             {
52             my $proto = shift;
53             my $class = ref($proto) || $proto;
54             my $self = {};
55              
56             bless $self, $class;
57             $self->_init(@_);
58              
59             return $self;
60             }
61              
62             ## @method int set(%opts)
63             # Set all options
64             #
65             # @details
66             # main method for customizing the chart, lets users
67             # specify values for different parameters\n
68             # The options are saved locally to be able to output them
69             # via @see getopts()
70             #
71             # @param[in] opts Hash of options to the Chart
72             # @return ok or croak
73             #
74             sub set
75             {
76             my $self = shift;
77             my %opts = @_;
78              
79             # basic error checking on the options, just warn 'em
80             unless ( $#_ % 2 )
81             {
82             carp "Whoops, some option to be set didn't have a value.\n", "You might want to look at that.\n";
83             }
84              
85             # set the options
86             for ( keys %opts )
87             {
88             $self->{$_} = $opts{$_};
89             $self->{saveopts}->{$_} = $opts{$_};
90              
91             # if someone wants to change the grid_lines color, we should set all
92             # the colors of the grid_lines
93             if ( $_ =~ /^colors$/ )
94             {
95             my %hash = %{ $opts{$_} };
96             foreach my $key ( sort keys %hash )
97             {
98             if ( $key =~ /^grid_lines$/ )
99             {
100              
101             # ORIG:
102             #$self->{'colors'}{'y_grid_lines'} = $hash{'grid_lines'},
103             # $self->{'colors'}{'x_grid_lines'} = $hash{'grid_lines'},
104             # $self->{'colors'}{'y2_grid_lines'} = $hash{'grid_lines'};
105             #
106             # NEW!!!!!!!!!!!!!!!!!!
107             if ( ref( $hash{'grid_lines'} ) eq 'ARRAY' )
108             {
109             my @aLocal = ( $hash{'grid_lines'}[0], $hash{'grid_lines'}[1], $hash{'grid_lines'}[2] );
110             $self->{'colors'}{'y_grid_lines'} = [@aLocal];
111             $self->{'colors'}{'x_grid_lines'} = [@aLocal];
112             $self->{'colors'}{'y2_grid_lines'} = [@aLocal];
113             }
114             elsif ( ref( \$hash{'grid_lines'} ) eq 'SCALAR' )
115             {
116             my $sLocal = $hash{'grid_lines'};
117             $self->{'colors'}{'y_grid_lines'} = $sLocal;
118             $self->{'colors'}{'x_grid_lines'} = $sLocal;
119             $self->{'colors'}{'y2_grid_lines'} = $sLocal;
120             }
121             else
122             {
123             carp "colors{'grid_lines'} is not SCALAR and not ARRAY\n";
124             }
125             }
126             }
127             }
128             }
129              
130             # now return
131             return 1;
132             }
133              
134             ## @method hash getopts()
135             # @return hash of all set options so far
136             #
137             # @brief
138             # get all options
139             #
140             # @details
141             # @return set options as a hash
142             sub getopts
143             {
144             my $self = shift;
145             my %opts = ();
146              
147             foreach ( keys %{ $self->{saveopts} } )
148             {
149             $opts{$_} = $self->{saveopts};
150             }
151             return %opts;
152             }
153              
154             ## @method int add_pt(@data)
155             # Graph API\n
156             # Add one dataset (as a list) to the dataref
157             #
158             # @param data Dataset to add
159              
160             ## @method add_pt(\\\@data)
161             # Graph API\n
162             # Add one dataset (as a reference to a list) to the dataref
163             # via
164             #
 
165             # for ( 0 .. $#data )
166             # {
167             # push @{ $self->{'dataref'}->[$_] }, $data[$_];
168             # }
169             #
170             #
171             # @param data Dataset to add
172             #
173             sub add_pt
174             {
175             my $self = shift;
176             my @data = ();
177              
178             if ( ( ref $_[0] ) =~ /^ARRAY/ )
179             {
180             my $rdata = shift;
181             @data = @$rdata if @$rdata;
182             }
183             elsif ( ( ref \$_[0] ) =~ /^SCALAR/ )
184             {
185             if ( defined $_[0] )
186             {
187             @data = @_;
188             }
189             }
190             else
191             {
192             croak "Not an array or reference to array";
193             }
194              
195             # error check the data (carp, don't croak)
196             if ( $self->{'dataref'} && ( $#{ $self->{'dataref'} } != $#data ) )
197             {
198             carp "New point to be added has an incorrect number of data sets";
199             return 0;
200             }
201              
202             # copy it into the dataref
203             for ( 0 .. $#data )
204             {
205             push @{ $self->{'dataref'}->[$_] }, $data[$_];
206             }
207              
208             # now return
209             return 1;
210             }
211              
212             ## @method int add_dataset(@data)
213             # Graph API\n
214             # Add many datasets (implemented as a list)
215             # to the dataref,
216             #
217             # @param data Dataset (list) to add
218              
219             ## @method int add_dataset(\\\@data)
220             # Graph API\n
221             # Add many datasets (implemented as a references to alist)
222             # to the dataref,
223             #
224             # @param data Dataset (reference to a list) to add
225             sub add_dataset
226             {
227             my $self = shift;
228             my @data = ();
229              
230             if ( ( ref $_[0] ) =~ /^ARRAY/ )
231             {
232             my $rdata = shift;
233             @data = @$rdata if @$rdata;
234             }
235             elsif ( ( ref \$_[0] ) =~ /^SCALAR/ )
236             {
237             if ( defined $_[0] )
238             {
239             @data = @_;
240             }
241             }
242             else
243             {
244             croak "Not an array or reference to array";
245             return;
246             }
247              
248             # error check the data (carp, don't croak)
249             if ( $self->{'dataref'} && ( $#{ $self->{'dataref'}->[0] } != $#data ) )
250             {
251             carp "New data set to be added has an incorrect number of points";
252             }
253              
254             # copy it into the dataref
255             push @{ $self->{'dataref'} }, [@data];
256              
257             # now return
258             return 1;
259             }
260              
261             ## @method int add_datafile($filename,$format)
262             # Graph API\n
263             # it's also possible to add a complete datafile\n
264             # Uses
265             # @see add_pt
266             # @see add_dataset
267             #
268             # @param[in] filename Name of file which contents is to be added
269             # @param[in] format 'pt' or 'set' to distiguish between function add_pt() in case of 'pt'
270             # or function add_dataset() in case of 'set'
271             sub add_datafile
272             {
273             my $self = shift;
274             my $filename = shift;
275             my $format = shift;
276             my ( $File, @array );
277              
278             # do some ugly checking to see if they gave me
279             # a filehandle or a file name
280             if ( ( ref \$filename ) eq 'SCALAR' )
281             {
282              
283             # they gave me a file name
284             open( $File, $filename ) or croak "Can't open the datafile: $filename.\n";
285             }
286             elsif ( ( ref \$filename ) =~ /^(?:REF|GLOB)$/ )
287             {
288              
289             # either a FileHandle object or a regular file handle
290             $File = $filename;
291             }
292             else
293             {
294             carp "I'm not sure what kind of datafile you gave me,\n", "but it wasn't a filename or a filehandle.\n";
295             }
296              
297             #add the data
298             while (<$File>)
299             {
300             @array = split;
301             if ( $#array > -1 )
302             {
303             if ( $format =~ m/^pt$/i )
304             {
305             $self->add_pt(@array);
306             }
307             elsif ( $format =~ m/^set$/i )
308             {
309             $self->add_dataset(@array);
310             }
311             else
312             {
313             carp "Tell me what kind of file you gave me: 'pt' or 'set'\n";
314             }
315             }
316             }
317             close($File);
318             }
319              
320             ## @method int clear_data()
321             # Clear Graph API (by undefining 'dataref'
322             # @return Status of function
323             sub clear_data
324             {
325             my $self = shift;
326              
327             # undef the internal data reference
328             $self->{'dataref'} = undef;
329              
330             # now return
331             return 1;
332             }
333              
334             ## @method arrayref get_data()
335             # Get array of data of the last graph
336             # @return Reference to data set of the last graph
337             sub get_data
338             {
339             my $self = shift;
340             my $ref = [];
341             my ( $i, $j );
342              
343             # give them a copy, not a reference into the object
344             for $i ( 0 .. $#{ $self->{'dataref'} } )
345             {
346             @{ $ref->[$i] } = @{ $self->{'dataref'}->[$i] }
347             ## speedup, compared to...
348             # for $j (0..$#{$self->{'dataref'}->[$i]}) {
349             # $ref->[$i][$j] = $self->{'dataref'}->[$i][$j];
350             # }
351             }
352              
353             # return it
354             return $ref;
355             }
356              
357             ## @method int png($file, $dataref)
358             # Produce the graph of options set in png format.
359             #
360             # called after the options are set, this method
361             # invokes all my private methods to actually
362             # draw the chart and plot the data
363             # @see _set_colors
364             # @see _copy_data
365             # @see _check_data
366             # @see _draw
367             # @param[in] file Name of file to write graph to
368             # @param[in] dataref Reference to external data space
369             # @return Status of the plot
370             sub png
371             {
372             my $self = shift;
373             my $file = shift;
374             my $dataref = shift;
375             my $fh;
376              
377             # do some ugly checking to see if they gave me
378             # a filehandle or a file name
379             if ( ( ref \$file ) eq 'SCALAR' )
380             {
381              
382             # they gave me a file name
383             # Try to delete an existing file
384             if ( -f $file )
385             {
386             my $number_deleted_files = unlink $file;
387             if ( $number_deleted_files != 1 )
388             {
389             croak "Error: File \"$file\" did already exist, but it failed to delete it";
390             }
391             }
392             $fh = FileHandle->new(">$file");
393             if ( !defined $fh )
394             {
395             croak "Error: File \"$file\" could not be created!\n";
396             }
397             }
398             elsif ( ( ref \$file ) =~ /^(?:REF|GLOB)$/ )
399             {
400              
401             # either a FileHandle object or a regular file handle
402             $fh = $file;
403             }
404             else
405             {
406             croak "I'm not sure what you gave me to write this png to,\n", "but it wasn't a filename or a filehandle.\n";
407             }
408              
409             # allocate the background color
410             $self->_set_colors();
411              
412             # make sure the object has its copy of the data
413             $self->_copy_data($dataref);
414              
415             # do a sanity check on the data, and collect some basic facts
416             # about the data
417             $self->_check_data();
418              
419             # pass off the real work to the appropriate subs
420             $self->_draw();
421              
422             # now write it to the file handle, and don't forget
423             # to be nice to the poor ppl using nt
424             binmode $fh;
425              
426             print $fh $self->{'gd_obj'}->png();
427              
428             # now exit
429             return 1;
430             }
431              
432             ## @method int cgi_png($dataref)
433             # Produce the graph of options set in png format to be directly
434             # written for CGI.
435             #
436             # called after the options are set, this method
437             # invokes all my private methods to actually
438             # draw the chart and plot the data
439             # @param[in] dataref Reference to external data space
440             # @return Status of the plot
441             sub cgi_png
442             {
443             my $self = shift;
444             my $dataref = shift;
445              
446             # allocate the background color
447             $self->_set_colors();
448              
449             # make sure the object has its copy of the data
450             $self->_copy_data($dataref);
451              
452             # do a sanity check on the data, and collect some basic facts
453             # about the data
454             $self->_check_data();
455              
456             # pass off the real work to the appropriate subs
457             $self->_draw();
458              
459             # print the header (ripped the crlf octal from the CGI module)
460             if ( $self->true( $self->{no_cache} ) )
461             {
462             print "Content-type: image/png\015\012Pragma: no-cache\015\012\015\012";
463             }
464             else
465             {
466             print "Content-type: image/png\015\012\015\012";
467             }
468              
469             # now print the png, and binmode it first so Windows-XX likes us
470             binmode STDOUT;
471             print STDOUT $self->{'gd_obj'}->png();
472              
473             # now exit
474             return 1;
475             }
476              
477             ## @method int scalar_png($dataref)
478             # Produce the graph of options set in PNG format to be directly returned
479             #
480             # called after the options are set, this method
481             # invokes all my private methods to actually
482             # draw the chart and return the image to the caller
483             #
484             # @param dataref Reference to data
485             # @return returns the png image as a scalar value, so that
486             # the programmer-user can do whatever the heck
487             # s/he wants to with it
488             sub scalar_png
489             {
490             my $self = shift;
491             my $dataref = shift;
492              
493             #allocate the background color
494             $self->_set_colors();
495              
496             # make sure the object has its copy of the data
497             $self->_copy_data($dataref);
498              
499             # do a sanity check on the data, and collect some basic facts
500             # about the data
501             $self->_check_data();
502              
503             # pass off the real work to the appropriate subs
504             $self->_draw();
505              
506             # returns the png image as a scalar value, so that
507             # the programmer/user can do whatever the she/he wants to with it
508             return $self->{'gd_obj'}->png();
509             }
510              
511             ## @method int jpeg($file,$dataref)
512             # Produce the graph of options set in JPG format to be directly plotted.\n
513             #
514             # Called after the options are set, this method
515             # invokes all my private methods to actually
516             # draw the chart and plot the data.
517             # The output has the jpeg format in opposite to png format produced by
518             # @see png
519             #
520             # Uses the following private functions:\n
521             # @see _set_colors
522             # @see _copy_data
523             # @see _check_data
524             # @see _draw
525             #
526             # @param[in] file Name of file to write graph to
527             # @param[in] dataref Reference to external data space
528             # @return Status of the plot
529             #
530             sub jpeg
531             {
532             my $self = shift;
533             my $file = shift;
534             my $dataref = shift;
535             my $fh;
536              
537             # do some ugly checking to see if they gave me
538             # a filehandle or a file name
539             if ( ( ref \$file ) eq 'SCALAR' )
540             {
541              
542             # they gave me a file name
543             # Try to delete an existing file
544             if ( -f $file )
545             {
546             my $number_deleted_files = unlink $file;
547             if ( $number_deleted_files != 1 )
548             {
549             croak "Error: File \"$file\" did already exist, but it fails to delete it";
550             }
551             }
552             $fh = FileHandle->new(">$file");
553             if ( !defined $fh )
554             {
555             croak "Error: File \"$file\" could not be created!\n";
556             }
557             }
558             elsif ( ( ref \$file ) =~ /^(?:REF|GLOB)$/ )
559             {
560              
561             # either a FileHandle object or a regular file handle
562             $fh = $file;
563             }
564             else
565             {
566             croak "I'm not sure what you gave me to write this jpeg to,\n", "but it wasn't a filename or a filehandle.\n";
567             }
568              
569             # allocate the background color
570             $self->_set_colors();
571              
572             # make sure the object has its copy of the data
573             $self->_copy_data($dataref);
574              
575             # do a sanity check on the data, and collect some basic facts
576             # about the data
577             $self->_check_data;
578              
579             # pass off the real work to the appropriate subs
580             $self->_draw();
581              
582             # now write it to the file handle, and don't forget
583             # to be nice to the poor ppl using Windows-XX
584             binmode $fh;
585             print $fh $self->{'gd_obj'}->jpeg( [100] ); # high quality need
586              
587             # now exit
588             return 1;
589             }
590              
591             ## @method int cgi_jpeg($dataref)
592             # Produce the graph of options set in JPG format to be directly
593             # for CGI.
594             #
595             # called after the options are set, this method
596             # invokes all my private methods to actually
597             # draw the chart and plot the data
598             # @param[in] dataref Reference to external data space
599             # @return Status of the plot
600             sub cgi_jpeg
601             {
602             my $self = shift;
603             my $dataref = shift;
604              
605             # allocate the background color
606             $self->_set_colors();
607              
608             # make sure the object has its copy of the data
609             $self->_copy_data($dataref);
610              
611             # do a sanity check on the data, and collect some basic facts
612             # about the data
613             $self->_check_data();
614              
615             # pass off the real work to the appropriate subs
616             $self->_draw();
617              
618             # print the header (ripped the crlf octal from the CGI module)
619             if ( $self->true( $self->{no_cache} ) )
620             {
621             print "Content-type: image/jpeg\015\012Pragma: no-cache\015\012\015\012";
622             }
623             else
624             {
625             print "Content-type: image/jpeg\015\012\015\012";
626             }
627              
628             # now print the jpeg, and binmode it first so Windows-XX likes us
629             binmode STDOUT;
630             print STDOUT $self->{'gd_obj'}->jpeg( [100] );
631              
632             # now exit
633             return 1;
634             }
635              
636             ## @method int scalar_jpeg($dataref)
637             # Produce the graph of options set in JPG format to be directly returned
638             #
639             # called after the options are set, this method
640             # invokes all my private methods to actually
641             # draw the chart and return the image to the caller
642             #
643             # @param dataref Reference to data area
644             # @return returns the jpeg image as a scalar value, so that
645             # the programmer-user can do whatever the heck
646             # s/he wants to with it
647             sub scalar_jpeg
648             {
649             my $self = shift;
650             my $dataref = shift;
651              
652             # allocate the background color
653             $self->_set_colors();
654              
655             # make sure the object has its copy of the data
656             $self->_copy_data($dataref);
657              
658             # do a sanity check on the data, and collect some basic facts
659             # about the data
660             $self->_check_data();
661              
662             # pass off the real work to the appropriate subs
663             $self->_draw();
664              
665             # returns the jpeg image as a scalar value, so that
666             # the programmer-user can do whatever the heck
667             # s/he wants to with it
668             $self->{'gd_obj'}->jpeg( [100] );
669             }
670              
671             ## @method int make_gd($dataref)
672             # Produce the graph of options set in GD format to be directly
673             #
674             # called after the options are set, this method
675             # invokes all my private methods to actually
676             # draw the chart and plot the data
677             # @param dataref Reference to data
678             # @return Status of the plot
679             sub make_gd
680             {
681             my $self = shift;
682             my $dataref = shift;
683              
684             # allocate the background color
685             $self->_set_colors();
686              
687             # make sure the object has its copy of the data
688             $self->_copy_data($dataref);
689              
690             # do a sanity check on the data, and collect some basic facts
691             # about the data
692             $self->_check_data();
693              
694             # pass off the real work to the appropriate subs
695             $self->_draw();
696              
697             # return the GD::Image object that we've drawn into
698             return $self->{'gd_obj'};
699             }
700              
701             ## @method imagemap_dump()
702             # get the information to turn the chart into an imagemap
703             #
704             # @return Reference to an array of the image
705             sub imagemap_dump
706             {
707             my $self = shift;
708             my $ref = [];
709             my ( $i, $j );
710              
711             # croak if they didn't ask me to remember the data, or if they're asking
712             # for the data before I generate it
713             unless ( ( $self->true( $self->{'imagemap'} ) ) && $self->{'imagemap_data'} )
714             {
715             croak "You need to set the imagemap option to true, and then call the png method, before you can get the imagemap data";
716             }
717              
718             # can't just return a ref to my internal structures...
719             for $i ( 0 .. $#{ $self->{'imagemap_data'} } )
720             {
721             for $j ( 0 .. $#{ $self->{'imagemap_data'}->[$i] } )
722             {
723             $ref->[$i][$j] = [ @{ $self->{'imagemap_data'}->[$i][$j] } ];
724             }
725             }
726              
727             # return their copy
728             return $ref;
729             }
730              
731             ## @method minimum (@array)
732             # determine minimum of an array of values
733             # @param array List of numerical values (\@array)
734             # @return Minimal value of list of values
735             sub minimum
736             {
737             my $self = shift;
738             my @array = @_;
739              
740             return undef if !@array;
741             my $min = $array[0];
742             for ( my $iIndex = 0 ; $iIndex < scalar @array ; $iIndex++ )
743             {
744             $min = $array[$iIndex] if ( $min > $array[$iIndex] );
745             }
746             $min;
747             }
748              
749             ## @method maximum(@array)
750             # determine maximum of an array of values
751             # @param array List of numerical values (@array)
752             # @return Maximal value of list of values
753             sub maximum
754             {
755             my $self = shift;
756             my @array = @_;
757              
758             return undef if !@array;
759             my $max = $array[0];
760             for ( my $iIndex = 0 ; $iIndex < scalar @array ; $iIndex++ )
761             {
762             $max = $array[$iIndex] if ( $max < $array[$iIndex] );
763             }
764             $max;
765             }
766              
767             ## @method arccos($a)
768             # Function arccos(a)
769             # @param a Value
770             # @return arccos(a)
771             sub arccos
772             {
773             my $self = shift;
774             my $a = shift;
775              
776             return ( atan2( sqrt( 1 - $a * $a ), $a ) );
777             }
778              
779             ## @method arcsin($a)
780             # Function arcsin(a)
781             # @param a Value
782             # @return arcsin(a)
783             sub arcsin
784             {
785             my $self = shift;
786             my $a = shift;
787              
788             return ( atan2( $a, sqrt( 1 - $a * $a ) ) );
789             }
790              
791             ## @method true($arg)
792             # determine true value of argument
793             # @param[in] arg Bool value to check for true
794             # @return 1 if argument is equal to TRUE, true, 1, t, T, and defined
795             sub true
796             {
797             my $pkg = shift;
798             my $arg = shift;
799              
800             if ( !defined($arg) )
801             {
802             return 0;
803             }
804              
805             if ( $arg eq 'true'
806             || $arg eq 'TRUE'
807             || $arg eq 't'
808             || $arg eq 'T'
809             || $arg eq '1' )
810             {
811             return 1;
812             }
813              
814             return 0;
815             }
816              
817             ## @method false($arg)
818             # determine false value of argument
819             # @param[in] arg Bool value to check for true
820             # @return 1 if argument is equal to false, FALSE, 0, f, F or undefined
821             sub false
822             {
823             my $pkg = shift;
824             my $arg = shift;
825              
826             if ( !defined($arg) )
827             {
828             return 1;
829             }
830              
831             if ( $arg eq 'false'
832             || $arg eq 'FALSE'
833             || $arg eq 'f'
834             || $arg eq 'F'
835             || $arg eq '0'
836             || $arg eq 'none' )
837             {
838             return 1;
839             }
840              
841             return 0;
842             }
843              
844             ## @method modulo($a,$b)
845             # Calculate float($a % $b) as the internal operator '%'
846             # does only calculate in integers
847             # @param[in] a a in a%b
848             # @param[in] b b in a%b
849             # @return $a % $b in float
850             sub modulo
851             {
852             my $pkg = shift;
853             my $a = shift;
854             my $b = shift;
855              
856             my $erg = 0.0;
857              
858             if ( !defined($a) || !defined($b) || $b == 0 )
859             {
860             die "Modulo needs valid parameters!"
861              
862             #return $erg;
863             }
864              
865             my $div = $a / $b;
866              
867             $erg = $a - int($div) * $b;
868              
869             return $erg;
870             }
871              
872             #>>>>>>>>>>>>>>>>>>>>>>>>>>>#
873             # private methods go here #
874             #<<<<<<<<<<<<<<<<<<<<<<<<<<<#
875              
876             ## @fn private int _init($x,$y)
877             # Initialize all default options here
878             # @param[in] x Width of the final image in pixels (Default: 400)
879             # @param[in] y Height of the final image in pixels (Default: 300)
880             #
881             sub _init
882             {
883             my $self = shift;
884             my $x = shift || 400; # give them a 400x300 image
885             my $y = shift || 300; # unless they say otherwise
886              
887             # get the gd object
888              
889             # Reference to new GD::Image
890             $self->{'gd_obj'} = GD::Image->new( $x, $y );
891              
892             # start keeping track of used space
893             # actual current y min Value
894             $self->{'curr_y_min'} = 0;
895             $self->{'curr_y_max'} = $y; # maximum pixel in y direction (down)
896             $self->{'curr_x_min'} = 0;
897             $self->{'curr_x_max'} = $x; # maximum pixel in x direction (right)
898              
899             # use a 10 pixel border around the whole png
900             $self->{'png_border'} = 10;
901              
902             # leave some space around the text fields
903             $self->{'text_space'} = 2;
904              
905             # and leave some more space around the chart itself
906             $self->{'graph_border'} = 10;
907              
908             # leave a bit of space inside the legend box
909             $self->{'legend_space'} = 4;
910              
911             # set some default fonts
912             $self->{'title_font'} = gdLargeFont,
913             $self->{'sub_title_font'} = gdLargeFont,
914             $self->{'legend_font'} = gdSmallFont,
915             $self->{'label_font'} = gdMediumBoldFont,
916             $self->{'tick_label_font'} = gdSmallFont;
917              
918             # put the legend on the bottom of the chart
919             $self->{'legend'} = 'right';
920              
921             # default to an empty list of labels
922             $self->{'legend_labels'} = [];
923              
924             # use 20 pixel length example lines in the legend
925             $self->{'legend_example_size'} = 20;
926              
927             # Set the maximum & minimum number of ticks to use.
928             $self->{'y_ticks'} = 6,
929             $self->{'min_y_ticks'} = 6,
930             $self->{'max_y_ticks'} = 100,
931             $self->{'x_number_ticks'} = 1,
932             $self->{'min_x_ticks'} = 6,
933             $self->{'max_x_ticks'} = 100;
934              
935             # make the ticks 4 pixels long
936             $self->{'tick_len'} = 4;
937              
938             # no custom y tick labels
939             $self->{'y_tick_labels'} = undef;
940              
941             # no patterns
942             $self->{'patterns'} = undef;
943              
944             # let the lines in Chart::Lines be 6 pixels wide
945             $self->{'brush_size'} = 6;
946              
947             # let the points in Chart::Points and Chart::LinesPoints be 18 pixels wide
948             $self->{'pt_size'} = 18;
949              
950             # use the old non-spaced bars
951             $self->{'spaced_bars'} = 'true';
952              
953             # use the new grey background for the plots
954             $self->{'grey_background'} = 'true';
955              
956             # don't default to transparent
957             $self->{'transparent'} = 'false';
958              
959             # default to "normal" x_tick drawing
960             $self->{'x_ticks'} = 'normal';
961              
962             # we're not a component until Chart::Composite says we are
963             $self->{'component'} = 'false';
964              
965             # don't force the y-axes in a Composite chare to be the same
966             $self->{'same_y_axes'} = 'false';
967              
968             # plot rectangeles in the legend instead of lines in a composite chart
969             $self->{'legend_example_height'} = 'false';
970              
971             # don't force integer y-ticks
972             $self->{'integer_ticks_only'} = 'false';
973              
974             # don't forbid a false zero scale.
975             $self->{'include_zero'} = 'false';
976              
977             # don't waste time/memory by storing imagemap info unless they ask
978             $self->{'imagemap'} = 'false';
979              
980             # default for grid_lines is off
981             $self->{grid_lines} = 'false',
982             $self->{x_grid_lines} = 'false',
983             $self->{y_grid_lines} = 'false',
984             $self->{y2_grid_lines} = 'false';
985              
986             # default for no_cache is false. (it breaks netscape 4.5)
987             $self->{no_cache} = 'false';
988              
989             # default value for skip_y_ticks for the labels
990             $self->{skip_y_ticks} = 1;
991              
992             # default value for skip_int_ticks only for integer_ticks_only
993             $self->{skip_int_ticks} = 1;
994              
995             # default value for precision
996             $self->{precision} = 3;
997              
998             # default value for legend label values in pie charts
999             $self->{legend_label_values} = 'value';
1000              
1001             # default value for the labels in a pie chart
1002             $self->{label_values} = 'percent';
1003              
1004             # default position for the y-axes
1005             $self->{y_axes} = 'left';
1006              
1007             # copies of the current values at the x-ticks function
1008             $self->{temp_x_min} = 0;
1009             $self->{temp_x_max} = 0;
1010             $self->{temp_y_min} = 0;
1011             $self->{temp_y_max} = 0;
1012              
1013             # Instance for a sum
1014             $self->{sum} = 0;
1015              
1016             # Don't sort the data unless they ask
1017             $self->{'sort'} = 'false';
1018              
1019             # The Interval for drawing the x-axes in the split module
1020             $self->{'interval'} = undef;
1021              
1022             # The start value for the split chart
1023             $self->{'start'} = undef;
1024              
1025             # How many ticks do i have to draw at the x-axes in one interval of a split-plot?
1026             $self->{'interval_ticks'} = 6;
1027              
1028             # Draw the Lines in the split-chart normal
1029             $self->{'scale'} = 1;
1030              
1031             # Make a x-y plot
1032             $self->{'xy_plot'} = 'false';
1033              
1034             # min and max for xy plot
1035             $self->{'x_min_val'} = 1;
1036             $self->{'x_max_val'} = 1;
1037              
1038             # use the same error value in ErrorBars
1039             $self->{'same_error'} = 'false';
1040              
1041             # Set the minimum and maximum number of circles to draw in a direction chart
1042             $self->{'min_circles'} = 4, $self->{'max_circles'} = 100;
1043              
1044             # set the style of a direction diagramm
1045             $self->{'point'} = 'true', $self->{'line'} = 'false', $self->{'arrow'} = 'false';
1046              
1047             # The number of angel axes in a direction Chart
1048             $self->{'angle_interval'} = 30;
1049              
1050             # dont use different 'x_axes' in a direction Chart
1051             $self->{'pairs'} = 'false';
1052              
1053             # polarplot for a direction Chart (not yet tested)
1054             $self->{'polar'} = 'false';
1055              
1056             # guiding lines in a Pie Chart
1057             $self->{'legend_lines'} = 'false';
1058              
1059             # Ring Chart instead of Pie
1060             $self->{'ring'} = 1; # width of ring; i.e. normal pie
1061              
1062             # stepline for Lines, LinesPoints
1063             $self->{'stepline'} = 'false';
1064             $self->{'stepline_mode'} = 'end'; # begin, end
1065              
1066             # used function to transform x- and y-tick labels to strings
1067             $self->{f_x_tick} = \&_default_f_tick, $self->{f_y_tick} = \&_default_f_tick, $self->{f_z_tick} = \&_default_f_tick;
1068              
1069             # default color specs for various color roles.
1070             # Subclasses should extend as needed.
1071             my $d = 0;
1072             $self->{'colors_default_spec'} = {
1073             background => 'white',
1074             misc => 'black',
1075             text => 'black',
1076             y_label => 'black',
1077             y_label2 => 'black',
1078             grid_lines => 'black',
1079             grey_background => 'grey',
1080             (
1081             map { 'dataset' . $d++ => $_ }
1082             qw (red green blue purple peach orange mauve olive pink light_purple light_blue plum yellow turquoise light_green brown
1083             HotPink PaleGreen1 DarkBlue BlueViolet orange2 chocolate1 LightGreen pink light_purple light_blue plum yellow turquoise light_green brown
1084             pink PaleGreen2 MediumPurple PeachPuff1 orange3 chocolate2 olive pink light_purple light_blue plum yellow turquoise light_green brown
1085             DarkOrange PaleGreen3 SlateBlue BlueViolet PeachPuff2 orange4 chocolate3 LightGreen pink light_purple light_blue plum yellow turquoise light_green brown
1086             snow1 honeydew3 SkyBlue1 cyan3 DarkOliveGreen1 IndianRed3
1087             orange1 LightPink3 MediumPurple1 snow3 LavenderBlush1 SkyBlue3
1088             DarkSlateGray1 DarkOliveGreen3 sienna1 orange3 PaleVioletRed1
1089             MediumPurple3 seashell1 LavenderBlush3 LightSkyBlue1
1090             DarkSlateGray3 khaki1 sienna3 DarkOrange1 PaleVioletRed3
1091             thistle1 seashell3 MistyRose1 LightSkyBlue3 aquamarine1 khaki3
1092             burlywood1 DarkOrange3 maroon1 thistle3 AntiqueWhite1
1093             MistyRose3 SlateGray1 aquamarine3 LightGoldenrod1 burlywood3
1094             coral1 maroon3 AntiqueWhite3 azure1 SlateGray3 DarkSeaGreen1
1095             LightGoldenrod3 wheat1 coral3 VioletRed1 bisque1 azure3
1096             LightSteelBlue1 DarkSeaGreen3 LightYellow1 wheat3 tomato1
1097             VioletRed3 bisque3 SlateBlue1 LightSteelBlue3 SeaGreen1
1098             LightYellow3 tan1 tomato3 magenta1 PeachPuff1 SlateBlue3
1099             LightBlue1 SeaGreen3 yellow1 tan3 OrangeRed1 magenta3
1100             PeachPuff3 RoyalBlue1 LightBlue3 PaleGreen1 yellow3 chocolate1
1101             OrangeRed3 orchid1 NavajoWhite1 RoyalBlue3 LightCyan1
1102             PaleGreen3 gold1 chocolate3 red1 orchid3 NavajoWhite3 blue1
1103             LightCyan3 SpringGreen1 gold3 firebrick1 red3 plum1
1104             LemonChiffon1 blue3 PaleTurquoise1 SpringGreen3 goldenrod1
1105             firebrick3 DeepPink1 plum3 LemonChiffon3 DodgerBlue1
1106             PaleTurquoise3 green1 goldenrod3 brown1 DeepPink3
1107             MediumOrchid1 cornsilk1 DodgerBlue3 CadetBlue1 green3
1108             DarkGoldenrod1 brown3 HotPink1 MediumOrchid3 cornsilk3
1109             SteelBlue1 CadetBlue3 chartreuse1 DarkGoldenrod3 salmon1
1110             HotPink3 DarkOrchid1 ivory1 SteelBlue3 turquoise1 chartreuse3
1111             RosyBrown1 salmon3 pink1 DarkOrchid3 ivory3 DeepSkyBlue1
1112             turquoise3 OliveDrab1 RosyBrown3 LightSalmon1 pink3 purple1
1113             honeydew1 DeepSkyBlue3 cyan1 OliveDrab3 IndianRed1
1114             LightSalmon3 LightPink1 purple3 honeydew2 DeepSkyBlue4 cyan2
1115             OliveDrab4 IndianRed2 LightSalmon4 LightPink2 purple4 snow2
1116             honeydew4 SkyBlue2 cyan4 DarkOliveGreen2 IndianRed4 orange2
1117             LightPink4 MediumPurple2 snow4 LavenderBlush2 SkyBlue4
1118             DarkSlateGray2 DarkOliveGreen4 sienna2 orange4 PaleVioletRed2
1119             MediumPurple4 seashell2 LavenderBlush4 LightSkyBlue2
1120             DarkSlateGray4 khaki2 sienna4 DarkOrange2 PaleVioletRed4
1121             thistle2 seashell4 MistyRose2 LightSkyBlue4 aquamarine2 khaki4
1122             burlywood2 DarkOrange4 maroon2 thistle4 AntiqueWhite2
1123             MistyRose4 SlateGray2 aquamarine4 LightGoldenrod2 burlywood4
1124             coral2 maroon4 AntiqueWhite4 azure2 SlateGray4 DarkSeaGreen2
1125             LightGoldenrod4 wheat2 coral4 VioletRed2 bisque2 azure4
1126             LightSteelBlue2 DarkSeaGreen4 LightYellow2 wheat4 tomato2
1127             VioletRed4 bisque4 SlateBlue2 LightSteelBlue4 SeaGreen2
1128             LightYellow4 tan2 tomato4 magenta2 PeachPuff2 SlateBlue4
1129             LightBlue2 SeaGreen4 yellow2 tan4 OrangeRed2 magenta4
1130             PeachPuff4 RoyalBlue2 LightBlue4 PaleGreen2 yellow4 chocolate2
1131             OrangeRed4 orchid2 NavajoWhite2 RoyalBlue4 LightCyan2
1132             PaleGreen4 gold2 chocolate4 red2 orchid4 NavajoWhite4 blue2
1133             LightCyan4 SpringGreen2 gold4 firebrick2 red4 plum2
1134             LemonChiffon2 blue4 PaleTurquoise2 SpringGreen4 goldenrod2
1135             firebrick4 DeepPink2 plum4 LemonChiffon4 DodgerBlue2
1136             PaleTurquoise4 green2 goldenrod4 brown2 DeepPink4
1137             MediumOrchid2 cornsilk2 DodgerBlue4 CadetBlue2 green4
1138             DarkGoldenrod2 brown4 HotPink2 MediumOrchid4 cornsilk4
1139             SteelBlue2 CadetBlue4 chartreuse2 DarkGoldenrod4 salmon2
1140             HotPink4 DarkOrchid2 ivory2 SteelBlue4 turquoise2 chartreuse4
1141             RosyBrown2 salmon4 pink2 DarkOrchid4 ivory4 DeepSkyBlue2
1142             turquoise4 OliveDrab2 RosyBrown4 LightSalmon2 pink4 purple2)
1143             ),
1144             };
1145              
1146             # get default color specs for some color roles from alternate role.
1147             # Subclasses should extend as needed.
1148             $self->{'colors_default_role'} = {
1149             'x_grid_lines' => 'grid_lines',
1150             'y_grid_lines' => 'grid_lines',
1151             'y2_grid_lines' => 'grid_lines', # should be added by Chart::Composite...
1152             };
1153              
1154             # Define style to plot dots in Points and Lines
1155             $self->{'brushStyle'} = 'FilledCircle';
1156              
1157             # and return
1158             return 1;
1159             }
1160              
1161             ## @fn private int _copy_data($extern_ref)
1162             # Copy external data via a reference to internal memory.
1163             #
1164             # Remember the external reference.\n
1165             # Therefore, this function can anly be called once!
1166             # @param extern_ref Reference to external data space
1167             sub _copy_data
1168             {
1169             my $self = shift;
1170             my $extern_ref = shift;
1171             my ( $ref, $i );
1172              
1173             # look to see if they used the other api
1174             if ( $self->{'dataref'} )
1175             {
1176              
1177             # we've already got a copy, thanks
1178             return 1;
1179             }
1180             else
1181             {
1182              
1183             # get an array reference
1184             $ref = [];
1185              
1186             # loop through and copy the external data to internal memory
1187             for $i ( 0 .. $#{$extern_ref} )
1188             {
1189             @{ $ref->[$i] } = @{ $extern_ref->[$i] };
1190             ## Speedup compared to:
1191             # for $j (0..$#{$extern_ref->[$i]}) {
1192             # $ref->[$i][$j] = $extern_ref->[$i][$j];
1193             # }
1194             }
1195              
1196             # put it in the object
1197             $self->{'dataref'} = $ref;
1198             return 1;
1199             }
1200             }
1201              
1202             ## @fn private int _check_data
1203             # Check the internal data to be displayed.
1204             #
1205             # Make sure the data isn't really weird
1206             # and collect some basic info about it\n
1207             # Not logical data is 'carp'ed.\n
1208             # @return status of check
1209             sub _check_data
1210             {
1211             my $self = shift;
1212             my $length = 0;
1213              
1214             # first make sure there's something there
1215             unless ( scalar( @{ $self->{'dataref'} } ) >= 2 )
1216             {
1217             croak "Call me again when you have some data to chart";
1218             }
1219              
1220             # make sure we don't end up dividing by zero if they ask for
1221             # just one y_tick
1222             if ( $self->{'y_ticks'} <= 1 )
1223             {
1224             $self->{'y_ticks'} = 2;
1225             carp "The number of y_ticks displayed must be at least 2";
1226             }
1227              
1228             # remember the number of datasets
1229             $self->{'num_datasets'} = $#{ $self->{'dataref'} };
1230              
1231             # remember the number of points in the largest dataset
1232             $self->{'num_datapoints'} = 0;
1233             for ( 0 .. $self->{'num_datasets'} )
1234             {
1235             if ( scalar( @{ $self->{'dataref'}[$_] } ) > $self->{'num_datapoints'} )
1236             {
1237             $self->{'num_datapoints'} = scalar( @{ $self->{'dataref'}[$_] } );
1238             }
1239             }
1240              
1241             # find good min and max y-values for the plot
1242             $self->_find_y_scale();
1243              
1244             # find the longest x-tick label
1245             $length = 0;
1246             for ( @{ $self->{'dataref'}->[0] } )
1247             {
1248             next if !defined($_);
1249             if ( length( $self->{f_x_tick}->($_) ) > $length )
1250             {
1251             $length = length( $self->{f_x_tick}->($_) );
1252             }
1253             }
1254             if ( $length <= 0 ) { $length = 1; } # make sure $length is positive and greater 0
1255              
1256             # now store it in the object
1257             $self->{'x_tick_label_length'} = $length;
1258              
1259             # find x-scale, if a x-y plot is wanted
1260             # makes only sense for some charts
1261             if (
1262             $self->true( $self->{'xy_plot'} )
1263             && ( $self->isa('Chart::Lines')
1264             || $self->isa('Chart::Points')
1265             || $self->isa('Chart::LinesPoints')
1266             || $self->isa('Chart::Split')
1267             || $self->isa('Chart::ErrorBars') )
1268             )
1269             {
1270             $self->_find_x_scale;
1271             }
1272              
1273             return 1;
1274             }
1275              
1276             ## @fn private int _draw
1277             # Plot the chart to the gd object\n
1278             # Calls:
1279             # @see _draw_title
1280             # @see _draw_sub_title
1281             # @see _sort_data
1282             # @see _plot
1283             #
1284             # @return status
1285             sub _draw
1286             {
1287             my $self = shift;
1288              
1289             # leave the appropriate border on the png
1290             $self->{'curr_x_max'} -= $self->{'png_border'};
1291             $self->{'curr_x_min'} += $self->{'png_border'};
1292             $self->{'curr_y_max'} -= $self->{'png_border'};
1293             $self->{'curr_y_min'} += $self->{'png_border'};
1294              
1295             # draw in the title
1296             $self->_draw_title() if $self->{'title'};
1297              
1298             # have to leave this here for backwards compatibility
1299             $self->_draw_sub_title() if $self->{'sub_title'};
1300              
1301             # sort the data if they want to (mainly here to make sure
1302             # pareto charts get sorted)
1303             $self->_sort_data() if ( $self->true( $self->{'sort'} ) );
1304              
1305             # start drawing the data (most methods in this will be
1306             # overridden by the derived classes)
1307             # include _draw_legend() in this to ensure that the legend
1308             # will be flush with the chart
1309             $self->_plot();
1310              
1311             # and return
1312             return 1;
1313             }
1314              
1315             ## @var Hash named_colors RGB values of named colors
1316             #
1317             # see URL http://en.wikipedia.org/wiki/Web_colors#X11_color_names
1318             our %named_colors = (
1319             'white' => [ 255, 255, 255 ],
1320             'black' => [ 0, 0, 0 ],
1321             'red' => [ 200, 0, 0 ],
1322             'green' => [ 0, 175, 0 ],
1323             'blue' => [ 0, 0, 200 ],
1324             'orange' => [ 250, 125, 0 ],
1325             'orange2' => [ 238, 154, 0 ],
1326             'orange3' => [ 205, 133, 0 ],
1327             'orange4' => [ 139, 90, 0 ],
1328             'yellow' => [ 225, 225, 0 ],
1329             'purple' => [ 200, 0, 200 ],
1330             'light_blue' => [ 0, 125, 250 ],
1331             'light_green' => [ 125, 250, 0 ],
1332             'light_purple' => [ 145, 0, 250 ],
1333             'pink' => [ 250, 0, 125 ],
1334             'peach' => [ 250, 125, 125 ],
1335             'olive' => [ 125, 125, 0 ],
1336             'plum' => [ 125, 0, 125 ],
1337             'turquoise' => [ 0, 125, 125 ],
1338             'mauve' => [ 200, 125, 125 ],
1339             'brown' => [ 160, 80, 0 ],
1340             'grey' => [ 225, 225, 225 ],
1341             'HotPink' => [ 255, 105, 180 ],
1342             'PaleGreen1' => [ 154, 255, 154 ],
1343             'PaleGreen2' => [ 144, 238, 144 ],
1344             'PaleGreen3' => [ 124, 205, 124 ],
1345             'PaleGreen4' => [ 84, 138, 84 ],
1346             'DarkBlue' => [ 0, 0, 139 ],
1347             'BlueViolet' => [ 138, 43, 226 ],
1348             'PeachPuff' => [ 255, 218, 185 ],
1349             'PeachPuff1' => [ 255, 218, 185 ],
1350             'PeachPuff2' => [ 238, 203, 173 ],
1351             'PeachPuff3' => [ 205, 175, 149 ],
1352             'PeachPuff4' => [ 139, 119, 101 ],
1353             'chocolate1' => [ 255, 127, 36 ],
1354             'chocolate2' => [ 238, 118, 33 ],
1355             'chocolate3' => [ 205, 102, 29 ],
1356             'chocolate4' => [ 139, 69, 19 ],
1357             'LightGreen' => [ 144, 238, 144 ],
1358             'lavender' => [ 230, 230, 250 ],
1359             'MediumPurple' => [ 147, 112, 219 ],
1360             'DarkOrange' => [ 255, 127, 0 ],
1361             'DarkOrange2' => [ 238, 118, 0 ],
1362             'DarkOrange3' => [ 205, 102, 0 ],
1363             'DarkOrange4' => [ 139, 69, 0 ],
1364             'SlateBlue' => [ 106, 90, 205 ],
1365             'BlueViolet' => [ 138, 43, 226 ],
1366             'RoyalBlue' => [ 65, 105, 225 ],
1367             'AntiqueWhite' => [ 250, 235, 215 ],
1368             'AntiqueWhite1' => [ 255, 239, 219 ],
1369             'AntiqueWhite2' => [ 238, 223, 204 ],
1370             'AntiqueWhite3' => [ 205, 192, 176 ],
1371             'AntiqueWhite4' => [ 139, 131, 120 ],
1372             'CadetBlue' => [ 95, 158, 160 ],
1373             'CadetBlue1' => [ 152, 245, 255 ],
1374             'CadetBlue2' => [ 142, 229, 238 ],
1375             'CadetBlue3' => [ 122, 197, 205 ],
1376             'CadetBlue4' => [ 83, 134, 139 ],
1377             'DarkGoldenrod' => [ 184, 134, 11 ],
1378             'DarkGoldenrod1' => [ 255, 185, 15 ],
1379             'DarkGoldenrod2' => [ 238, 173, 14 ],
1380             'DarkGoldenrod3' => [ 205, 149, 12 ],
1381             'DarkGoldenrod4' => [ 139, 101, 8 ],
1382             'DarkOliveGreen' => [ 85, 107, 47 ],
1383             'DarkOliveGreen1' => [ 202, 255, 112 ],
1384             'DarkOliveGreen2' => [ 188, 238, 104 ],
1385             'DarkOliveGreen3' => [ 162, 205, 90 ],
1386             'DarkOliveGreen4' => [ 110, 139, 61 ],
1387             'DarkOrange1' => [ 255, 127, 0 ],
1388             'DarkOrchid' => [ 153, 50, 204 ],
1389             'DarkOrchid1' => [ 191, 62, 255 ],
1390             'DarkOrchid2' => [ 178, 58, 238 ],
1391             'DarkOrchid3' => [ 154, 50, 205 ],
1392             'DarkOrchid4' => [ 104, 34, 139 ],
1393             'DarkSeaGreen' => [ 143, 188, 143 ],
1394             'DarkSeaGreen1' => [ 193, 255, 193 ],
1395             'DarkSeaGreen2' => [ 180, 238, 180 ],
1396             'DarkSeaGreen3' => [ 155, 205, 155 ],
1397             'DarkSeaGreen4' => [ 105, 139, 105 ],
1398             'DarkSlateGray' => [ 47, 79, 79 ],
1399             'DarkSlateGray1' => [ 151, 255, 255 ],
1400             'DarkSlateGray2' => [ 141, 238, 238 ],
1401             'DarkSlateGray3' => [ 121, 205, 205 ],
1402             'DarkSlateGray4' => [ 82, 139, 139 ],
1403             'DeepPink' => [ 255, 20, 147 ],
1404             'DeepPink1' => [ 255, 20, 147 ],
1405             'DeepPink2' => [ 238, 18, 137 ],
1406             'DeepPink3' => [ 205, 16, 118 ],
1407             'DeepPink4' => [ 139, 10, 80 ],
1408             'DeepSkyBlue' => [ 0, 191, 255 ],
1409             'DeepSkyBlue1' => [ 0, 191, 255 ],
1410             'DeepSkyBlue2' => [ 0, 178, 238 ],
1411             'DeepSkyBlue3' => [ 0, 154, 205 ],
1412             'DeepSkyBlue4' => [ 0, 104, 139 ],
1413             'DodgerBlue' => [ 30, 144, 255 ],
1414             'DodgerBlue1' => [ 30, 144, 255 ],
1415             'DodgerBlue2' => [ 28, 134, 238 ],
1416             'DodgerBlue3' => [ 24, 116, 205 ],
1417             'DodgerBlue4' => [ 16, 78, 139 ],
1418             'HotPink1' => [ 255, 110, 180 ],
1419             'HotPink2' => [ 238, 106, 167 ],
1420             'HotPink3' => [ 205, 96, 144 ],
1421             'HotPink4' => [ 139, 58, 98 ],
1422             'IndianRed' => [ 205, 92, 92 ],
1423             'IndianRed1' => [ 255, 106, 106 ],
1424             'IndianRed2' => [ 238, 99, 99 ],
1425             'IndianRed3' => [ 205, 85, 85 ],
1426             'IndianRed4' => [ 139, 58, 58 ],
1427             'LavenderBlush' => [ 255, 240, 245 ],
1428             'LavenderBlush1' => [ 255, 240, 245 ],
1429             'LavenderBlush2' => [ 238, 224, 229 ],
1430             'LavenderBlush3' => [ 205, 193, 197 ],
1431             'LavenderBlush4' => [ 139, 131, 134 ],
1432             'LemonChiffon' => [ 255, 250, 205 ],
1433             'LemonChiffon1' => [ 255, 250, 205 ],
1434             'LemonChiffon2' => [ 238, 233, 191 ],
1435             'LemonChiffon3' => [ 205, 201, 165 ],
1436             'LemonChiffon4' => [ 139, 137, 112 ],
1437             'LightBlue' => [ 173, 216, 230 ],
1438             'LightBlue1' => [ 191, 239, 255 ],
1439             'LightBlue2' => [ 178, 223, 238 ],
1440             'LightBlue3' => [ 154, 192, 205 ],
1441             'LightBlue4' => [ 104, 131, 139 ],
1442             'LightCyan' => [ 224, 255, 255 ],
1443             'LightCyan1' => [ 224, 255, 255 ],
1444             'LightCyan2' => [ 209, 238, 238 ],
1445             'LightCyan3' => [ 180, 205, 205 ],
1446             'LightCyan4' => [ 122, 139, 139 ],
1447             'LightGoldenrod' => [ 238, 221, 130 ],
1448             'LightGoldenrod1' => [ 255, 236, 139 ],
1449             'LightGoldenrod2' => [ 238, 220, 130 ],
1450             'LightGoldenrod3' => [ 205, 190, 112 ],
1451             'LightGoldenrod4' => [ 139, 129, 76 ],
1452             'LightPink' => [ 255, 182, 193 ],
1453             'LightPink1' => [ 255, 174, 185 ],
1454             'LightPink2' => [ 238, 162, 173 ],
1455             'LightPink3' => [ 205, 140, 149 ],
1456             'LightPink4' => [ 139, 95, 101 ],
1457             'LightSalmon' => [ 255, 160, 122 ],
1458             'LightSalmon1' => [ 255, 160, 122 ],
1459             'LightSalmon2' => [ 238, 149, 114 ],
1460             'LightSalmon3' => [ 205, 129, 98 ],
1461             'LightSalmon4' => [ 139, 87, 66 ],
1462             'LightSkyBlue' => [ 135, 206, 250 ],
1463             'LightSkyBlue1' => [ 176, 226, 255 ],
1464             'LightSkyBlue2' => [ 164, 211, 238 ],
1465             'LightSkyBlue3' => [ 141, 182, 205 ],
1466             'LightSkyBlue4' => [ 96, 123, 139 ],
1467             'LightSteelBlue' => [ 176, 196, 222 ],
1468             'LightSteelBlue1' => [ 202, 225, 255 ],
1469             'LightSteelBlue2' => [ 188, 210, 238 ],
1470             'LightSteelBlue3' => [ 162, 181, 205 ],
1471             'LightSteelBlue4' => [ 110, 123, 139 ],
1472             'LightYellow' => [ 255, 255, 224 ],
1473             'LightYellow1' => [ 255, 255, 224 ],
1474             'LightYellow2' => [ 238, 238, 209 ],
1475             'LightYellow3' => [ 205, 205, 180 ],
1476             'LightYellow4' => [ 139, 139, 122 ],
1477             'MediumOrchid' => [ 186, 85, 211 ],
1478             'MediumOrchid1' => [ 224, 102, 255 ],
1479             'MediumOrchid2' => [ 209, 95, 238 ],
1480             'MediumOrchid3' => [ 180, 82, 205 ],
1481             'MediumOrchid4' => [ 122, 55, 139 ],
1482             'MediumPurple1' => [ 171, 130, 255 ],
1483             'MediumPurple2' => [ 159, 121, 238 ],
1484             'MediumPurple3' => [ 137, 104, 205 ],
1485             'MediumPurple4' => [ 93, 71, 139 ],
1486             'MistyRose' => [ 255, 228, 225 ],
1487             'MistyRose1' => [ 255, 228, 225 ],
1488             'MistyRose2' => [ 238, 213, 210 ],
1489             'MistyRose3' => [ 205, 183, 181 ],
1490             'MistyRose4' => [ 139, 125, 123 ],
1491             'NavajoWhite' => [ 255, 222, 173 ],
1492             'NavajoWhite1' => [ 255, 222, 173 ],
1493             'NavajoWhite2' => [ 238, 207, 161 ],
1494             'NavajoWhite3' => [ 205, 179, 139 ],
1495             'NavajoWhite4' => [ 139, 121, 94 ],
1496             'OliveDrab' => [ 107, 142, 35 ],
1497             'OliveDrab1' => [ 192, 255, 62 ],
1498             'OliveDrab2' => [ 179, 238, 58 ],
1499             'OliveDrab3' => [ 154, 205, 50 ],
1500             'OliveDrab4' => [ 105, 139, 34 ],
1501             'OrangeRed' => [ 255, 69, 0 ],
1502             'OrangeRed1' => [ 255, 69, 0 ],
1503             'OrangeRed2' => [ 238, 64, 0 ],
1504             'OrangeRed3' => [ 205, 55, 0 ],
1505             'OrangeRed4' => [ 139, 37, 0 ],
1506             'PaleGreen' => [ 152, 251, 152 ],
1507             'PaleTurquoise' => [ 175, 238, 238 ],
1508             'PaleTurquoise1' => [ 187, 255, 255 ],
1509             'PaleTurquoise2' => [ 174, 238, 238 ],
1510             'PaleTurquoise3' => [ 150, 205, 205 ],
1511             'PaleTurquoise4' => [ 102, 139, 139 ],
1512             'PaleVioletRed' => [ 219, 112, 147 ],
1513             'PaleVioletRed1' => [ 255, 130, 171 ],
1514             'PaleVioletRed2' => [ 238, 121, 159 ],
1515             'PaleVioletRed3' => [ 205, 104, 137 ],
1516             'PaleVioletRed4' => [ 139, 71, 93 ],
1517             'RosyBrown' => [ 188, 143, 143 ],
1518             'RosyBrown1' => [ 255, 193, 193 ],
1519             'RosyBrown2' => [ 238, 180, 180 ],
1520             'RosyBrown3' => [ 205, 155, 155 ],
1521             'RosyBrown4' => [ 139, 105, 105 ],
1522             'RoyalBlue1' => [ 72, 118, 255 ],
1523             'RoyalBlue2' => [ 67, 110, 238 ],
1524             'RoyalBlue3' => [ 58, 95, 205 ],
1525             'RoyalBlue4' => [ 39, 64, 139 ],
1526             'SeaGreen' => [ 46, 139, 87 ],
1527             'SeaGreen1' => [ 84, 255, 159 ],
1528             'SeaGreen2' => [ 78, 238, 148 ],
1529             'SeaGreen3' => [ 67, 205, 128 ],
1530             'SeaGreen4' => [ 46, 139, 87 ],
1531             'SkyBlue' => [ 135, 206, 235 ],
1532             'SkyBlue1' => [ 135, 206, 255 ],
1533             'SkyBlue2' => [ 126, 192, 238 ],
1534             'SkyBlue3' => [ 108, 166, 205 ],
1535             'SkyBlue4' => [ 74, 112, 139 ],
1536             'SlateBlue1' => [ 131, 111, 255 ],
1537             'SlateBlue2' => [ 122, 103, 238 ],
1538             'SlateBlue3' => [ 105, 89, 205 ],
1539             'SlateBlue4' => [ 71, 60, 139 ],
1540             'SlateGray' => [ 112, 128, 144 ],
1541             'SlateGray1' => [ 198, 226, 255 ],
1542             'SlateGray2' => [ 185, 211, 238 ],
1543             'SlateGray3' => [ 159, 182, 205 ],
1544             'SlateGray4' => [ 108, 123, 139 ],
1545             'SpringGreen' => [ 0, 255, 127 ],
1546             'SpringGreen1' => [ 0, 255, 127 ],
1547             'SpringGreen2' => [ 0, 238, 118 ],
1548             'SpringGreen3' => [ 0, 205, 102 ],
1549             'SpringGreen4' => [ 0, 139, 69 ],
1550             'SteelBlue' => [ 70, 130, 180 ],
1551             'SteelBlue1' => [ 99, 184, 255 ],
1552             'SteelBlue2' => [ 92, 172, 238 ],
1553             'SteelBlue3' => [ 79, 148, 205 ],
1554             'SteelBlue4' => [ 54, 100, 139 ],
1555             'VioletRed' => [ 208, 32, 144 ],
1556             'VioletRed1' => [ 255, 62, 150 ],
1557             'VioletRed2' => [ 238, 58, 140 ],
1558             'VioletRed3' => [ 205, 50, 120 ],
1559             'VioletRed4' => [ 139, 34, 82 ],
1560             'aquamarine' => [ 127, 255, 212 ],
1561             'aquamarine1' => [ 127, 255, 212 ],
1562             'aquamarine2' => [ 118, 238, 198 ],
1563             'aquamarine3' => [ 102, 205, 170 ],
1564             'aquamarine4' => [ 69, 139, 116 ],
1565             'azure' => [ 240, 255, 255 ],
1566             'azure1' => [ 240, 255, 255 ],
1567             'azure2' => [ 224, 238, 238 ],
1568             'azure3' => [ 193, 205, 205 ],
1569             'azure4' => [ 131, 139, 139 ],
1570             'bisque' => [ 255, 228, 196 ],
1571             'bisque1' => [ 255, 228, 196 ],
1572             'bisque2' => [ 238, 213, 183 ],
1573             'bisque3' => [ 205, 183, 158 ],
1574             'bisque4' => [ 139, 125, 107 ],
1575             'blue1' => [ 0, 0, 255 ],
1576             'blue2' => [ 0, 0, 238 ],
1577             'blue3' => [ 0, 0, 205 ],
1578             'blue4' => [ 0, 0, 139 ],
1579             'brown1' => [ 255, 64, 64 ],
1580             'brown2' => [ 238, 59, 59 ],
1581             'brown3' => [ 205, 51, 51 ],
1582             'brown4' => [ 139, 35, 35 ],
1583             'burlywood' => [ 222, 184, 135 ],
1584             'burlywood1' => [ 255, 211, 155 ],
1585             'burlywood2' => [ 238, 197, 145 ],
1586             'burlywood3' => [ 205, 170, 125 ],
1587             'burlywood4' => [ 139, 115, 85 ],
1588             'chartreuse' => [ 127, 255, 0 ],
1589             'chartreuse1' => [ 127, 255, 0 ],
1590             'chartreuse2' => [ 118, 238, 0 ],
1591             'chartreuse3' => [ 102, 205, 0 ],
1592             'chartreuse4' => [ 69, 139, 0 ],
1593             'chocolate' => [ 210, 105, 30 ],
1594             'coral' => [ 255, 127, 80 ],
1595             'coral1' => [ 255, 114, 86 ],
1596             'coral2' => [ 238, 106, 80 ],
1597             'coral3' => [ 205, 91, 69 ],
1598             'coral4' => [ 139, 62, 47 ],
1599             'cornsilk' => [ 255, 248, 220 ],
1600             'cornsilk1' => [ 255, 248, 220 ],
1601             'cornsilk2' => [ 238, 232, 205 ],
1602             'cornsilk3' => [ 205, 200, 177 ],
1603             'cornsilk4' => [ 139, 136, 120 ],
1604             'cyan' => [ 0, 255, 255 ],
1605             'cyan1' => [ 0, 255, 255 ],
1606             'cyan2' => [ 0, 238, 238 ],
1607             'cyan3' => [ 0, 205, 205 ],
1608             'cyan4' => [ 0, 139, 139 ],
1609             'firebrick' => [ 178, 34, 34 ],
1610             'firebrick1' => [ 255, 48, 48 ],
1611             'firebrick2' => [ 238, 44, 44 ],
1612             'firebrick3' => [ 205, 38, 38 ],
1613             'firebrick4' => [ 139, 26, 26 ],
1614             'gold' => [ 255, 215, 0 ],
1615             'gold1' => [ 255, 215, 0 ],
1616             'gold2' => [ 238, 201, 0 ],
1617             'gold3' => [ 205, 173, 0 ],
1618             'gold4' => [ 139, 117, 0 ],
1619             'goldenrod' => [ 218, 165, 32 ],
1620             'goldenrod1' => [ 255, 193, 37 ],
1621             'goldenrod2' => [ 238, 180, 34 ],
1622             'goldenrod3' => [ 205, 155, 29 ],
1623             'goldenrod4' => [ 139, 105, 20 ],
1624             'gray' => [ 190, 190, 190 ],
1625             'gray1' => [ 3, 3, 3 ],
1626             'gray2' => [ 5, 5, 5 ],
1627             'gray3' => [ 8, 8, 8 ],
1628             'gray4' => [ 10, 10, 10 ],
1629             'green1' => [ 0, 255, 0 ],
1630             'green2' => [ 0, 238, 0 ],
1631             'green3' => [ 0, 205, 0 ],
1632             'green4' => [ 0, 139, 0 ],
1633             'grey1' => [ 3, 3, 3 ],
1634             'grey2' => [ 5, 5, 5 ],
1635             'grey3' => [ 8, 8, 8 ],
1636             'grey4' => [ 10, 10, 10 ],
1637             'honeydew' => [ 240, 255, 240 ],
1638             'honeydew1' => [ 240, 255, 240 ],
1639             'honeydew2' => [ 224, 238, 224 ],
1640             'honeydew3' => [ 193, 205, 193 ],
1641             'honeydew4' => [ 131, 139, 131 ],
1642             'ivory' => [ 255, 255, 240 ],
1643             'ivory1' => [ 255, 255, 240 ],
1644             'ivory2' => [ 238, 238, 224 ],
1645             'ivory3' => [ 205, 205, 193 ],
1646             'ivory4' => [ 139, 139, 131 ],
1647             'khaki' => [ 240, 230, 140 ],
1648             'khaki1' => [ 255, 246, 143 ],
1649             'khaki2' => [ 238, 230, 133 ],
1650             'khaki3' => [ 205, 198, 115 ],
1651             'khaki4' => [ 139, 134, 78 ],
1652             'magenta' => [ 255, 0, 255 ],
1653             'magenta1' => [ 255, 0, 255 ],
1654             'magenta2' => [ 238, 0, 238 ],
1655             'magenta3' => [ 205, 0, 205 ],
1656             'magenta4' => [ 139, 0, 139 ],
1657             'maroon' => [ 176, 48, 96 ],
1658             'maroon1' => [ 255, 52, 179 ],
1659             'maroon2' => [ 238, 48, 167 ],
1660             'maroon3' => [ 205, 41, 144 ],
1661             'maroon4' => [ 139, 28, 98 ],
1662             'orange1' => [ 255, 165, 0 ],
1663             'orchid' => [ 218, 112, 214 ],
1664             'orchid1' => [ 255, 131, 250 ],
1665             'orchid2' => [ 238, 122, 233 ],
1666             'orchid3' => [ 205, 105, 201 ],
1667             'orchid4' => [ 139, 71, 137 ],
1668             'pink1' => [ 255, 181, 197 ],
1669             'pink2' => [ 238, 169, 184 ],
1670             'pink3' => [ 205, 145, 158 ],
1671             'pink4' => [ 139, 99, 108 ],
1672             'plum1' => [ 255, 187, 255 ],
1673             'plum2' => [ 238, 174, 238 ],
1674             'plum3' => [ 205, 150, 205 ],
1675             'plum4' => [ 139, 102, 139 ],
1676             'purple1' => [ 155, 48, 255 ],
1677             'purple2' => [ 145, 44, 238 ],
1678             'purple3' => [ 125, 38, 205 ],
1679             'purple4' => [ 85, 26, 139 ],
1680             'red1' => [ 255, 0, 0 ],
1681             'red2' => [ 238, 0, 0 ],
1682             'red3' => [ 205, 0, 0 ],
1683             'red4' => [ 139, 0, 0 ],
1684             'salmon' => [ 250, 128, 114 ],
1685             'salmon1' => [ 255, 140, 105 ],
1686             'salmon2' => [ 238, 130, 98 ],
1687             'salmon3' => [ 205, 112, 84 ],
1688             'salmon4' => [ 139, 76, 57 ],
1689             'seashell' => [ 255, 245, 238 ],
1690             'seashell1' => [ 255, 245, 238 ],
1691             'seashell2' => [ 238, 229, 222 ],
1692             'seashell3' => [ 205, 197, 191 ],
1693             'seashell4' => [ 139, 134, 130 ],
1694             'sienna' => [ 160, 82, 45 ],
1695             'sienna1' => [ 255, 130, 71 ],
1696             'sienna2' => [ 238, 121, 66 ],
1697             'sienna3' => [ 205, 104, 57 ],
1698             'sienna4' => [ 139, 71, 38 ],
1699             'snow' => [ 255, 250, 250 ],
1700             'snow1' => [ 255, 250, 250 ],
1701             'snow2' => [ 238, 233, 233 ],
1702             'snow3' => [ 205, 201, 201 ],
1703             'snow4' => [ 139, 137, 137 ],
1704             'tan' => [ 210, 180, 140 ],
1705             'tan1' => [ 255, 165, 79 ],
1706             'tan2' => [ 238, 154, 73 ],
1707             'tan3' => [ 205, 133, 63 ],
1708             'tan4' => [ 139, 90, 43 ],
1709             'thistle' => [ 216, 191, 216 ],
1710             'thistle1' => [ 255, 225, 255 ],
1711             'thistle2' => [ 238, 210, 238 ],
1712             'thistle3' => [ 205, 181, 205 ],
1713             'thistle4' => [ 139, 123, 139 ],
1714             'tomato' => [ 255, 99, 71 ],
1715             'tomato1' => [ 255, 99, 71 ],
1716             'tomato2' => [ 238, 92, 66 ],
1717             'tomato3' => [ 205, 79, 57 ],
1718             'tomato4' => [ 139, 54, 38 ],
1719             'turquoise1' => [ 0, 245, 255 ],
1720             'turquoise2' => [ 0, 229, 238 ],
1721             'turquoise3' => [ 0, 197, 205 ],
1722             'turquoise4' => [ 0, 134, 139 ],
1723             'wheat' => [ 245, 222, 179 ],
1724             'wheat1' => [ 255, 231, 186 ],
1725             'wheat2' => [ 238, 216, 174 ],
1726             'wheat3' => [ 205, 186, 150 ],
1727             'wheat4' => [ 139, 126, 102 ],
1728             'yellow1' => [ 255, 255, 0 ],
1729             'yellow2' => [ 238, 238, 0 ],
1730             'yellow3' => [ 205, 205, 0 ],
1731             'yellow4' => [ 139, 139, 0 ],
1732             );
1733              
1734             ## @fn private int _set_colors
1735             # specify my colors
1736             # @return status
1737             sub _set_colors
1738             {
1739             my $self = shift;
1740              
1741             my $index = $self->_color_role_to_index('background'); # allocate GD color
1742             if ( $self->true( $self->{'transparent'} ) )
1743             {
1744             $self->{'gd_obj'}->transparent($index);
1745             }
1746              
1747             # all other roles are initialized by calling $self->_color_role_to_index(ROLENAME);
1748              
1749             # and return
1750             return 1;
1751             }
1752              
1753             ## @fn private int _color_role_to_index
1754             # return a (list of) color index(es) corresponding to the (list of) role(s)
1755             #
1756             # @details wantarray
1757             # is a special keyword which returns a flag indicating
1758             # which context your subroutine has been called in.
1759             # It will return one of three values.
1760             #
1761             # @li true: If your subroutine has been called in list context
1762             # @li false: If your subroutine has been called in scalar context
1763             # @li undef: If your subroutine has been called in void context
1764             #
1765             # @return a (list of) color index(es) corresponding to the (list of) role(s) in \\\@_.
1766             #
1767             sub _color_role_to_index
1768             {
1769             my $self = shift;
1770              
1771             # Return a (list of) color index(es) corresponding to the (list of) role(s) in @_.
1772             my @result = map {
1773             my $role = $_;
1774             my $index = $self->{'color_table'}->{$role};
1775              
1776             #print STDERR "Role = $_\n";
1777              
1778             unless ( defined $index )
1779             {
1780             my $spec =
1781             $self->{'colors'}->{$role}
1782             || $self->{'colors_default_spec'}->{$role}
1783             || $self->{'colors_default_spec'}->{ $self->{'colors_default_role'}->{$role} };
1784              
1785             my @rgb = $self->_color_spec_to_rgb( $role, $spec );
1786              
1787             #print STDERR "spec = $spec\n";
1788              
1789             my $string = sprintf " RGB(%d,%d,%d)", map { $_ + 0 } @rgb;
1790              
1791             $index = $self->{'color_table'}->{$string};
1792             unless ( defined $index )
1793             {
1794             $index = $self->{'gd_obj'}->colorAllocate(@rgb);
1795             $self->{'color_table'}->{$string} = $index;
1796             }
1797              
1798             $self->{'color_table'}->{$role} = $index;
1799             }
1800             $index;
1801             } @_;
1802              
1803             #print STDERR "Result= ".$result[0]."\n";
1804             ( wantarray && @_ > 1 ? @result : $result[0] );
1805             }
1806              
1807             ## @fn private array _color_spec_to_rgb($role,$spec)
1808             # Return an array (list of) rgb values for spec
1809             # @param[in] role name of a role
1810             # @param[in] spec [r,g,b] or name
1811             # @return array of rgb values as a list (i.e., \\\@rgb)
1812             #
1813             sub _color_spec_to_rgb
1814             {
1815             my $self = shift;
1816             my $role = shift; # for error messages
1817             my $spec = shift; # [r,g,b] or name
1818              
1819             my @rgb; # result
1820             if ( ref($spec) eq 'ARRAY' )
1821             {
1822             @rgb = @{$spec};
1823             croak "Invalid color RGB array (" . join( ',', @rgb ) . ") for $role\n"
1824              
1825             unless @rgb == 3 && grep( !m/^\d+$/ || $_ > 255, @rgb ) == 0;
1826             }
1827             elsif ( !ref($spec) )
1828             {
1829             croak "Unknown named color ($spec) for $role\n"
1830             unless $named_colors{$spec};
1831             @rgb = @{ $named_colors{$spec} };
1832             }
1833             else
1834             {
1835             croak "Unrecognized color for $role\n";
1836             }
1837             @rgb;
1838             }
1839              
1840             ## @fn private int _brushStyles_of_roles
1841             # return a (list of) brushStyles corresponding to the (list of) role(s)
1842             #
1843             # @param list_of_roles List of roles (\\\@list_of_roles)
1844             # @return (list of) brushStyle(s) corresponding to the (list of) role(s) in \\\@_.
1845             #
1846             sub _brushStyles_of_roles
1847             {
1848             my $self = shift;
1849             my @roles = @_;
1850              
1851             my @results = ();
1852             foreach my $role (@roles)
1853             {
1854             my $brushStyle = $self->{'brushStyles'}->{$role};
1855              
1856             if ( !defined($brushStyle) )
1857             {
1858             $brushStyle = $self->{'brushStyle'};
1859             }
1860             push( @results, $brushStyle );
1861             }
1862             @results;
1863             }
1864              
1865             ## @fn private int _draw_title
1866             # draw the title for the chart
1867             #
1868             # The title was defined by the user in set('title' => ....)\n
1869             # The user may define some title lines by separating them via character '\\n';\n
1870             # The used font is taken from 'title_font';\n
1871             # The used color is calculated by function '_color_role_to_index'
1872             # based on 'title' or 'text'\n
1873             # @see _color_role_to_index
1874             # @return status
1875             sub _draw_title
1876             {
1877             my $self = shift;
1878             my $font = $self->{'title_font'};
1879             my $color;
1880             my ( $h, $w, @lines, $x, $y );
1881              
1882             #get the right color
1883             if ( defined $self->{'colors'}{'title'} )
1884             {
1885             $color = $self->_color_role_to_index('title');
1886             }
1887             else
1888             {
1889             $color = $self->_color_role_to_index('text');
1890             }
1891              
1892             # make sure we're actually using a real font
1893             unless ( ( ref $font ) eq 'GD::Font' )
1894             {
1895             croak "The title font you specified isn\'t a GD Font object";
1896             }
1897              
1898             # get the height and width of the font
1899             ( $h, $w ) = ( $font->height, $font->width );
1900              
1901             # split the title into lines
1902             @lines = split( /\\n/, $self->{'title'} );
1903              
1904             # write the first line
1905             $x = ( $self->{'curr_x_max'} - $self->{'curr_x_min'} ) / 2 + $self->{'curr_x_min'} - ( length( $lines[0] ) * $w ) / 2;
1906             $y = $self->{'curr_y_min'} + $self->{'text_space'};
1907              
1908             #-----------------------------------------------------------
1909              
1910             # Tests for Version 2.5
1911             # ttf are found in /var/share/fonts/truetype/freefont/
1912              
1913             # /var/share/fonts/truetype
1914              
1915             # Sketch for further processing
1916             # if ( $font ~= /^gd/ && ! -f $font )
1917             # {
1918             # $self->{'gd_obj'}->string( $font, $x, $y, $lines[0], $color );
1919             # }
1920             # elsif ( -f $font )
1921             # {
1922             # my $fontname = '/var/share/fonts/truetype/freefont/FreeSerifBoldItalic.ttf';
1923             # $self->{'gd_obj'}->stringFT( $color, $fontname, 8,0, $x, $y, $lines[0] );
1924             # }
1925              
1926             # my $fontname = '/var/share/fonts/truetype/freefont/FreeSerifBoldItalic.ttf';
1927             # # size, angle
1928             # $self->{'gd_obj'}->stringFT( $color, $fontname, 12,0, $x, $y, $lines[0] );
1929              
1930             #-----------------------------------------------------------------
1931             $self->{'gd_obj'}->string( $font, $x, $y, $lines[0], $color );
1932              
1933             # now loop through the rest of them
1934             # (the font is decreased in width and height by 1
1935             if ( $w > 1 ) { $w--; }
1936             if ( $h > 1 ) { $h--; }
1937             for ( 1 .. $#lines )
1938             {
1939             $self->{'curr_y_min'} += $self->{'text_space'} + $h;
1940             $x = ( $self->{'curr_x_max'} - $self->{'curr_x_min'} ) / 2 + $self->{'curr_x_min'} - ( length( $lines[$_] ) * $w ) / 2;
1941             $y = $self->{'curr_y_min'} + $self->{'text_space'};
1942             $self->{'gd_obj'}->string( $font, $x, $y, $lines[$_], $color );
1943             }
1944              
1945             # mark off that last space
1946             $self->{'curr_y_min'} += 2 * $self->{'text_space'} + $h;
1947              
1948             # and return
1949             return 1;
1950             }
1951              
1952             ## @fn private int _draw_sub_title()
1953             # draw the sub-title for the chart
1954             # @see _draw_title\n
1955             # _draw_sub_title() is more or less obsolete as _draw_title() does the same
1956             # by writing more than one line as the title.
1957             # Both use decreased width and height of the font by one.
1958             # @return status
1959             sub _draw_sub_title
1960             {
1961             my $self = shift;
1962              
1963             my $font = $self->{'sub_title_font'};
1964             my $text = $self->{'sub_title'};
1965             return 1 if length($text) == 0; # nothing to plot
1966              
1967             #get the right color
1968             my $color;
1969             if ( defined $self->{'colors'}{'title'} )
1970             {
1971             $color = $self->_color_role_to_index('title');
1972             }
1973             else
1974             {
1975             $color = $self->_color_role_to_index('text');
1976             }
1977              
1978             my ( $h, $w, $x, $y );
1979              
1980             # make sure we're using a real font
1981             unless ( ( ref($font) ) eq 'GD::Font' )
1982             {
1983             croak "The subtitle font you specified isn\'t a GD Font object";
1984             }
1985              
1986             # get the size of the font
1987             ( $h, $w ) = ( $font->height, $font->width );
1988             if ( $h > 1 && $w > 1 ) { $h--, $w-- }
1989              
1990             # figure out the placement
1991             $x = ( $self->{'curr_x_max'} - $self->{'curr_x_min'} ) / 2 + $self->{'curr_x_min'} - ( length($text) * $w ) / 2;
1992             $y = $self->{'curr_y_min'};
1993              
1994             # now draw the subtitle
1995             $self->{'gd_obj'}->string( $font, $x, $y, $text, $color );
1996              
1997             # Adapt curr_y_min
1998             $self->{'curr_y_min'} += $self->{'text_space'} + $h;
1999              
2000             # and return
2001             return 1;
2002             }
2003              
2004             ## @fn private int _sort_data()
2005             # sort the data nicely (mostly for the pareto charts and xy-plots)
2006             # @return status
2007             sub _sort_data
2008             {
2009             my $self = shift;
2010             my $data_ref = $self->{'dataref'};
2011             my @data = @{ $self->{'dataref'} };
2012             my @sort_index;
2013              
2014             #sort the data with slices
2015             @sort_index = sort { $data[0][$a] <=> $data[0][$b] } ( 0 .. scalar( @{ $data[1] } ) - 1 );
2016             for ( 1 .. $#data )
2017             {
2018             @{ $self->{'dataref'}->[$_] } = @{ $self->{'dataref'}->[$_] }[@sort_index];
2019             }
2020             @{ $data_ref->[0] } = sort { $a <=> $b } @{ $data_ref->[0] };
2021              
2022             #finally return
2023             return 1;
2024             }
2025              
2026             ## @fn private int _find_x_scale()
2027             # For a xy-plot do the same for the x values, as '_find_y_scale' does for the y values!
2028             # @see _find_y_scale
2029             # @return status
2030             sub _find_x_scale
2031             {
2032             my $self = shift;
2033             my @data = @{ $self->{'dataref'} };
2034             my ( $i, $j );
2035             my ( $d_min, $d_max );
2036             my ( $p_min, $p_max, $f_min, $f_max );
2037             my ( $tickInterval, $tickCount, $skip );
2038             my @tickLabels;
2039             my $maxtickLabelLen = 0;
2040              
2041             #look, if we have numbers
2042             #see also if we only have integers
2043             for $i ( 0 .. ( $self->{'num_datasets'} ) )
2044             {
2045             for $j ( 0 .. ( $self->{'num_datapoints'} - 1 ) )
2046             {
2047              
2048             # the following regular Expression matches all possible numbers, including scientific numbers
2049             # iff data is defined
2050             if ( defined $data[$i][$j] and $data[$i][$j] !~ m/^[\+\-]?((\.\d+)|(\d+\.?\d*))([eE][+-]?\d+)?[fFdD]?$/ )
2051             {
2052             croak "<$data[$i][$j]> You should give me numbers for drawing a xy plot!\n";
2053             }
2054             }
2055             }
2056              
2057             #find the dataset min and max
2058             ( $d_min, $d_max ) = $self->_find_x_range();
2059              
2060             # Force the inclusion of zero if the user has requested it.
2061             if ( $self->true( $self->{'include_zero'} ) )
2062             {
2063             if ( ( $d_min * $d_max ) > 0 ) # If both are non zero and of the same sign.
2064             {
2065             if ( $d_min > 0 ) # If the whole scale is positive.
2066             {
2067             $d_min = 0;
2068             }
2069             else # The scale is entirely negative.
2070             {
2071             $d_max = 0;
2072             }
2073             }
2074             }
2075              
2076             # Calculate the width of the dataset. (possibly modified by the user)
2077             my $d_width = $d_max - $d_min;
2078              
2079             # If the width of the range is zero, forcebly widen it
2080             # (to avoid division by zero errors elsewhere in the code).
2081             if ( 0 == $d_width )
2082             {
2083             $d_min--, $d_max++, $d_width = 2;
2084             }
2085              
2086             # Descale the range by converting the dataset width into
2087             # a floating point exponent & mantisa pair.
2088             my ( $rangeExponent, $rangeMantisa ) = $self->_sepFP($d_width);
2089             my $rangeMuliplier = 10**$rangeExponent;
2090              
2091             # Find what tick
2092             # to use & how many ticks to plot,
2093             # round the plot min & max to suatable round numbers.
2094             ( $tickInterval, $tickCount, $p_min, $p_max ) = $self->_calcXTickInterval(
2095             $d_min / $rangeMuliplier,
2096             $d_max / $rangeMuliplier,
2097             $f_min, $f_max,
2098             $self->{'min_x_ticks'},
2099             $self->{'max_x_ticks'}
2100             );
2101              
2102             # Restore the tickInterval etc to the correct scale
2103             $_ *= $rangeMuliplier foreach ( $tickInterval, $p_min, $p_max );
2104              
2105             #get the precision for the labels
2106             my $precision = $self->{'precision'};
2107              
2108             # Now sort out an array of tick labels.
2109             for ( my $labelNum = $p_min ; $labelNum < $p_max + $tickInterval / 2 ; $labelNum += $tickInterval )
2110             {
2111             my $labelText;
2112              
2113             if ( defined $self->{f_y_tick} )
2114             {
2115              
2116             # Is _default_f_tick function used?
2117             if ( $self->{f_y_tick} == \&_default_f_tick )
2118             {
2119             $labelText = sprintf( "%." . $precision . "f", $labelNum );
2120             }
2121             else
2122             {
2123             $labelText = $self->{f_y_tick}->($labelNum);
2124             }
2125             }
2126             else
2127             {
2128             $labelText = sprintf( "%." . $precision . "f", $labelNum );
2129             }
2130              
2131             push @tickLabels, $labelText;
2132             $maxtickLabelLen = length $labelText if $maxtickLabelLen < length $labelText;
2133             }
2134              
2135             # Store the calculated data.
2136             $self->{'x_min_val'} = $p_min,
2137             $self->{'x_max_val'} = $p_max,
2138             $self->{'x_tick_labels'} = \@tickLabels,
2139             $self->{'x_tick_label_length'} = $maxtickLabelLen,
2140             $self->{'x_number_ticks'} = $tickCount;
2141             return 1;
2142             }
2143              
2144             ## @fn private int _find_y_scale()
2145             # find good values for the minimum and maximum y-value on the chart
2146             # @return status
2147             #
2148             # New version, re-written by David Pottage of Tao Group.\n
2149             # This code is *AS IS* and comes with *NO WARRANTY*\n
2150             #
2151             # This Sub calculates correct values for the following class local variables,
2152             # if they have not been set by the user.
2153             #
2154             # max_val, min_val: The maximum and minimum values for the y axis.\n
2155             # y_ticks: The number of ticks to plot on the y scale, including
2156             # the end points. e.g. If the scale runs from 0 to 50,
2157             # with ticks every 10, y_ticks will have the value of 6.\n
2158             # y_tick_labels: An array of strings, each is a label for the y axis.\n
2159             # y_tick_labels_length: The length to allow for B tick labels. (How long is
2160             # the longest?)
2161             sub _find_y_scale
2162             {
2163             my $self = shift;
2164              
2165             # Predeclare vars.
2166             my ( $d_min, $d_max ); # Dataset min & max.
2167             my ( $p_min, $p_max ); # Plot min & max.
2168             my ( $tickInterval, $tickCount, $skip );
2169             my @tickLabels; # List of labels for each tick.
2170             my $maxtickLabelLen = 0; # The length of the longest tick label.
2171             my $prec_test = 0; # Boolean which indicate if precision < |rangeExponent|
2172             my $temp_rangeExponent;
2173              
2174             my $flag_all_integers = 1; # assume true
2175              
2176             # Find the dataset minimum and maximum.
2177             ( $d_min, $d_max, $flag_all_integers ) = $self->_find_y_range();
2178              
2179             # Force the inclusion of zero if the user has requested it.
2180             if ( $self->true( $self->{'include_zero'} ) )
2181             {
2182              
2183             #print "include_zero = true\n";
2184             if ( ( $d_min * $d_max ) > 0 ) # If both are non zero and of the same sign.
2185             {
2186             if ( $d_min > 0 ) # If the whole scale is positive.
2187             {
2188             $d_min = 0;
2189             }
2190             else # The scale is entirely negative.
2191             {
2192             $d_max = 0;
2193             }
2194             }
2195             }
2196              
2197             if ( $self->true( $self->{'integer_ticks_only'} ) )
2198             {
2199              
2200             # Allow the dataset range to be overidden by the user.
2201             # f_min/f_max are booleans which indicate that the min & max should not be modified.
2202             my $f_min = 0;
2203             if ( defined $self->{'min_val'} ) { $f_min = 1; }
2204             $d_min = $self->{'min_val'} if $f_min;
2205              
2206             my $f_max = 0;
2207             if ( defined $self->{'max_val'} ) { $f_max = 1; }
2208             $d_max = $self->{'max_val'} if $f_max;
2209              
2210             # Assert against defined min and max.
2211             if ( !defined $d_min || !defined $d_max )
2212             {
2213             croak "No min_val or max_val is defined";
2214             }
2215              
2216             # Assert against the min is larger than the max.
2217             if ( $d_min > $d_max )
2218             {
2219             croak "The specified 'min_val' & 'max_val' values are reversed (min > max: $d_min>$d_max)";
2220             }
2221              
2222             # The user asked for integer ticks, force the limits to integers.
2223             # & work out the range directly.
2224             #$p_min = $self->_round2Tick($d_min, 1, -1);
2225             #$p_max = $self->_round2Tick($d_max, 1, 1);
2226              
2227             $skip = $self->{skip_int_ticks};
2228             $skip = 1 if $skip < 1;
2229              
2230             $p_min = $self->_round2Tick( $d_min, 1, -1 );
2231             $p_max = $self->_round2Tick( $d_max, 1, 1 );
2232             if ( ( $p_max - $p_min ) == 0 )
2233             {
2234             $p_max++ if ( $f_max != 1 ); # p_max is not defined by the user
2235             $p_min-- if ( $f_min != 1 ); # p_min is not defined by the user
2236             $p_max++ if ( ( $p_max - $p_min ) == 0 );
2237             }
2238              
2239             $tickInterval = $skip;
2240             $tickCount = ( $p_max - $p_min ) / $skip + 1;
2241              
2242             # Now sort out an array of tick labels.
2243              
2244             for ( my $labelNum = $p_min ; $labelNum < $p_max + $tickInterval / 3 ; $labelNum += $tickInterval )
2245             {
2246             my $labelText;
2247              
2248             if ( defined $self->{f_y_tick} )
2249             {
2250              
2251             # Is _default_f_tick function used?
2252             if ( $self->{f_y_tick} == \&_default_f_tick )
2253             {
2254             $labelText = sprintf( "%d", $labelNum );
2255             }
2256             else
2257             {
2258             $labelText = $self->{f_y_tick}->($labelNum);
2259             }
2260             }
2261             else
2262             {
2263             $labelText = sprintf( "%d", $labelNum );
2264             }
2265              
2266             push @tickLabels, $labelText;
2267             $maxtickLabelLen = length $labelText if $maxtickLabelLen < length $labelText;
2268             }
2269             }
2270             else
2271             {
2272              
2273             # Allow the dataset range to be overidden by the user.
2274             # f_min/f_max are booleans which indicate that the min & max should not be modified.
2275             my $f_min = 0;
2276             if ( defined $self->{'min_val'} ) { $f_min = 1; }
2277             $d_min = $self->{'min_val'} if $f_min;
2278              
2279             my $f_max = 0;
2280             if ( defined $self->{'max_val'} ) { $f_max = 1; }
2281             $d_max = $self->{'max_val'} if $f_max;
2282              
2283             # print "fmin $f_min fmax $f_max\n";
2284             # print "dmin $d_min dmax $d_max\n";
2285              
2286             # Assert against defined min and max.
2287             if ( !defined $d_min || !defined $d_max )
2288             {
2289             croak "No min_val or max_val is defined";
2290             }
2291              
2292             # Assert against the min is larger than the max.
2293             if ( $d_min > $d_max )
2294             {
2295             croak "The the specified 'min_val' & 'max_val' values are reversed (min > max: $d_min>$d_max)";
2296             }
2297              
2298             # Calculate the width of the dataset. (possibly modified by the user)
2299             my $d_width = $d_max - $d_min;
2300              
2301             # If the width of the range is zero, forcibly widen it
2302             # (to avoid division by zero errors elsewhere in the code).
2303             if ( $d_width == 0 )
2304             {
2305             $d_min--, $d_max++, $d_width = 2;
2306             }
2307              
2308             # Descale the range by converting the dataset width into
2309             # a floating point exponent & mantisa pair.
2310             my ( $rangeExponent, $rangeMantisa ) = $self->_sepFP($d_width);
2311             my $rangeMuliplier = 10**$rangeExponent;
2312              
2313             # print "fmin $f_min fmax $f_max\n";
2314             # print "dmin $d_min dmax $d_max\n";
2315              
2316             # Find what tick
2317             # to use & how many ticks to plot,
2318             # round the plot min & max to suitable round numbers.
2319             ( $tickInterval, $tickCount, $p_min, $p_max ) = $self->_calcTickInterval(
2320             $d_min / $rangeMuliplier,
2321             $d_max / $rangeMuliplier,
2322             $f_min, $f_max,
2323             $self->{'min_y_ticks'},
2324             $self->{'max_y_ticks'}
2325             );
2326              
2327             # Restore the tickInterval etc to the correct scale
2328             $_ *= $rangeMuliplier foreach ( $tickInterval, $p_min, $p_max );
2329              
2330             # Is precision < |rangeExponent|?
2331             if ( $rangeExponent < 0 )
2332             {
2333             $temp_rangeExponent = -$rangeExponent;
2334             }
2335             else
2336             {
2337             $temp_rangeExponent = $rangeExponent;
2338             }
2339              
2340             # print "pmin $p_min pmax $p_max\n";
2341             # print "range exponent $rangeExponent\n";
2342              
2343             #get the precision for the labels
2344             my $precision = $self->{'precision'};
2345              
2346             if ( $temp_rangeExponent != 0
2347             && $rangeExponent < 0
2348             && $temp_rangeExponent > $precision )
2349             {
2350             $prec_test = 1;
2351             }
2352              
2353             # Now sort out an array of tick labels.
2354             for ( my $labelNum = $p_min ; $labelNum < $p_max + $tickInterval / 2 ; $labelNum += $tickInterval )
2355             {
2356             my $labelText;
2357             if ( defined $self->{f_y_tick} )
2358             {
2359              
2360             # Is _default_f_tick function used?
2361             if ( ( $self->{f_y_tick} == \&_default_f_tick ) && ( $prec_test == 0 ) )
2362             {
2363             $labelText = sprintf( "%." . $precision . "f", $labelNum );
2364             }
2365              
2366             # If precision <|rangeExponent| print the labels whith exponents
2367             elsif ( ( $self->{f_y_tick} == \&_default_f_tick ) && ( $prec_test == 1 ) )
2368             {
2369             $labelText = $self->{f_y_tick}->($labelNum);
2370              
2371             # print "precision $precision\n";
2372             # print "temp range exponent $temp_rangeExponent\n";
2373             # print "range exponent $rangeExponent\n";
2374             # print "labelText $labelText\n";
2375              
2376             }
2377             else
2378             {
2379             $labelText = $self->{f_y_tick}->($labelNum);
2380             }
2381             }
2382             else
2383             {
2384             $labelText = sprintf( "%." . $precision . "f", $labelNum );
2385             }
2386             push @tickLabels, $labelText;
2387             $maxtickLabelLen = length $labelText if $maxtickLabelLen < length $labelText;
2388             } # end for
2389             }
2390              
2391             # Store the calculated data.
2392             #### begin debugging output
2393             #if ( defined $self->{'y_ticks'} )
2394             #{
2395             # print "_find_y_scale: self->{'y_ticks'}=".$self->{'y_ticks'}."\n";
2396             #}
2397             #else
2398             #{
2399             # print "_find_y_scale: self->{'y_ticks'}= NOT DEFINED\n";
2400             #}
2401             #if ( defined $self->{'min_val'} )
2402             #{
2403             # print "_find_y_scale: self->{'min_val'}=".$self->{'min_val'}."\n";
2404             #}
2405             #else
2406             #{
2407             # print "_find_y_scale: self->{'min_val'}=NOT DEFINED\n";
2408             #}
2409             #if ( defined $self->{'max_val'} )
2410             #{
2411             # print "_find_y_scale: self->{'max_val'}=".$self->{'max_val'}."\n";
2412             #}
2413             #else
2414             #{
2415             # print "_find_y_scale: self->{'max_val'}= NOT DEFINED\n";
2416             #}
2417             #### end debugging output
2418              
2419             $self->{'min_val'} = $p_min,
2420             $self->{'max_val'} = $p_max,
2421             $self->{'y_ticks'} = $tickCount,
2422             $self->{'y_tick_labels'} = \@tickLabels,
2423             $self->{'y_tick_label_length'} = $maxtickLabelLen;
2424              
2425             ##################
2426             #print statement is for debug only
2427             #print "_find_y_scale: min_val = $p_min, max_val=$p_max\n";
2428             ##################
2429              
2430             # and return.
2431             return 1;
2432             }
2433              
2434             ## @fn private _calcTickInterval($dataset_min, $dataset_max, $flag_fixed_min, $flag_fixed_max, $minTicks, $maxTicks)
2435             # @brief
2436             # Calculate the Interval between ticks in y direction
2437             #
2438             # @details
2439             # Calculate the Interval between ticks in y direction
2440             # and compare the number of ticks to
2441             # the user's given values min_y_ticks, max_y_ticks.
2442             #
2443             # @param[in] dataset_min Minimal value in y direction
2444             # @param[in] dataset_max Maximal value in y direction
2445             # @param[in] flag_fixed_min Indicator whether the dataset_min value is fixed
2446             # @param[in] flag_fixed_max Indicator whether the dataset_max value is fixed
2447             # @param[in] minTicks Minimal number of ticks wanted
2448             # @param[in] maxTicks Maximal number of ticks wanted
2449             # @return Array of ($tickInterval, $tickCount, $pMin, $pMax)
2450             #
2451             sub _calcTickInterval
2452             {
2453             my $self = shift;
2454              
2455             my (
2456             $dataset_min, $dataset_max, # The dataset min & max.
2457             $flag_fixed_min, $flag_fixed_max, # Indicates if those min/max are fixed.
2458             $minTicks, $maxTicks, # The minimum & maximum number of ticks.
2459             ) = @_;
2460              
2461             # print "calcTickInterval dataset_min $dataset_min dataset_max $dataset_max flag_fixed_min $flag_fixed_min flag_mixed_max $flag_fixed_max\n";
2462              
2463             # Verify the supplied 'min_y_ticks' & 'max_y_ticks' are sensible.
2464             if ( $minTicks < 2 )
2465             {
2466              
2467             #print STDERR "Chart::Base::_calcTickInterval : Incorrect value for 'min_y_ticks', too small (less than 2).\n";
2468             $minTicks = 2;
2469             }
2470              
2471             if ( $maxTicks < 5 * $minTicks )
2472             {
2473              
2474             #print STDERR "Chart::Base::_calcTickInterval : Incorrect value for 'max_y_ticks', too small (<5*minTicks).\n";
2475             $maxTicks = 5 * $minTicks;
2476             }
2477              
2478             my $width = $dataset_max - $dataset_min;
2479             my @divisorList;
2480              
2481             for ( my $baseMul = 1 ; ; $baseMul *= 10 )
2482             {
2483             TRY: foreach my $tryMul ( 1, 2, 5 )
2484             {
2485              
2486             # Calc a fresh, smaller tick interval.
2487             my $divisor = $baseMul * $tryMul;
2488              
2489             # Count the number of ticks.
2490             my ( $tickCount, $pMin, $pMax ) = $self->_countTicks( $dataset_min, $dataset_max, 1 / $divisor );
2491              
2492             # Look a the number of ticks.
2493             if ( $maxTicks < $tickCount )
2494             {
2495              
2496             # If it is to high, Backtrack.
2497             $divisor = pop @divisorList;
2498              
2499             # just for security:
2500             if ( !defined($divisor) || $divisor == 0 ) { $divisor = 1; }
2501             ( $tickCount, $pMin, $pMax ) = $self->_countTicks( $dataset_min, $dataset_max, 1 / $divisor );
2502              
2503             #print STDERR "\nChart::Base : Caution: Tick limit of $maxTicks exceeded. Backing of to an interval of ".1/$divisor." which plots $tickCount ticks\n";
2504             return ( 1 / $divisor, $tickCount, $pMin, $pMax );
2505             }
2506             elsif ( $minTicks > $tickCount )
2507             {
2508              
2509             # If it is too low, try again.
2510             next TRY;
2511             }
2512             else
2513             {
2514              
2515             # Store the divisor for possible later backtracking.
2516             push @divisorList, $divisor;
2517              
2518             # if the min or max is fixed, check they will fit in the interval.
2519             next TRY if ( $flag_fixed_min && ( int( $dataset_min * $divisor ) != ( $dataset_min * $divisor ) ) );
2520             next TRY if ( $flag_fixed_max && ( int( $dataset_max * $divisor ) != ( $dataset_max * $divisor ) ) );
2521              
2522             # If everything passes the tests, return.
2523             return ( 1 / $divisor, $tickCount, $pMin, $pMax );
2524             }
2525             }
2526             }
2527              
2528             die "can't happen!";
2529             }
2530              
2531             ## @fn private int _calcXTickInterval($min,$max,$minF,$maxF,$minTicks,$maxTicks)
2532             # @brief
2533             # Calculate the Interval between ticks in x direction
2534             #
2535             # @details
2536             # Calculate the Interval between ticks in x direction
2537             # and compare the number of ticks to
2538             # the user's given values minTicks, maxTicks.
2539             #
2540             # @param[in] min Minimal value of dataset in x direction
2541             # @param[in] max Maximal value of dataset in x direction
2542             # @param[in] minF Inddicator if those min value is fixed
2543             # @param[in] maxF Inddicator if those max value is fixed
2544             # @param[in] minTicks Minimal number of tick in x direction
2545             # @param[in] maxTicks Maximal number of tick in x direction
2546             # @return $tickInterval, $tickCount, $pMin, $pMax
2547             sub _calcXTickInterval
2548             {
2549             my $self = shift;
2550             my (
2551             $min, $max, # The dataset min & max.
2552             $minF, $maxF, # Indicates if those min/max are fixed.
2553             $minTicks, $maxTicks, # The minimum & maximum number of ticks.
2554             ) = @_;
2555              
2556             # Verify the supplied 'min_y_ticks' & 'max_y_ticks' are sensible.
2557             if ( $minTicks < 2 )
2558             {
2559              
2560             #print STDERR "Chart::Base::_calcXTickInterval : Incorrect value for 'min_y_ticks', too small.\n";
2561             $minTicks = 2;
2562             }
2563              
2564             if ( $maxTicks < 5 * $minTicks )
2565             {
2566              
2567             #print STDERR "Chart::Base::_calcXTickInterval : Incorrect value for 'max_y_ticks', to small.\n";
2568             $maxTicks = 5 * $minTicks;
2569             }
2570              
2571             my $width = $max - $min;
2572             my @divisorList;
2573              
2574             for ( my $baseMul = 1 ; ; $baseMul *= 10 )
2575             {
2576             TRY: foreach my $tryMul ( 1, 2, 5 )
2577             {
2578              
2579             # Calc a fresh, smaller tick interval.
2580             my $divisor = $baseMul * $tryMul;
2581              
2582             # Count the number of ticks.
2583             my ( $tickCount, $pMin, $pMax ) = $self->_countTicks( $min, $max, 1 / $divisor );
2584              
2585             #print STDERR "Chart::Base::_calcXTickInterval : tickCount = $tickCount, maxTicks = $maxTicks\n";
2586             # Look a the number of ticks.
2587             if ( $maxTicks < $tickCount )
2588             {
2589              
2590             # If it is to high, Backtrack.
2591             $divisor = pop @divisorList;
2592              
2593             # just for security:
2594             if ( !defined($divisor) || $divisor == 0 ) { $divisor = 1; }
2595             ( $tickCount, $pMin, $pMax ) = $self->_countTicks( $min, $max, 1 / $divisor );
2596              
2597             #print STDERR "\nChart::Base : Caution: Tick limit of $maxTicks exceeded. Backing of to an interval of ".1/$divisor." which plots $tickCount ticks\n";
2598             return ( 1 / $divisor, $tickCount, $pMin, $pMax );
2599             }
2600             elsif ( $minTicks > $tickCount )
2601             {
2602              
2603             # If it is too low, try again.
2604             next TRY;
2605             }
2606             else
2607             {
2608              
2609             # Store the divisor for possible later backtracking.
2610             push @divisorList, $divisor;
2611              
2612             # if the min or max is fixed, check they will fit in the interval.
2613             next TRY if ( $minF && ( int( $min * $divisor ) != ( $min * $divisor ) ) );
2614             next TRY if ( $maxF && ( int( $max * $divisor ) != ( $max * $divisor ) ) );
2615              
2616             # If everything passes the tests, return.
2617             return ( 1 / $divisor, $tickCount, $pMin, $pMax );
2618             }
2619             }
2620             }
2621              
2622             croak "can't happen!";
2623             }
2624              
2625             ## @fn private int _countTicks($min,$max,$interval)
2626             #
2627             # @brief
2628             # Works out how many ticks would be displayed at that interval
2629             #
2630             # @param min Minimal value
2631             # @param max Maximal value
2632             # @param interval value
2633             # @return ($tickCount, $minR, $maxR)
2634             #
2635             # @details
2636             #
2637             # e.g min=2, max=5, interval=1, result is 4 ticks.\n
2638             # written by David Pottage of Tao Group.\n
2639             # $minR = $self->_round2Tick( $min, $interval, -1);\n
2640             # $maxR = $self->_round2Tick( $max, $interval, 1);\n
2641             # $tickCount = ( $maxR/$interval ) - ( $minR/$interval ) +1;
2642             sub _countTicks
2643             {
2644             my $self = shift;
2645             my ( $min, $max, $interval ) = @_;
2646              
2647             my $minR = $self->_round2Tick( $min, $interval, -1 );
2648             my $maxR = $self->_round2Tick( $max, $interval, 1 );
2649              
2650             my $tickCount = ( $maxR / $interval ) - ( $minR / $interval ) + 1;
2651              
2652             return ( $tickCount, $minR, $maxR );
2653             }
2654              
2655             ## @fn private int _round2Tick($input, $interval, $roundUP)
2656             # Rounds up or down to the next tick of interval size.
2657             #
2658             # $roundUP can be +1 or -1 to indicate if rounding should be up or down.\n
2659             # written by David Pottage of Tao Group.
2660             #
2661             # @param input
2662             # @param interval
2663             # @param roundUP
2664             # @return retN*interval
2665             sub _round2Tick
2666             {
2667             my $self = shift;
2668             my ( $input, $interval, $roundUP ) = @_;
2669             return $input if $interval == 0;
2670             die unless 1 == $roundUP * $roundUP;
2671              
2672             my $intN = int( $input / $interval );
2673             my $fracN = ( $input / $interval ) - $intN;
2674              
2675             my $retN =
2676             ( ( 0 == $fracN ) || ( ( $roundUP * $fracN ) < 0 ) )
2677             ? $intN
2678             : $intN + $roundUP;
2679              
2680             return $retN * $interval;
2681             }
2682              
2683             ## @fn private array _sepFP($num)
2684             # @brief
2685             # Seperates a number into it's base 10 floating point exponent & mantisa.
2686             # @details
2687             # written by David Pottage of Tao Group.
2688             #
2689             # @param num Floating point number
2690             # @return ( exponent, mantissa)
2691             sub _sepFP
2692             {
2693             my $self = shift;
2694             my ($num) = @_;
2695             return ( 0, 0 ) if $num == 0;
2696              
2697             my $sign = ( $num > 0 ) ? 1 : -1;
2698             $num *= $sign;
2699              
2700             my $exponent = int( log($num) / log(10) );
2701             my $mantisa = $sign * ( $num / ( 10**$exponent ) );
2702              
2703             return ( $exponent, $mantisa );
2704             }
2705              
2706             ## @fn private array _find_y_range()
2707             # Find minimum and maximum value of y data sets.
2708             #
2709             # @return ( min, max, flag_all_integers )
2710             sub _find_y_range
2711             {
2712             my $self = shift;
2713             my $data = $self->{'dataref'};
2714              
2715             my $max = undef;
2716             my $min = undef;
2717             my $flag_all_integers = 1; # assume true
2718              
2719             for my $dataset ( @$data[ 1 .. $#$data ] )
2720             {
2721             for my $datum (@$dataset)
2722             {
2723             if ( defined $datum )
2724             {
2725              
2726             #croak "Missing data (dataset)";
2727             if ($flag_all_integers)
2728             {
2729              
2730             # it's worth looking for integers
2731             if ( $datum !~ /^[\-\+]?\d+$/ )
2732             {
2733             $flag_all_integers = 0; # No
2734             }
2735             }
2736             if ( $datum =~ /^[\-\+]?\s*[\d\.eE\-\+]+/ )
2737             {
2738             if ( defined $max && $max =~ /^[\-\+]{0,}\s*[\d\.eE\-\+]+/ )
2739             {
2740             if ( $datum > $max ) { $max = $datum; }
2741             elsif ( !defined $min ) { $min = $datum; }
2742             elsif ( $datum < $min ) { $min = $datum; }
2743             }
2744             else { $min = $max = $datum }
2745             }
2746             }
2747             }
2748             }
2749              
2750             # Return:
2751             ( $min, $max, $flag_all_integers );
2752             }
2753              
2754             ## @fn private array _find_x_range()
2755             # Find minimum and maximum value of x data sets
2756             # @return ( min, max )
2757             sub _find_x_range
2758             {
2759             my $self = shift;
2760             my $data = $self->{'dataref'};
2761              
2762             my $max = undef;
2763             my $min = undef;
2764              
2765             for my $datum ( @{ $data->[0] } )
2766             {
2767             if ( defined $datum && $datum =~ /^[\-\+]{0,1}\s*[\d\.eE\-\+]+/ )
2768             {
2769             if ( defined $max && $max =~ /^[\-\+]{0,1}\s*[\d\.eE\-\+]+/ )
2770             {
2771             if ( $datum > $max ) { $max = $datum }
2772             elsif ( $datum < $min ) { $min = $datum }
2773             }
2774             else { $min = $max = $datum }
2775             }
2776             }
2777              
2778             return ( $min, $max );
2779             }
2780              
2781             ## @fn private int _plot()
2782             # main sub that controls all the plotting of the actual chart
2783             # @return status
2784             sub _plot
2785             {
2786             my $self = shift;
2787              
2788             # draw the legend first
2789             $self->_draw_legend();
2790              
2791             # mark off the graph_border space
2792             $self->{'curr_x_min'} += $self->{'graph_border'};
2793             $self->{'curr_x_max'} -= $self->{'graph_border'};
2794             $self->{'curr_y_min'} += $self->{'graph_border'};
2795             $self->{'curr_y_max'} -= $self->{'graph_border'};
2796              
2797             # draw the x- and y-axis labels
2798             $self->_draw_x_label if $self->{'x_label'};
2799             $self->_draw_y_label('left') if $self->{'y_label'};
2800             $self->_draw_y_label('right') if $self->{'y_label2'};
2801              
2802             # draw the ticks and tick labels
2803             $self->_draw_ticks();
2804              
2805             # give the plot a grey background if they want it
2806             $self->_grey_background if ( $self->true( $self->{'grey_background'} ) );
2807              
2808             #draw the ticks again if grey_background has ruined it in a Direction Chart.
2809             if ( $self->true( $self->{'grey_background'} ) && $self->isa("Chart::Direction") )
2810             {
2811             $self->_draw_ticks;
2812             }
2813             $self->_draw_grid_lines if ( $self->true( $self->{'grid_lines'} ) );
2814             $self->_draw_x_grid_lines if ( $self->true( $self->{'x_grid_lines'} ) );
2815             $self->_draw_y_grid_lines if ( $self->true( $self->{'y_grid_lines'} ) );
2816             $self->_draw_y2_grid_lines if ( $self->true( $self->{'y2_grid_lines'} ) );
2817              
2818             # plot the data
2819             $self->_draw_data();
2820              
2821             # and return
2822             return 1;
2823             }
2824              
2825             ## @fn private int _draw_legend()
2826             # let the user know what all the pretty colors mean.\n
2827             # The user define the position of the legend by setting option
2828             # 'legend' to 'top', 'bottom', 'left', 'right' or 'none'.
2829             # The legend is positioned at the defined place, respectively.
2830             # @return status
2831             sub _draw_legend
2832             {
2833             my $self = shift;
2834             my $length;
2835              
2836             # check to see if legend type is none..
2837             if ( $self->{'legend'} =~ /^none$/ || length( $self->{'legend'} ) == 0 )
2838             {
2839             return 1;
2840             }
2841              
2842             # check to see if they have as many labels as datasets,
2843             # warn them if not
2844             if ( ( $#{ $self->{'legend_labels'} } >= 0 )
2845             && ( ( scalar( @{ $self->{'legend_labels'} } ) ) != $self->{'num_datasets'} ) )
2846             {
2847             carp "The number of legend labels and datasets doesn\'t match";
2848             }
2849              
2850             # init a field to store the length of the longest legend label
2851             unless ( $self->{'max_legend_label'} )
2852             {
2853             $self->{'max_legend_label'} = 0;
2854             }
2855              
2856             # fill in the legend labels, find the longest one
2857             for ( 1 .. $self->{'num_datasets'} )
2858             {
2859             unless ( $self->{'legend_labels'}[ $_ - 1 ] )
2860             {
2861             $self->{'legend_labels'}[ $_ - 1 ] = "Dataset $_";
2862             }
2863             $length = length( $self->{'legend_labels'}[ $_ - 1 ] );
2864             if ( $length > $self->{'max_legend_label'} )
2865             {
2866             $self->{'max_legend_label'} = $length;
2867             }
2868             }
2869              
2870             # different legend types
2871             if ( $self->{'legend'} eq 'bottom' )
2872             {
2873             $self->_draw_bottom_legend;
2874             }
2875             elsif ( $self->{'legend'} eq 'right' )
2876             {
2877             $self->_draw_right_legend;
2878             }
2879             elsif ( $self->{'legend'} eq 'left' )
2880             {
2881             $self->_draw_left_legend;
2882             }
2883             elsif ( $self->{'legend'} eq 'top' )
2884             {
2885             $self->_draw_top_legend;
2886             }
2887             elsif ( $self->{'legend'} eq 'none' || length( $self->{'legend'} ) == 0 )
2888             {
2889             $self->_draw_none_legend;
2890             }
2891             else
2892             {
2893             carp "I can't put a legend there (at " . $self->{'legend'} . ")\n";
2894             }
2895              
2896             # and return
2897             return 1;
2898             }
2899              
2900             ## @fn private int _draw_bottom_legend()
2901             # put the legend on the bottom of the chart
2902             # @return status
2903             sub _draw_bottom_legend
2904             {
2905             my $self = shift;
2906              
2907             my @labels = @{ $self->{'legend_labels'} };
2908             my ( $x1, $y1, $x2, $x3, $y2 );
2909             my ( $empty_width, $max_label_width, $cols, $rows, $color, $brush );
2910             my ( $col_width, $row_height, $r, $c, $index, $x, $y, $w, $h, $axes_space );
2911             my $font = $self->{'legend_font'};
2912              
2913             # make sure we're using a real font
2914             unless ( ( ref($font) ) eq 'GD::Font' )
2915             {
2916             croak "The font you specified isn\'t a GD Font object";
2917             }
2918              
2919             # get the size of the font
2920             ( $h, $w ) = ( $font->height, $font->width );
2921              
2922             # find the base x values
2923             $axes_space =
2924             ( $self->{'y_tick_label_length'} * $self->{'tick_label_font'}->width ) +
2925             $self->{'tick_len'} +
2926             ( 3 * $self->{'text_space'} );
2927             $x1 = $self->{'curr_x_min'} + $self->{'graph_border'};
2928             $x2 = $self->{'curr_x_max'} - $self->{'graph_border'};
2929              
2930             if ( $self->{'y_axes'} =~ /^right$/i )
2931             {
2932             $x2 -= $axes_space;
2933             }
2934             elsif ( $self->{'y_axes'} =~ /^both$/i )
2935             {
2936             $x2 -= $axes_space;
2937             $x1 += $axes_space;
2938             }
2939              
2940             if ( $self->{'y_label'} )
2941             {
2942             $x1 += $self->{'label_font'}->height + 2 * $self->{'text_space'};
2943             }
2944             if ( $self->{'y_label2'} )
2945             {
2946             $x2 -= $self->{'label_font'}->height + 2 * $self->{'text_space'};
2947             }
2948              
2949             # figure out how wide the columns need to be, and how many we
2950             # can fit in the space available
2951             $empty_width = ( $x2 - $x1 ) - ( 2 * $self->{'legend_space'} );
2952             $max_label_width = $self->{'max_legend_label'} * $w + ( 4 * $self->{'text_space'} ) + $self->{'legend_example_size'};
2953             $cols = int( $empty_width / $max_label_width );
2954              
2955             unless ($cols)
2956             {
2957             $cols = 1;
2958             }
2959             $col_width = $empty_width / $cols;
2960              
2961             # figure out how many rows we need, remember how tall they are
2962             $rows = int( $self->{'num_datasets'} / $cols );
2963             unless ( ( $self->{'num_datasets'} % $cols ) == 0 )
2964             {
2965             $rows++;
2966             }
2967             unless ($rows)
2968             {
2969             $rows = 1;
2970             }
2971             $row_height = $h + $self->{'text_space'};
2972              
2973             # box the legend off
2974             $y1 = $self->{'curr_y_max'} - $self->{'text_space'} - ( $rows * $row_height ) - ( 2 * $self->{'legend_space'} );
2975             $y2 = $self->{'curr_y_max'};
2976             $self->{'gd_obj'}->rectangle( $x1, $y1, $x2, $y2, $self->_color_role_to_index('misc') );
2977             $x1 += $self->{'legend_space'} + $self->{'text_space'};
2978             $x2 -= $self->{'legend_space'};
2979             $y1 += $self->{'legend_space'} + $self->{'text_space'};
2980             $y2 -= $self->{'legend_space'} + $self->{'text_space'};
2981              
2982             # draw in the actual legend
2983             for $r ( 0 .. $rows - 1 )
2984             {
2985             for $c ( 0 .. $cols - 1 )
2986             {
2987             $index = ( $r * $cols ) + $c; # find the index in the label array
2988             if ( $labels[$index] )
2989             {
2990              
2991             # get the color
2992             $color = $self->_color_role_to_index( 'dataset' . $index );
2993              
2994             # get the x-y coordinate for the start of the example line
2995             $x = $x1 + ( $col_width * $c );
2996             $y = $y1 + ( $row_height * $r ) + $h / 2;
2997              
2998             # now draw the example line
2999             $self->{'gd_obj'}->line( $x, $y, $x + $self->{'legend_example_size'}, $y, $color );
3000              
3001             # reset the brush for points
3002             $brush = $self->_prepare_brush( $color, 'point', 'dataset' . $index );
3003             $self->{'gd_obj'}->setBrush($brush);
3004              
3005             # draw the point
3006             $x3 = int( $x + $self->{'legend_example_size'} / 2 );
3007             $self->{'gd_obj'}->line( $x3, $y, $x3, $y, gdBrushed );
3008              
3009             # adjust the x-y coordinates for the start of the label
3010             $x += $self->{'legend_example_size'} + ( 2 * $self->{'text_space'} );
3011             $y = $y1 + ( $row_height * $r );
3012              
3013             # now draw the label
3014             $self->{'gd_obj'}->string( $font, $x, $y, $labels[$index], $color );
3015             }
3016             }
3017             }
3018              
3019             # mark off the space used
3020             $self->{'curr_y_max'} -= $rows * $row_height + 2 * $self->{'text_space'} + 2 * $self->{'legend_space'};
3021              
3022             # now return
3023             return 1;
3024             }
3025              
3026             ## @fn private int _draw_right_legend()
3027             # put the legend on the right of the chart
3028             # @return status
3029             sub _draw_right_legend
3030             {
3031             my $self = shift;
3032             my @labels = @{ $self->{'legend_labels'} };
3033             my ( $x1, $x2, $x3, $y1, $y2, $width, $color, $misccolor, $w, $h, $brush );
3034             my $font = $self->{'legend_font'};
3035              
3036             # make sure we're using a real font
3037             unless ( ( ref($font) ) eq 'GD::Font' )
3038             {
3039             croak "The subtitle font you specified isn\'t a GD Font object";
3040             }
3041              
3042             # get the size of the font
3043             ( $h, $w ) = ( $font->height, $font->width );
3044              
3045             # get the miscellaneous color
3046             $misccolor = $self->_color_role_to_index('misc');
3047              
3048             # find out how wide the largest label is
3049             $width =
3050             ( 2 * $self->{'text_space'} ) +
3051             ( $self->{'max_legend_label'} * $w ) +
3052             $self->{'legend_example_size'} +
3053             ( 2 * $self->{'legend_space'} );
3054              
3055             # get some starting x-y values
3056             $x1 = $self->{'curr_x_max'} - $width;
3057             $x2 = $self->{'curr_x_max'};
3058             $y1 = $self->{'curr_y_min'} + $self->{'graph_border'};
3059             $y2 =
3060             $self->{'curr_y_min'} +
3061             $self->{'graph_border'} +
3062             $self->{'text_space'} +
3063             ( $self->{'num_datasets'} * ( $h + $self->{'text_space'} ) ) +
3064             ( 2 * $self->{'legend_space'} );
3065              
3066             # box the legend off
3067             $self->{'gd_obj'}->rectangle( $x1, $y1, $x2, $y2, $misccolor );
3068              
3069             # leave that nice space inside the legend box
3070             $x1 += $self->{'legend_space'};
3071             $y1 += $self->{'legend_space'} + $self->{'text_space'};
3072              
3073             # now draw the actual legend
3074             for ( 0 .. $#labels )
3075             {
3076              
3077             # get the color
3078             my $c = $self->{'num_datasets'} - $_ - 1;
3079              
3080             # color of the datasets in the legend
3081             $color = $self->_color_role_to_index( 'dataset' . $_ );
3082              
3083             # find the x-y coords
3084             $x2 = $x1;
3085             $x3 = $x2 + $self->{'legend_example_size'};
3086             $y2 = $y1 + ( $_ * ( $self->{'text_space'} + $h ) ) + $h / 2;
3087              
3088             # do the line first
3089             $self->{'gd_obj'}->line( $x2, $y2, $x3, $y2, $color );
3090              
3091             # reset the brush for points
3092             my $offset = 0;
3093             ( $brush, $offset ) = $self->_prepare_brush( $color, 'point', 'dataset' . $_ );
3094             $self->{'gd_obj'}->setBrush($brush);
3095              
3096             # draw the point
3097             $self->{'gd_obj'}->line( int( ( $x3 + $x2 ) / 2 ), $y2, int( ( $x3 + $x2 ) / 2 ), $y2, gdBrushed );
3098              
3099             # now the label
3100             $x2 = $x3 + ( 2 * $self->{'text_space'} );
3101             $y2 -= $h / 2;
3102              
3103             # order of the datasets in the legend
3104             $self->{'gd_obj'}->string( $font, $x2, $y2, $labels[$_], $color );
3105             }
3106              
3107             # mark off the used space
3108             $self->{'curr_x_max'} -= $width;
3109              
3110             # and return
3111             return 1;
3112             }
3113              
3114             ## @fn private int _draw_top_legend()
3115             # put the legend on top of the chart
3116             # @return status
3117             sub _draw_top_legend
3118             {
3119             my $self = shift;
3120             my @labels = @{ $self->{'legend_labels'} };
3121             my ( $x1, $y1, $x2, $x3, $y2, $empty_width, $max_label_width );
3122             my ( $cols, $rows, $color, $brush );
3123             my ( $col_width, $row_height, $r, $c, $index, $x, $y, $w, $h, $axes_space );
3124             my $font = $self->{'legend_font'};
3125              
3126             # make sure we're using a real font
3127             unless ( ( ref($font) ) eq 'GD::Font' )
3128             {
3129             croak "The subtitle font you specified isn\'t a GD Font object";
3130             }
3131              
3132             # get the size of the font
3133             ( $h, $w ) = ( $font->height, $font->width );
3134              
3135             # find the base x values
3136             $axes_space =
3137             ( $self->{'y_tick_label_length'} * $self->{'tick_label_font'}->width ) +
3138             $self->{'tick_len'} +
3139             ( 3 * $self->{'text_space'} );
3140             $x1 = $self->{'curr_x_min'} + $self->{'graph_border'};
3141             $x2 = $self->{'curr_x_max'} - $self->{'graph_border'};
3142              
3143             if ( $self->{'y_axes'} =~ /^right$/i )
3144             {
3145             $x2 -= $axes_space;
3146             }
3147             elsif ( $self->{'y_axes'} =~ /^both$/i )
3148             {
3149             $x2 -= $axes_space;
3150             $x1 += $axes_space;
3151             }
3152              
3153             # figure out how wide the columns can be, and how many will fit
3154             $empty_width = ( $x2 - $x1 ) - ( 2 * $self->{'legend_space'} );
3155             $max_label_width = ( 4 * $self->{'text_space'} ) + ( $self->{'max_legend_label'} * $w ) + $self->{'legend_example_size'};
3156             $cols = int( $empty_width / $max_label_width );
3157             unless ($cols)
3158             {
3159             $cols = 1;
3160             }
3161             $col_width = $empty_width / $cols;
3162              
3163             # figure out how many rows we need and remember how tall they are
3164             $rows = int( $self->{'num_datasets'} / $cols );
3165             unless ( ( $self->{'num_datasets'} % $cols ) == 0 )
3166             {
3167             $rows++;
3168             }
3169             unless ($rows)
3170             {
3171             $rows = 1;
3172             }
3173             $row_height = $h + $self->{'text_space'};
3174              
3175             # box the legend off
3176             $y1 = $self->{'curr_y_min'};
3177             $y2 = $self->{'curr_y_min'} + $self->{'text_space'} + ( $rows * $row_height ) + ( 2 * $self->{'legend_space'} );
3178             $self->{'gd_obj'}->rectangle( $x1, $y1, $x2, $y2, $self->_color_role_to_index('misc') );
3179              
3180             # leave some space inside the legend
3181             $x1 += $self->{'legend_space'} + $self->{'text_space'};
3182             $x2 -= $self->{'legend_space'};
3183             $y1 += $self->{'legend_space'} + $self->{'text_space'};
3184             $y2 -= $self->{'legend_space'} + $self->{'text_space'};
3185              
3186             # draw in the actual legend
3187             for $r ( 0 .. $rows - 1 )
3188             {
3189             for $c ( 0 .. $cols - 1 )
3190             {
3191             $index = ( $r * $cols ) + $c; # find the index in the label array
3192             if ( $labels[$index] )
3193             {
3194              
3195             # get the color
3196             $color = $self->_color_role_to_index( 'dataset' . $index );
3197              
3198             # find the x-y coords
3199             $x = $x1 + ( $col_width * $c );
3200             $y = $y1 + ( $row_height * $r ) + $h / 2;
3201              
3202             # draw the line first
3203             $self->{'gd_obj'}->line( $x, $y, $x + $self->{'legend_example_size'}, $y, $color );
3204              
3205             # reset the brush for points
3206             $brush = $self->_prepare_brush( $color, 'point', 'dataset' . $index );
3207             $self->{'gd_obj'}->setBrush($brush);
3208              
3209             # draw the point
3210             $x3 = int( $x + $self->{'legend_example_size'} / 2 );
3211             $self->{'gd_obj'}->line( $x3, $y, $x3, $y, gdBrushed );
3212              
3213             # now the label
3214             $x += $self->{'legend_example_size'} + ( 2 * $self->{'text_space'} );
3215             $y -= $h / 2;
3216             $self->{'gd_obj'}->string( $font, $x, $y, $labels[$index], $color );
3217             }
3218             }
3219             }
3220              
3221             # mark off the space used
3222             $self->{'curr_y_min'} += ( $rows * $row_height ) + $self->{'text_space'} + 2 * $self->{'legend_space'};
3223              
3224             # now return
3225             return 1;
3226             }
3227              
3228             ## @fn private int _draw_left_legend()
3229             # put the legend on the left of the chart
3230             # @return status
3231             sub _draw_left_legend
3232             {
3233             my $self = shift;
3234             my @labels = @{ $self->{'legend_labels'} };
3235             my ( $x1, $x2, $x3, $y1, $y2, $width, $color, $misccolor, $w, $h, $brush );
3236             my $font = $self->{'legend_font'};
3237              
3238             # make sure we're using a real font
3239             unless ( ( ref($font) ) eq 'GD::Font' )
3240             {
3241             croak "The subtitle font you specified isn\'t a GD Font object";
3242             }
3243              
3244             # get the size of the font
3245             ( $h, $w ) = ( $font->height, $font->width );
3246              
3247             # get the miscellaneous color
3248             $misccolor = $self->_color_role_to_index('misc');
3249              
3250             # find out how wide the largest label is
3251             $width =
3252             ( 2 * $self->{'text_space'} ) +
3253             ( $self->{'max_legend_label'} * $w ) +
3254             $self->{'legend_example_size'} +
3255             ( 2 * $self->{'legend_space'} );
3256              
3257             # get some base x-y coordinates
3258             $x1 = $self->{'curr_x_min'};
3259             $x2 = $self->{'curr_x_min'} + $width;
3260             $y1 = $self->{'curr_y_min'} + $self->{'graph_border'};
3261             $y2 =
3262             $self->{'curr_y_min'} +
3263             $self->{'graph_border'} +
3264             $self->{'text_space'} +
3265             ( $self->{'num_datasets'} * ( $h + $self->{'text_space'} ) ) +
3266             ( 2 * $self->{'legend_space'} );
3267              
3268             # box the legend off
3269             $self->{'gd_obj'}->rectangle( $x1, $y1, $x2, $y2, $misccolor );
3270              
3271             # leave that nice space inside the legend box
3272             $x1 += $self->{'legend_space'};
3273             $y1 += $self->{'legend_space'} + $self->{'text_space'};
3274              
3275             # now draw the actual legend
3276             for ( 0 .. $#labels )
3277             {
3278              
3279             # get the color
3280             my $c = $self->{'num_datasets'} - $_ - 1;
3281              
3282             # color of the datasets in the legend
3283             $color = $self->_color_role_to_index( 'dataset' . $_ );
3284              
3285             # find the x-y coords
3286             $x2 = $x1;
3287             $x3 = $x2 + $self->{'legend_example_size'};
3288             $y2 = $y1 + ( $_ * ( $self->{'text_space'} + $h ) ) + $h / 2;
3289              
3290             # do the line first
3291             $self->{'gd_obj'}->line( $x2, $y2, $x3, $y2, $color );
3292              
3293             # reset the brush for points
3294             $brush = $self->_prepare_brush( $color, 'point', 'dataset' . $_ );
3295             $self->{'gd_obj'}->setBrush($brush);
3296              
3297             # draw the point
3298             $self->{'gd_obj'}->line( int( ( $x3 + $x2 ) / 2 ), $y2, int( ( $x3 + $x2 ) / 2 ), $y2, gdBrushed );
3299              
3300             # now the label
3301             $x2 = $x3 + ( 2 * $self->{'text_space'} );
3302             $y2 -= $h / 2;
3303              
3304             # order of the datasets in the legend
3305             $self->{'gd_obj'}->string( $font, $x2, $y2, $labels[$_], $color );
3306             }
3307              
3308             # mark off the used space
3309             $self->{'curr_x_min'} += $width;
3310              
3311             # and return
3312             return 1;
3313             }
3314              
3315             ## @fn private int _draw_none_legend()
3316             # no legend to draw..
3317             # Just return in this case. This routine may be overwritten by
3318             # subclasses.
3319             # @return 1
3320             sub _draw_none_legend
3321             {
3322             my $self = shift;
3323             my $status = 1;
3324              
3325             return $status;
3326             }
3327              
3328             ## @fn private int _draw_x_label()
3329             # draw the label for the x-axis
3330             #
3331             # Get font for labels\n
3332             # Get the color of x_label or text\n
3333             # Get size of font\n
3334             # and write x-Label
3335             #
3336             # @return status
3337             sub _draw_x_label
3338             {
3339             my $self = shift;
3340             my $label = $self->{'x_label'};
3341             my $font = $self->{'label_font'};
3342             my $color;
3343             my ( $h, $w, $x, $y );
3344              
3345             #get the right color
3346             if ( defined $self->{'colors'}->{'x_label'} )
3347             {
3348             $color = $self->_color_role_to_index('x_label');
3349             }
3350             else
3351             {
3352             $color = $self->_color_role_to_index('text');
3353             }
3354              
3355             # make sure it's a real GD Font object
3356             unless ( ( ref($font) ) eq 'GD::Font' )
3357             {
3358             croak "The x-axis label font you specified isn\'t a GD Font object";
3359             }
3360              
3361             # get the size of the font
3362             ( $h, $w ) = ( $font->height, $font->width );
3363              
3364             # make sure it goes in the right place
3365             $x = ( $self->{'curr_x_max'} - $self->{'curr_x_min'} ) / 2 + $self->{'curr_x_min'} - ( length($label) * $w ) / 2;
3366             $y = $self->{'curr_y_max'} - ( $self->{'text_space'} + $h );
3367              
3368             # now write it
3369             $self->{'gd_obj'}->string( $font, $x, $y, $label, $color );
3370              
3371             # mark the space written to as used
3372             $self->{'curr_y_max'} -= $h + 2 * $self->{'text_space'};
3373              
3374             # and return
3375             return 1;
3376             }
3377              
3378             ## @fn private int _draw_y_label()
3379             # draw the label for the y-axis
3380             # @return status
3381             sub _draw_y_label
3382             {
3383             my $self = shift;
3384             my $side = shift;
3385             my $font = $self->{'label_font'};
3386             my ( $label, $h, $w, $x, $y, $color );
3387              
3388             # get the label
3389             if ( $side eq 'left' )
3390             {
3391             $label = $self->{'y_label'};
3392             $color = $self->_color_role_to_index('y_label');
3393             }
3394             elsif ( $side eq 'right' )
3395             {
3396             $label = $self->{'y_label2'};
3397             $color = $self->_color_role_to_index('y_label2');
3398             }
3399              
3400             # make sure it's a real GD Font object
3401             unless ( ( ref($font) ) eq 'GD::Font' )
3402             {
3403             croak "The x-axis label font you specified isn\'t a GD Font object";
3404             }
3405              
3406             # get the size of the font
3407             ( $h, $w ) = ( $font->height, $font->width );
3408              
3409             # make sure it goes in the right place
3410             if ( $side eq 'left' )
3411             {
3412             $x = $self->{'curr_x_min'} + $self->{'text_space'};
3413             }
3414             elsif ( $side eq 'right' )
3415             {
3416             $x = $self->{'curr_x_max'} - $self->{'text_space'} - $h;
3417             }
3418             $y = ( $self->{'curr_y_max'} - $self->{'curr_y_min'} ) / 2 + $self->{'curr_y_min'} + ( length($label) * $w ) / 2;
3419              
3420             # write it
3421             $self->{'gd_obj'}->stringUp( $font, $x, $y, $label, $color );
3422              
3423             # mark the space written to as used
3424             if ( $side eq 'left' )
3425             {
3426             $self->{'curr_x_min'} += $h + 2 * $self->{'text_space'};
3427             }
3428             elsif ( $side eq 'right' )
3429             {
3430             $self->{'curr_x_max'} -= $h + 2 * $self->{'text_space'};
3431             }
3432              
3433             # now return
3434             return 1;
3435             }
3436              
3437             ## @fn private int _draw_ticks()
3438             # draw the ticks and tick labels
3439             # @return status
3440             sub _draw_ticks
3441             {
3442             my $self = shift;
3443              
3444             #if the user wants an xy_plot, calculate the x-ticks too
3445             if (
3446             $self->true( $self->{'xy_plot'} )
3447             && ( $self->isa('Chart::Lines')
3448             || $self->isa('Chart::Points')
3449             || $self->isa('Chart::LinesPoints')
3450             || $self->isa('Chart::Split')
3451             || $self->isa('Chart::ErrorBars') )
3452             )
3453             {
3454             $self->_draw_x_number_ticks;
3455             }
3456             else
3457             { # draw the x ticks with strings
3458             $self->_draw_x_ticks;
3459             }
3460              
3461             # now the y ticks
3462             $self->_draw_y_ticks( $self->{'y_axes'} );
3463              
3464             # then return
3465             return 1;
3466             }
3467              
3468             ## @fn private int _draw_x_number_ticks()
3469             # draw the ticks and tick labels
3470             # @return status
3471             sub _draw_x_number_ticks
3472             {
3473             my $self = shift;
3474             my $data = $self->{'dataref'};
3475             my $font = $self->{'tick_label_font'};
3476             my $textcolor = $self->_color_role_to_index('text');
3477             my $misccolor = $self->_color_role_to_index('misc');
3478             my ( $h, $w, $x1, $y1, $y2, $x2, $delta, $width, $label );
3479             my @labels = @{ $self->{'x_tick_labels'} };
3480              
3481             $self->{'grid_data'}->{'x'} = [];
3482              
3483             #make sure we have a real font
3484             unless ( ( ref $font ) eq 'GD::Font' )
3485             {
3486             croak "The tick label font you specified isn't a GD font object";
3487             }
3488              
3489             #get height and width of the font
3490             ( $h, $w ) = ( $font->height, $font->width );
3491              
3492             #store actual borders, for a possible later repair
3493             $self->{'temp_x_min'} = $self->{'curr_x_min'};
3494             $self->{'temp_x_max'} = $self->{'curr_x_max'};
3495             $self->{'temp_y_max'} = $self->{'curr_y_max'};
3496             $self->{'temp_y_min'} = $self->{'curr_y_min'};
3497              
3498             #get the right x-value and width
3499             #The one and only way to get the RIGHT x value and the width
3500             if ( $self->{'y_axes'} =~ /^right$/i )
3501             {
3502             $x1 = $self->{'curr_x_min'};
3503             $width =
3504             $self->{'curr_x_max'} -
3505             $x1 -
3506             ( $w * $self->{'y_tick_label_length'} ) -
3507             3 * $self->{'text_space'} -
3508             $self->{'tick_len'};
3509             }
3510             elsif ( $self->{'y_axes'} =~ /^both$/i )
3511             {
3512             $x1 = $self->{'curr_x_min'} + ( $w * $self->{'y_tick_label_length'} ) + 3 * $self->{'text_space'} + $self->{'tick_len'};
3513             $width =
3514             $self->{'curr_x_max'} -
3515             $x1 -
3516             ( $w * $self->{'y_tick_label_length'} ) -
3517             ( 3 * $self->{'text_space'} ) -
3518             $self->{'tick_len'};
3519             }
3520             else
3521             {
3522             $x1 = $self->{'curr_x_min'} + ( $w * $self->{'y_tick_label_length'} ) + 3 * $self->{'text_space'} + $self->{'tick_len'};
3523             $width = $self->{'curr_x_max'} - $x1;
3524             }
3525              
3526             #get the delta value
3527             $delta = $width / ( $self->{'x_number_ticks'} - 1 );
3528              
3529             #draw the labels
3530             $y2 = $y1;
3531              
3532             if ( $self->{'x_ticks'} =~ /^normal/i )
3533             { #just normal ticks
3534             #get the point for updating later
3535             $y1 = $self->{'curr_y_max'} - 2 * $self->{'text_space'} - $h - $self->{'tick_len'};
3536              
3537             #get the start point
3538             $y2 = $y1 + $self->{'tick_len'} + $self->{'text_space'};
3539              
3540             if ( $self->{'xlabels'} )
3541             {
3542             unless ( $self->{'xrange'} )
3543             {
3544             croak "Base.pm: xrange must be specified with xlabels!\n";
3545             }
3546             my $xmin = $self->{'xrange'}[0];
3547             my $xmax = $self->{'xrange'}[1];
3548             my @labels = @{ $self->{'xlabels'}[0] };
3549             my @vals = @{ $self->{'xlabels'}[1] };
3550             my $delta = $width / ( $xmax - $xmin );
3551              
3552             for ( 0 .. $#labels )
3553             {
3554             my $label = $labels[$_];
3555             my $val = $vals[$_];
3556             $x2 = $x1 + ( $delta * ( $val - $xmin ) ) - ( 0.5 * $w * length($label) );
3557             $self->{'gd_obj'}->string( $font, $x2, $y2, $label, $textcolor );
3558              
3559             #print "write x-label '".$label."' at ($x2,$y2)\n";
3560             }
3561             }
3562             else
3563             {
3564             my $last_x = 'undefined';
3565             for ( 0 .. $#labels )
3566             {
3567             $label = $self->{f_x_tick}->( $self->{'x_tick_labels'}[$_] );
3568             $x2 = $x1 + ( $delta * $_ ) - ( 0.5 * $w * length($label) );
3569             if ( $last_x eq 'undefined'
3570             or $last_x < $x2 )
3571             {
3572             $self->{'gd_obj'}->string( $font, $x2, $y2, $label, $textcolor );
3573             $last_x = $x2 + ( $w * length($label) );
3574             }
3575              
3576             #print "last_x = $last_x, write string '".$label."' at ($x2,$y2) to '$_'\n";
3577             }
3578             }
3579             }
3580              
3581             elsif ( $self->{'x_ticks'} =~ /^staggered/i )
3582             { #staggered ticks
3583             #get the point for updating later
3584             $y1 = $self->{'curr_y_max'} - 3 * $self->{'text_space'} - 2 * $h - $self->{'tick_len'};
3585              
3586             if ( $self->{'xlabels'} )
3587             {
3588             unless ( $self->{'xrange'} )
3589             {
3590             croak "Base.pm: xrange must be specified with xlabels!\n";
3591             }
3592             my $xmin = $self->{'xrange'}[0];
3593             my $xmax = $self->{'xrange'}[1];
3594             my @labels = @{ $self->{'xlabels'}[0] };
3595             my @vals = @{ $self->{'xlabels'}[1] };
3596             my $delta = $width / ( $xmax - $xmin );
3597              
3598             for ( 0 .. $#labels )
3599             {
3600             my $label = $labels[$_];
3601             my $val = $vals[$_];
3602             $x2 = $x1 + ( $delta * ( $val - $xmin ) ) - ( 0.5 * $w * length($label) );
3603             unless ( $_ % 2 )
3604             {
3605             $y2 = $y1 + $self->{'text_space'} + $self->{'tick_len'};
3606             }
3607             else
3608             {
3609             $y2 = $y1 + $h + 2 * $self->{'text_space'} + $self->{'tick_len'};
3610             }
3611             $self->{'gd_obj'}->string( $font, $x2, $y2, $label, $textcolor );
3612              
3613             #print "write x-label '".$label."' at ($x2,$y2)\n";
3614             }
3615             }
3616             else
3617             {
3618             for ( 0 .. $#labels )
3619             {
3620             $label = $self->{f_x_tick}->( $self->{'x_tick_labels'}[$_] );
3621             $x2 = $x1 + ( $delta * $_ ) - ( 0.5 * $w * length($label) );
3622             unless ( $_ % 2 )
3623             {
3624             $y2 = $y1 + $self->{'text_space'} + $self->{'tick_len'};
3625             }
3626             else
3627             {
3628             $y2 = $y1 + $h + 2 * $self->{'text_space'} + $self->{'tick_len'};
3629             }
3630             $self->{'gd_obj'}->string( $font, $x2, $y2, $label, $textcolor );
3631             }
3632             }
3633             }
3634              
3635             elsif ( $self->{'x_ticks'} =~ /^vertical/i )
3636             { #vertical ticks
3637             #get the point for updating later
3638             $y1 = $self->{'curr_y_max'} - 2 * $self->{'text_space'} - $w * $self->{'x_tick_label_length'} - $self->{'tick_len'};
3639              
3640             if ( $self->{'xlabels'} )
3641             {
3642             unless ( $self->{'xrange'} )
3643             {
3644             croak "Base.pm: xrange must be specified with xlabels!\n";
3645             }
3646             my $xmin = $self->{'xrange'}[0];
3647             my $xmax = $self->{'xrange'}[1];
3648             my @labels = @{ $self->{'xlabels'}[0] };
3649             my @vals = @{ $self->{'xlabels'}[1] };
3650             my $delta = $width / ( $xmax - $xmin );
3651              
3652             for ( 0 .. $#labels )
3653             {
3654             my $label = $labels[$_];
3655             my $val = $vals[$_];
3656             $y2 = $y1 + $self->{'tick_len'} + $w * length($label) + $self->{'text_space'};
3657             $x2 = $x1 + ( $delta * ( $val - $xmin ) ) - ( $h / 2 );
3658             $self->{'gd_obj'}->stringUp( $font, $x2, $y2, $label, $textcolor );
3659              
3660             #print "write x-label '".$label."' at ($x2,$y2)\n";
3661             }
3662             }
3663             else
3664             {
3665              
3666             for ( 0 .. $#labels )
3667             {
3668             $label = $self->{f_x_tick}->( $self->{'x_tick_labels'}[$_] );
3669              
3670             #get the start point
3671             $y2 = $y1 + $self->{'tick_len'} + $w * length($label) + $self->{'text_space'};
3672             $x2 = $x1 + ( $delta * $_ ) - ( $h / 2 );
3673             $self->{'gd_obj'}->stringUp( $font, $x2, $y2, $label, $textcolor );
3674             }
3675             }
3676             }
3677              
3678             else
3679             {
3680             croak "I don't understand the type of x-ticks you specified\n"
3681             . "x-ticks must be one of 'normal', 'staggered' or 'vertical' but not of '"
3682             . $self->{'x_ticks'} . "'.";
3683             }
3684              
3685             #update the curr y max value
3686             $self->{'curr_y_max'} = $y1;
3687              
3688             #draw the ticks
3689             $y1 = $self->{'curr_y_max'};
3690             $y2 = $self->{'curr_y_max'} + $self->{'tick_len'};
3691              
3692             #draw grid lines
3693             if ( $self->{'xlabels'} )
3694             {
3695             unless ( $self->{'xrange'} )
3696             {
3697             croak "Base.pm: xrange must be specified with xlabels!\n";
3698             }
3699             my $xmin = $self->{'xrange'}[0];
3700             my $xmax = $self->{'xrange'}[1];
3701             my @vals = @{ $self->{'xlabels'}[1] };
3702             my $delta = $width / ( $xmax - $xmin );
3703              
3704             for ( 0 .. $#vals )
3705             {
3706             my $val = $vals[$_];
3707             $x2 = ($x1) + ( $delta * ( $val - $xmin ) );
3708             $self->{'gd_obj'}->line( $x2, $y1, $x2, $y2, $misccolor );
3709             if ( $self->true( $self->{'grid_lines'} )
3710             or $self->true( $self->{'x_grid_lines'} ) )
3711             {
3712             $self->{'grid_data'}->{'x'}->[$_] = $x2;
3713             }
3714             }
3715             }
3716             else
3717             {
3718             for ( 0 .. $#labels )
3719             {
3720             $x2 = $x1 + ( $delta * $_ );
3721             $self->{'gd_obj'}->line( $x2, $y1, $x2, $y2, $misccolor );
3722             if ( ( $self->true( $self->{'grid_lines'} ) )
3723             or ( $self->true( $self->{'x_grid_lines'} ) ) )
3724             {
3725             $self->{'grid_data'}->{'x'}->[$_] = $x2;
3726             }
3727             }
3728             }
3729             return 1;
3730             }
3731              
3732             ## @fn private int _draw_x_ticks()
3733             # draw the x-ticks and their labels
3734             # @return status
3735             sub _draw_x_ticks
3736             {
3737             my $self = shift;
3738             my $data = $self->{'dataref'};
3739             my $font = $self->{'tick_label_font'};
3740             my $textcolor = $self->_color_role_to_index('text');
3741             my $misccolor = $self->_color_role_to_index('misc');
3742             my $label;
3743             my ( $h, $w );
3744             my ( $x1, $x2, $y1, $y2 );
3745             my ( $width, $delta );
3746             my ($stag);
3747              
3748             $self->{'grid_data'}->{'x'} = [];
3749              
3750             # make sure we got a real font
3751             unless ( ( ref $font ) eq 'GD::Font' )
3752             {
3753             croak "The tick label font you specified isn\'t a GD Font object";
3754             }
3755              
3756             # get the height and width of the font
3757             ( $h, $w ) = ( $font->height, $font->width );
3758              
3759             # maybe, we need the actual x and y values later for drawing the x-ticks again
3760             # in the draw function in the lines modul. So copy them.
3761             $self->{'temp_x_min'} = $self->{'curr_x_min'};
3762             $self->{'temp_x_max'} = $self->{'curr_x_max'};
3763             $self->{'temp_y_min'} = $self->{'curr_y_min'};
3764             $self->{'temp_y_max'} = $self->{'curr_y_max'};
3765              
3766             # allow for the amount of space the y-ticks will push the
3767             # axes over to the right
3768             ## _draw_y_ticks allows 3 * text_space, not 1 * ; this caused mismatch between
3769             ## the ticks (and grid lines) and the data.
3770             # $x1 = $self->{'curr_x_min'} + ($w * $self->{'y_tick_label_length'})
3771             # + $self->{'text_space'} + $self->{'tick_len'};
3772             ## And, what about the right-tick space?? Only affects Composite, I guess....
3773              
3774             #The one and only way to get the RIGHT x value and the width
3775             if ( $self->{'y_axes'} =~ /^right$/i )
3776             {
3777             $x1 = $self->{'curr_x_min'};
3778             $width =
3779             $self->{'curr_x_max'} -
3780             $x1 -
3781             ( $w * $self->{'y_tick_label_length'} ) -
3782             3 * $self->{'text_space'} -
3783             $self->{'tick_len'};
3784             }
3785             elsif ( $self->{'y_axes'} =~ /^both$/i )
3786             {
3787             $x1 = $self->{'curr_x_min'} + ( $w * $self->{'y_tick_label_length'} ) + 3 * $self->{'text_space'} + $self->{'tick_len'};
3788             $width =
3789             $self->{'curr_x_max'} -
3790             $x1 -
3791             ( $w * $self->{'y_tick_label_length'} ) -
3792             3 * $self->{'text_space'} -
3793             $self->{'tick_len'};
3794             }
3795             else
3796             {
3797             $x1 = $self->{'curr_x_min'} + ( $w * $self->{'y_tick_label_length'} ) + 3 * $self->{'text_space'} + $self->{'tick_len'};
3798             $width = $self->{'curr_x_max'} - $x1;
3799             }
3800              
3801             #the same for the y value, but not so tricky
3802             $y1 = $self->{'curr_y_max'} - $h - $self->{'text_space'};
3803              
3804             # get the delta value, figure out how to draw the labels
3805             $delta = $width / ( $self->{'num_datapoints'} > 0 ? $self->{'num_datapoints'} : 1 );
3806             if ( !defined( $self->{'skip_x_ticks'} ) )
3807             {
3808             $self->{'skip_x_ticks'} = 1;
3809             }
3810             elsif ( $self->{'skip_x_ticks'} == 0 )
3811             {
3812             $self->{'skip_x_ticks'} = 1;
3813             }
3814             if ( $delta <= ( $self->{'x_tick_label_length'} * $w ) / $self->{'skip_x_ticks'} )
3815             {
3816             if ( $self->{'x_ticks'} =~ /^normal$/i )
3817             {
3818             $self->{'x_ticks'} = 'staggered';
3819             }
3820             }
3821              
3822             # now draw the labels
3823             if ( $self->{'x_ticks'} =~ /^normal$/i )
3824             { # normal ticks
3825             if ( $self->{'skip_x_ticks'} > 1 )
3826             { # draw only every nth tick and label
3827             for ( 0 .. int( ( $self->{'num_datapoints'} - 1 ) / $self->{'skip_x_ticks'} ) )
3828             {
3829             if ( defined( $data->[0][ $_ * $self->{'skip_x_ticks'} ] ) )
3830             {
3831             $label = $self->{f_x_tick}->( $data->[0][ $_ * $self->{'skip_x_ticks'} ] );
3832             $x2 = $x1 + ( $delta / 2 ) + ( $delta * ( $_ * $self->{'skip_x_ticks'} ) ) - ( $w * length($label) ) / 2;
3833             $self->{'gd_obj'}->string( $font, $x2, $y1, $label, $textcolor );
3834             }
3835             }
3836             }
3837             elsif ( $self->{'custom_x_ticks'} )
3838             { # draw only the ticks they wanted
3839             for ( @{ $self->{'custom_x_ticks'} } )
3840             {
3841             if ( defined($_) )
3842             {
3843             $label = $self->{f_x_tick}->( $data->[0][$_] );
3844             $x2 = $x1 + ( $delta / 2 ) + ( $delta * $_ ) - ( $w * length($label) ) / 2;
3845             $self->{'gd_obj'}->string( $font, $x2, $y1, $label, $textcolor );
3846             }
3847             }
3848             }
3849             else
3850             {
3851             for ( 0 .. $self->{'num_datapoints'} - 1 )
3852             {
3853             if ( defined($_) )
3854             {
3855             $label = $self->{f_x_tick}->( $data->[0][$_] );
3856             $x2 = $x1 + ( $delta / 2 ) + ( $delta * $_ ) - ( $w * length($label) ) / 2;
3857             $self->{'gd_obj'}->string( $font, $x2, $y1, $label, $textcolor );
3858             }
3859             }
3860             }
3861             }
3862              
3863             elsif ( $self->{'x_ticks'} =~ /^staggered$/i )
3864             { # staggered ticks
3865             if ( $self->{'skip_x_ticks'} > 1 )
3866             {
3867             $stag = 0;
3868             for ( 0 .. int( ( $self->{'num_datapoints'} - 1 ) / $self->{'skip_x_ticks'} ) )
3869             {
3870             if ( defined( $data->[0][ $_ * $self->{'skip_x_ticks'} ] ) )
3871             {
3872             $x2 =
3873             $x1 +
3874             ( $delta / 2 ) +
3875             ( $delta * ( $_ * $self->{'skip_x_ticks'} ) ) -
3876             ( $w * length( $self->{f_x_tick}->( $data->[0][ $_ * $self->{'skip_x_ticks'} ] ) ) ) / 2;
3877             if ( ( $stag % 2 ) == 1 )
3878             {
3879             $y1 -= $self->{'text_space'} + $h;
3880             }
3881             $self->{'gd_obj'}
3882             ->string( $font, $x2, $y1, $self->{f_x_tick}->( $data->[0][ $_ * $self->{'skip_x_ticks'} ] ),
3883             $textcolor );
3884             if ( ( $stag % 2 ) == 1 )
3885             {
3886             $y1 += $self->{'text_space'} + $h;
3887             }
3888             $stag++;
3889             }
3890             }
3891             }
3892             elsif ( $self->{'custom_x_ticks'} )
3893             {
3894             $stag = 0;
3895             for ( sort ( @{ $self->{'custom_x_ticks'} } ) )
3896             { # sort to make it look good
3897             if ( defined($_) )
3898             {
3899             $x2 = $x1 + ( $delta / 2 ) + ( $delta * $_ ) - ( $w * length( $self->{f_x_tick}->( $data->[0][$_] ) ) ) / 2;
3900             if ( ( $stag % 2 ) == 1 )
3901             {
3902             $y1 -= $self->{'text_space'} + $h;
3903             }
3904             $self->{'gd_obj'}->string( $font, $x2, $y1, $self->{f_x_tick}->( $data->[0][$_] ), $textcolor );
3905             if ( ( $stag % 2 ) == 1 )
3906             {
3907             $y1 += $self->{'text_space'} + $h;
3908             }
3909             $stag++;
3910             }
3911             }
3912             }
3913             else
3914             {
3915             for ( 0 .. $self->{'num_datapoints'} - 1 )
3916             {
3917             if ( defined( $self->{f_x_tick}->( $data->[0][$_] ) ) )
3918             {
3919             $x2 = $x1 + ( $delta / 2 ) + ( $delta * $_ ) - ( $w * length( $self->{f_x_tick}->( $data->[0][$_] ) ) ) / 2;
3920             if ( ( $_ % 2 ) == 1 )
3921             {
3922             $y1 -= $self->{'text_space'} + $h;
3923             }
3924             $self->{'gd_obj'}->string( $font, $x2, $y1, $self->{f_x_tick}->( $data->[0][$_] ), $textcolor );
3925             if ( ( $_ % 2 ) == 1 )
3926             {
3927             $y1 += $self->{'text_space'} + $h;
3928             }
3929             }
3930             }
3931             }
3932             }
3933             elsif ( $self->{'x_ticks'} =~ /^vertical$/i )
3934             { # vertical ticks
3935             $y1 = $self->{'curr_y_max'} - $self->{'text_space'};
3936             if ( $self->{'skip_x_ticks'} > 1 )
3937             {
3938             for ( 0 .. int( ( $self->{'num_datapoints'} - 1 ) / $self->{'skip_x_ticks'} ) )
3939             {
3940             if ( defined($_) )
3941             {
3942             $x2 = $x1 + ( $delta / 2 ) + ( $delta * ( $_ * $self->{'skip_x_ticks'} ) ) - $h / 2;
3943             $y2 = $y1 - (
3944             (
3945             $self->{'x_tick_label_length'} -
3946             length( $self->{f_x_tick}->( $data->[0][ $_ * $self->{'skip_x_ticks'} ] ) )
3947             ) * $w
3948             );
3949             $self->{'gd_obj'}
3950             ->stringUp( $font, $x2, $y2, $self->{f_x_tick}->( $data->[0][ $_ * $self->{'skip_x_ticks'} ] ),
3951             $textcolor );
3952             }
3953             }
3954             }
3955             elsif ( $self->{'custom_x_ticks'} )
3956             {
3957             for ( @{ $self->{'custom_x_ticks'} } )
3958             {
3959             if ( defined($_) )
3960             {
3961             $x2 = $x1 + ( $delta / 2 ) + ( $delta * $_ ) - $h / 2;
3962             $y2 = $y1 - ( ( $self->{'x_tick_label_length'} - length( $self->{f_x_tick}->( $data->[0][$_] ) ) ) * $w );
3963             $self->{'gd_obj'}->stringUp( $font, $x2, $y2, $self->{f_x_tick}->( $data->[0][$_] ), $textcolor );
3964             }
3965             }
3966             }
3967             else
3968             {
3969             for ( 0 .. $self->{'num_datapoints'} - 1 )
3970             {
3971             if ( defined($_) )
3972             {
3973             $x2 = $x1 + ( $delta / 2 ) + ( $delta * $_ ) - $h / 2;
3974             $y2 = $y1 - ( ( $self->{'x_tick_label_length'} - length( $self->{f_x_tick}->( $data->[0][$_] ) ) ) * $w );
3975             $self->{'gd_obj'}->stringUp( $font, $x2, $y2, $self->{f_x_tick}->( $data->[0][$_] ), $textcolor );
3976             }
3977             }
3978             }
3979             }
3980             else
3981             { # error time
3982             carp "I don't understand the type of x-ticks you specified";
3983             }
3984              
3985             # update the current y-max value
3986             if ( $self->{'x_ticks'} =~ /^normal$/i )
3987             {
3988             $self->{'curr_y_max'} -= $h + ( 2 * $self->{'text_space'} );
3989             }
3990             elsif ( $self->{'x_ticks'} =~ /^staggered$/i )
3991             {
3992             $self->{'curr_y_max'} -= ( 2 * $h ) + ( 3 * $self->{'text_space'} );
3993             }
3994             elsif ( $self->{'x_ticks'} =~ /^vertical$/i )
3995             {
3996             $self->{'curr_y_max'} -= ( $w * $self->{'x_tick_label_length'} ) + ( 2 * $self->{'text_space'} );
3997             }
3998              
3999             # now plot the ticks
4000             $y1 = $self->{'curr_y_max'};
4001             $y2 = $self->{'curr_y_max'} - $self->{'tick_len'};
4002             if ( $self->{'skip_x_ticks'} > 1 )
4003             {
4004             for ( 0 .. int( ( $self->{'num_datapoints'} - 1 ) / $self->{'skip_x_ticks'} ) )
4005             {
4006             $x2 = $x1 + ( $delta / 2 ) + ( $delta * ( $_ * $self->{'skip_x_ticks'} ) );
4007             $self->{'gd_obj'}->line( $x2, $y1, $x2, $y2, $misccolor );
4008             if ( $self->true( $self->{'grid_lines'} )
4009             or $self->true( $self->{'x_grid_lines'} ) )
4010             {
4011             $self->{'grid_data'}->{'x'}->[$_] = $x2;
4012             }
4013             }
4014             }
4015             elsif ( $self->{'custom_x_ticks'} )
4016             {
4017             for ( @{ $self->{'custom_x_ticks'} } )
4018             {
4019             $x2 = $x1 + ( $delta / 2 ) + ( $delta * $_ );
4020             $self->{'gd_obj'}->line( $x2, $y1, $x2, $y2, $misccolor );
4021             if ( $self->true( $self->{'grid_lines'} )
4022             or $self->true( $self->{'x_grid_lines'} ) )
4023             {
4024             $self->{'grid_data'}->{'x'}->[$_] = $x2;
4025             }
4026             }
4027             }
4028             else
4029             {
4030             for ( 0 .. $self->{'num_datapoints'} - 1 )
4031             {
4032             $x2 = $x1 + ( $delta / 2 ) + ( $delta * $_ );
4033             $self->{'gd_obj'}->line( $x2, $y1, $x2, $y2, $misccolor );
4034             if ( $self->true( $self->{'grid_lines'} )
4035             or $self->true( $self->{'x_grid_lines'} ) )
4036             {
4037             $self->{'grid_data'}->{'x'}->[$_] = $x2;
4038             }
4039             }
4040             }
4041              
4042             # update the current y-max value
4043             $self->{'curr_y_max'} -= $self->{'tick_len'};
4044             }
4045              
4046             ## @fn private int _draw_y_ticks()
4047             # draw the y-ticks and their labels
4048             # @return status
4049             sub _draw_y_ticks
4050             {
4051             my $self = shift;
4052             my $side = shift || 'left';
4053             my $data = $self->{'dataref'};
4054             my $font = $self->{'tick_label_font'};
4055             my $textcolor = $self->_color_role_to_index('text');
4056             my $misccolor = $self->_color_role_to_index('misc');
4057             my @labels = @{ $self->{'y_tick_labels'} };
4058             my ( $w, $h );
4059             my ( $x1, $x2, $y1, $y2 );
4060             my ( $height, $delta, $label );
4061             my ( $s, $f );
4062              
4063             $self->{grid_data}->{'y'} = [];
4064             $self->{grid_data}->{'y2'} = [];
4065              
4066             # make sure we got a real font
4067             unless ( ( ref $font ) eq 'GD::Font' )
4068             {
4069             croak "The tick label font you specified isn\'t a GD Font object";
4070             }
4071              
4072             # find out how big the font is
4073             ( $w, $h ) = ( $font->width, $font->height );
4074              
4075             # figure out which ticks not to draw
4076             if ( $self->{'min_val'} >= 0 )
4077             {
4078             $s = 1;
4079             $f = $#labels;
4080             }
4081             elsif ( $self->{'max_val'} <= 0 )
4082             {
4083             $s = 0;
4084             $f = $#labels; # -1 entfernt
4085             }
4086             else
4087             {
4088             $s = 0;
4089             $f = $#labels;
4090             }
4091              
4092             # now draw them
4093             if ( $side eq 'right' )
4094             { # put 'em on the right side of the chart
4095             # get the base x-y values, and the delta value
4096             $x1 =
4097             $self->{'curr_x_max'} - $self->{'tick_len'} - ( 3 * $self->{'text_space'} ) - ( $w * $self->{'y_tick_label_length'} );
4098             $y1 = $self->{'curr_y_max'};
4099             $height = $self->{'curr_y_max'} - $self->{'curr_y_min'};
4100             $self->{'y_ticks'} = 2 if $self->{'y_ticks'} < 2;
4101             $delta = $height / ( $self->{'y_ticks'} - 1 );
4102              
4103             # update the curr_x_max value
4104             $self->{'curr_x_max'} = $x1;
4105              
4106             # now draw the ticks
4107             $x2 = $x1 + $self->{'tick_len'};
4108             for ( $s .. $f )
4109             {
4110             $y2 = $y1 - ( $delta * $_ );
4111             $self->{'gd_obj'}->line( $x1, $y2, $x2, $y2, $misccolor );
4112             if ( $self->true( $self->{'grid_lines'} )
4113             or $self->true( $self->{'y2_grid_lines'} ) )
4114             {
4115             $self->{'grid_data'}->{'y2'}->[$_] = $y2;
4116             }
4117             }
4118              
4119             # update the current x-min value
4120             $x1 += $self->{'tick_len'} + ( 2 * $self->{'text_space'} );
4121             $y1 -= $h / 2;
4122              
4123             # now draw the labels
4124             for ( 0 .. $#labels )
4125             {
4126             $y2 = $y1 - ( $delta * $_ );
4127             $self->{'gd_obj'}->string( $font, $x1, $y2, $self->{'y_tick_labels'}[$_], $textcolor );
4128             }
4129             }
4130             elsif ( $side eq 'both' )
4131             { # put the ticks on the both sides
4132             ## left side first
4133              
4134             # get the base x-y values
4135             $x1 = $self->{'curr_x_min'} + $self->{'text_space'};
4136             $y1 = $self->{'curr_y_max'} - $h / 2;
4137              
4138             # now draw the labels
4139             $height = $self->{'curr_y_max'} - $self->{'curr_y_min'};
4140             $delta = $height / ( $self->{'y_ticks'} - 1 );
4141             for ( 0 .. $#labels )
4142             {
4143             $label = $self->{'y_tick_labels'}[$_];
4144             $y2 = $y1 - ( $delta * $_ );
4145             $x2 = $x1 + ( $w * $self->{'y_tick_label_length'} ) - ( $w * length($label) );
4146             $self->{'gd_obj'}->string( $font, $x2, $y2, $label, $textcolor );
4147             }
4148              
4149             # and update the current x-min value
4150             $self->{'curr_x_min'} += ( 3 * $self->{'text_space'} ) + ( $w * $self->{'y_tick_label_length'} );
4151              
4152             # now draw the ticks (skipping the one at zero);
4153             $x1 = $self->{'curr_x_min'};
4154             $x2 = $self->{'curr_x_min'} + $self->{'tick_len'};
4155             $y1 += $h / 2;
4156             for ( $s .. $f )
4157             {
4158             $y2 = $y1 - ( $delta * $_ );
4159             $self->{'gd_obj'}->line( $x1, $y2, $x2, $y2, $misccolor );
4160             if ( $self->true( $self->{grid_lines} )
4161             or $self->true( $self->{'y_grid_lines'} ) )
4162             {
4163             $self->{'grid_data'}->{'y'}->[$_] = $y2;
4164             }
4165             }
4166              
4167             # update the current x-min value
4168             $self->{'curr_x_min'} += $self->{'tick_len'};
4169              
4170             ## now the right side
4171             # get the base x-y values, and the delta value
4172             $x1 =
4173             $self->{'curr_x_max'} - $self->{'tick_len'} - ( 3 * $self->{'text_space'} ) - ( $w * $self->{'y_tick_label_length'} );
4174             $y1 = $self->{'curr_y_max'};
4175             $height = $self->{'curr_y_max'} - $self->{'curr_y_min'};
4176             $delta = $height / ( $self->{'y_ticks'} - 1 );
4177              
4178             # update the curr_x_max value
4179             $self->{'curr_x_max'} = $x1;
4180              
4181             # now draw the ticks (skipping the one at zero);
4182             $x2 = $x1 + $self->{'tick_len'};
4183              
4184             for ( $s .. $f )
4185             {
4186             $y2 = $y1 - ( $delta * $_ );
4187             $self->{'gd_obj'}->line( $x1, $y2, $x2, $y2, $misccolor ); # draw tick_line
4188             if ( $self->true( $self->{grid_lines} )
4189             or $self->true( $self->{'y2_grid_lines'} ) )
4190             {
4191             $self->{'grid_data'}->{'y2'}->[$_] = $y2;
4192             }
4193             }
4194              
4195             # update the current x-min value
4196             $x1 += $self->{'tick_len'} + ( 2 * $self->{'text_space'} );
4197             $y1 -= $h / 2;
4198              
4199             # now draw the labels
4200             for ( 0 .. $#labels )
4201             {
4202             $y2 = $y1 - ( $delta * $_ );
4203             $self->{'gd_obj'}->string( $font, $x1, $y2, $self->{'y_tick_labels'}[$_], $textcolor );
4204             }
4205             }
4206             else
4207             { # just the left side
4208             # get the base x-y values
4209             $x1 = $self->{'curr_x_min'} + $self->{'text_space'};
4210             $y1 = $self->{'curr_y_max'} - $h / 2;
4211              
4212             # now draw the labels
4213             $height = $self->{'curr_y_max'} - $self->{'curr_y_min'};
4214             $self->{'y_ticks'} = 2 if $self->{'y_ticks'} < 2;
4215             $delta = $height / ( $self->{'y_ticks'} - 1 );
4216             for ( 0 .. $#labels )
4217             {
4218             $label = $self->{'y_tick_labels'}[$_];
4219             $y2 = $y1 - ( $delta * $_ );
4220             $x2 = $x1 + ( $w * $self->{'y_tick_label_length'} ) - ( $w * length($label) );
4221             $self->{'gd_obj'}->string( $font, $x2, $y2, $label, $textcolor );
4222             }
4223              
4224             # and update the current x-min value
4225             $self->{'curr_x_min'} += ( 3 * $self->{'text_space'} ) + ( $w * $self->{'y_tick_label_length'} );
4226              
4227             # now draw the ticks
4228             $x1 = $self->{'curr_x_min'};
4229             $x2 = $self->{'curr_x_min'} + $self->{'tick_len'};
4230             $y1 += $h / 2;
4231             for ( $s .. $f )
4232             {
4233             $y2 = $y1 - ( $delta * $_ );
4234             $self->{'gd_obj'}->line( $x1, $y2, $x2, $y2, $misccolor );
4235             if ( $self->true( $self->{'grid_lines'} )
4236             or $self->true( $self->{'y_grid_lines'} ) )
4237             {
4238             $self->{'grid_data'}->{'y'}->[$_] = $y2;
4239             }
4240             }
4241              
4242             # update the current x-min value
4243             $self->{'curr_x_min'} += $self->{'tick_len'};
4244             }
4245              
4246             # and return
4247             return 1;
4248             }
4249              
4250             ## @fn private int _grey_background()
4251             # put a grey background on the plot of the data itself
4252             # @return status
4253             sub _grey_background
4254             {
4255             my $self = shift;
4256              
4257             # draw it
4258             $self->{'gd_obj'}
4259             ->filledRectangle( $self->{'curr_x_min'}, $self->{'curr_y_min'}, $self->{'curr_x_max'}, $self->{'curr_y_max'},
4260             $self->_color_role_to_index('grey_background') );
4261              
4262             # now return
4263             return 1;
4264             }
4265              
4266             ## @fn private int _draw_grid_lines()
4267             # draw grid_lines
4268             # @return status
4269             sub _draw_grid_lines
4270             {
4271             my $self = shift;
4272             $self->_draw_x_grid_lines();
4273             $self->_draw_y_grid_lines();
4274             $self->_draw_y2_grid_lines();
4275             return 1;
4276             }
4277              
4278             ## @fn private int _draw_x_grid_lines()
4279             # draw grid_lines for x
4280             # @return status
4281             sub _draw_x_grid_lines
4282             {
4283             my $self = shift;
4284             my $grid_role = shift || 'x_grid_lines';
4285             my $gridcolor = $self->_color_role_to_index($grid_role);
4286             my ( $x, $y, $i );
4287              
4288             foreach $x ( @{ $self->{grid_data}->{'x'} } )
4289             {
4290             if ( defined $x )
4291             {
4292             $self->{gd_obj}->line( ( $x, $self->{'curr_y_min'} + 1 ), $x, ( $self->{'curr_y_max'} - 1 ), $gridcolor );
4293             }
4294             }
4295             return 1;
4296             }
4297              
4298             ## @fn private int _draw_y_grid_lines()
4299             # draw grid_lines for y
4300             # @return status
4301             sub _draw_y_grid_lines
4302             {
4303             my $self = shift;
4304             my $grid_role = shift || 'y_grid_lines';
4305             my $gridcolor = $self->_color_role_to_index($grid_role);
4306             my ( $x, $y, $i );
4307              
4308             #Look if I'm an HorizontalBars object
4309             if ( $self->isa('Chart::HorizontalBars') )
4310             {
4311             for ( $i = 0 ; $i < ( $#{ $self->{grid_data}->{'y'} } ) + 1 ; $i++ )
4312             {
4313             $y = $self->{grid_data}->{'y'}->[$i];
4314             $self->{gd_obj}->line( ( $self->{'curr_x_min'} + 1 ), $y, ( $self->{'curr_x_max'} - 1 ), $y, $gridcolor );
4315             }
4316             }
4317             else
4318             {
4319              
4320             # loop for y values is a little different. This is to discard the first
4321             # and last values we were given - the top/bottom of the chart area.
4322             for ( $i = 1 ; $i < ( $#{ $self->{grid_data}->{'y'} } ) + 1 ; $i++ )
4323             { ###
4324             $y = $self->{grid_data}->{'y'}->[$i];
4325             $self->{gd_obj}->line( ( $self->{'curr_x_min'} + 1 ), $y, ( $self->{'curr_x_max'} - 1 ), $y, $gridcolor );
4326             }
4327             }
4328             return 1;
4329             }
4330              
4331             ## @fn private int _draw_y2_grid_lines()
4332             # draw grid_lines for y
4333             # @return status
4334             sub _draw_y2_grid_lines
4335             {
4336             my $self = shift;
4337             my $grid_role = shift || 'y2_grid_lines';
4338             my $gridcolor = $self->_color_role_to_index($grid_role);
4339             my ( $x, $y, $i );
4340              
4341             #Look if I'm an HorizontalBars object
4342             if ( $self->isa('Chart::HorizontalBars') )
4343             {
4344             for ( $i = 0 ; $i < ( $#{ $self->{grid_data}->{'y'} } ) + 1 ; $i++ )
4345             {
4346             $y = $self->{grid_data}->{'y'}->[$i];
4347             $self->{gd_obj}->line( ( $self->{'curr_x_min'} + 1 ), $y, ( $self->{'curr_x_max'} - 1 ), $y, $gridcolor );
4348             }
4349             }
4350             else
4351             {
4352              
4353             # loop for y2 values is a little different. This is to discard the first
4354             # and last values we were given - the top/bottom of the chart area.
4355             for ( $i = 1 ; $i < $#{ $self->{grid_data}->{'y2'} } ; $i++ )
4356             {
4357             $y = $self->{grid_data}->{'y2'}->[$i];
4358             $self->{gd_obj}->line( ( $self->{'curr_x_min'} + 1 ), $y, ( $self->{'curr_x_max'} - 1 ), $y, $gridcolor );
4359             }
4360             }
4361             return 1;
4362             }
4363              
4364             ## @fn private int _prepare_brush($color,$type,$role)
4365             # prepare brush
4366             #
4367             # @details
4368             # set the gdBrush object to tick GD into drawing fat lines & points
4369             # of interesting shapes
4370             # Needed by "Lines", "Points" and "LinesPoints"
4371             # All hacked up by Richard Dice Sunday 16 May 1999
4372             #
4373             # @param color
4374             # @param type 'line','point'
4375             # @param role
4376             #
4377             # @return status
4378             sub _prepare_brush
4379             {
4380             my $self = shift;
4381             my $color = shift;
4382             my $type = shift;
4383             my $role = shift || 'default';
4384              
4385             my $brushStyle = $self->{'brushStyle'};
4386             if ( defined $role )
4387             {
4388             my (@brushStyles) = $self->_brushStyles_of_roles($role);
4389             $brushStyle = $brushStyles[0];
4390             }
4391              
4392             #print STDERR "role=$role\n";
4393              
4394             # decide what $type should be in the event that a param isn't
4395             # passed -- this is necessary to preserve backward compatibility
4396             # with apps that use this module prior to putting _prepare_brush
4397             # in with Base.pm
4398             if ( !defined($type) ) { $type = 'point'; }
4399              
4400             if ( ( !length($type) )
4401             || ( !grep { $type eq $_ } ( 'line', 'point' ) ) )
4402             {
4403             $brushStyle = $self->{'brushStyle'};
4404             $type = 'line' if ref $self eq 'Chart::Lines';
4405             $type = 'point' if ref $self eq 'Chart::Points';
4406             }
4407              
4408             my ( $radius, @rgb, $brush, $white, $newcolor );
4409              
4410             # get the rgb values for the desired color
4411             @rgb = $self->{'gd_obj'}->rgb($color);
4412              
4413             # get the appropriate brush size
4414             if ( $type eq 'line' )
4415             {
4416             $radius = $self->{'brush_size'} / 2;
4417             }
4418             elsif ( $type eq 'point' )
4419             {
4420             $radius = $self->{'pt_size'} / 2;
4421             }
4422              
4423             # create the new image
4424             $brush = GD::Image->new( $radius * 2, $radius * 2 );
4425              
4426             # get the colors, make the background transparent
4427             $white = $brush->colorAllocate( 255, 255, 255 );
4428             $newcolor = $brush->colorAllocate(@rgb);
4429             $brush->transparent($white);
4430              
4431             # draw the circle
4432             if ( $type eq 'line' )
4433             {
4434             $brush->arc( $radius - 1, $radius - 1, $radius, $radius, 0, 360, $newcolor );
4435             $brush->fill( $radius - 1, $radius - 1, $newcolor );
4436              
4437             # RLD
4438             #
4439             # Does $brush->fill really have to be here? Dunno... this
4440             # seems to be a relic from earlier code
4441             #
4442             # Note that 'line's don't benefit from a $brushStyle... yet.
4443             # It shouldn't be too tough to hack this in by taking advantage
4444             # of GD's gdStyled facility
4445              
4446             }
4447              
4448             if ( $type eq 'point' )
4449             {
4450             $brushStyle = $self->{'brushStyle'}
4451             unless grep { $brushStyle eq $_ } (
4452             'FilledCircle', 'circle', 'donut', 'OpenCircle',
4453             'triangle', 'upsidedownTriangle', 'square', 'hollowSquare',
4454             'OpenRectangle', 'fatPlus', 'Star', 'OpenStar',
4455             'FilledDiamond', 'OpenDiamond'
4456             );
4457              
4458             my ( $xc, $yc ) = ( $radius, $radius );
4459              
4460             if ( grep { $brushStyle eq $_ } ( 'default', 'circle', 'donut', 'OpenCircle', 'FilledCircle' ) )
4461             {
4462             $brush->arc( $xc, $yc, $radius, $radius, 0, 360, $newcolor );
4463             $brush->fill( $xc, $yc, $newcolor );
4464              
4465             # draw a white (and therefore transparent) circle in the middle
4466             # of the existing circle to make the "donut", if appropriate
4467              
4468             if ( $brushStyle eq 'donut' || $brushStyle eq 'OpenCircle' )
4469             {
4470             $brush->arc( $xc, $yc, int( $radius / 2 ), int( $radius / 2 ), 0, 360, $white );
4471             $brush->fill( $xc, $yc, $white );
4472             }
4473             }
4474              
4475             if ( grep { $brushStyle eq $_ } ( 'triangle', 'upsidedownTriangle' ) )
4476             {
4477             my $poly = new GD::Polygon;
4478             my $sign = ( $brushStyle eq 'triangle' ) ? 1 : (-1);
4479             my $z = int( 0.8 * $radius ); # scaling factor
4480              
4481             # co-ords are chosen to make an equilateral triangle
4482              
4483             $poly->addPt( $xc, $yc - ( $z * $sign ) );
4484             $poly->addPt( $xc + int( ( sqrt(3) * $z ) / 2 ), $yc + ( int( $z / 2 ) * $sign ) );
4485             $poly->addPt( $xc - int( ( sqrt(3) * $z ) / 2 ), $yc + ( int( $z / 2 ) * $sign ) );
4486              
4487             $brush->filledPolygon( $poly, $newcolor );
4488             }
4489              
4490             if ( $brushStyle eq 'fatPlus' )
4491             {
4492             my $poly = new GD::Polygon;
4493              
4494             my $z = int( 0.3 * $radius );
4495              
4496             $poly->addPt( $xc + $z, $yc + $z );
4497             $poly->addPt( $xc + 2 * $z, $yc + $z );
4498             $poly->addPt( $xc + 2 * $z, $yc - $z );
4499              
4500             $poly->addPt( $xc + $z, $yc - $z );
4501             $poly->addPt( $xc + $z, $yc - 2 * $z );
4502             $poly->addPt( $xc - $z, $yc - 2 * $z );
4503              
4504             $poly->addPt( $xc - $z, $yc - $z );
4505             $poly->addPt( $xc - 2 * $z, $yc - $z );
4506             $poly->addPt( $xc - 2 * $z, $yc + $z );
4507              
4508             $poly->addPt( $xc - $z, $yc + $z );
4509             $poly->addPt( $xc - $z, $yc + 2 * $z );
4510             $poly->addPt( $xc + $z, $yc + 2 * $z );
4511             $brush->filledPolygon( $poly, $newcolor );
4512             }
4513              
4514             if ( $brushStyle eq 'Star' || $brushStyle eq 'OpenStar' )
4515             {
4516             my $poly = new GD::Polygon;
4517              
4518             my $z = int($radius);
4519             my $sz = int( $z / 3 * 1.75 ); # small z
4520              
4521             my $x1 = int( $xc + $z );
4522             my $y1 = int($yc);
4523             my ( $x2, $y2 );
4524              
4525             my $xyRatio = $self->_xyRatio();
4526              
4527             $poly->addPt( $x1, $y1 );
4528              
4529             $x2 = $xc + int( $sz * 0.5 );
4530             $y2 = $yc - int( $sz * 0.5 );
4531             $poly->addPt( $x2, $y2 );
4532              
4533             $x2 = $xc;
4534             $y2 = $yc - $z;
4535             $poly->addPt( $x2, $y2 );
4536              
4537             $x2 = $xc - int( $sz * 0.5 );
4538             $y2 = $yc - int( $sz * 0.5 );
4539             $poly->addPt( $x2, $y2 );
4540              
4541             $x2 = $xc - $z;
4542             $y2 = $yc;
4543             $poly->addPt( $x2, $y2 );
4544              
4545             $x2 = $xc - int( $sz * 0.5 );
4546             $y2 = $yc + int( $sz * 0.5 );
4547             $poly->addPt( $x2, $y2 );
4548              
4549             $x2 = $xc;
4550             $y2 = $yc + $z;
4551             $poly->addPt( $x2, $y2 );
4552              
4553             $x2 = $xc + int( $sz * 0.5 );
4554             $y2 = $yc + int( $sz * 0.5 );
4555             $poly->addPt( $x2, $y2 );
4556             if ( $brushStyle eq 'OpenStar' )
4557             {
4558             $brush->polygon( $poly, $newcolor );
4559             }
4560             else
4561             {
4562             $brush->filledPolygon( $poly, $newcolor );
4563             }
4564             }
4565              
4566             if ( grep { $brushStyle eq $_ } ( 'square', 'hollowSquare', 'OpenRectangle' ) )
4567             {
4568             my $z = int( 0.5 * $radius );
4569              
4570             $brush->filledRectangle( $xc - $z, $yc - $z, $xc + $z, $yc + $z, $newcolor );
4571              
4572             if ( $brushStyle eq 'hollowSquare' || $brushStyle eq 'OpenRectangle' )
4573             {
4574             $z = int( $z / 2 );
4575              
4576             $brush->filledRectangle( $xc - $z, $yc - $z, $xc + $z, $yc + $z, $white );
4577             }
4578             }
4579              
4580             if ( grep { $brushStyle eq $_ } ( 'FilledDiamond', 'OpenDiamond' ) )
4581             {
4582             my $z = int( 0.75 * $radius );
4583              
4584             $brush->line( $xc + $z, $yc, $xc, $yc + $z, $newcolor );
4585             $brush->line( $xc, $yc + $z, $xc - $z, $yc, $newcolor );
4586             $brush->line( $xc - $z, $yc, $xc, $yc - $z, $newcolor );
4587             $brush->line( $xc, $yc - $z, $xc + $z, $yc, $newcolor );
4588              
4589             if ( $brushStyle eq 'FilledDiamond' )
4590             {
4591              
4592             # and fill it
4593             $brush->fill( $radius - 1, $radius - 1, $newcolor );
4594             }
4595             }
4596              
4597             }
4598              
4599             # set the new image as the main object's brush
4600             return $brush;
4601             }
4602              
4603             ## @fn private int _default_f_tick
4604             # default tick conversion function
4605             # This function is pointed to be $self->{f_x_tick} resp. $self->{f_y_tick}
4606             # if the user does not provide another function
4607             #
4608             # @return status
4609             sub _default_f_tick
4610             {
4611             my $label = shift;
4612              
4613             return $label;
4614             }
4615              
4616             ## @fn private float _xyRatio
4617             # Get ratio width_x/width_y
4618             #
4619             # @return ratio width_x and width_y
4620             sub _xyRatio
4621             {
4622             my $self = shift;
4623              
4624             my $width_x = $self->{'curr_x_max'} - $self->{'curr_x_min'} + 1;
4625             my $width_y = $self->{'curr_y_max'} - $self->{'curr_y_min'} + 1;
4626              
4627             my $ratio = $width_x / $width_y;
4628              
4629             return $ratio;
4630             }
4631              
4632             ## @fn private float _xPixelInReal
4633             # Get width of one Pixel in real coordinates in x-direction
4634             #
4635             # @return width(interval) of reality in x direction
4636             #
4637             sub _xPixelInReal
4638             {
4639             my $self = shift;
4640              
4641             my $width_x = $self->{'curr_x_max'} - $self->{'curr_x_min'} + 1;
4642             my ( $min, $max ) = $self->_find_x_range();
4643             my $xRealWidth = $max - $min;
4644             my $ratio = $xRealWidth / $width_x;
4645              
4646             return $ratio;
4647             }
4648              
4649             ## @fn private float _yPixelInReal
4650             # Get width of one Pixel in real coordinates in y-direction
4651             #
4652             # @return width(interval) of reality in y direction
4653             #
4654             sub _yPixelInReal
4655             {
4656             my $self = shift;
4657              
4658             my $width_y = $self->{'curr_y_max'} - $self->{'curr_y_min'} + 1;
4659             my ( $min, $max, $flag_all_integers ) = $self->_find_y_range();
4660             my $yRealWidth = $max - $min;
4661             my $ratio = $yRealWidth / $width_y;
4662              
4663             return $ratio;
4664             }
4665              
4666             ## be a good module and return positive
4667             1;
4668