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