File Coverage

blib/lib/Chart/Base.pm
Criterion Covered Total %
statement 975 1269 76.8
branch 277 454 61.0
condition 83 129 64.3
subroutine 47 58 81.0
pod 0 15 0.0
total 1382 1925 71.8


line stmt bran cond sub pod time code
1             #===================================================================
2             # Chart::Base
3             #
4             # written by david bonner
5             # dbonner@cs.bu.edu
6             #
7             # maintained by the Chart Group
8             # Chart@wettzell.ifag.de
9             #---------------------------------------------------------------------
10             # History:
11             # --------
12             # $RCSfile: Base.pm,v $ $Revision: 1.8 $ $Date: 2003/04/08 16:03:41 $
13             # $Author: dassing $
14             # $Log: Base.pm,v $
15             # Revision 1.8 2003/04/08 16:03:41 dassing
16             # _draw_y_grid_lines does plot all lines now
17             #
18             # Revision 1.7 2003/03/20 15:01:11 dassing
19             # Some print statements did not go to STDERR
20             #
21             # Revision 1.6 2003/01/14 13:38:37 dassing
22             # Big changes for Version 2.0
23             #
24             # Revision 1.5 2002/06/19 12:36:58 dassing
25             # Correcting some undefines
26             #
27             # Revision 1.4 2002/06/06 07:38:25 dassing
28             # Updates in Function _find_y_scale by David Pottage
29             #
30             # Revision 1.3 2002/05/31 13:18:02 dassing
31             # Release 1.1
32             #
33             # Revision 1.2 2002/05/29 16:13:20 dassing
34             # Changes included by David Pottage
35             #
36             #=======================================================================
37              
38             package Chart::Base;
39              
40 58     58   2456 use GD;
  58         617  
  58         3380  
41 58     58   1389 use strict;
  58         602  
  58         1008  
42 58     58   1171 use Carp;
  58         546  
  58         2040  
43 58     58   937 use FileHandle;
  58         2124  
  58         1140  
44              
45             $Chart::Base::VERSION = '2.3';
46              
47 58     58   3088 use vars qw(%named_colors);
  58         538  
  58         950  
