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