1#========================================================================== 2# Module: calamaris::calAxestype.pm 3# 4# Copyright 5# 6# calAxestype.pm Copyright (c) 2004 Michael Pophal based on 7# GD::Graph Copyright (c) 1995-1999 Martien Verbruggen. 8# (http://search.cpan.org/~mverb/GDGraph-1.43/Graph.pm) 9# 10# All rights reserved. This package is free software; you can redistribute 11# it and/or modify it under the same terms as Perl itself. 12# 13# Acknowledgements 14# 15# Thanks to Martien Verbruggen's ingenious tool GD::Graph, which is basically 16# the same, except some small changes needed for calamaris. 17#========================================================================== 18# 19# Adapted to calamaris by: (c) 2004 Michael Pophal 20# 21# Based on: 22# GD::Graph::axestype.pm,v 1.21 2000/04/15 08:59:36 mgjv 23# http://search.cpan.org/~mverb/GDGraph-1.43/Graph.pm 24# Copyright (c) 1995-1998 Martien Verbruggen 25# 26#-------------------------------------------------------------------------- 27# 28# Name: 29# calamaris::calAxestype.pm 30# 31# $Id: calAxestype.pm,v 3.2 2004-09-15 21:02:13 cord Exp $ 32# 33#-------------------------------------------------------------------------- 34# Date Modification Author 35# ------------------------------------------------------------------------- 36# 2004AUG30 Adapted to calamaris staehler 37#========================================================================== 38 39package calamaris::calAxestype; 40 41($axestype::VERSION) = '$Revision: 3.2 $' =~ /\s([\d.]+)/; 42 43use strict; 44 45use lib '/usr/local'; 46use GD::Graph; 47use GD::Graph::utils qw(:all); 48use Carp; 49 50@calamaris::calAxestype::ISA = qw(GD::Graph); 51 52use constant PI => 4 * atan2(1,1); 53 54my %Defaults = ( 55 56 # Set the length for the 'short' ticks on the axes. 57 x_tick_length => 4, 58 y_tick_length => 4, 59 60 # Do you want ticks to span the entire width of the graph? 61 x_long_ticks => 0, 62 y_long_ticks => 0, 63 64 # Number of ticks for the y axis 65 y_tick_number => 5, 66 x_tick_number => undef, # CONTRIB Scott Prahl 67 x_tick_offset => 0, # CONTRIB Damon Brodi 68 69 # Skip every nth label. if 1 will print every label on the axes, 70 # if 2 will print every second, etc.. 71 x_label_skip => 1, 72 y_label_skip => 1, 73 74 # Do we want ticks on the x axis? 75 x_ticks => 1, 76 x_all_ticks => 0, 77 78 # Where to place the x and y labels 79 x_label_position => 3/4, 80 y_label_position => 1/2, 81 82 # vertical printing of x labels 83 x_labels_vertical => 0, 84 85 # Draw axes as a box? (otherwise just left and bottom) 86 box_axis => 1, 87 88 # Disable axes? 89 # undef -> all axes, 0 -> Only line for bars, other -> no axes at all. 90 no_axes => undef, 91 92 # Use two different axes for the first and second dataset. The first 93 # will be displayed using the left axis, the second using the right 94 # axis. You cannot use more than two datasets when this option is on. 95 two_axes => 0, 96 97 # Which axis to use for each dataset. This only is in effect when 98 # two_axes is true. The axis number will wrap around, just like 99 # the dclrs array. 100 use_axis => [1, 2], 101 102 # Print values on the axes? 103 x_plot_values => 1, 104 y_plot_values => 1, 105 106 # Space between axis and text 107 axis_space => 4, 108 109 # Do you want bars to be drawn on top of each other, or side by side? 110 overwrite => 0, 111 112 # This will replace 'overwrite = 2'. For now, it is hardcoded to set 113 # overwrite to 2 114 cumulate => 0, 115 116 # Do you want me to correct the width of the graph, so that bars are 117 # always drawn with a nice integer number of pixels? 118 # 119 # The GD::Graph::bars::initialise sub will switch this on. 120 # Do not set this to anything else than undef! 121 correct_width => undef, 122 123 # XXX The following two need to get better defaults. Maybe computed. 124 # Draw the zero axis in the graph in case there are negative values 125 zero_axis => 0, 126 127 # Draw the zero axis, but do not draw the bottom axis, in case 128 # box-axis == 0 129 # This also moves the x axis labels to the zero axis 130 zero_axis_only => 0, 131 132 # Size of the legend markers 133 legend_marker_height => 8, 134 legend_marker_width => 12, 135 legend_spacing => 4, 136 legend_placement => 'BC', # '[BR][LCR]' 137 lg_cols => undef, 138 139 # Display the y values above the bar or point in the graph. 140 show_values => undef, 141 values_vertical => undef, # vertical? 142 values_space => 4, # extra spacing 143 values_format => undef, # how to format the value 144 145 # Draw the X axis left and the y1 axis at the bottom (y2 at top) 146 rotate_chart => undef, 147 148 # CONTRIB Edwin Hildebrand 149 # How narrow is a dataset allowed to become before we drop the 150 # accents? 151 accent_treshold => 4, 152 153 # Format of the numbers on the x and y axis 154 y_number_format => undef, 155 x_number_format => undef, # CONTRIB Scott Prahl 156 157 # and some attributes without default values 158 x_label => undef, 159 y_label => undef, 160 y1_label => undef, 161 y2_label => undef, 162 x_min_value => undef, 163 x_max_value => undef, 164 y_min_value => undef, 165 y1_min_value => undef, 166 y2_min_value => undef, 167 y_max_value => undef, 168 y1_max_value => undef, 169 y2_max_value => undef, 170 y_min_range => undef, # CONTRIB Ben Tilly 171 y1_min_range => undef, 172 y2_min_range => undef, 173 174 borderclrs => undef, 175 176 # XXX 177 # Multiple inheritance (linespoints and mixed) finally bit me. The 178 # _has_defaults and set methods can only work correctly when the 179 # spot where the defaults are kept are in a mutual parent, which 180 # would be this. The odd implementation of SUPER doesn't help 181 182 # XXX points 183 # The size of the marker to use in the points and linespoints graphs 184 # in pixels 185 marker_size => 4, 186 187 # attributes with no default 188 markers => undef, 189 190 # XXX lines 191 # The width of the line to use in the lines and linespoints graphs 192 # in pixels 193 line_width => 1, 194 195 # Set the scale of the line types 196 line_type_scale => 8, 197 198 # Which line types to use 199 line_types => [1], 200 201 # Skip undefined values, and don't draw them at all 202 skip_undef => 0, 203 204 # XXX bars 205 # Spacing between the bars 206 bar_width => undef, 207 bar_spacing => 0, 208 set_spacing => 0, 209 210 # cycle through colours per data point, not set 211 cycle_clrs => 0, 212 213 # colour of the shadow 214 shadowclr => 'dgray', 215 shadow_depth => 0, 216 217 # XXX mixed 218 default_type => 'lines', 219 types => undef, 220); 221 222sub _has_default { 223 my $self = shift; 224 my $attr = shift || return; 225 exists $Defaults{$attr} || $self->SUPER::_has_default($attr); 226} 227 228sub initialise 229{ 230 my $self = shift; 231 232 $self->SUPER::initialise(); 233 234 while (my($key, $val) = each %Defaults) 235 { $self->{$key} = $val } 236 237 $self->set_x_label_font(GD::gdSmallFont); 238 $self->set_y_label_font(GD::gdSmallFont); 239 $self->set_x_axis_font(GD::gdTinyFont); 240 $self->set_y_axis_font(GD::gdTinyFont); 241 $self->set_legend_font(GD::gdTinyFont); 242 $self->set_values_font(GD::gdTinyFont); 243} 244 245# PUBLIC 246sub plot 247{ 248 my $self = shift; 249 my $data = shift; 250 251 $self->check_data($data) or return; 252 $self->init_graph() or return; 253 $self->setup_text() or return; 254 $self->setup_legend(); 255 $self->setup_coords() or return; 256 $self->draw_text(); 257 unless (defined $self->{no_axes}) 258 { 259 $self->draw_axes(); 260 $self->draw_ticks() or return; 261 } 262 $self->draw_data() or return; 263 $self->draw_values() or return; 264 $self->draw_legend(); 265 266 return $self->{graph} 267} 268 269sub set 270{ 271 my $self = shift; 272 my %args = @_; 273 274 for (keys %args) 275 { 276 /^tick_length$/ and do 277 { 278 $self->{x_tick_length} = 279 $self->{y_tick_length} = $args{$_}; 280 delete $args{$_}; 281 next; 282 }; 283 /^long_ticks$/ and do 284 { 285 $self->{x_long_ticks} = 286 $self->{y_long_ticks} = $args{$_}; 287 delete $args{$_}; 288 next; 289 }; 290 /^overwrite$/ and do 291 { 292 $self->{cumulate} = 1 if $args{$_} == 2; 293 $self->{overwrite} = $args{$_}; 294 delete $args{$_}; 295 next; 296 }; 297 /^cumulate$/ and do 298 { 299 $self->{cumulate} = $args{$_}; 300 # XXX And for now 301 $self->{overwrite} = 2 if $args{$_}; 302 delete $args{$_}; 303 next; 304 }; 305 } 306 307 return $self->SUPER::set(%args); 308} 309 310sub setup_text 311{ 312 my $self = shift; 313 314 $self->{gdta_x_label}->set(colour => $self->{lci}); 315 $self->{gdta_y_label}->set(colour => $self->{lci}); 316 $self->{xlfh} = $self->{gdta_x_label}->get('height'); 317 $self->{ylfh} = $self->{gdta_y_label}->get('height'); 318 319 $self->{gdta_x_axis}->set(colour => $self->{alci}); 320 $self->{gdta_y_axis}->set(colour => $self->{alci}); 321 $self->{xafh} = $self->{gdta_x_axis}->get('height'); 322 $self->{yafh} = $self->{gdta_x_axis}->get('height'); 323 324 $self->{gdta_title}->set(colour => $self->{tci}); 325 $self->{gdta_title}->set_align('top', 'center'); 326 $self->{tfh} = $self->{gdta_title}->get('height'); 327 328 $self->{gdta_legend}->set(colour => $self->{legendci}); 329 $self->{gdta_legend}->set_align('top', 'left'); 330 $self->{lgfh} = $self->{gdta_legend}->get('height'); 331 332 $self->{gdta_values}->set(colour => $self->{valuesci}); 333 unless ($self->{rotate_chart}) 334 { 335 if ($self->{values_vertical}) 336 { 337 $self->{gdta_values}->set_align('center', 'left'); 338 } 339 else 340 { 341 $self->{gdta_values}->set_align('bottom', 'center'); 342 } 343 } 344 else 345 { 346 if ($self->{values_vertical}) 347 { 348 $self->{gdta_values}->set_align('top', 'center'); 349 } 350 else 351 { 352 $self->{gdta_values}->set_align('center', 'left'); 353 } 354 } 355 356 return $self; 357} 358 359sub set_x_label_font # (fontname) 360{ 361 my $self = shift; 362 $self->_set_font('gdta_x_label', @_); 363} 364sub set_y_label_font # (fontname) 365{ 366 my $self = shift; 367 $self->_set_font('gdta_y_label', @_); 368} 369sub set_x_axis_font # (fontname) 370{ 371 my $self = shift; 372 $self->_set_font('gdta_x_axis', @_); 373} 374 375sub set_y_axis_font # (fontname) 376{ 377 my $self = shift; 378 $self->_set_font('gdta_y_axis', @_); 379} 380 381sub set_values_font 382{ 383 my $self = shift; 384 $self->_set_font('gdta_values', @_); 385} 386 387sub set_legend # List of legend keys 388{ 389 my $self = shift; 390 $self->{legend} = [@_]; 391} 392 393sub set_legend_font # (font name) 394{ 395 my $self = shift; 396 $self->_set_font('gdta_legend', @_); 397} 398 399sub get_hotspot 400{ 401 my $self = shift; 402 my $ds = shift; # Which data set 403 my $np = shift; # Which data point? 404 405 if (defined $np && defined $ds) 406 { 407 return @{$self->{_hotspots}->[$ds]->[$np]}; 408 } 409 elsif (defined $ds) 410 { 411 return @{$self->{_hotspots}->[$ds]}; 412 } 413 else 414 { 415 return @{$self->{_hotspots}}; 416 } 417} 418 419sub _set_feature_coords 420{ 421 my $self = shift; 422 my $feature = shift; 423 my $type = shift; 424 $self->{_feat_coords}->{$feature} = [ $type, @_ ]; 425} 426 427sub _set_text_feature_coords 428{ 429 my $self = shift; 430 my $feature = shift; 431 $self->_set_feature_coords($feature, "rect", @_[0,1,4,5]); 432} 433 434sub get_feature_coordinates 435{ 436 my $self = shift; 437 my $feature = shift; 438 if ($feature) 439 { 440 $self->{_feat_coords}->{$feature}; 441 } 442 else 443 { 444 $self->{_feat_coords}; 445 } 446} 447 448# PRIVATE 449 450# inherit check_data from GD::Graph 451 452# 453# calculate the bottom of the bounding box for the graph 454# 455sub setup_bottom_boundary 456{ 457 my $self = shift; 458 $self->{bottom} = $self->{height} - $self->{b_margin} - 1; 459 if (! $self->{rotate_chart}) 460 { 461 # X label 462 $self->{bottom} -= $self->{xlfh} + $self->{text_space} 463 if $self->{xlfh}; 464 # X axis tick labels 465 $self->{bottom} -= $self->{x_label_height} + $self->{axis_space} 466 if $self->{xafh}; 467 } 468 else 469 { 470 # Y1 label 471 $self->{bottom} -= $self->{ylfh} + $self->{text_space} 472 if $self->{y1_label}; 473 # Y1 axis labels 474 $self->{bottom} -= $self->{y_label_height}[1] + $self->{axis_space} 475 if $self->{y_label_height}[1]; 476 } 477} 478# 479# Calculate the top of the bounding box for the graph 480# 481sub setup_top_boundary 482{ 483 my $self = shift; 484 485 $self->{top} = $self->{t_margin}; 486 # Chart title 487 $self->{top} += $self->{tfh} + $self->{text_space} if $self->{tfh}; 488 if (! $self->{rotate_chart}) 489 { 490 # Make sure the text for the y axis tick markers fits on the canvas 491 $self->{top} = $self->{yafh}/2 if $self->{top} == 0; 492 } 493 else 494 { 495 if ($self->{two_axes}) 496 { 497 # Y2 label 498 $self->{top} += $self->{ylfh} + $self->{text_space} 499 if $self->{y2_label}; 500 # Y2 axis labels 501 $self->{top} += $self->{y_label_height}[2] + $self->{axis_space} 502 if $self->{y_label_height}[2]; 503 } 504 } 505} 506# 507# calculate the left of the bounding box for the graph 508# 509sub setup_left_boundary 510{ 511 my $self = shift; 512 513 $self->{left} = $self->{l_margin}; 514 if (! $self->{rotate_chart}) 515 { 516 # Y1 label 517 $self->{left} += $self->{ylfh} + $self->{text_space} 518 if $self->{y1_label}; 519 # Y1 axis labels 520 $self->{left} += $self->{y_label_len}[1] + $self->{axis_space} 521 if $self->{y_label_len}[1]; 522 } 523 else 524 { 525 # X label 526 $self->{left} += $self->{xlfh} + $self->{text_space} 527 if $self->{x_label}; 528 # X axis labels 529 $self->{left} += $self->{x_label_width} + $self->{axis_space} 530 if $self->{x_label_width}; 531 } 532} 533# 534# calculate the right of the bounding box for the graph 535# 536sub setup_right_boundary 537{ 538 my $self = shift; 539 $self->{right} = $self->{width} - $self->{r_margin} - 1; 540 541 if (! $self->{rotate_chart}) 542 { 543 if ($self->{two_axes}) 544 { 545 # Y2 label 546 $self->{right} -= $self->{ylfh} + $self->{text_space} 547 if $self->{y2_label}; 548 # Y2 axis label 549 $self->{right} -= $self->{y_label_len}[2] + $self->{axis_space} 550 if $self->{y_label_len}[2]; 551 } 552 } 553 else 554 { 555 # Adjust right margin to allow last label of y axes. Only do 556 # this when the right margin doesn't have enough space 557 # already. 558 # 559 # TODO Don't assume rightmost label is the same as the 560 # longest label (stored in y_label_len) The worst that can 561 # happen now is that we reserve too much space. 562 563 my $max_len = $self->{y_label_len}[1]; 564 if ($self->{two_axes}) 565 { 566 $max_len = $self->{y_label_len}[2] if 567 $self->{y_label_len}[2] > $max_len; 568 } 569 $max_len = int ($max_len/2); 570 571 if ($self->{right} + $max_len >= $self->{width} - $self->{r_margin}) 572 { 573 $self->{right} -= $max_len; 574 } 575 } 576} 577 578sub _setup_boundaries 579{ 580 my $self = shift; 581 582 $self->setup_bottom_boundary(); 583 $self->setup_top_boundary(); 584 $self->setup_left_boundary(); 585 $self->setup_right_boundary(); 586 587 if ($self->correct_width && !$self->{x_tick_number}) 588 { 589 if (! $self->{rotate_chart}) 590 { 591 # Make sure we have a nice integer number of pixels 592 $self->{r_margin} += ($self->{right} - $self->{left}) % 593 ($self->{_data}->num_points + 1); 594 595 $self->setup_right_boundary(); 596 } 597 else 598 { 599 # Make sure we have a nice integer number of pixels 600 $self->{b_margin} += ($self->{bottom} - $self->{top}) % 601 ($self->{_data}->num_points + 1); 602 603 $self->setup_bottom_boundary(); 604 } 605 } 606 607 return $self->_set_error('Vertical size too small') 608 if $self->{bottom} <= $self->{top}; 609 return $self->_set_error('Horizontal size too small') 610 if $self->{right} <= $self->{left}; 611 612 return $self; 613} 614 615# This method should return 1 if the width of the graph needs to be 616# corrected to whole integers, and 0 if not. The default behaviour is to 617# not correct the width. Individual classes should override this by 618# setting the $self->{correct_width} attribute in their initialise 619# method. Only in complex cases (see mixed.pm) should this method be 620# overridden 621sub correct_width { $_[0]->{correct_width} } 622 623sub setup_x_step_size_v 624{ 625 my $s = shift; 626 627 # calculate the step size for x data 628 # CONTRIB Changes by Scott Prahl 629 if (defined $s->{x_tick_number}) 630 { 631 my $delta = ($s->{right} - $s->{left})/($s->{x_max} - $s->{x_min}); 632 # 'True' numerical X axis addition # From: Gary Deschaines 633 if (defined($s->{x_min_value}) && defined($s->{x_max_value})) 634 { 635 $s->{x_offset} = $s->{left}; 636 $s->{x_step} = $delta; 637 } 638 else 639 { 640 $s->{x_offset} = 641 ($s->{true_x_min} - $s->{x_min}) * $delta + $s->{left}; 642 $s->{x_step} = 643 ($s->{true_x_max} - $s->{true_x_min}) * 644 $delta/($s->{_data}->num_points - 1); 645 } 646 } 647 else 648 { 649 $s->{x_step} = ($s->{right} - $s->{left})/($s->{_data}->num_points + 1); 650 $s->{x_offset} = $s->{left}; 651 } 652} 653 654sub setup_x_step_size_h 655{ 656 my $s = shift; 657 658 # calculate the step size for x data 659 # CONTRIB Changes by Scott Prahl 660 if (defined $s->{x_tick_number}) 661 { 662 my $delta = ($s->{bottom} - $s->{top})/($s->{x_max} - $s->{x_min}); 663 # 'True' numerical X axis addition # From: Gary Deschaines 664 if (defined($s->{x_min_value}) && defined($s->{x_max_value})) 665 { 666 $s->{x_offset} = $s->{top}; 667 $s->{x_step} = $delta; 668 } 669 else 670 { 671 $s->{x_offset} = 672 ($s->{true_x_min} - $s->{x_min}) * $delta + $s->{top}; 673 $s->{x_step} = 674 ($s->{true_x_max} - $s->{true_x_min}) * 675 $delta/($s->{_data}->num_points - 1); 676 } 677 } 678 else 679 { 680 $s->{x_step} = ($s->{bottom} - $s->{top})/($s->{_data}->num_points + 1); 681 $s->{x_offset} = $s->{top}; 682 } 683} 684 685sub setup_coords 686{ 687 my $s = shift; 688 689 # Do some sanity checks 690 $s->{two_axes} = 0 if $s->{_data}->num_sets < 2 || $s->{two_axes} < 0; 691 $s->{two_axes} = 1 if $s->{two_axes} > 1; 692 693 delete $s->{y_label2} unless $s->{two_axes}; 694 695 # Set some heights for text 696 $s->{tfh} = 0 unless $s->{title}; 697 $s->{xlfh} = 0 unless $s->{x_label}; 698 699 # Make sure the y1 axis has a label if there is one set for y in 700 # general 701 $s->{y1_label} = $s->{y_label} if !$s->{y1_label} && $s->{y_label}; 702 703 # Set axis tick text heights and widths to 0 if they don't need to 704 # be plotted. 705 $s->{xafh} = 0, $s->{xafw} = 0 unless $s->{x_plot_values}; 706 $s->{yafh} = 0, $s->{yafw} = 0 unless $s->{y_plot_values}; 707 708 # Calculate minima and maxima for the axes 709 $s->set_max_min() or return; 710 711 # Create the labels for the axes, and calculate the max length 712 $s->create_y_labels(); 713 $s->create_x_labels(); # CONTRIB Scott Prahl 714 715 # Calculate the boundaries of the chart 716 $s->_setup_boundaries() or return; 717 718 # CONTRIB Scott Prahl 719 # make sure that we can generate valid x tick marks 720 undef($s->{x_tick_number}) if $s->{_data}->num_points < 3; 721 undef($s->{x_tick_number}) if 722 !defined $s->{x_max} || 723 !defined $s->{x_min} || 724 $s->{x_max} == $s->{x_min}; 725 726 $s->{rotate_chart} ? $s->setup_x_step_size_h() : 727 $s->setup_x_step_size_v(); 728 729 # get the zero axis level 730 my ($zl, $zb) = $s->val_to_pixel(0, 0, 1); 731 $s->{zeropoint} = $s->{rotate_chart} ? $zl : $zb; 732 733 # More sanity checks 734 $s->{x_label_skip} = 1 if $s->{x_label_skip} < 1; 735 $s->{y_label_skip} = 1 if $s->{y_label_skip} < 1; 736 $s->{y_tick_number} = 1 if $s->{y_tick_number} < 1; 737 738 return $s; 739} 740 741sub create_y_labels 742{ 743 my $self = shift; 744 745 # XXX This should really be y_label_width 746 $self->{y_label_len}[$_] = 0 for 1, 2; 747 $self->{y_label_height}[$_] = 0 for 1, 2; 748 749 for my $t (0 .. $self->{y_tick_number}) 750 { 751 # XXX Ugh, why did I ever do it this way? How bloody obscure. 752 for my $axis (1 .. ($self->{two_axes} + 1)) 753 { 754 my $label = $self->{y_min}[$axis] + 755 $t * ($self->{y_max}[$axis] - $self->{y_min}[$axis]) / 756 $self->{y_tick_number}; 757 758 $self->{y_values}[$axis][$t] = $label; 759 760 if (defined $self->{y_number_format}) 761 { 762 $label = ref $self->{y_number_format} eq 'CODE' ? 763 &{$self->{y_number_format}}($label) : 764 sprintf($self->{y_number_format}, $label); 765 } 766 767 $self->{gdta_y_axis}->set_text($label); 768 my $len = $self->{gdta_y_axis}->get('width'); 769 770 $self->{y_labels}[$axis][$t] = $label; 771 772 # TODO Allow vertical y labels 773 $self->{y_label_len}[$axis] = $len 774 if $len > $self->{y_label_len}[$axis]; 775 $self->{y_label_height}[$axis] = $self->{yafh}; 776 } 777 } 778} 779 780sub get_x_axis_label_length 781{ 782 my $self = shift; 783 784 my @values = $self->{x_tick_number} ? 785 @{$self->{x_values}} : 786 $self->{_data}->x_values; 787 788 my $maxlen = 0; 789 foreach my $label (@values) 790 { 791 $self->{gdta_x_axis}->set_text($label); 792 my $len = $self->{gdta_x_axis}->get('width'); 793 $maxlen = $len if $maxlen < $len; 794 } 795 796 return $maxlen; 797} 798 799# CONTRIB Scott Prahl 800sub create_x_labels 801{ 802 my $self = shift; 803 my $maxlen = 0; 804 805 $self->{x_label_height} = 0; 806 $self->{x_label_width} = 0; 807 808 if (defined $self->{x_tick_number}) 809 { 810 # We want to emulate numerical x axes 811 foreach my $t (0..$self->{x_tick_number}) 812 { 813 my $label = 814 $self->{x_min} + 815 $t * ($self->{x_max} - $self->{x_min})/$self->{x_tick_number}; 816 817 $self->{x_values}[$t] = $label; 818 819 if (defined $self->{x_number_format}) 820 { 821 $label = ref $self->{x_number_format} eq 'CODE' ? 822 &{$self->{x_number_format}}($label) : 823 sprintf($self->{x_number_format}, $label); 824 } 825 826 $self->{gdta_x_label}->set_text($label); 827 my $len = $self->{gdta_x_label}->get('width'); 828 829 $self->{x_labels}[$t] = $label; 830 $maxlen = $len 831 if $len > $self->{x_label_height}; 832 } 833 } 834 else 835 { 836 $maxlen = $self->get_x_axis_label_length; 837 } 838 839 $self->{x_label_height} = $self->{x_labels_vertical} ? 840 $maxlen : $self->{xafh}; 841 $self->{x_label_width} = $self->{x_labels_vertical} ? 842 $self->{xafh} : $maxlen; 843} 844 845# 846# The drawing of labels for the axes. This is split up in the four 847# positions a label can appear in, depending on a few settings. These 848# settings are all dealt with in the draw_x_labels and draw_y_labels 849# subroutines, which in turn call the approriate directional label 850# drawer 851# 852sub draw_left_label 853{ 854 my ($self, $label, $align) = @_; 855 856 $label->set_align('top', 'left'); 857 my $tx = $self->{l_margin}; 858 my $ty = $self->{bottom} - $align * ($self->{bottom} - $self->{top}) + 859 $align * $label->get('width'); 860 $label->draw($tx, $ty, PI/2); 861} 862 863sub draw_bottom_label 864{ 865 my ($self, $label, $align) = @_; 866 867 $label->set_align('bottom', 'left'); 868 my $tx = $self->{left} + $align * ($self->{right} - $self->{left}) - 869 $align * $label->get('width'); 870 my $ty = $self->{height} - $self->{b_margin}; 871 $label->draw($tx, $ty, 0); 872} 873 874sub draw_top_label 875{ 876 my ($self, $label, $align) = @_; 877 878 $label->set_align('top', 'left'); 879 my $tx = $self->{left} + $align * ($self->{right} - $self->{left}) - 880 $align * $label->get('width'); 881 my $ty = $self->{t_margin}; 882 $ty += $self->{tfh} + $self->{text_space} if $self->{tfh}; 883 $label->draw($tx, $ty, 0); 884} 885 886sub draw_right_label 887{ 888 my ($self, $label, $align) = @_; 889 890 $label->set_align('bottom', 'left'); 891 my $tx = $self->{width} - $self->{r_margin}; 892 my $ty = $self->{bottom} - $align * ($self->{bottom} - $self->{top}) + 893 $align * $label->get('width'); 894 $label->draw($tx, $ty, PI/2); 895} 896 897sub draw_x_label 898{ 899 my $self = shift; 900 my ($tx, $ty, $a); 901 902 my @coords; # coordinates of the label drawn 903 904 return unless $self->{x_label}; 905 906 $self->{gdta_x_label}->set_text($self->{x_label}); 907 if ($self->{rotate_chart}) 908 { 909 @coords = $self->draw_left_label($self->{gdta_x_label}, 910 $self->{x_label_position}); 911 } 912 else 913 { 914 @coords = $self->draw_bottom_label($self->{gdta_x_label}, 915 $self->{x_label_position}); 916 } 917 $self->_set_text_feature_coords("x_label", @coords); 918} 919 920sub draw_y_labels 921{ 922 my $self = shift; 923 924 my @coords; # coordinates of the labels drawn 925 926 if (defined $self->{y1_label}) 927 { 928 $self->{gdta_y_label}->set_text($self->{y1_label}); 929 if ($self->{rotate_chart}) 930 { 931 @coords = $self->draw_bottom_label($self->{gdta_y_label}, 932 $self->{y_label_position}); 933 } 934 else 935 { 936 @coords = $self->draw_left_label($self->{gdta_y_label}, 937 $self->{y_label_position}); 938 } 939 $self->_set_text_feature_coords("y1_label", @coords); 940 $self->_set_text_feature_coords("y_label", @coords); 941 } 942 if ( $self->{two_axes} && defined $self->{y2_label} ) 943 { 944 $self->{gdta_y_label}->set_text($self->{y2_label}); 945 if ($self->{rotate_chart}) 946 { 947 @coords = $self->draw_top_label($self->{gdta_y_label}, 948 $self->{y_label_position}); 949 } 950 else 951 { 952 @coords = $self->draw_right_label($self->{gdta_y_label}, 953 $self->{y_label_position}); 954 } 955 $self->_set_text_feature_coords("y2_label", @coords); 956 } 957} 958 959sub draw_text 960{ 961 my $self = shift; 962 963 if ($self->{title}) 964 { 965 my $xc = $self->{left} + ($self->{right} - $self->{left})/2; 966 $self->{gdta_title}->set_align('top', 'center'); 967 $self->{gdta_title}->set_text($self->{title}); 968 my @coords = $self->{gdta_title}->draw($xc, $self->{t_margin}); 969 $self->_set_text_feature_coords("title", @coords); 970 } 971 972 $self->draw_x_label(); 973 $self->draw_y_labels(); 974} 975 976sub draw_axes 977{ 978 my $self = shift; 979 980 my ($l, $r, $b, $t) = 981 ( $self->{left}, $self->{right}, $self->{bottom}, $self->{top} ); 982 983 # Sanity check for zero_axis and zero_axis_only 984 unless ($self->{y_min}[1] < 0 && $self->{y_max}[1] > 0) 985 { 986 $self->{zero_axis} = 0; 987 $self->{zero_axis_only} = 0; 988 } 989 990 if ( $self->{box_axis} ) 991 { 992 $self->{graph}->filledRectangle($l+1, $t+1, $r-1, $b-1, $self->{boxci}) 993 if $self->{boxci}; 994 995 $self->{graph}->rectangle($l, $t, $r, $b, $self->{fgci}); 996 } 997 else 998 { 999 $self->{graph}->line($l, $t, $l, $b, $self->{fgci}); 1000 $self->{graph}->line($l, $b, $r, $b, $self->{fgci}) 1001 unless ($self->{zero_axis_only}); 1002 $self->{graph}->line($r, $b, $r, $t, $self->{fgci}) 1003 if ($self->{two_axes}); 1004 } 1005 1006 if ($self->{zero_axis} or $self->{zero_axis_only}) 1007 { 1008 my ($x, $y) = $self->val_to_pixel(0, 0, 1); 1009 $self->{graph}->line($l, $y, $r, $y, $self->{fgci}); 1010 } 1011 1012 $self->_set_feature_coords("axes", "rect", $l, $b, $r, $t); 1013} 1014 1015# 1016# Ticks and values for y axes 1017# 1018sub draw_y_ticks_h 1019{ 1020 my $self = shift; 1021 1022 for my $t (0 .. $self->{y_tick_number}) 1023 { 1024 for my $axis (1 .. ($self->{two_axes} + 1)) 1025 { 1026 my $value = $self->{y_values}[$axis][$t]; 1027 my $label = $self->{y_labels}[$axis][$t]; 1028 1029 my ($x, $y) = $self->val_to_pixel(0, $value, $axis); 1030 $y = ($axis == 1) ? $self->{bottom} : $self->{top}; 1031 1032 if ($self->{y_long_ticks}) 1033 { 1034 $self->{graph}->line( 1035 $x, $self->{bottom}, 1036 $x, $self->{top}, 1037 $self->{fgci} 1038 ) unless ($axis-1); 1039 } 1040 else 1041 { 1042 $self->{graph}->line( 1043 $x, $y, 1044 $x, $y - $self->{y_tick_length}, 1045 $self->{fgci} 1046 ); 1047 } 1048 1049 next 1050 if $t % ($self->{y_label_skip}) || ! $self->{y_plot_values}; 1051 1052 $self->{gdta_y_axis}->set_text($label); 1053 if ($axis == 1) 1054 { 1055 $self->{gdta_y_axis}->set_align('top', 'center'); 1056 $y += $self->{axis_space}; 1057 } 1058 else 1059 { 1060 $self->{gdta_y_axis}->set_align('bottom', 'center'); 1061 $y -= $self->{axis_space}; 1062 } 1063 $self->{gdta_y_axis}->draw($x, $y); 1064 } 1065 } 1066 1067 return $self; 1068} 1069 1070sub draw_y_ticks_v 1071{ 1072 my $self = shift; 1073 1074 for my $t (0 .. $self->{y_tick_number}) 1075 { 1076 # XXX Ugh, why did I ever do it this way? How bloody obscure. 1077 for my $axis (1 .. ($self->{two_axes} + 1)) 1078 { 1079 my $value = $self->{y_values}[$axis][$t]; 1080 my $label = $self->{y_labels}[$axis][$t]; 1081 1082 my ($x, $y) = $self->val_to_pixel(0, $value, $axis); 1083 $x = ($axis == 1) ? $self->{left} : $self->{right}; 1084 1085 if ($self->{y_long_ticks}) 1086 { 1087 $self->{graph}->line( 1088 $x, $y, 1089 $x + $self->{right} - $self->{left}, $y, 1090 $self->{fgci} 1091 ) unless ($axis-1); 1092 } 1093 else 1094 { 1095 $self->{graph}->line( 1096 $x, $y, 1097 $x + (3 - 2 * $axis) * $self->{y_tick_length}, $y, 1098 $self->{fgci} 1099 ); 1100 } 1101 1102 next 1103 if $t % ($self->{y_label_skip}) || ! $self->{y_plot_values}; 1104 1105 $self->{gdta_y_axis}->set_text($label); 1106 if ($axis == 1) 1107 { 1108 $self->{gdta_y_axis}->set_align('center', 'right'); 1109 $x -= $self->{axis_space}; 1110 } 1111 else 1112 { 1113 $self->{gdta_y_axis}->set_align('center', 'left'); 1114 $x += $self->{axis_space}; 1115 } 1116 $self->{gdta_y_axis}->draw($x, $y); 1117 } 1118 } 1119 1120 return $self; 1121} 1122 1123sub draw_y_ticks 1124{ 1125 #TODO Clean this up! 1126 $_[0]->{rotate_chart} ? goto &draw_y_ticks_h : goto &draw_y_ticks_v; 1127} 1128 1129 1130# 1131# Ticks and values for x axes 1132# 1133sub draw_x_ticks_h 1134{ 1135 my $self = shift; 1136 1137 for (my $i = 0; $i < $self->{_data}->num_points; $i++) 1138 { 1139 my ($x, $y) = $self->val_to_pixel($i + 1, 0, 1); 1140 1141 $x = $self->{left} unless $self->{zero_axis_only}; 1142 1143 # CONTRIB Damon Brodie for x_tick_offset 1144 next if (!$self->{x_all_ticks} and 1145 ($i - $self->{x_tick_offset}) % $self->{x_label_skip} and 1146 $i != $self->{_data}->num_points - 1 1147 ); 1148 1149 if ($self->{x_ticks}) 1150 { 1151 if ($self->{x_long_ticks}) 1152 { 1153 $self->{graph}->line($self->{left}, $y, $self->{right}, $y, 1154 $self->{fgci}); 1155 } 1156 else 1157 { 1158 $self->{graph}->line( $x, $y, $x + $self->{x_tick_length}, $y, 1159 $self->{fgci}); 1160 } 1161 } 1162 1163 # CONTRIB Damon Brodie for x_tick_offset 1164 next if 1165 ($i - $self->{x_tick_offset}) % ($self->{x_label_skip}) and 1166 $i != $self->{_data}->num_points - 1; 1167 1168 $self->{gdta_x_axis}->set_text($self->{_data}->get_x($i)); 1169 1170 my $angle = 0; 1171 if ($self->{x_labels_vertical}) 1172 { 1173 $self->{gdta_x_axis}->set_align('bottom', 'center'); 1174 $angle = PI/2; 1175 } 1176 else 1177 { 1178 $self->{gdta_x_axis}->set_align('center', 'right'); 1179 } 1180 $self->{gdta_x_axis}->draw($x - $self->{axis_space}, $y, $angle); 1181 } 1182 1183 return $self; 1184} 1185 1186sub draw_x_ticks_v 1187{ 1188 my $self = shift; 1189 1190 for (my $i = 0; $i < $self->{_data}->num_points; $i++) 1191 { 1192 my ($x, $y) = $self->val_to_pixel($i + 1, 0, 1); 1193 1194 $y = $self->{bottom} unless $self->{zero_axis_only}; 1195 1196 # CONTRIB Damon Brodie for x_tick_offset 1197 next if (!$self->{x_all_ticks} and 1198 ($i - $self->{x_tick_offset}) % $self->{x_label_skip} and 1199 $i != $self->{_data}->num_points - 1 1200 ); 1201 1202 if ($self->{x_ticks}) 1203 { 1204 if ($self->{x_long_ticks}) 1205 { 1206 $self->{graph}->line($x, $self->{bottom}, $x, $self->{top}, 1207 $self->{fgci}); 1208 } 1209 else 1210 { 1211 $self->{graph}->line($x, $y, $x, $y - $self->{x_tick_length}, 1212 $self->{fgci}); 1213 } 1214 } 1215 1216 # CONTRIB Damon Brodie for x_tick_offset 1217 next if 1218 ($i - $self->{x_tick_offset}) % ($self->{x_label_skip}) and 1219 $i != $self->{_data}->num_points - 1; 1220 1221 $self->{gdta_x_axis}->set_text($self->{_data}->get_x($i)); 1222 1223 my $angle = 0; 1224 if ($self->{x_labels_vertical}) 1225 { 1226 $self->{gdta_x_axis}->set_align('center', 'right'); 1227 $angle = PI/2; 1228 } 1229 else 1230 { 1231 $self->{gdta_x_axis}->set_align('top', 'center'); 1232 } 1233 $self->{gdta_x_axis}->draw($x, $y + $self->{axis_space}, $angle); 1234 } 1235 1236 return $self; 1237} 1238 1239sub draw_x_ticks 1240{ 1241 #TODO Clean this up! 1242 $_[0]->{rotate_chart} ? goto &draw_x_ticks_h : goto &draw_x_ticks_v; 1243} 1244 1245# CONTRIB Scott Prahl 1246# Assume x array contains equally spaced x-values 1247# and generate an appropriate axis 1248# 1249#### 1250# 'True' numerical X axis addition 1251# From: Gary Deschaines 1252# 1253# These modification to draw_x_ticks_number pass x-tick values to the 1254# val_to_pixel subroutine instead of x-tick indices when ture numerical 1255# x-axis mode is detected. Also, x_tick_offset and x_label_skip are 1256# processed differently when true numerical x-axis mode is detected to 1257# allow labeled major x-tick marks and un-labeled minor x-tick marks. 1258# 1259# For example: 1260# 1261# x_tick_number => 14, 1262# x_ticks => 1, 1263# x_long_ticks => 1, 1264# x_tick_length => -4, 1265# x_min_value => 100, 1266# x_max_value => 800, 1267# x_tick_offset => 2, 1268# x_label_skip => 2, 1269# 1270# 1271# ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ 1272# | | | | | | | | | | | | | 1273# 1 -| | | | | | | | | | | | | 1274# | | | | | | | | | | | | | 1275# 0 _|_________|____|____|____|____|____|____|____|____|____|____|_________| 1276# | | | | | | | | | | | 1277# 200 300 400 500 600 700 1278sub draw_x_ticks_number 1279{ 1280 my $self = shift; 1281 1282 for my $i (0 .. $self->{x_tick_number}) 1283 { 1284 my ($value, $x, $y); 1285 1286 if (defined($self->{x_min_value}) && defined($self->{x_max_value})) 1287 { 1288 next if ($i - $self->{x_tick_offset}) < 0; 1289 next if ($i + $self->{x_tick_offset}) > $self->{x_tick_number}; 1290 $value = $self->{x_values}[$i]; 1291 ($x, $y) = $self->val_to_pixel($value, 0, 1); 1292 } 1293 else 1294 { 1295 $value = ($self->{_data}->num_points - 1) 1296 * ($self->{x_values}[$i] - $self->{true_x_min}) 1297 / ($self->{true_x_max} - $self->{true_x_min}); 1298 ($x, $y) = $self->val_to_pixel($value + 1, 0, 1); 1299 } 1300 1301 $y = $self->{bottom} unless $self->{zero_axis_only}; 1302 1303 if ($self->{x_ticks}) 1304 { 1305 if ($self->{x_long_ticks}) 1306 { 1307 # XXX This mod needs to be done everywhere ticks are 1308 # drawn 1309 if ( $self->{x_tick_length} >= 0 ) 1310 { 1311 $self->{graph}->line($x, $self->{bottom}, 1312 $x, $self->{top}, $self->{fgci}); 1313 } 1314 else 1315 { 1316 $self->{graph}->line( 1317 $x, $self->{bottom} - $self->{x_tick_length}, 1318 $x, $self->{top}, $self->{fgci}); 1319 } 1320 } 1321 else 1322 { 1323 $self->{graph}->line($x, $y, 1324 $x, $y - $self->{x_tick_length}, $self->{fgci} ); 1325 } 1326 } 1327 1328 # If we have to skip labels, we'll do it here. 1329 # Make sure to always draw the last one. 1330 next if $i % $self->{x_label_skip} && $i != $self->{x_tick_number}; 1331 1332 $self->{gdta_x_axis}->set_text($self->{x_labels}[$i]); 1333 1334 if ($self->{x_labels_vertical}) 1335 { 1336 $self->{gdta_x_axis}->set_align('center', 'right'); 1337 my $yt = $y + $self->{text_space}/2; 1338 $self->{gdta_x_axis}->draw($x, $yt, PI/2); 1339 } 1340 else 1341 { 1342 $self->{gdta_x_axis}->set_align('top', 'center'); 1343 my $yt = $y + $self->{text_space}/2; 1344 $self->{gdta_x_axis}->draw($x, $yt); 1345 } 1346 } 1347 1348 return $self; 1349} 1350 1351sub draw_ticks 1352{ 1353 my $self = shift; 1354 1355 $self->draw_y_ticks() or return; 1356 1357 return $self 1358 unless $self->{x_plot_values}; 1359 1360 if (defined $self->{x_tick_number}) 1361 { 1362 $self->draw_x_ticks_number() or return; 1363 } 1364 else 1365 { 1366 $self->draw_x_ticks() or return; 1367 } 1368 1369 return $self; 1370} 1371 1372sub draw_data 1373{ 1374 my $self = shift; 1375 1376 # Calculate bar_spacing from bar_width 1377 if ($self->{bar_width}) 1378 { 1379 my $chart_width = $self->{rotate_chart} ? 1380 $self->{right} - $self->{left} : 1381 $self->{bottom} - $self->{top}; 1382 my $n_bars = $self->{_data}->num_points; 1383 my $n_sets = $self->{_data}->num_sets; 1384 my $bar_space = $chart_width/($n_bars + 1) / 1385 ($self->{overwrite} ? 1 : $n_sets); 1386 $self->{bar_spacing} = $bar_space - $self->{bar_width}; 1387 $self->{bar_spacing} = 0 if $self->{bar_spacing} < 0; 1388 } 1389 1390 # XXX is this comment still pertinent? 1391 # The drawing of 'cumulated' sets needs to be done in reverse, 1392 # for area and bar charts. This is mainly because of backward 1393 # compatibility 1394 1395 for (my $dsn = 1; $dsn <= $self->{_data}->num_sets; $dsn++) 1396 { 1397 $self->draw_data_set($dsn) or return; 1398 } 1399 1400 return $self 1401} 1402 1403# 1404# Draw the values of the data point with the bars, lines or markers 1405sub draw_values 1406{ 1407 my $self = shift; 1408 1409 return $self unless $self->{show_values}; 1410 1411 my $text_angle = $self->{values_vertical} ? PI/2 : 0; 1412 1413 for (my $dsn = 1; $dsn <= $self->{_data}->num_sets; $dsn++) 1414 { 1415 my @values = $self->{_data}->y_values($dsn) or 1416 return $self->_set_error("Impossible illegal data set: $dsn", 1417 $self->{_data}->error); 1418 my @display = $self->{show_values}->y_values($dsn) or next; 1419 1420 for (my $i = 0; $i < @values; $i++) 1421 { 1422 next unless defined $display[$i]; 1423 my ($xp, $yp); 1424 if (defined($self->{x_min_value}) && defined($self->{x_max_value})) 1425 { 1426 ($xp, $yp) = $self->val_to_pixel( 1427 $self->{_data}->get_x($i), $values[$i], $dsn); 1428 } 1429 else 1430 { 1431 ($xp, $yp) = $self->val_to_pixel($i+1, $values[$i], $dsn); 1432 } 1433 $yp -= $self->{values_space}; 1434 1435 my $value = $display[$i]; 1436 if (defined $self->{values_format}) 1437 { 1438 $value = ref $self->{values_format} eq 'CODE' ? 1439 &{$self->{values_format}}($value) : 1440 sprintf($self->{values_format}, $value); 1441 } 1442 1443 $self->{gdta_values}->set_text($value); 1444 $self->{gdta_values}->draw($xp, $yp, $text_angle); 1445 } 1446 } 1447 1448 return $self 1449} 1450 1451# 1452# draw_data_set is in sub classes 1453# 1454sub draw_data_set 1455{ 1456 # ABSTRACT 1457 my $self = shift; 1458 $self->die_abstract( "sub draw_data missing, ") 1459} 1460 1461# 1462# This method corrects the minimum and maximum y values for chart 1463# types that need to always include a zero point. 1464# This is supposed to be called before the methods that pick 1465# good-looking values. 1466# 1467# Input: current minimum and maximum. 1468# Output: new minimum and maximum. 1469# 1470sub _correct_y_min_max 1471{ 1472 my $self = shift; 1473 my ($min, $max) = @_; 1474 1475 # Make sure bars and area always have a zero offset 1476 # Only bars and areas need 1477 return ($min, $max) 1478 unless $self->isa("GD::Graph::bars") or $self->isa("GD::Graph::area"); 1479 1480 # If either $min or $max are 0, we can return 1481 return ($min, $max) if $max == 0 or $min == 0; 1482 1483 # If $min and $max on opposite end of zero axis, no work needed 1484 return ($min, $max) unless $min/$max > 0; 1485 1486 if ($min > 0) 1487 { 1488 $min = 0; 1489 } 1490 else 1491 { 1492 $max = 0; 1493 } 1494 1495 return ($min, $max); 1496} 1497 1498# 1499# Figure out the maximum values for the vertical exes, and calculate 1500# a more or less sensible number for the tops. 1501# 1502sub set_max_min 1503{ 1504 my $self = shift; 1505 1506 # XXX fix to calculate min and max for each data set 1507 # independently, and store in an array. Then, based on use_axis, 1508 # pick the minimust and maximust for each axis, and use those. 1509 1510 # First, calculate some decent values 1511 if ( $self->{two_axes} ) 1512 { 1513 my $min_range_1 = defined($self->{min_range_1}) 1514 ? $self->{min_range_1} 1515 : $self->{min_range}; 1516 my $min_range_2 = defined($self->{min_range_2}) 1517 ? $self->{min_range_2} 1518 : $self->{min_range}; 1519 ( 1520 $self->{y_min}[1], $self->{y_max}[1], 1521 $self->{y_min}[2], $self->{y_max}[2], 1522 $self->{y_tick_number} 1523 ) = _best_dual_ends( 1524 $self->_correct_y_min_max($self->{_data}->get_min_max_y(1)), 1525 $min_range_1, 1526 $self->_correct_y_min_max($self->{_data}->get_min_max_y(2)), 1527 $min_range_2, 1528 $self->{y_tick_number} 1529 ); 1530 } 1531 else 1532 { 1533 my ($y_min, $y_max); 1534 if ($self->{cumulate}) 1535 { 1536 my $data_set = $self->{_data}->copy(); 1537 $data_set->cumulate; 1538 ($y_min, $y_max) = $data_set->get_min_max_y($data_set->num_sets); 1539 } 1540 else 1541 { 1542 ($y_min, $y_max) = $self->{_data}->get_min_max_y_all; 1543 } 1544 ($y_min, $y_max) = $self->_correct_y_min_max($y_min, $y_max); 1545 ($self->{y_min}[1], $self->{y_max}[1], $self->{y_tick_number}) = 1546 _best_ends($y_min, $y_max, @$self{'y_tick_number','y_min_range'}); 1547 } 1548 1549 if (defined($self->{x_tick_number})) 1550 { 1551 if (defined($self->{x_min_value}) && defined($self->{x_max_value})) 1552 { 1553 $self->{true_x_min} = $self->{x_min_value}; 1554 $self->{true_x_max} = $self->{x_max_value}; 1555 } 1556 else 1557 { 1558 ($self->{true_x_min}, $self->{true_x_max}) = 1559 $self->{_data}->get_min_max_x; 1560 ($self->{x_min}, $self->{x_max}, $self->{x_tick_number}) = 1561 _best_ends($self->{true_x_min}, $self->{true_x_max}, 1562 @$self{'y_tick_number','y_min_range'}); 1563 1564 } 1565 } 1566 1567 # Overwrite these with any user supplied ones 1568 $self->{y_min}[1] = $self->{y_min_value} if defined $self->{y_min_value}; 1569 $self->{y_min}[2] = $self->{y_min_value} if defined $self->{y_min_value}; 1570 1571 $self->{y_max}[1] = $self->{y_max_value} if defined $self->{y_max_value}; 1572 $self->{y_max}[2] = $self->{y_max_value} if defined $self->{y_max_value}; 1573 1574 $self->{y_min}[1] = $self->{y1_min_value} if defined $self->{y1_min_value}; 1575 $self->{y_max}[1] = $self->{y1_max_value} if defined $self->{y1_max_value}; 1576 1577 $self->{y_min}[2] = $self->{y2_min_value} if defined $self->{y2_min_value}; 1578 $self->{y_max}[2] = $self->{y2_max_value} if defined $self->{y2_max_value}; 1579 1580 $self->{x_min} = $self->{x_min_value} if defined $self->{x_min_value}; 1581 $self->{x_max} = $self->{x_max_value} if defined $self->{x_max_value}; 1582 1583 if ($self->{two_axes}) 1584 { 1585 # If we have two axes, we need to make sure that the zero is at 1586 # the same spot. 1587 # And we need to change the number of ticks on the axes 1588 1589 my $l_range = $self->{y_max}[1] - $self->{y_min}[1]; 1590 my $r_range = $self->{y_max}[2] - $self->{y_min}[2]; 1591 1592 my $l_top = $self->{y_max}[1]/$l_range; 1593 my $r_top = $self->{y_max}[2]/$r_range; 1594 my $l_bot = $self->{y_min}[1]/$l_range; 1595 my $r_bot = $self->{y_min}[2]/$r_range; 1596 1597 if ($l_top > $r_top) 1598 { 1599 $self->{y_max}[2] = $l_top * $r_range; 1600 $self->{y_min}[1] = $r_bot * $l_range; 1601 $self->{y_tick_number} *= 1 + abs $r_bot - $l_bot; 1602 } 1603 else 1604 { 1605 $self->{y_max}[1] = $r_top * $l_range; 1606 $self->{y_min}[2] = $l_bot * $r_range; 1607 $self->{y_tick_number} *= 1 + abs $r_top - $l_top; 1608 } 1609 } 1610 1611 # Check to see if we have sensible values 1612 if ($self->{two_axes}) 1613 { 1614 for my $i (1 .. 2) 1615 { 1616 my ($min, $max) = $self->{_data}->get_min_max_y($i); 1617 return $self->_set_error("Minimum for y" . $i . " too large") 1618 if $self->{y_min}[$i] > $min; 1619 return $self->_set_error("Maximum for y" . $i . " too small") 1620 if $self->{y_max}[$i] < $max; 1621 } 1622 } 1623 1624 return $self; 1625} 1626 1627# CONTRIB Scott Prahl 1628# 1629# Calculate best endpoints and number of intervals for an axis and 1630# returns ($nice_min, $nice_max, $n), where $n is the number of 1631# intervals and 1632# 1633# $nice_min <= $min < $max <= $nice_max 1634# 1635# Usage: 1636# ($nmin,$nmax,$nint) = _best_ends(247, 508); 1637# ($nmin,$nmax) = _best_ends(247, 508, 5); 1638# use 5 intervals 1639# ($nmin,$nmax,$nint) = _best_ends(247, 508, [4..7]); 1640# best of 4,5,6,7 intervals 1641# ($nmin,$nmax,$nint) = _best_ends(247, 508, 'auto'); 1642# best of 3,4,5,6 intervals 1643# ($nmin,$nmax,$nint) = _best_ends(247, 508, [2..5]); 1644# best of 2,3,4,5 intervals 1645sub _best_ends 1646{ 1647 my ($min, $max, $n_ref, $min_range) = @_; 1648 1649 # Adjust for the min range if need be 1650 ($min, $max) = _fit_vals_range($min, $max, $min_range); 1651 1652 my ($best_min, $best_max, $best_num) = ($min, $max, 1); 1653 1654 # mgjv - Sometimes, for odd values, and only one data set, this will be 1655 # necessary _after_ the previous step, not before. Data sets of one 1656 # long with negative values were causing infinite loops later on. 1657 ($min, $max) = ($max, $min) if ($min > $max); 1658 1659 # Check that min and max are not the same, and not 0 1660 ($min, $max) = ($min) ? ($min * 0.5, $min * 1.5) : (-1,1) 1661 if ($max == $min); 1662 1663 my @n = ref($n_ref) ? @$n_ref : $n_ref; 1664 1665 if (@n <= 0) 1666 { 1667 @n = (3..6); 1668 } 1669 else 1670 { 1671 @n = map { ref($_) ? @$_ : /(\d+)/i ? $1 : (3..6) } @n; 1672 } 1673 1674 my $best_fit = 1e30; 1675 my $range = $max - $min; 1676 1677 # create array of interval sizes 1678 my $s = 1; 1679 while ($s < $range) { $s *= 10 } 1680 while ($s > $range) { $s /= 10 } 1681 my @step = map {$_ * $s} (0.2, 0.5, 1, 2, 5); 1682 1683 for my $n (@n) 1684 { 1685 # Try all numbers of intervals 1686 next if ($n < 1); 1687 1688 for my $step (@step) 1689 { 1690 next if ($n != 1) && ($step < $range/$n); # $step too small 1691 1692 my ($nice_min, $nice_max, $fit) 1693 = _fit_interval($min, $max, $n, $step); 1694 1695 next if $best_fit <= $fit; 1696 1697 $best_min = $nice_min; 1698 $best_max = $nice_max; 1699 $best_fit = $fit; 1700 $best_num = $n; 1701 } 1702 } 1703 return ($best_min, $best_max, $best_num) 1704} 1705 1706# CONTRIB Ben Tilly 1707# 1708# Calculate best endpoints and number of intervals for a pair of axes 1709# where it is trying to line up the scale of the two intervals. It 1710# returns ($nice_min_1, $nice_max_1, $nice_min_2, $nice_max_2, $n), 1711# where $n is the number of intervals and 1712# 1713# $nice_min_1 <= $min_1 < $max_1 <= $nice_max_1 1714# $nice_min_2 <= $min_2 < $max_2 <= $nice_max_2 1715# 1716# and 0 will appear at the same point on both axes. 1717# 1718# Usage: 1719# ($nmin_1,$nmax_1,$nmin_2,$nmax_2,$nint) = _best_dual_ends(247, 508, undef, -1, 5, undef, [2..5]); 1720# etc. (The usage of the last arguments just parallels _best_ends.) 1721# 1722sub _best_dual_ends 1723{ 1724 my ($min_1, $max_1) = _fit_vals_range(splice @_, 0, 3); 1725 my ($min_2, $max_2) = _fit_vals_range(splice @_, 0, 3); 1726 my @rem_args = @_; 1727 1728 # Fix the situation where both min_1 and max_1 are 0, which makes it 1729 # loop forever 1730 ($min_1, $max_1) = (0, 1) unless $min_1 or $max_1; 1731 1732 my $scale_1 = _max(abs($min_1), abs($max_1)); 1733 my $scale_2 = _max(abs($min_2), abs($max_2)); 1734 1735 $scale_1 = defined($scale_2) ? $scale_2 : 1 unless defined($scale_1); 1736 $scale_2 = $scale_1 unless defined($scale_2); 1737 1738 my $ratio = $scale_1 / ($scale_2 || 1); 1739 my $fact_1 = my $fact_2 = 1; 1740 1741 while ($ratio < sqrt(0.1)) 1742 { 1743 $ratio *= 10; 1744 $fact_2 *= 10; 1745 } 1746 while ($ratio > sqrt(10)) 1747 { 1748 $ratio /= 10; 1749 $fact_1 *= 10; 1750 } 1751 1752 my ($best_min_1, $best_max_1, $best_min_2, $best_max_2, $best_n, $best_fit) 1753 = ($min_1, $max_1, $min_2, $max_2, 1, 1e10); 1754 1755 # Now try all of the ratios of "simple numbers" in the right size-range 1756 foreach my $frac 1757 ( 1758 [1,1], [1,2], [1,3], [2,1], [2,3], [2,5], 1759 [3,1], [3,2], [3,4], [3,5], [3,8], [3,10], 1760 [4,3], [4,5], [5,2], [5,3], [5,4], [5,6], 1761 [5,8], [6,5], [8,3], [8,5], [10,3] 1762 ) 1763 { 1764 my $bfact_1 = $frac->[0] * $fact_1; 1765 my $bfact_2 = $frac->[1] * $fact_2; 1766 1767 my $min = _min( $min_1/$bfact_1, $min_2/$bfact_2 ); 1768 my $max = _max( $max_1/$bfact_1, $max_2/$bfact_2 ); 1769 1770 my ($bmin, $bmax, $n) = _best_ends($min, $max, @rem_args); 1771 my ($bmin_1, $bmax_1) = ($bfact_1*$bmin, $bfact_1*$bmax); 1772 my ($bmin_2, $bmax_2) = ($bfact_2*$bmin, $bfact_2*$bmax); 1773 1774 my $fit = _measure_interval_fit($bmin_1, $min_1, $max_1, $bmax_1) 1775 + _measure_interval_fit($bmin_2, $min_2, $max_2, $bmax_2); 1776 1777 next if $best_fit < $fit; 1778 1779 ( 1780 $best_min_1, $best_max_1, $best_min_2, $best_max_2, 1781 $best_n, $best_fit 1782 ) = ( 1783 $bmin_1, $bmax_1, $bmin_2, $bmax_2, 1784 $n, $fit 1785 ); 1786 } 1787 1788 return ($best_min_1, $best_max_1, $best_min_2, $best_max_2, $best_n); 1789} 1790 1791# Takes $min, $max, $step_count, $step_size. Assumes $min <= $max and both 1792# $step_count and $step_size are positive. Returns the fitted $min, $max, 1793# and a $fit statistic (where smaller is better). Failure to fit the 1794# interval results in a poor fit statistic. :-) 1795sub _fit_interval 1796{ 1797 my ($min, $max, $step_count, $step_size) = @_; 1798 1799 my $nice_min = $step_size * int($min/$step_size); 1800 $nice_min -= $step_size if ($nice_min > $min); 1801 my $nice_max = ($step_count == 1) 1802 ? $step_size * int($max/$step_size + 1) 1803 : $nice_min + $step_count * $step_size; 1804 1805 my $fit = _measure_interval_fit($nice_min, $min, $max, $nice_max); 1806 1807 # Prevent division by zero errors further up 1808 return ($min, $max, 0) if ($step_size == 0); 1809 return ($nice_min, $nice_max, $fit); 1810} 1811 1812# Takes 2 values and a minimum range. Returns a min and max which holds 1813# both values and is at least that minimum size 1814sub _fit_vals_range 1815{ 1816 my ($min, $max, $min_range) = @_; 1817 1818 ($min, $max) = ($max, $min) if $max < $min; 1819 1820 if (defined($min_range) and $min_range > $max - $min) 1821 { 1822 my $nice_min = $min_range * int($min/$min_range); 1823 $nice_min = $nice_min - $min_range if $min < $nice_min; 1824 my $nice_max = $max < $nice_min + $min_range 1825 ? $nice_min + $min_range 1826 : $max; 1827 ($min, $max) = ($nice_min, $nice_max); 1828 } 1829 return ($min, $max); 1830} 1831 1832# Takes $bmin, $min, $max, $bmax and returns a fit statistic for how well 1833# ($bmin, $bmax) encloses the interval ($min, $max). Smaller is better, 1834# and failure to fit will be a very bad fit. Assumes that $min <= $max 1835# and $bmin < $bmax. 1836sub _measure_interval_fit 1837{ 1838 my ($bmin, $min, $max, $bmax) = @_; 1839 return 1000 if $bmin > $min or $bmax < $max; 1840 1841 my $range = $max - $min; 1842 my $brange = $bmax - $bmin; 1843 1844 return $brange < 10 * $range 1845 ? ($brange / $range) 1846 : 10; 1847 } 1848 1849sub _get_bottom 1850{ 1851 my $self = shift; 1852 my ($ds, $np) = @_; 1853 my $bottom = $self->{zeropoint}; 1854 1855 if ($self->{cumulate} && $ds > 1) 1856 { 1857 my $left; 1858 my $pvalue = $self->{_data}->get_y_cumulative($ds - 1, $np); 1859 ($left, $bottom) = $self->val_to_pixel($np + 1, $pvalue, $ds); 1860 $bottom = $left if $self->{rotate_chart}; 1861 } 1862 1863 return $bottom; 1864} 1865 1866# 1867# Convert value coordinates to pixel coordinates on the canvas. 1868# TODO Clean up all the rotate_chart stuff 1869# 1870sub val_to_pixel # ($x, $y, $i) in real coords ($Dataspace), 1871{ # return [x, y] in pixel coords 1872 my $self = shift; 1873 my ($x, $y, $i) = @_; 1874 1875 # XXX use_axis 1876 my $y_min = ($self->{two_axes} && $i == 2) ? 1877 $self->{y_min}[2] : $self->{y_min}[1]; 1878 1879 my $y_max = ($self->{two_axes} && $i == 2) ? 1880 $self->{y_max}[2] : $self->{y_max}[1]; 1881 1882 my $y_step = $self->{rotate_chart} ? 1883 abs(($self->{right} - $self->{left})/($y_max - $y_min)) : 1884 abs(($self->{bottom} - $self->{top})/($y_max - $y_min)); 1885 1886 my $ret_x; 1887 my $origin = $self->{rotate_chart} ? $self->{top} : $self->{left}; 1888 1889 if (defined($self->{x_min_value}) && defined($self->{x_max_value})) 1890 { 1891 $ret_x = $origin + ($x - $self->{x_min}) * $self->{x_step}; 1892 } 1893 else 1894 { 1895 $ret_x = ($self->{x_tick_number} ? $self->{x_offset} : $origin) 1896 + $x * $self->{x_step}; 1897 } 1898 my $ret_y = $self->{rotate_chart} ? 1899 $self->{left} + ($y - $y_min) * $y_step : 1900 $self->{bottom} - ($y - $y_min) * $y_step; 1901 1902 return $self->{rotate_chart} ? 1903 (_round($ret_y), _round($ret_x)) : 1904 (_round($ret_x), _round($ret_y)); 1905} 1906 1907# 1908# Legend 1909# 1910sub setup_legend 1911{ 1912 my $self = shift; 1913 1914 return unless defined $self->{legend}; 1915 1916 my $maxlen = 0; 1917 my $num = 0; 1918 1919 # Save some variables 1920 $self->{r_margin_abs} = $self->{r_margin}; 1921 $self->{b_margin_abs} = $self->{b_margin}; 1922 1923 foreach my $legend (@{$self->{legend}}) 1924 { 1925 if (defined($legend) and $legend ne "") 1926 { 1927 $self->{gdta_legend}->set_text($legend); 1928 my $len = $self->{gdta_legend}->get('width'); 1929 $maxlen = ($maxlen > $len) ? $maxlen : $len; 1930 $num++; 1931 } 1932 last if $num >= $self->{_data}->num_sets; 1933 } 1934 1935 $self->{lg_num} = $num; 1936 1937 # calculate the height and width of each element 1938 my $legend_height = _max($self->{lgfh}, $self->{legend_marker_height}); 1939 1940 $self->{lg_el_width} = 1941 $maxlen + $self->{legend_marker_width} + 3 * $self->{legend_spacing}; 1942 $self->{lg_el_height} = $legend_height + 2 * $self->{legend_spacing}; 1943 1944 my ($lg_pos, $lg_align) = split(//, $self->{legend_placement}); 1945 1946 if ($lg_pos eq 'R') 1947 { 1948 # Always work in one column 1949 $self->{lg_cols} = 1; 1950 $self->{lg_rows} = $num; 1951 1952 # Just for completeness, might use this in later versions 1953 $self->{lg_x_size} = $self->{lg_cols} * $self->{lg_el_width}; 1954 $self->{lg_y_size} = $self->{lg_rows} * $self->{lg_el_height}; 1955 1956 # Adjust the right margin for the rest of the graph 1957 $self->{r_margin} += $self->{lg_x_size}; 1958 1959 # Set the x starting point 1960 $self->{lg_xs} = $self->{width} - $self->{r_margin}; 1961 1962 # Set the y starting point, depending on alignment 1963 if ($lg_align eq 'T') 1964 { 1965 $self->{lg_ys} = $self->{t_margin}; 1966 } 1967 elsif ($lg_align eq 'B') 1968 { 1969 $self->{lg_ys} = $self->{height} - $self->{b_margin} - 1970 $self->{lg_y_size}; 1971 } 1972 else # default 'C' 1973 { 1974 my $height = $self->{height} - $self->{t_margin} - 1975 $self->{b_margin}; 1976 1977 $self->{lg_ys} = 1978 int($self->{t_margin} + $height/2 - $self->{lg_y_size}/2) ; 1979 } 1980 } 1981 else # 'B' is the default 1982 { 1983 # What width can we use 1984 my $width = $self->{width} - $self->{l_margin} - $self->{r_margin}; 1985 1986 (!defined($self->{lg_cols})) and 1987 $self->{lg_cols} = int($width/$self->{lg_el_width}); 1988 1989 $self->{lg_cols} = _min($self->{lg_cols}, $num); 1990 1991 $self->{lg_rows} = 1992 int($num / $self->{lg_cols}) + (($num % $self->{lg_cols}) ? 1 : 0); 1993 1994 $self->{lg_x_size} = $self->{lg_cols} * $self->{lg_el_width}; 1995 $self->{lg_y_size} = $self->{lg_rows} * $self->{lg_el_height}; 1996 1997 # Adjust the bottom margin for the rest of the graph 1998 $self->{b_margin} += $self->{lg_y_size}; 1999 2000 # Set the y starting point 2001 $self->{lg_ys} = $self->{height} - $self->{b_margin}; 2002 2003 # Set the x starting point, depending on alignment 2004 if ($lg_align eq 'R') 2005 { 2006 $self->{lg_xs} = $self->{width} - $self->{r_margin} - 2007 $self->{lg_x_size}; 2008 } 2009 elsif ($lg_align eq 'L') 2010 { 2011 $self->{lg_xs} = $self->{l_margin}; 2012 } 2013 else # default 'C' 2014 { 2015 $self->{lg_xs} = 2016 int($self->{l_margin} + $width/2 - $self->{lg_x_size}/2); 2017 } 2018 } 2019} 2020 2021sub draw_legend 2022{ 2023 my $self = shift; 2024 2025 return unless defined $self->{legend}; 2026 2027 my $xl = $self->{lg_xs} + $self->{legend_spacing}; 2028 my $y = $self->{lg_ys} + $self->{legend_spacing} - 1; 2029 2030 my $i = 0; 2031 my $row = 1; 2032 my $x = $xl; # start position of current element 2033 2034 foreach my $legend (@{$self->{legend}}) 2035 { 2036 $i++; 2037 last if $i > $self->{_data}->num_sets; 2038 2039 my $xe = $x; # position within an element 2040 2041 next unless defined($legend) && $legend ne ""; 2042 2043 $self->draw_legend_marker($i, $xe, $y); 2044 2045 $xe += $self->{legend_marker_width} + $self->{legend_spacing}; 2046 my $ys = int($y + $self->{lg_el_height}/2 - $self->{lgfh}/2); 2047 2048 $self->{gdta_legend}->set_text($legend); 2049 $self->{gdta_legend}->draw($xe, $ys); 2050 2051 $x += $self->{lg_el_width}; 2052 2053 if (++$row > $self->{lg_cols}) 2054 { 2055 $row = 1; 2056 $y += $self->{lg_el_height}; 2057 $x = $xl; 2058 } 2059 } 2060} 2061 2062# 2063# This will be virtual; every sub class should define their own 2064# if this one doesn't suffice 2065# 2066sub draw_legend_marker # data_set_number, x, y 2067{ 2068 my $s = shift; 2069 my $n = shift; 2070 my $x = shift; 2071 my $y = shift; 2072 2073 my $g = $s->{graph}; 2074 2075 my $ci = ($n<=2) ? $s->set_clr($s->pick_data_clr($n)) : $s->set_clr($s->_darken($s->_darken($s->pick_data_clr($n)))); 2076 return unless defined $ci; 2077 2078 $y += int($s->{lg_el_height}/2 - $s->{legend_marker_height}/2); 2079 2080 $g->filledRectangle( 2081 $x, $y, 2082 $x + $s->{legend_marker_width}, $y + $s->{legend_marker_height}, 2083 $ci 2084 ); 2085 2086 $g->rectangle( 2087 $x, $y, 2088 $x + $s->{legend_marker_width}, $y + $s->{legend_marker_height}, 2089 $s->{acci} 2090 ); 2091} 2092 2093"Just another true value"; 2094