48              
49              
50             #>>>>>>>>>>>>>>>>>>>>>>>>>>#
51             # public methods go here #
52             #<<<<<<<<<<<<<<<<<<<<<<<<<<#
53              
54             ## standard nice object creator
55             sub new {
56 76     76 0 322015   my $proto = shift;
57 76   33     1411   my $class = ref($proto) || $proto;
58 76         17818   my $self = {};
59              
60 76         2138   bless $self, $class;
61 76         1401   $self->_init(@_);
62              
63 76         1033   return $self;
64             }
65              
66              
67             ## main method for customizing the chart, lets users
68             ## specify values for different parameters
69             sub set {
70 185     185 0 2510   my $self = shift;
71 185         6090   my %opts = @_;
72               
73             # basic error checking on the options, just warn 'em
74 185 50       2306   unless ($#_ % 2) {
75 0         0     carp "Whoops, some option to be set didn't have a value.\n",
76                      "You might want to look at that.\n";
77               }
78              
79               
80             # set the options
81 185         2225   for (keys %opts) {
82              
83 656         6800     $self->{$_} = $opts{$_};
84                 
85             # if someone wants to change the grid_lines color, we should set all
86             # the colors of the grid_lines
87 656 100       8088     if ($_ =~ /^colors$/ ) {
88 38         345       my %hash = %{$opts{$_}};
  38         628  
89 38         2307       foreach my $key (sort keys %hash){
90 159 100       1757           if ($key =~ /^grid_lines$/) {
91 2         23             $self->{'colors'}{'y_grid_lines'} = $hash{'grid_lines'};
92 2         20             $self->{'colors'}{'x_grid_lines'} = $hash{'grid_lines'};
93 2         22             $self->{'colors'}{'y2_grid_lines'} = $hash{'grid_lines'};
94                      }
95                   }
96                 }
97               }
98              
99             # now return
100 185         2295   return 1;
101             }
102              
103              
104             ## Graph API
105             sub add_pt {
106 0     0 0 0   my $self = shift;
107 0         0   my @data = @_;
108              
109             # error check the data (carp, don't croak)
110 0 0 0     0   if ($self->{'dataref'} && ($#{$self->{'dataref'}} != $#data)) {
  0         0  
111 0         0     carp "New point to be added has an incorrect number of data sets";
112 0         0     return 0;
113               }
114              
115             # copy it into the dataref
116 0         0   for (0..$#data) {
117 0         0     push @{$self->{'dataref'}->[$_]}, $data[$_];
  0         0  
118               }
119               
120             # now return
121 0         0   return 1;
122             }
123              
124              
125             ## more Graph API
126             sub add_dataset {
127 216     216 0 15368   my $self = shift;
128 216         15958   my @data = @_;
129              
130             # error check the data (carp, don't croak)
131 216 50 66     3896   if ($self->{'dataref'} && ($#{$self->{'dataref'}->[0]} != $#data)) {
  160         6853  
132 0         0     carp "New data set to be added has an incorrect number of points";
133               }
134              
135             # copy it into the dataref
136 216         2210   push @{$self->{'dataref'}}, [ @data ];
  216         26799  
137               
138             # now return
139 216         6112   return 1;
140             }
141              
142             # it's also possible to add a complete datafile
143             sub add_datafile {
144 0     0 0 0    my $self = shift;
145 0         0    my $filename = shift;
146 0         0    my $format = shift;
147 0         0    my ($File, @array);
148                
149             # do some ugly checking to see if they gave me
150             # a filehandle or a file name
151 0 0       0    if ((ref \$filename) eq 'SCALAR') {
    0          
152             # they gave me a file name
153 0 0       0     open ($File, $filename) or croak "Can't open the datafile: $filename.\n";
154                }
155                elsif ((ref \$filename) =~ /^(?:REF|GLOB)$/) {
156             # either a FileHandle object or a regular file handle
157 0         0     $File = $filename;
158                }
159                else {
160 0         0     carp "I'm not sure what kind of datafile you gave me,\n",
161                       "but it wasn't a filename or a filehandle.\n";
162                }
163              
164             #add the data
165 0         0    while(<$File>) {
166 0         0       @array = split;
167 0 0       0       if ( @array != ( )) {
168 0 0       0         if ($format =~ m/^pt$/i) {
    0          
169 0         0           $self->add_pt(@array);
170                     }
171                     elsif ($format =~ m/^set$/i) {
172 0         0           $self->add_dataset(@array);
173                     }
174                     else {
175 0         0           carp "Tell me what kind of file you gave me: 'pt' or 'set'\n";
176                     }
177                   }
178                }
179 0         0    close ($File);
180             }
181              
182             ## even more Graph API
183             sub clear_data {
184 0     0 0 0   my $self = shift;
185              
186             # undef the internal data reference
187 0         0   $self->{'dataref'} = undef;
188              
189             # now return
190 0         0   return 1;
191             }
192              
193              
194             ## and the last of the Graph API
195             sub get_data {
196 0     0 0 0   my $self = shift;
197 0         0   my $ref = [];
198 0         0   my ($i, $j);
199              
200             # give them a copy, not a reference into the object
201 0         0   for $i (0..$#{$self->{'dataref'}}) {
  0         0  
202 0         0     @{ $ref->[$i] } = @{ $self->{'dataref'}->[$i] }
  0         0  
  0         0  
203             ## speedup, compared to...
204             # for $j (0..$#{$self->{'dataref'}->[$i]}) {
205             # $ref->[$i][$j] = $self->{'dataref'}->[$i][$j];
206             # }
207               }
208              
209             # return it
210 0         0   return $ref;
211             }
212              
213              
214             ## called after the options are set, this method
215             ## invokes all my private methods to actually
216             ## draw the chart and plot the data
217             sub png {
218 60     60 0 876   my $self = shift;
219 60         793   my $file = shift;
220 60         2441   my $dataref = shift;
221 60         644   my $fh;
222              
223             # do some ugly checking to see if they gave me
224             # a filehandle or a file name
225 60 100       996   if ((ref \$file) eq 'SCALAR') {
    50          
226             # they gave me a file name
227             # Try to delete an existing file
228 58 50       2563     if ( -f $file ) {
229 58         14123        my $number_deleted_files = unlink $file;
230 58 50       5196        if ( $number_deleted_files != 1 ) {
231 0         0           croak "Error: File \"$file\" did already exist, but it fails to delete it";
232                    }
233                 }
234 58         1465     $fh = FileHandle->new (">$file");
235 58 50       22661     if( !defined $fh) {
236 0         0        croak "Error: File \"$file\" could not be created!\n";
237                 }
238               }
239               elsif ((ref \$file) =~ /^(?:REF|GLOB)$/) {
240             # either a FileHandle object or a regular file handle
241 2         19     $fh = $file;
242               }
243               else {
244 0         0     croak "I'm not sure what you gave me to write this png to,\n",
245                       "but it wasn't a filename or a filehandle.\n";
246               }
247              
248             # allocate the background color
249 60         1303   $self->_set_colors();
250              
251             # make sure the object has its copy of the data
252 60         1114   $self->_copy_data($dataref);
253              
254             # do a sanity check on the data, and collect some basic facts
255             # about the data
256 60         1462   $self->_check_data();
257              
258             # pass off the real work to the appropriate subs
259 60         1445   $self->_draw();
260              
261             # now write it to the file handle, and don't forget
262             # to be nice to the poor ppl using nt
263 60         888   binmode $fh;
264              
265 60         751245   print $fh $self->{'gd_obj'}->png();
266               
267             # now exit
268 60         995   return 1;
269             }
270              
271              
272             ## called after the options are set, this method
273             ## invokes all my private methods to actually
274             ## draw the chart and plot the data
275             sub cgi_png {
276 0     0 0 0   my $self = shift;
277 0         0   my $dataref = shift;
278              
279             # allocate the background color
280 0         0   $self->_set_colors();
281              
282             # make sure the object has its copy of the data
283 0         0   $self->_copy_data($dataref);
284              
285             # do a sanity check on the data, and collect some basic facts
286             # about the data
287 0         0   $self->_check_data();
288              
289             # pass off the real work to the appropriate subs
290 0         0   $self->_draw();
291              
292             # print the header (ripped the crlf octal from the CGI module)
293 0 0       0   if ($self->{no_cache} =~ /^true$/i) {
294 0         0       print "Content-type: image/png\015\012Pragma: no-cache\015\012\015\012";
295               } else {
296 0         0       print "Content-type: image/png\015\012\015\012";
297               }
298              
299             # now print the png, and binmode it first so nt likes us
300 0         0   binmode STDOUT;
301 0         0   print STDOUT $self->{'gd_obj'}->png();
302              
303             # now exit
304 0         0   return 1;
305             }
306              
307             ## called after the options are set, this method
308             ## invokes all my private methods to actually
309             ## draw the chart and plot the data
310             sub scalar_png {
311 0     0 0 0   my $self = shift;
312 0         0   my $dataref = shift;
313              
314             # make sure the object has its copy of the data
315 0         0   $self->_copy_data($dataref);
316              
317             # do a sanity check on the data, and collect some basic facts
318             # about the data
319 0         0   $self->_check_data();
320              
321             # pass off the real work to the appropriate subs
322 0         0   $self->_draw();
323              
324             # returns the png image as a scalar value, so that
325             # the programmer-user can do whatever the heck
326             # s/he wants to with it
327 0         0   $self->{'gd_obj'}->png();
328             }
329              
330              
331             ## called after the options are set, this method
332             ## invokes all my private methods to actually
333             ## draw the chart and plot the data
334             sub jpeg {
335 0     0 0 0   my $self = shift;
336 0         0   my $file = shift;
337 0         0   my $dataref = shift;
338 0         0   my $fh;
339              
340             # do some ugly checking to see if they gave me
341             # a filehandle or a file name
342 0 0       0   if ((ref \$file) eq 'SCALAR') {
    0          
343             # they gave me a file name
344 0         0     $fh = FileHandle->new (">$file");
345             # they gave me a file name
346             # Try to delete an existing file
347 0 0       0     if ( -f $file ) {
348 0         0        my $number_deleted_files = unlink $file;
349 0 0       0        if ( $number_deleted_files != 1 ) {
350 0         0           croak "Error: File \"$file\" did already exist, but it fails to delete it";
351                    }
352                 }
353 0         0     $fh = FileHandle->new (">$file");
354 0 0       0     if( !defined $fh) {
355 0         0        croak "Error: File \"$file\" could not be created!\n";
356                 }
357               }
358               elsif ((ref \$file) =~ /^(?:REF|GLOB)$/) {
359             # either a FileHandle object or a regular file handle
360 0         0     $fh = $file;
361               }
362               else {
363 0         0     croak "I'm not sure what you gave me to write this jpeg to,\n",
364                       "but it wasn't a filename or a filehandle.\n";
365               }
366              
367             # allocate the background color
368 0         0   $self->_set_colors();
369              
370             # make sure the object has its copy of the data
371 0         0   $self->_copy_data($dataref);
372              
373             # do a sanity check on the data, and collect some basic facts
374             # about the data
375 0         0   $self->_check_data;
376              
377             # pass off the real work to the appropriate subs
378 0         0   $self->_draw();
379              
380             # now write it to the file handle, and don't forget
381             # to be nice to the poor ppl using nt
382 0         0   binmode $fh;
383 0         0   print $fh $self->{'gd_obj'}->jpeg([100]); # high quality need
384              
385             # now exit
386 0         0   return 1;
387             }
388              
389             ## called after the options are set, this method
390             ## invokes all my private methods to actually
391             ## draw the chart and plot the data
392             sub cgi_jpeg {
393 0     0 0 0   my $self = shift;
394 0         0   my $dataref = shift;
395              
396             # allocate the background color
397 0         0   $self->_set_colors();
398              
399             # make sure the object has its copy of the data
400 0         0   $self->_copy_data($dataref);
401              
402             # do a sanity check on the data, and collect some basic facts
403             # about the data
404 0         0   $self->_check_data();
405              
406             # pass off the real work to the appropriate subs
407 0         0   $self->_draw();
408              
409             # print the header (ripped the crlf octal from the CGI module)
410 0 0       0   if ($self->{no_cache} =~ /^true$/i) {
411 0         0       print "Content-type: image/jpeg\015\012Pragma: no-cache\015\012\015\012";
412               } else {
413 0         0       print "Content-type: image/jpeg\015\012\015\012";
414               }
415              
416             # now print the png, and binmode it first so nt likes us
417 0         0   binmode STDOUT;
418 0         0   print STDOUT $self->{'gd_obj'}->jpeg([100]);
419              
420             # now exit
421 0         0   return 1;
422             }
423              
424             ## called after the options are set, this method
425             ## invokes all my private methods to actually
426             ## draw the chart and plot the data
427             sub scalar_jpeg {
428 0     0 0 0   my $self = shift;
429 0         0   my $dataref = shift;
430              
431             # make sure the object has its copy of the data
432 0         0   $self->_copy_data($dataref);
433              
434             # do a sanity check on the data, and collect some basic facts
435             # about the data
436 0         0   $self->_check_data();
437              
438             # pass off the real work to the appropriate subs
439 0         0   $self->_draw();
440              
441             # returns the png image as a scalar value, so that
442             # the programmer-user can do whatever the heck
443             # s/he wants to with it
444 0         0   $self->{'gd_obj'}->jpeg([100]);
445             }
446              
447             sub make_gd {
448 0     0 0 0   my $self = shift;
449 0         0   my $dataref = shift;
450              
451             # allocate the background color
452 0         0   $self->_set_colors();
453              
454             # make sure the object has its copy of the data
455 0         0   $self->_copy_data($dataref);
456              
457             # do a sanity check on the data, and collect some basic facts
458             # about the data
459 0         0   $self->_check_data();
460              
461             # pass off the real work to the appropriate subs
462 0         0   $self->_draw();
463              
464             # return the GD::Image object that we've drawn into
465 0         0   return $self->{'gd_obj'};
466             }
467              
468              
469             ## get the information to turn the chart into an imagemap
470             sub imagemap_dump {
471 1     1 0 12   my $self = shift;
472 1         11   my $ref = [];
473 1         10   my ($i, $j);
474              
475             # croak if they didn't ask me to remember the data, or if they're asking
476             # for the data before I generate it
477 1 50 33     28   unless (($self->{'imagemap'} =~ /^true$/i) && $self->{'imagemap_data'}) {
478 0         0     croak "You need to set the imagemap option to true, and then call the png method, before you can get the imagemap data";
479               }
480              
481             # can't just return a ref to my internal structures...
482 1         37   for $i (0..$#{$self->{'imagemap_data'}}) {
  1         16  
483 3         25     for $j (0..$#{$self->{'imagemap_data'}->[$i]}) {
  3         36  
484 14         113       $ref->[$i][$j] = [ @{ $self->{'imagemap_data'}->[$i][$j] } ];
  14         206  
485                 }
486               }
487              
488             # return their copy
489 1         13   return $ref;
490             }
491              
492             #>>>>>>>>>>>>>>>>>>>>>>>>>>>#
493             # private methods go here #
494             #<<<<<<<<<<<<<<<<<<<<<<<<<<<#
495              
496             ## initialize all the default options here
497             sub _init {
498 76     76   745   my $self = shift;
499 76   100     4238   my $x = shift || 400; # give them a 400x300 image
500 76   100     1229   my $y = shift || 300; # unless they say otherwise
501               
502             # get the gd object
503 76         2210   $self->{'gd_obj'} = GD::Image->new($x, $y);
504              
505             # start keeping track of used space
506 76         112182   $self->{'curr_y_min'} = 0;
507 76         944   $self->{'curr_y_max'} = $y;
508 76         1420   $self->{'curr_x_min'} = 0;
509 76         823   $self->{'curr_x_max'} = $x;
510              
511             # use a 10 pixel border around the whole png
512 76         789   $self->{'png_border'} = 10;
513              
514             # leave some space around the text fields
515 76         862   $self->{'text_space'} = 2;
516              
517             # and leave some more space around the chart itself
518 76         888   $self->{'graph_border'} = 10;
519              
520             # leave a bit of space inside the legend box
521 76         811   $self->{'legend_space'} = 4;
522               
523             # set some default fonts
524 76         1191   $self->{'title_font'} = gdLargeFont;
525 76         12457   $self->{'sub_title_font'} = gdLargeFont;
526 76         2104   $self->{'legend_font'} = gdSmallFont;
527 76         4202   $self->{'label_font'} = gdMediumBoldFont;
528 76         1725   $self->{'tick_label_font'} = gdSmallFont;
529              
530             # put the legend on the bottom of the chart
531 76         1500   $self->{'legend'} = 'right';
532              
533             # default to an empty list of labels
534 76         3218   $self->{'legend_labels'} = [];
535              
536             # use 20 pixel length example lines in the legend
537 76         2804   $self->{'legend_example_size'} = 20;
538              
539             # Set the maximum & minimum number of ticks to use.
540 76         851   $self->{'y_ticks'} = 6;
541 76         880   $self->{'min_y_ticks'} = 6;
542 76         771   $self->{'max_y_ticks'} = 100;
543 76         1075   $self->{'x_number_ticks'} = 1;
544 76         755   $self->{'min_x_ticks'} = 6;
545 76         920   $self->{'max_x_ticks'} = 100;
546              
547             # make the ticks 4 pixels long
548 76         1260   $self->{'tick_len'} = 4;
549              
550             # no custom y tick labels
551 76         774   $self->{'y_tick_labels'} = undef;
552               
553             # no patterns
554 76         759   $self->{'patterns'} = undef;
555              
556             # let the lines in Chart::Lines be 6 pixels wide
557 76         826   $self->{'brush_size'} = 6;
558              
559             # let the points in Chart::Points and Chart::LinesPoints be 18 pixels wide
560 76         3336   $self->{'pt_size'} = 18;
561              
562             # use the old non-spaced bars
563 76         1301   $self->{'spaced_bars'} = 'true';
564              
565             # use the new grey background for the plots
566 76         843   $self->{'grey_background'} = 'true';
567              
568             # don't default to transparent
569 76         843   $self->{'transparent'} = 'false';
570              
571             # default to "normal" x_tick drawing
572 76         1101   $self->{'x_ticks'} = 'normal';
573              
574             # we're not a component until Chart::Composite says we are
575 76         2721   $self->{'component'} = 'false';
576              
577             # don't force the y-axes in a Composite chare to be the same
578 76         1095   $self->{'same_y_axes'} = 'false';
579               
580             # plot rectangeles in the legend instead of lines in a composite chart
581 76         841   $self->{'legend_example_height'} = 'false';
582                 
583             # don't force integer y-ticks
584 76         1183   $self->{'integer_ticks_only'} = 'false';
585               
586             # don't forbid a false zero scale.
587 76         823   $self->{'include_zero'} = 'false';
588              
589             # don't waste time/memory by storing imagemap info unless they ask
590 76         841   $self->{'imagemap'} = 'false';
591              
592             # default for grid_lines is off
593 76         915   $self->{grid_lines} = 'false';
594 76         905   $self->{x_grid_lines} = 'false';
595 76         945   $self->{y_grid_lines} = 'false';
596 76         810   $self->{y2_grid_lines} = 'false';
597              
598             # default for no_cache is false. (it breaks netscape 4.5)
599 76         19064   $self->{no_cache} = 'false';
600              
601 76         886   $self->{typeStyle} = 'default';
602              
603             # default value for skip_y_ticks for the labels
604 76         1109   $self->{skip_y_ticks} = 1;
605              
606             # default value for skip_int_ticks only for integer_ticks_only
607 76         854   $self->{skip_int_ticks} = 1;
608              
609             # default value for precision
610 76         1871   $self->{precision} = 3;
611              
612             # default value for legend label values in pie charts
613 76         1189   $self->{legend_label_values} = 'value';
614               
615             # default value for the labels in a pie chart
616 76         851   $self->{label_values} = 'percent';
617               
618             # default position for the y-axes
619 76         962   $self->{y_axes} = 'left';
620               
621             # copies of the current values at the x-ticks function
622 76         1617   $self->{temp_x_min} = 0;
623 76         793   $self->{temp_x_max} = 0;
624 76         769   $self->{temp_y_min} = 0;
625 76         744   $self->{temp_y_max} = 0;
626              
627             # Instance for summe
628 76         2703   $self->{sum} = 0;
629               
630             # Don't sort the data unless they ask
631 76         889   $self->{'sort'} = 'false';
632               
633             # The Interval for drawing the x-axes in the split module
634 76         765   $self->{'interval'} = undef;
635               
636             # The start value for the split chart
637 76         846   $self->{'start'} = undef;
638               
639             # How many ticks do i have to draw at the x-axes in one interval of a split-plot?
640 76         3792   $self->{'interval_ticks'} = 6;
641               
642             # Draw the Lines in the split-chart normal
643 76         813   $self->{'scale'} = 1;
644               
645             # Make a x-y plot
646 76         827   $self->{'xy_plot'} = 'false';
647               
648             # min and max for xy plot
649 76         815   $self->{'x_min_val'} =1;
650 76         766   $self->{'x_max_val'} =1;
651               
652             # use the same error value in ErrorBars
653 76         3831   $self->{'same_error'} = 'false';
654               
655              
656             # Set the minimum and maximum number of circles to draw in a direction chart
657 76         1683   $self->{'min_circles'} = 4;
658 76         810   $self->{'max_circles'} = 100;
659               
660             # set the style of a direction diagramm
661 76         839   $self->{'point'} = 'true';
662 76         1984   $self->{'line'} = 'false';
663 76         772   $self->{'arrow'} = 'false';
664               
665             # The number of angel axes in a direction Chart
666 76         1185   $self->{'angle_interval'} = 30;
667               
668             # dont use different 'x_axes' in a direction Chart
669 76         824   $self->{'pairs'} = 'false';
670               
671             # used function to transform x- and y-tick labels to strings
672 76         835   $self->{f_x_tick} = \&_default_f_tick;
673 76         877   $self->{f_y_tick} = \&_default_f_tick;
674 76         933   $self->{f_z_tick} = \&_default_f_tick;
675             # default color specs for various color roles.
676             # Subclasses should extend as needed.
677 76         762   my $d = 0;
678 4712         75391   $self->{'colors_default_spec'} = {
679                 background => 'white',
680                 misc => 'black',
681                 text => 'black',
682                 y_label => 'black',
683                 y_label2 => 'black',
684                 grid_lines => 'black',
685                 grey_background => 'grey',
686 76         1106     (map { 'dataset'.$d++ => $_ } qw (red green blue purple peach orange mauve olive pink light_purple light_blue plum yellow turquoise light_green brown
687             HotPink PaleGreen1 DarkBlue BlueViolet orange2 chocolate1 LightGreen pink light_purple light_blue plum yellow turquoise light_green brown
688             pink PaleGreen2 MediumPurple PeachPuff1 orange3 chocolate2 olive pink light_purple light_blue plum yellow turquoise light_green brown
689             DarkOrange PaleGreen3 SlateBlue BlueViolet PeachPuff2 orange4 chocolate3 LightGreen pink light_purple light_blue plum yellow turquoise light_green brown) ),
690              
691               };
692               
693             # get default color specs for some color roles from alternate role.
694             # Subclasses should extend as needed.
695 76         5413   $self->{'colors_default_role'} = {
696                 'x_grid_lines' => 'grid_lines',
697                 'y_grid_lines' => 'grid_lines',
698                 'y2_grid_lines' => 'grid_lines', # should be added by Char::Composite...
699               };
700              
701             # and return
702 76         1211   return 1;
703             }
704              
705              
706             ## be nice and leave their data alone
707             sub _copy_data {
708 76     76   794   my $self = shift;
709 76         758   my $extern_ref = shift;
710 76         759   my ($ref, $i, $j);
711              
712             # look to see if they used the other api
713 76 100       1164   if ($self->{'dataref'}) {
714             # we've already got a copy, thanks
715 56         601     return 1;
716               }
717               else {
718             # get an array reference
719 20         403     $ref = [];
720                 
721             # loop through and copy
722 20         188     for $i (0..$#{$extern_ref}) {
  20         357  
723 71         617       @{ $ref->[$i] } = @{ $extern_ref->[$i] };
  71         1205  
  71         995  
724             ## Speedup compared to:
725             # for $j (0..$#{$extern_ref->[$i]}) {
726             # $ref->[$i][$j] = $extern_ref->[$i][$j];
727             # }
728                 }
729              
730             # put it in the object
731 20         307     $self->{'dataref'} = $ref;
732               }
733             }
734              
735              
736             ## make sure the data isn't really weird
737             ## and collect some basic info about it
738             sub _check_data {
739 66     66   778   my $self = shift;
740 66         655   my $length = 0;
741              
742             # first make sure there's something there
743 66 50       587   unless (scalar (@{$self->{'dataref'}}) >= 2) {
  66         1023  
744 0         0     croak "Call me again when you have some data to chart";
745               }
746              
747             # make sure we don't end up dividing by zero if they ask for
748             # just one y_tick
749 66 50       950   if ($self->{'y_ticks'} <= 1) {
750 0         0     $self->{'y_ticks'} = 2;
751 0         0     carp "The number of y_ticks displayed must be at least 2";
752               }
753              
754             # remember the number of datasets
755 66         651   $self->{'num_datasets'} = $#{$self->{'dataref'}};
  66         3168  
756              
757             # remember the number of points in the largest dataset
758 66         720   $self->{'num_datapoints'} = 0;
759 66         809   for (0..$self->{'num_datasets'}) {
760 230 100       1998     if (scalar(@{$self->{'dataref'}[$_]}) > $self->{'num_datapoints'}) {
  230         2995  
761 66         656       $self->{'num_datapoints'} = scalar(@{$self->{'dataref'}[$_]});
  66         786  
762                 }
763               }
764              
765             # find good min and max y-values for the plot
766 66         1262   $self->_find_y_scale;
767               
768              
769              
770             # find the longest x-tick label
771 66         891   $length = 0;
772 66         750   for (@{$self->{'dataref'}->[0]}) {
  66         929  
773 30685 100       872318         next if !defined($_);
774 30676 100       367158         if (length($self->{f_x_tick}->($_)) > $length) {
775 117         1549            $length = length ($self->{f_x_tick}->($_));
776                     }
777               }
778 66 50       1300   if ( $length <= 0 ) { $length = 1; } # make sure $length is positive and greater 0
  0         0  
779              
780             # now store it in the object
781 66         806   $self->{'x_tick_label_length'} = $length;
782              
783             # find x-scale, if a x-y plot is wanted
784             # makes only sense for some charts
785 66 100 66     2551   if ( $self->{'xy_plot'} =~ /^true$/i && ($self->isa('Chart::Lines') || $self->isa('Chart::Points')
      100        
      66        
      100        
      100        
786                    || $self->isa('Chart::LinesPoints') || $self->isa('Chart::Split') || $self->isa('Chart::ErrorBars')) ) {
787 4         63      $self->_find_x_scale;
788               }
789               
790 66         706   return 1;
791             }
792              
793              
794             ## plot the chart to the gd object
795             sub _draw {
796 60     60   911   my $self = shift;
797               
798             ## No Longer needed.
799             # # use their colors if they want
800             # if ($self->{'colors'}) {
801             # $self->_set_user_colors();
802             # }
803              
804             ## Moved to png(), cgi_png(), etc.
805             # # fill in the defaults for the colors
806             # $self->_set_colors();
807              
808             # leave the appropriate border on the png
809 60         717   $self->{'curr_x_max'} -= $self->{'png_border'};
810 60         674   $self->{'curr_x_min'} += $self->{'png_border'};
811 60         644   $self->{'curr_y_max'} -= $self->{'png_border'};
812 60         675   $self->{'curr_y_min'} += $self->{'png_border'};
813              
814             # draw in the title
815 60 100       1507   $self->_draw_title() if $self->{'title'};
816              
817             # have to leave this here for backwards compatibility
818 60 100       2824   $self->_draw_sub_title() if $self->{'sub_title'};
819              
820             # sort the data if they want to (mainly here to make sure
821             # pareto charts get sorted)
822 60 100       4618   $self->_sort_data() if ($self->{'sort'} =~ /^true$/i);
823              
824             # start drawing the data (most methods in this will be
825             # overridden by the derived classes)
826             # include _draw_legend() in this to ensure that the legend
827             # will be flush with the chart
828 60         1153   $self->_plot();
829              
830             # and return
831 60         798   return 1;
832             }
833              
834              
835             %named_colors = (
836               'white' => [255,255,255],
837               'black' => [0,0,0],
838               'red' => [200,0,0],
839               'green' => [0,175,0],
840               'blue' => [0,0,200],
841               'orange' => [250,125,0],
842               'orange2' => [238,154,0],
843               'orange3' => [205,133,0],
844               'orange4' => [139,90,0],
845               'yellow' => [225,225,0],
846               'purple' => [200,0,200],
847               'light_blue' => [0,125,250],
848               'light_green' => [125,250,0],
849               'light_purple' => [145,0,250],
850               'pink' => [250,0,125],
851               'peach' => [250,125,125],
852               'olive' => [125,125,0],
853               'plum' => [125,0,125],
854               'turquoise' => [0,125,125],
855               'mauve' => [200,125,125],
856               'brown' => [160,80,0],
857               'grey' => [225,225,225],
858               'HotPink' => [255,105,180],
859               'PaleGreen1' => [154,255,154],
860               'PaleGreen2' => [144,238,144],
861               'PaleGreen3' => [124,205,124],
862               'PaleGreen4' => [84,138,84],
863               'DarkBlue' => [0,0,139],
864               'BlueViolet' => [138,43,226],
865               'PeachPuff' => [255,218,185],
866               'PeachPuff1' => [255,218,185],
867               'PeachPuff2' => [238,203,173],
868               'PeachPuff3' => [205,175,149],
869               'PeachPuff4' => [139,119,101],
870               'chocolate1' => [255,127,36],
871               'chocolate2' => [238,118,33],
872               'chocolate3' => [205,102,29],
873               'chocolate4' => [139,69,19],
874               'LightGreen' => [144,238,144],
875               'lavender' => [230,230,250],
876               'MediumPurple' => [147,112,219],
877               'DarkOrange' => [255,127,0],
878               'DarkOrange2' => [238,118,0],
879               'DarkOrange3' => [205,102,0],
880               'DarkOrange4' => [139,69,0],
881               'SlateBlue' => [106,90,205],
882               'BlueViolet' => [138,43,226],
883               'RoyalBlue' => [65,105,225],
884             );
885              
886              
887             ## No Longer needed.
888             ## let the user specify their own colors in $self->{'colors'}
889             # sub _set_user_colors {
890             # my $self = shift;
891             # my $color_table = {};
892             # my @rgb;
893             #
894             # # see if they want a different background
895             # if (($self->{'colors'}{'background'}) &&
896             # (scalar(@{$self->{'colors'}{'background'}}) == 3)) {
897             # @rgb = @{$self->{'colors'}{'background'}};
898             # $color_table->{'background'} = $self->{'gd_obj'}->colorAllocate(@rgb);
899             # }
900             # else { # make sure white becomes the background color
901             # @rgb = (255, 255, 255);
902             # $color_table->{'background'} = $self->{'gd_obj'}->colorAllocate(@rgb);
903             # }
904             #
905             # # make the background transparent if they asked nicely
906             # if ($self->{'transparent'} =~ /^true$/i) {
907             # $self->{'gd_obj'}->transparent ($color_table->{'background'});
908             # }
909             #
910             # # next check for the color for the miscellaneous stuff
911             # # (the axes on the plot, the box around the legend, etc.)
912             # if (($self->{'colors'}{'misc'}) &&
913             # (scalar(@{$self->{'colors'}{'misc'}}) == 3)) {
914             # @rgb = @{$self->{'colors'}{'misc'}};
915             # $color_table->{'misc'} = $self->{'gd_obj'}->colorAllocate(@rgb);
916             # }
917             #
918             # # what about the text?
919             # if (($self->{'colors'}{'text'}) &&
920             # (scalar(@{$self->{'colors'}{'text'}}) == 3)) {
921             # @rgb = @{$self->{'colors'}{'text'}};
922             # $color_table->{'text'} = $self->{'gd_obj'}->colorAllocate(@rgb);
923             # }
924             #
925             # # and how about y_labels?
926             # if (($self->{'colors'}{'y_label'}) &&
927             # (scalar(@{$self->{'colors'}{'y_label'}}) == 3)) {
928             # @rgb = @{$self->{'colors'}{'y_label'}};
929             # $color_table->{'y_label'} = $self->{'gd_obj'}->colorAllocate(@rgb);
930             # }
931             #
932             # if (($self->{'colors'}{'y_label2'}) &&
933             # (scalar(@{$self->{'colors'}{'y_label2'}}) == 3)) {
934             # @rgb = @{$self->{'colors'}{'y_label2'}};
935             # $color_table->{'y_label2'} = $self->{'gd_obj'}->colorAllocate(@rgb);
936             # }
937             #
938             # # set user-specified "default" grid_lines color
939             # if (($self->{'colors'}{'grid_lines'}) &&
940             # (scalar(@{$self->{'colors'}{'grid_lines'}}) == 3)) {
941             # @rgb = @{$self->{'colors'}{'grid_lines'}};
942             # $color_table->{'grid_lines'} = $self->{'gd_obj'}->colorAllocate(@rgb);
943             # }
944             #
945             # # x_grid_lines color
946             # if (($self->{'colors'}{'x_grid_lines'}) &&
947             # (scalar(@{$self->{'colors'}{'x_grid_lines'}}) == 3)) {
948             # @rgb = @{$self->{'colors'}{'x_grid_lines'}};
949             # $color_table->{'x_grid_lines'} = $self->{'gd_obj'}->colorAllocate(@rgb);
950             # }
951             #
952             # # y_grid_lines color
953             # if (($self->{'colors'}{'y_grid_lines'}) &&
954             # (scalar(@{$self->{'colors'}{'y_grid_lines'}}) == 3)) {
955             # @rgb = @{$self->{'colors'}{'y_grid_lines'}};
956             # $color_table->{'y_grid_lines'} = $self->{'gd_obj'}->colorAllocate(@rgb);
957             # }
958             #
959             # # y2_grid_lines color
960             # if (($self->{'colors'}{'y2_grid_lines'}) &&
961             # (scalar(@{$self->{'colors'}{'y2_grid_lines'}}) == 3)) {
962             # @rgb = @{$self->{'colors'}{'y2_grid_lines'}};
963             # $color_table->{'y2_grid_lines'} = $self->{'gd_obj'}->colorAllocate(@rgb);
964             # }
965             #
966             # # okay, now go for the data sets
967             # for (keys(%{$self->{'colors'}})) {
968             # if (($_ =~ /^dataset/i) &&
969             # (scalar(@{$self->{'colors'}{$_}}) == 3)) {
970             # @rgb = @{$self->{'colors'}{$_}};
971             # $color_table->{$_} = $self->{'gd_obj'}->colorAllocate(@rgb);
972             # }
973             # }
974             #
975             # # stick the color table in the object
976             # $self->{'color_table'} = $color_table;
977             #
978             # # and return
979             # return 1;
980             # }
981              
982              
983             ## specify my colors
984             sub _set_colors {
985 60     60   738   my $self = shift;
986               
987              
988 60         1268   my $index = $self->_color_role_to_index('background'); # allocate GD color
989 60 100       1107   if ( $self->{'transparent'} =~ m/^true$/i ) {
990 4         168     $self->{'gd_obj'}->transparent($index);
991               }
992             # all other roles are initialized by calling $self->_color_role_to_index(ROLENAME);
993              
994              
995              
996             ## Replaced by above, and calls to _color_role_to_index method elsewhere.
997             # my ($color_table, @rgb, @colors);
998             #
999             # # check to see if they specified colors
1000             # if ($self->{'color_table'}) {
1001             # $color_table = $self->{'color_table'};
1002             # }
1003             # else {
1004             # $color_table = {};
1005             # }
1006             #
1007             # # put the background in first
1008             # unless ($color_table->{'background'}) {
1009             # @rgb = @{$colors{'white'}};
1010             # $color_table->{'background'} = $self->{'gd_obj'}->colorAllocate(@rgb);
1011             # }
1012             #
1013             # # make the background transparent if they asked for it
1014             # if ($self->{'transparent'} =~ /^true$/i) {
1015             # $self->{'gd_obj'}->transparent ($color_table->{'background'});
1016             # }
1017             #
1018             # # now get all my named colors
1019             # for (keys (%colors)) {
1020             # @rgb = @{$colors{$_}};
1021             # $color_table->{$_} = $self->{'gd_obj'}->colorAllocate(@rgb);
1022             # }
1023             #
1024             # # set up the datatset* colors
1025             # @colors = qw (red green blue purple peach orange mauve olive pink light_purple light_blue plum yellow turquoise light_green brown);
1026             # for (0..$#colors) {
1027             # unless ($color_table->{'dataset'.$_}) { # don't override their colors
1028             # $color_table->{'dataset'.$_} = $color_table->{$colors[$_]};
1029             # }
1030             # }
1031             #
1032             # # set up the miscellaneous color
1033             # unless ($color_table->{'misc'}) {
1034             # $color_table->{'misc'} = $color_table->{'black'};
1035             # }
1036             #
1037             # # and the text color
1038             # unless ($color_table->{'text'}) {
1039             # $color_table->{'text'} = $color_table->{'black'};
1040             # }
1041             #
1042             # unless ($color_table->{'y_label'}) {
1043             # $color_table->{'y_label'} = $color_table->{'black'};
1044             # }
1045             # unless ($color_table->{'y_label2'}) {
1046             # $color_table->{'y_label2'} = $color_table->{'black'};
1047             # }
1048             #
1049             # unless ($color_table->{'grid_lines'}) {
1050             # $color_table->{'grid_lines'} = $color_table->{'black'};
1051             # }
1052             #
1053             # unless ($color_table->{'x_grid_lines'}) {
1054             # $color_table->{'x_grid_lines'} = $color_table->{'grid_lines'};
1055             # }
1056             #
1057             # unless ($color_table->{'y_grid_lines'}) {
1058             # $color_table->{'y_grid_lines'} = $color_table->{'grid_lines'};
1059             # }
1060             #
1061             # unless ($color_table->{'y2_grid_lines'}) {
1062             # $color_table->{'y2_grid_lines'} = $color_table->{'grid_lines'};
1063             # }
1064             #
1065             # # put the color table back in the object
1066             # $self->{'color_table'} = $color_table;
1067             #
1068             # # and return
1069             # return 1;
1070             }
1071              
1072             sub _color_role_to_index {
1073 10431     10431   127280     my $self = shift;
1074                 
1075             # Return a (list of) color index(es) corresponding to the (list of) role(s) in @_.
1076 10431         140325     my @result = map {
1077 10431         188444     my $role = $_;
1078 10431         134239     my $index = $self->{'color_table'}->{$role};
1079                 
1080             #print STDERR "Role = $_\n";
1081                   
1082 10431 100       125720       unless ( defined $index ) {
1083 568   100     12644         my $spec = $self->{'colors'}->{$role}
      66        
1084                       || $self->{'colors_default_spec'}->{$role}
1085                       || $self->{'colors_default_spec'}->{$self->{'colors_default_role'}->{$role}};
1086                       
1087                   
1088 568         10882         my @rgb = $self->_color_spec_to_rgb($role, $spec);
1089             #print STDERR "spec = $spec\n";
1090                    
1091 568         5990         my $string = sprintf " RGB(%d,%d,%d)", map { $_ + 0 } @rgb;
  1704         23665  
1092                     
1093 568         6892         $index = $self->{'color_table'}->{$string};
1094 568 100       6168         unless ( defined $index ) {
1095 392         10596           $index = $self->{'gd_obj'}->colorAllocate(@rgb);
1096 392         5918          $self->{'color_table'}->{$string} = $index;
1097                     }
1098                     
1099 568         20137         $self->{'color_table'}->{$role} = $index;
1100                   }
1101 10431         134251       $index;
1102                 } @_;
1103             #print STDERR "Result= ".$result[0]."\n";
1104 10431 50 66     304481     (wantarray && @_ > 1 ? @result : $result[0]);
1105               }
1106                   
1107               sub _color_spec_to_rgb {
1108 568     568   5422     my $self = shift;
1109 568         7321     my $role = shift; # for error messages
1110 568         7195     my $spec = shift; # [r,g,b] or name
1111 568         5105     my @rgb;
1112 568 100       7544     if ( ref($spec) eq 'ARRAY' ) {
    50          
1113 88         979       @rgb = @{ $spec };
  88         1160  
1114 88 50 33     5719       croak "Invalid color RGB array (" . join(',', @rgb) . ") for $role\n"
      33        
1115                     unless @rgb == 3 && grep( ! m/^\d+$/ || $_ > 255, @rgb) == 0;
1116                 }
1117                 elsif ( ! ref($spec) ) {
1118 480 50       7266       croak "Unknown named color ($spec) for $role\n"
1119                     unless $named_colors{$spec};
1120 480         4867       @rgb = @{ $named_colors{$spec} };
  480         6349  
1121                 }
1122                 else {
1123 0         0       croak "Unrecognized color for $role\n";
1124                 }
1125 568         12879     @rgb;
1126               }
1127              
1128              
1129             ## draw the title for the chart
1130             sub _draw_title {
1131 59     59   792   my $self = shift;
1132 59         646   my $font = $self->{'title_font'};
1133 59         593   my $color;
1134 59         1527   my ($h, $w, @lines, $x, $y);
1135              
1136             #get the right color
1137 59 100       1141   if (defined $self->{'colors'}{'title'} ) {
1138 7         344       $color = $self->_color_role_to_index('title') ;
1139               }
1140               else {
1141 52         706       $color = $self->_color_role_to_index('text') ;
1142               }
1143             # make sure we're actually using a real font
1144 59 50       1001   unless ((ref $font) eq 'GD::Font') {
1145 0         0     croak "The title font you specified isn\'t a GD Font object";
1146               }
1147              
1148             # get the height and width of the font
1149 59         1155   ($h, $w) = ($font->height, $font->width);
1150              
1151             # split the title into lines
1152 59         995   @lines = split (/\\n/, $self->{'title'});
1153              
1154             # write the first line
1155 59         955   $x = ($self->{'curr_x_max'} - $self->{'curr_x_min'}) / 2
1156                      + $self->{'curr_x_min'} - (length($lines[0]) * $w) /2;
1157 59         1640   $y = $self->{'curr_y_min'} + $self->{'text_space'};
1158 59         7300   $self->{'gd_obj'}->string($font, $x, $y, $lines[0], $color);
1159              
1160             # now loop through the rest of them
1161 59         892   for (1..$#lines) {
1162 5         55     $self->{'curr_y_min'} += $self->{'text_space'} + $h;
1163 5         93     $x = ($self->{'curr_x_max'} - $self->{'curr_x_min'}) / 2
1164                        + $self->{'curr_x_min'} - (length($lines[$_]) * $w) /2;
1165 5         51     $y = $self->{'curr_y_min'} + $self->{'text_space'};
1166 5         220     $self->{'gd_obj'}->string($font, $x, $y, $lines[$_], $color);
1167               }
1168              
1169             # mark off that last space
1170 59         770   $self->{'curr_y_min'} += 2 * $self->{'text_space'} + $h;
1171              
1172             # and return
1173 59         1637   return 1;
1174             }
1175              
1176              
1177             ## pesky backwards-compatible sub
1178             sub _draw_sub_title {
1179 8     8   128   my $self = shift;
1180 8         88   my $font = $self->{'sub_title_font'};
1181 8         94   my $color = $self->_color_role_to_index('text');
1182 8         84   my $text = $self->{'sub_title'};
1183 8         105   my ($h, $w, $x, $y);
1184              
1185             # make sure we're using a real font
1186 8 50       104   unless ((ref ($font)) eq 'GD::Font') {
1187 0         0     croak "The subtitle font you specified isn\'t a GD Font object";
1188               }
1189              
1190             # get the size of the font
1191 8         129   ($h, $w) = ($font->height, $font->width);
1192              
1193             # figure out the placement
1194 8         106   $x = ($self->{'curr_x_max'} - $self->{'curr_x_min'}) / 2
1195                      + $self->{'curr_x_min'} - (length($text) * $w) / 2;
1196 8         80   $y = $self->{'curr_y_min'};
1197               
1198             # now draw the subtitle
1199 8         558   $self->{'gd_obj'}->string ($font, $x, $y, $text, $color);
1200              
1201             # Adapt curr_y_min
1202 8         84   $self->{'curr_y_min'} += $self->{'text_space'} + $h;
1203              
1204             # and return
1205 8         77   return 1;
1206             }
1207              
1208              
1209             ## sort the data nicely (mostly for the pareto charts and xy-plots)
1210             sub _sort_data {
1211 0     0   0    my $self = shift;
1212 0         0    my $data_ref = $self->{'dataref'};
1213 0         0    my @data = @{$self->{'dataref'}};
  0         0  
1214 0         0    my @sort_index;
1215              
1216             #sort the data with slices
1217 0         0    @sort_index = sort { $data[0][$a] <=> $data[0][$b] } (0..scalar(@{$data[1]})-1);
  0         0  
  0         0  
1218 0         0    for (1..$#data) {
1219 0         0        @{$self->{'dataref'}->[$_]} = @{$self->{'dataref'}->[$_]}[@sort_index];
  0         0  
  0         0  
1220                }
1221 0         0    @{$data_ref->[0]} = sort {$a <=> $b} @{$data_ref->[0]};
  0         0  
  0         0  
  0         0  
1222              
1223             #finally return
1224 0         0    return 1;
1225             }
1226              
1227             #For a xy-plot do the same for the x values, as _find_y_scale does for the y values!
1228             sub _find_x_scale {
1229 4     4   42     my $self = shift;
1230 4         38     my @data = @{$self->{'dataref'}};
  4         50  
1231 4         39     my ($i, $j);
1232 4         36     my ($d_min, $d_max);
1233 4         39     my ($p_min, $p_max, $f_min, $f_max);
1234 4         36     my ($tickInterval, $tickCount, $skip);
1235 4         37     my @tickLabels;
1236 4         37     my $maxtickLabelLen = 0;
1237                 
1238             #look, if we have numbers
1239 4         45     for $i (0..($self->{'num_datasets'})) {
1240 13         167         for $j (0..($self->{'num_datapoints'}-1)) {
1241             #the following regular Expression matches all possible numbers, including scientific numbers!!
1242 1165 50       32923                 if ($data[$i][$j] !~ m/^[+-]?((\.\d+)|(\d+\.?\d*))([eE][+-]?\d+)?[fFdD]?$/ ) {
1243 0         0                    croak "<$data[$i][$j]> You should give me numbers for drawing a xy plot!\n";
1244                             }
1245                     }
1246                 }
1247                 
1248             #find the dataset min and max
1249 4         106     ($d_min, $d_max) = $self->_find_x_range();
1250              
1251             # Force the inclusion of zero if the user has requested it.
1252 4 100       78    if( $self->{'include_zero'} =~ m!^true$!i ) {
1253 1 50       14        if( ($d_min * $d_max) > 0 ) { # If both are non zero and of the same sign.
1254 1 50       12          if( $d_min > 0 ) { # If the whole scale is positive.
1255 1         10              $d_min = 0;
1256                      }
1257                      else { # The scale is entirely negative.
1258 0         0      $d_max = 0;
1259                      }
1260                   }
1261                }
1262              
1263             # Calculate the width of the dataset. (posibly modified by the user)
1264 4         43    my $d_width = $d_max - $d_min;
1265              
1266             # If the width of the range is zero, forcibly widen it
1267             # (to avoid division by zero errors elsewhere in the code).
1268 4 50       49    if( 0 == $d_width ) {
1269 0         0        $d_min--;
1270 0         0        $d_max++;
1271 0         0        $d_width = 2;
1272                }
1273              
1274             # Descale the range by converting the dataset width into
1275             # a floating point exponent & mantisa pair.
1276 4         102    my( $rangeExponent, $rangeMantisa ) = $self->_sepFP( $d_width );
1277 4         40    my $rangeMuliplier = 10 ** $rangeExponent;
1278              
1279             # Find what tick
1280             # to use & how many ticks to plot,
1281             # round the plot min & max to suatable round numbers.
1282 4         135    ($tickInterval, $tickCount, $p_min, $p_max)
1283                 = $self->_calcXTickInterval($d_min/$rangeMuliplier, $d_max/$rangeMuliplier,
1284             $f_min, $f_max,
1285             $self->{'min_x_ticks'}, $self->{'max_x_ticks'});
1286             # Restore the tickInterval etc to the correct scale
1287 4         39    $_ *= $rangeMuliplier foreach($tickInterval, $p_min, $p_max);
  4         54  
1288              
1289             #get teh precision for the labels
1290 4         46    my $precision = $self->{'precision'};
1291              
1292             # Now sort out an array of tick labels.
1293                for( my $labelNum = $p_min; $labelNum<=$p_max; $labelNum+=$tickInterval ) {
1294 31         290 my $labelText;
1295              
1296 31 50       377         if( defined $self->{f_y_tick} ) {
1297             # Is _default_f_tick function used?
1298 31 50       335            if ( $self->{f_y_tick} == \&_default_f_tick) {
1299 31         2091                   $labelText = sprintf("%.".$precision."f", $labelNum);
1300                        }
1301                        else {
1302 0         0                   $labelText = $self->{f_y_tick}->($labelNum);
1303                        }
1304                     }
1305                     else {
1306 0         0            $labelText = sprintf("%.".$precision."f", $labelNum);
1307                    }
1308              
1309 31         344        push @tickLabels, $labelText;
1310 31 100       464        $maxtickLabelLen = length $labelText if $maxtickLabelLen < length $labelText;
1311 4         38    }
1312              
1313             # Store the calculated data.
1314 4         42    $self->{'x_min_val'} = $p_min;
1315 4         42    $self->{'x_max_val'} = $p_max;
1316 4         40    $self->{'x_tick_labels'} = \@tickLabels;
1317 4         41    $self->{'x_tick_label_length'} = $maxtickLabelLen;
1318 4         42    $self->{'x_number_ticks'} = $tickCount;
1319 4         51    return 1;
1320             }
1321             ## find good values for the minimum and maximum y-value on the chart
1322             # New version, re-written by David Pottage of Tao Group.
1323             # This code is *AS IS* and comes with *NO WARRANTY*
1324             #
1325             # This Sub calculates correct values for the following class local variables,
1326             # if they have not been set by the user.
1327             #
1328             # max_val, min_val: The maximum and minimum values for the y axis.
1329             #
1330             # y_ticks: The number of ticks to plot on the y scale, including
1331             # the end points. e.g. If the scale runs from 0 to 50,
1332             # with ticks every 10, y_ticks will have the value of 6.
1333             #
1334             # y_tick_labels: An array of strings, each is a label for the y axis.
1335             #
1336             # y_tick_labels_length: The length to allow for B tick labels. (How long is
1337             # the longest?)
1338              
1339             sub _find_y_scale
1340             {
1341 61     61   675 my $self = shift;
1342            
1343             # Predeclare vars.
1344 61         2502 my ($d_min, $d_max); # Dataset min & max.
1345 61         554 my ($p_min, $p_max); # Plot min & max.
1346 61         611 my ($tickInterval, $tickCount, $skip);
1347 61         632 my @tickLabels; # List of labels for each tick.
1348 61         551 my $maxtickLabelLen = 0; # The length of the longest tick label.
1349 61         687 my $prec_test=0; # Boolean which indicate if precision < |rangeExponent|
1350 61         809 my $temp_rangeExponent;
1351            
1352             # Find the datatset minimum and maximum.
1353 61         1108 ($d_min, $d_max) = $self->_find_y_range();
1354              
1355             # Force the inclusion of zero if the user has requested it.
1356 61 100       1311 if( $self->{'include_zero'} =~ m!^true$!i )
1357             {
1358 14 100       179 if( ($d_min * $d_max) > 0 ) # If both are non zero and of the same sign.
1359             {
1360 8 50       88 if( $d_min > 0 ) # If the whole scale is positive.
1361             {
1362 8         74 $d_min = 0;
1363             }
1364             else # The scale is entirely negative.
1365             {
1366 0         0 $d_max = 0;
1367             }
1368             }
1369             }
1370            
1371 61 50       883         if ( $self->{'integer_ticks_only'} =~ /^\d$/ ) {
1372 0 0       0            if ( $self->{'integer_ticks_only'} == 1 ) {
1373 0         0               $self->{'integer_ticks_only'} = 'true';
1374                        } else {
1375 0         0               $self->{'integer_ticks_only'} = 'false';
1376                        }
1377                     }
1378 61 100       2389 if( $self->{'integer_ticks_only'} =~ m!^true$!i )
1379             {
1380             # Allow the dataset range to be overidden by the user.
1381             # f_min/max are booleans which indicate that the min & max should not be modified.
1382 10         126 my $f_min = defined $self->{'min_val'};
1383 10 100       151 $d_min = $self->{'min_val'} if $f_min;
1384              
1385 10         99 my $f_max = defined $self->{'max_val'};
1386 10 100       113 $d_max = $self->{'max_val'} if $f_max;
1387              
1388             # Assert against the min is larger than the max.
1389 10 50       107 if( $d_min > $d_max )
1390             {
1391 0         0 croak "The the specified 'min_val' & 'max_val' values are reversed (min > max: $d_min>$d_max)";
1392             }
1393             # The user asked for integer ticks, force the limits to integers.
1394             # & work out the range directly.
1395             #$p_min = $self->_round2Tick($d_min, 1, -1);
1396             #$p_max = $self->_round2Tick($d_max, 1, 1);
1397              
1398 10         94 $skip = $self->{skip_int_ticks};
1399 10 50       149                 $skip = 1 if $skip < 1;
1400            
1401 10         157                 $p_min = $self->_round2Tick($d_min, 1, -1);
1402 10         3844 $p_max = $self->_round2Tick($d_max, 1, 1);
1403              
1404 10         120 $tickInterval = $skip;
1405 10         100 $tickCount = ($p_max - $p_min ) / $skip + 1;
1406              
1407                             
1408              
1409             # Now sort out an array of tick labels.
1410              
1411             for( my $labelNum = $p_min; $labelNum<=$p_max; $labelNum+=$tickInterval )
1412             {
1413 91         784 my $labelText;
1414            
1415 91 50       1049 if( defined $self->{f_y_tick} )
1416             {
1417             # Is _default_f_tick function used?
1418 91 100       1916                          if ( $self->{f_y_tick} == \&_default_f_tick) {
1419 82         962 $labelText = sprintf("%d", $labelNum);
1420            
1421                                      }
1422             else {
1423 9         93 $labelText =