Graph.pm

   1 package Imager::Graph;
   2 require 5.006;
   3
   4 =head1 NAME
   5
   6 Imager::Graph - Perl extension for producing Graphs using the Imager library.
   7
   8 =head1 SYNOPSIS
   9
  10   use Imager::Graph::Sub_class;
  11   my $chart = Imager::Graph::Sub_class->new;
  12   my $img = $chart->draw(data=> \@data, ...)
  13     or die $chart->error;
  14   $img->write(file => 'image.png');
  15
  16 =head1 DESCRIPTION
  17
  18 Imager::Graph provides style information to its base classes.  It
  19 defines the colors, text display information and fills based on both
  20 built-in styles and modifications supplied by the user to the draw()
  21 method.
  22
  23 =over
  24
  25 =cut
  26
  27 use strict;
  28 use vars qw($VERSION);
  29 use Imager qw(:handy);
  30 use Imager::Fountain;
  31
  32 $VERSION = '0.10';
  33
  34 # the maximum recursion depth in determining a color, fill or number
  35 use constant MAX_DEPTH => 10;
  36
  37 my $NUM_RE = '(?:[+-]?(?:\d+(?:\.\d*)?|\.\d+)(?:[eE][+-]\d+?)?)';
  38
  39 =item new
  40
  41 This is a simple constructor.  No parameters required.
  42
  43 =cut
  44
  45 sub new {
  46   bless {}, $_[0];
  47 }
  48
  49 =item set_graph_size($size)
  50
  51 Sets the size of the graph (in pixels) within the image.  The size of the image defaults to 1.5 * $graph_size.
  52
  53 =cut
  54
  55 sub set_graph_size {
  56   $_[0]->{'custom_style'}->{'size'} = $_[1];
  57 }
  58
  59 =item set_image_width($width)
  60
  61 Sets the width of the image in pixels.
  62
  63 =cut
  64
  65 sub set_image_width {
  66   $_[0]->{'custom_style'}->{'width'} = $_[1];
  67 }
  68
  69 =item set_image_height($height)
  70
  71 Sets the height of the image in pixels.
  72
  73 =cut
  74
  75 sub set_image_height {
  76   $_[0]->{'custom_style'}->{'height'} = $_[1];
  77 }
  78
  79 =item add_data_series([8, 6, 7, 5, 3, 0, 9], 'Series Name');
  80
  81 Adds a data series to the graph.  For L<Imager::Graph::Pie>, only one data series can be added.
  82
  83 =cut
  84
  85 sub add_data_series {
  86   my $self = shift;
  87   my $data_ref = shift;
  88   my $series_name = shift;
  89
  90   my $graph_data = $self->{'graph_data'} || [];
  91
  92   push @$graph_data, { data => $data_ref, series_name => $series_name };
  93   if (defined $series_name) {
  94     push @{$self->{'labels'}}, $series_name;
  95   }
  96
  97   $self->{'graph_data'} = $graph_data;
  98   return;
  99 }
 100
 101 sub _get_data_series {
 102   my ($self, $opts) = @_;
 103
 104   # return the data supplied to draw() if any.
 105   if ($opts->{data}) {
 106     # one or multiple series?
 107     my $data = $opts->{data};
 108     if (@$data && ref $data->[0] && ref $data->[0] =~ /ARRAY/) {
 109       return $data;
 110     }
 111     else {
 112       return [ { data => $data } ];
 113     }
 114   }
 115
 116   return $self->{'graph_data'};
 117 }
 118
 119 =item set_labels(['label1', 'label2' ... ])
 120
 121 Labels the specific data points.  For line/bar graphs, this is the x-axis.  For pie graphs, it is the label for the wedges.
 122
 123 =cut
 124
 125 sub set_labels {
 126   $_[0]->{'labels'} = $_[1];
 127 }
 128
 129 sub _get_labels {
 130   my ($self, $opts) = @_;
 131
 132   $opts->{labels}
 133     and return $opts->{labels};
 134
 135   return $_[0]->{'labels'}
 136 }
 137
 138 =item set_title($title)
 139
 140 Sets the title of the graph.  Requires setting a font.
 141
 142 =cut
 143
 144 sub set_title {
 145   $_[0]->{'custom_style'}->{'title'}->{'text'} = $_[1];
 146 }
 147
 148 =item set_font($font)
 149
 150 Sets the font to use for text.  Takes an L<Imager::Font> object.
 151
 152 =cut
 153
 154 sub set_font {
 155   $_[0]->{'custom_style'}->{'font'} = $_[1];
 156 }
 157
 158 =item set_style($style_name)
 159
 160 Sets the style to be used for the graph.  Imager::Graph comes with several pre-defined styles: fount_lin (default), fount_rad, mono, primary_red, and primary.
 161
 162 =cut
 163
 164 sub set_style {
 165   $_[0]->{'style'} = $_[1];
 166 }
 167
 168 sub _get_style {
 169   my ($self, $opts) = @_;
 170
 171   $opts->{style}
 172     and return $opts->{style};
 173
 174   return $self->{'style'};
 175 }
 176
 177 =item error
 178
 179 Returns an error message.  Only valid if the draw() method returns false.
 180
 181 =cut
 182
 183 sub error {
 184   $_[0]->{_errstr};
 185 }
 186
 187 =item draw
 188
 189 Creates a new image, draws the chart onto that image and returns it.
 190
 191 Optionally, instead of using the api methods to configure your chart,
 192 you can supply a C<data> parameter in the format
 193 required by that particular graph, and if your graph will use any
 194 text, a C<font> parameter
 195
 196 You can also supply many different parameters which control the way
 197 the graph looks.  These are supplied as keyword, value pairs, where
 198 the value can be a hashref containing sub values.
 199
 200 The C<style> parameter will selects a basic color set, and possibly
 201 sets other related parameters.  See L</"STYLES">.
 202
 203  my $font = Imager::Font->new(file => 'ImUgly.ttf');
 204  my $img = $chart->draw(
 205                  data    => \@data,
 206                  font    => $font,
 207                  title   => {
 208                                  text  => "Hello, World!",
 209                                  size  => 36,
 210                                  color => 'FF0000'
 211                             }
 212                  );
 213
 214 When referring to a single sub-value this documentation will refer to
 215 'title.color' rather than 'the color element of title'.
 216
 217 Returns the graph image on success, or false on failure.
 218
 219 =back
 220
 221 =head1 STYLES
 222
 223 The currently defined styles are:
 224
 225 =over
 226
 227 =item primary
 228
 229 a light grey background with no outlines.  Uses primary colors for the
 230 data fills.
 231
 232 =item primary_red
 233
 234 a light red background with no outlines.  Uses primary colors for the
 235 data fills.
 236
 237 Graphs drawn using this style should save well as a gif, even though
 238 some graphs may perform a slight blur.
 239
 240 This was the default style, but the red was too loud.
 241
 242 =item mono
 243
 244 designed for monochrome output, such as most laser printers, this uses
 245 hatched fills for the data, and no colors.  The returned image is a
 246 one channel image (which can be overridden with the C<channels>
 247 parameter.)
 248
 249 You can also override the colors used by all components for background
 250 or drawing by supplying C<fg> and/or C<bg> parameters.  ie.  if you
 251 supply C<<fg=>'FF0000', channels=>3>> then the hash fills and anything
 252 else will be drawn in red.  Another use might be to set a transparent
 253 background, by supplying C<<bg=>'00000000', channels=>4>>.
 254
 255 This style outlines the legend if present and outlines the hashed fills.
 256
 257 =item fount_lin
 258
 259 designed as a "pretty" style this uses linear fountain fills for the
 260 background and data fills, and adds a drop shadow.
 261
 262 You can override the value used for text and outlines by setting the
 263 C<fg> parameter.
 264
 265 This is the default style.
 266
 267 =item fount_rad
 268
 269 also designed as a "pretty" style this uses radial fountain fills for
 270 the data and a linear blue to green fill for the background.
 271
 272 =back
 273
 274 =head1 Style API
 275
 276 To set or override styles, you can use the following methods:
 277
 278 =over 4
 279
 280 =item set_image_background
 281
 282 =cut
 283
 284 sub set_image_background {
 285   $_[0]->{'custom_style'}->{'back'} = $_[1];
 286 }
 287
 288 =item set_channels
 289
 290 =cut
 291
 292 sub set_channels {
 293   $_[0]->{'custom_style'}->{'channels'} = $_[1];
 294 }
 295
 296 =item set_line_color
 297
 298 =cut
 299
 300 sub set_line_color {
 301   $_[0]->{'custom_style'}->{'line'} = $_[1];
 302 }
 303
 304 =item set_title_font_size
 305
 306 =cut
 307
 308 sub set_title_font_size {
 309   $_[0]->{'custom_style'}->{'title'}->{'size'} = $_[1];
 310 }
 311
 312 =item set_title_font_color
 313
 314 =cut
 315
 316 sub set_title_font_color {
 317   $_[0]->{'custom_style'}->{'title'}->{'color'} = $_[1];
 318 }
 319
 320 =item set_title_horizontal_align
 321
 322 =cut
 323
 324 sub set_title_horizontal_align {
 325   $_[0]->{'custom_style'}->{'title'}->{'halign'} = $_[1];
 326 }
 327
 328 =item set_title_vertical_align
 329
 330 =cut
 331
 332 sub set_title_vertical_align {
 333   $_[0]->{'custom_style'}->{'title'}->{'valign'} = $_[1];
 334 }
 335
 336 =item set_text_font_color
 337
 338 =cut
 339
 340 sub set_text_font_color {
 341   $_[0]->{'custom_style'}->{'text'}->{'color'} = $_[1];
 342 }
 343
 344 =item set_text_font_size
 345
 346 =cut
 347
 348 sub set_text_font_size {
 349   $_[0]->{'custom_style'}->{'text'}->{'size'} = $_[1];
 350 }
 351
 352 =item set_graph_background_color
 353
 354 =cut
 355
 356 sub set_graph_background_color {
 357   $_[0]->{'custom_style'}->{'bg'} = $_[1];
 358 }
 359
 360 =item set_graph_foreground_color
 361
 362 =cut
 363
 364 sub set_graph_foreground_color {
 365   $_[0]->{'custom_style'}->{'fg'} = $_[1];
 366 }
 367
 368 =item set_legend_font_color
 369
 370 =cut
 371
 372 sub set_legend_font_color {
 373   $_[0]->{'custom_style'}->{'legend'}->{'color'} = $_[1];
 374 }
 375
 376 =item set_legend_font
 377
 378 =cut
 379
 380 sub set_legend_font {
 381   $_[0]->{'custom_style'}->{'legend'}->{'font'} = $_[1];
 382 }
 383
 384 =item set_legend_font_size
 385
 386 =cut
 387
 388 sub set_legend_font_size {
 389   $_[0]->{'custom_style'}->{'legend'}->{'size'} = $_[1];
 390 }
 391
 392 =item set_legend_patch_size
 393
 394 =cut
 395
 396 sub set_legend_patch_size {
 397   $_[0]->{'custom_style'}->{'legend'}->{'patchsize'} = $_[1];
 398 }
 399
 400 =item set_legend_patch_gap
 401
 402 =cut
 403
 404 sub set_legend_patch_gap {
 405   $_[0]->{'custom_style'}->{'legend'}->{'patchgap'} = $_[1];
 406 }
 407
 408 =item set_legend_horizontal_align
 409
 410 =cut
 411
 412 sub set_legend_horizontal_align {
 413   $_[0]->{'custom_style'}->{'legend'}->{'halign'} = $_[1];
 414 }
 415
 416 =item set_legend_vertical_align
 417
 418 =cut
 419
 420 sub set_legend_vertical_align {
 421   $_[0]->{'custom_style'}->{'legend'}->{'valign'} = $_[1];
 422 }
 423
 424 =item set_legend_padding
 425
 426 =cut
 427
 428 sub set_legend_padding {
 429   $_[0]->{'custom_style'}->{'legend'}->{'padding'} = $_[1];
 430 }
 431
 432 =item set_legend_outside_padding
 433
 434 =cut
 435
 436 sub set_legend_outside_padding {
 437   $_[0]->{'custom_style'}->{'legend'}->{'outsidepadding'} = $_[1];
 438 }
 439
 440 =item set_legend_fill
 441
 442 =cut
 443
 444 sub set_legend_fill {
 445   $_[0]->{'custom_style'}->{'legend'}->{'fill'} = $_[1];
 446 }
 447
 448 =item set_legend_border
 449
 450 =cut
 451
 452 sub set_legend_border {
 453   $_[0]->{'custom_style'}->{'legend'}->{'border'} = $_[1];
 454 }
 455
 456 =item set_legend_orientation
 457
 458 =cut
 459
 460 sub set_legend_orientation {
 461   $_[0]->{'custom_style'}->{'legend'}->{'orientation'} = $_[1];
 462 }
 463
 464 =item set_callout_font_color
 465
 466 =cut
 467
 468 sub set_callout_font_color {
 469   $_[0]->{'custom_style'}->{'callout'}->{'color'} = $_[1];
 470 }
 471
 472 =item set_callout_font
 473
 474 =cut
 475
 476 sub set_callout_font {
 477   $_[0]->{'custom_style'}->{'callout'}->{'font'} = $_[1];
 478 }
 479
 480 =item set_callout_font_size
 481
 482 =cut
 483
 484 sub set_callout_font_size {
 485   $_[0]->{'custom_style'}->{'callout'}->{'size'} = $_[1];
 486 }
 487
 488 =item set_callout_line_color
 489
 490 =cut
 491
 492 sub set_callout_line_color {
 493   $_[0]->{'custom_style'}->{'callout'}->{'line'} = $_[1];
 494 }
 495
 496 =item set_callout_leader_inside_length
 497
 498 =cut
 499
 500 sub set_callout_leader_inside_length {
 501   $_[0]->{'custom_style'}->{'callout'}->{'inside'} = $_[1];
 502 }
 503
 504 =item set_callout_leader_outside_length
 505
 506 =cut
 507
 508 sub set_callout_leader_outside_length {
 509   $_[0]->{'custom_style'}->{'callout'}->{'outside'} = $_[1];
 510 }
 511
 512 =item set_callout_leader_length
 513
 514 =cut
 515
 516 sub set_callout_leader_length {
 517   $_[0]->{'custom_style'}->{'callout'}->{'leadlen'} = $_[1];
 518 }
 519
 520 =item set_callout_gap
 521
 522 =cut
 523
 524 sub set_callout_gap {
 525   $_[0]->{'custom_style'}->{'callout'}->{'gap'} = $_[1];
 526 }
 527
 528 =item set_label_font_color
 529
 530 =cut
 531
 532 sub set_label_font_color {
 533   $_[0]->{'custom_style'}->{'label'}->{'color'} = $_[1];
 534 }
 535
 536 =item set_label_font
 537
 538 =cut
 539
 540 sub set_label_font {
 541   $_[0]->{'custom_style'}->{'label'}->{'font'} = $_[1];
 542 }
 543
 544 =item set_label_font_size
 545
 546 =cut
 547
 548 sub set_label_font_size {
 549   $_[0]->{'custom_style'}->{'label'}->{'size'} = $_[1];
 550 }
 551
 552 =item set_drop_shadow_fill_color
 553
 554 =cut
 555
 556 sub set_drop_shadow_fill_color {
 557   $_[0]->{'custom_style'}->{'dropshadow'}->{'fill'} = $_[1];
 558 }
 559
 560 =item set_drop_shadow_offset
 561
 562 =cut
 563
 564 sub set_drop_shadow_offset {
 565   $_[0]->{'custom_style'}->{'dropshadow'}->{'off'} = $_[1];
 566 }
 567
 568 =item set_drop_shadowXOffset
 569
 570 =cut
 571
 572 sub set_drop_shadowXOffset {
 573   $_[0]->{'custom_style'}->{'dropshadow'}->{'offx'} = $_[1];
 574 }
 575
 576 =item set_drop_shadowYOffset
 577
 578 =cut
 579
 580 sub set_drop_shadowYOffset {
 581   $_[0]->{'custom_style'}->{'dropshadow'}->{'offy'} = $_[1];
 582 }
 583
 584 =item set_drop_shadow_filter
 585
 586 =cut
 587
 588 sub set_drop_shadow_filter {
 589   $_[0]->{'custom_style'}->{'dropshadow'}->{'filter'} = $_[1];
 590 }
 591
 592 =item set_outline_color
 593
 594 =cut
 595
 596 sub set_outline_color {
 597   $_[0]->{'custom_style'}->{'outline'}->{'line'} = $_[1];
 598 }
 599
 600 =item set_data_area_fills
 601
 602 =cut
 603
 604 sub set_data_area_fills {
 605   $_[0]->{'custom_style'}->{'fills'} = $_[1];
 606 }
 607
 608 =item set_data_line_colors
 609
 610 =cut
 611
 612 sub set_data_line_colors {
 613   $_[0]->{'custom_style'}->{'colors'} = $_[1];
 614 }
 615
 616 =back
 617
 618 =head1 FEATURES
 619
 620 Each graph type has a number of features.  These are used to add
 621 various items that are displayed in the graph area.
 622
 623 Features can be controlled by calling methods on the graph object, or
 624 by passing a C<features> parameter to draw().
 625
 626 Some common features are:
 627
 628 =over
 629
 630 =item show_legend()
 631
 632 Feature: legend
 633 X<legend><features, legend>
 634
 635 adds a box containing boxes filled with the data fills, with
 636 the labels provided to the draw method.  The legend will only be
 637 displayed if both the legend feature is enabled and labels are
 638 supplied.
 639
 640 =cut
 641
 642 sub show_legend {
 643     $_[0]->{'custom_style'}->{'features'}->{'legend'} = 1;
 644 }
 645
 646 =item show_outline()
 647
 648 Feature: outline
 649 X<outline>X<features, outline>
 650
 651 If enabled, draw a border around the elements representing data in the
 652 graph, eg. around each pie segments on a pie chart, around each bar on
 653 a bar chart.
 654
 655 =cut
 656
 657 sub show_outline {
 658     $_[0]->{'custom_style'}->{'features'}->{'outline'} = 1;
 659 }
 660
 661 =item show_labels()
 662
 663 Feature: labels
 664 X<labels>X<features, labels>
 665
 666 labels each data fill, usually by including text inside the data fill.
 667 If the text does not fit in the fill, they could be displayed in some
 668 other form, eg. as callouts in a pie graph.
 669
 670 For pie charts there isn't much point in enabling both the C<legend>
 671 and C<labels> features.
 672
 673 For other charts, the labels label the independent variable, while the
 674 legend describes the color used to plot the dependent variables.
 675
 676 =cut
 677
 678 sub show_labels {
 679     $_[0]->{'custom_style'}->{'features'}->{'labels'} = 1;
 680 }
 681
 682 =item show_drop_shadow()
 683
 684 Feature: dropshadow
 685 X<dropshadow>X<features, dropshadow>
 686
 687 a simple drop shadow is shown behind some of the graph elements.
 688
 689 =cut
 690
 691 sub show_drop_shadow {
 692     $_[0]->{'custom_style'}->{'features'}->{'dropshadow'} = 1;
 693 }
 694
 695 =item reset_features()
 696
 697 Unsets all of the features.
 698
 699 Note: this disables all features, even those enabled by default for a
 700 style.  They can then be enabled by calling feature methods or by
 701 supplying a C<feature> parameter to the draw() method.
 702
 703 =cut
 704
 705 sub reset_features {
 706     $_[0]->{'custom_style'}->{'features'} = {};
 707     $_[0]->{'custom_style'}->{'features'}->{'reset'} = 1;
 708 }
 709
 710 =back
 711
 712 Additionally, features can be set by passing them into the draw()
 713 method, named as above:
 714
 715 =over
 716
 717 =item *
 718
 719 if supplied as an array reference, then any element C<no>I<featurename> will
 720 disable that feature, while an element I<featurename> will enable it.
 721
 722 =item *
 723
 724 if supplied as a scalar, it is treated as if it were a reference to
 725 an array containing only that scalar.
 726
 727 =item *
 728
 729 if supplied as a hash reference, then a C<reset> key with a true value
 730 will avoid inheriting any default features, a key I<feature> with a
 731 false value will disable that feature and a key I<feature> with a true
 732 value will enable that feature.
 733
 734 =back
 735
 736 Each graph also has features specific to that graph.
 737
 738 =head1 COMMON PARAMETERS
 739
 740 When referring to a single sub-value this documentation will refer to
 741 'title.color' rather than 'the color element of title'.
 742
 743 Normally, except for the font parameter, these are controlled by
 744 styles, but these are the style parameters I'd mostly likely expect
 745 you want to use:
 746
 747 =over
 748
 749 =item font
 750
 751 the Imager font object used to draw text on the chart.
 752
 753 =item back
 754
 755 the background fill for the graph.  Default depends on the style.
 756
 757 =item size
 758
 759 the base size of the graph image.  Default: 256
 760
 761 =item width
 762
 763 the width of the graph image.  Default: 1.5 * size (384)
 764
 765 =item height
 766
 767 the height of the graph image.  Default: size (256)
 768
 769 =item channels
 770
 771 the number of channels in the image.  Default: 3 (the 'mono' style
 772 sets this to 1).
 773
 774 =item line
 775
 776 the color used for drawing lines, such as outlines or callouts.
 777 Default depends on the current style.  Set to undef to remove the
 778 outline from a style.
 779
 780 =item title
 781
 782 the text used for a graph title.  Default: no title.  Note: this is
 783 the same as the title=>{ text => ... } field.
 784
 785 =over
 786
 787 =item halign
 788
 789 horizontal alignment of the title in the graph, one of 'left',
 790 'center' or 'right'. Default: center
 791
 792 =item valign
 793
 794 vertical alignment of the title, one of 'top', 'center' or 'right'.
 795 Default: top.  It's probably a bad idea to set this to 'center' unless
 796 you have a very short title.
 797
 798 =back
 799
 800 =item text
 801
 802 This contains basic defaults used in drawing text.
 803
 804 =over
 805
 806 =item color
 807
 808 the default color used for all text, defaults to the fg color.
 809
 810 =item size
 811
 812 the base size used for text, also used to scale many graph elements.
 813 Default: 14.
 814
 815 =back
 816
 817 =back
 818
 819 =head1 BEYOND STYLES
 820
 821 In most cases you will want to use just the styles, but you may want
 822 to exert more control over the way your chart looks.  This section
 823 describes the options you can use to control the way your chart looks.
 824
 825 Hopefully you don't need to read this.
 826
 827 =over
 828
 829 =item back
 830
 831 The background of the graph.
 832
 833 =item bg
 834
 835 =item fg
 836
 837 Used to define basic background and foreground colors for the graph.
 838 The bg color may be used for the background of the graph, and is used
 839 as a default for the background of hatched fills.  The fg is used as
 840 the default for line and text colors.
 841
 842 =item font
 843
 844 The default font used by the graph.  Normally you should supply this
 845 if your graph as any text.
 846
 847 =item line
 848
 849 The default line color.
 850
 851 =item text
 852
 853 defaults for drawing text.  Other textual graph elements will inherit
 854 or modify these values.
 855
 856 =over
 857
 858 =item color
 859
 860 default text color, defaults to the I<fg> color.
 861
 862 =item size
 863
 864 default text size. Default: 14.  This is used to scale many graph
 865 elements, including padding and leader sizes.  Other text elements
 866 will either use or scale this value.
 867
 868 =item font
 869
 870 default font object.  Inherited from I<font>, which should have been
 871 supplied by the caller.
 872
 873 =back
 874
 875 =item title
 876
 877 If you supply a scalar value for this element, it will be stored in
 878 the I<text> field.
 879
 880 Defines the text, font and layout information for the title.
 881
 882 =over
 883
 884 =item color
 885
 886 The color of the title, inherited from I<text.color>.
 887
 888 =item font
 889
 890 The font object used for the title, inherited from I<text.font>.
 891
 892 =item size
 893
 894 size of the title text. Default: double I<text.size>
 895
 896 =item halign
 897
 898 =item valign
 899
 900 The horizontal and vertical alignment of the title.
 901
 902 =back
 903
 904 =item legend
 905
 906 defines attributes of the graph legend, if present.
 907
 908 =over
 909
 910 =item color
 911
 912 =item font
 913
 914 =item size
 915
 916 text attributes for the labels used in the legend.
 917
 918 =item patchsize
 919
 920 the width and height of the color patch in the legend.  Defaults to
 921 90% of the legend text size.
 922
 923 =item patchgap
 924
 925 the minimum gap between patches in pixels.  Defaults to 30% of the
 926 patchsize.
 927
 928 =item patchborder
 929
 930 the color of the border drawn around each patch.  Inherited from I<line>.
 931
 932 =item halign
 933
 934 =item valign
 935
 936 the horizontal and vertical alignment of the legend within the graph.
 937 Defaults to 'right' and 'top'.
 938
 939 =item padding
 940
 941 the gap between the legend patches and text and the outside of its
 942 box, or to the legend border, if any.
 943
 944 =item outsidepadding
 945
 946 the gap between the border and the outside of the legend's box.  This
 947 is only used if the I<legend.border> attribute is defined.
 948
 949 =item fill
 950
 951 the background fill for the legend.  Default: none
 952
 953 =item border
 954
 955 the border color of the legend.  Default: none (no border is drawn
 956 around the legend.)
 957
 958 =item orientation
 959
 960 The orientation of the legend.  If this is C<vertical> the the patches
 961 and labels are stacked on top of each other.  If this is C<horizontal>
 962 the patchs and labels are word wrapped across the image.  Default:
 963 vertical.
 964
 965 =back
 966
 967 For example to create a horizontal legend with borderless patches,
 968 darker than the background, you might do:
 969
 970   my $im = $chart->draw
 971     (...,
 972     legend =>
 973     {
 974       patchborder => undef,
 975       orientation => 'horizontal',
 976       fill => { solid => Imager::Color->new(0, 0, 0, 32), }
 977     },
 978     ...);
 979
 980 =item callout
 981
 982 defines attributes for graph callouts, if any are present.  eg. if the
 983 pie graph cannot fit the label into the pie graph segement it will
 984 present it as a callout.
 985
 986 =over
 987
 988 =item color
 989
 990 =item font
 991
 992 =item size
 993
 994 the text attributes of the callout label.  Inherited from I<text>.
 995
 996 =item line
 997
 998 the color of the callout lines.  Inherited from I<line>
 999
1000 =item inside
1001
1002 =item outside
1003
1004 the length of the leader on the inside and the outside of the fill,
1005 usually at some angle.  Both default to the size of the callout text.
1006
1007 =item leadlen
1008
1009 the length of the horizontal portion of the leader.  Default:
1010 I<callout.size>.
1011
1012 =item gap
1013
1014 the gap between the callout leader and the callout text.  Defaults to
1015 30% of the text callout size.
1016
1017 =back
1018
1019 =item label
1020
1021 defines attributes for labels drawn into the data areas of a graph.
1022
1023 =over
1024
1025 =item color
1026
1027 =item font
1028
1029 =item size
1030
1031 The text attributes of the labels.  Inherited from I<text>.
1032
1033 =back
1034
1035 =item dropshadow
1036
1037 the attributes of the graph's drop shadow
1038
1039 =over
1040
1041 =item fill
1042
1043 the fill used for the drop shadow.  Default: '404040' (dark gray)
1044
1045 =item off
1046
1047 the offset of the drop shadow.  A convenience value inherited by offx
1048 and offy.  Default: 40% of I<text.size>.
1049
1050 =item offx
1051
1052 =item offy
1053
1054 the horizontal and vertical offsets of the drop shadow.  Both
1055 inherited from I<dropshadow.off>.
1056
1057 =item filter
1058
1059 the filter description passed to Imager's filter method to blur the
1060 drop shadow.  Default: an 11 element convolution filter.
1061
1062 =back
1063
1064 =item outline
1065
1066 describes the lines drawn around filled data areas, such as the
1067 segments of a pie chart.
1068
1069 =over
1070
1071 =item line
1072
1073 the line color of the outlines, inherited from I<line>.
1074
1075 =back
1076
1077 =item fills
1078
1079 a reference to an array containing fills for each data item.
1080
1081 You can mix fill types, ie. using a simple color for the first item, a
1082 hatched fill for the second and a fountain fill for the next.
1083
1084 =back
1085
1086 =head1 HOW VALUES WORK
1087
1088 Internally rather than specifying literal color, fill, or font objects
1089 or literal sizes for each element, Imager::Graph uses a number of
1090 special values to inherit or modify values taken from other graph
1091 element names.
1092
1093 =head2 Specifying colors
1094
1095 You can specify colors by either supplying an Imager::Color object, by
1096 supplying lookup of another color, or by supplying a single value that
1097 Imager::Color::new can use as an initializer.  The most obvious is
1098 just a 6 or 8 digit hex value representing the red, green, blue and
1099 optionally alpha channels of the image.
1100
1101 You can lookup another color by using the lookup() "function", for
1102 example if you give a color as "lookup(fg)" then Imager::Graph will
1103 look for the fg element in the current style (or as overridden by
1104 you.)  This is used internally by Imager::Graph to set up the
1105 relationships between the colors of various elements, for example the
1106 default style information contains:
1107
1108    text=>{
1109           color=>'lookup(fg)',
1110           ...
1111          },
1112    legend =>{
1113              color=>'lookup(text.color)',
1114              ...
1115             },
1116
1117 So by setting the I<fg> color, you also set the default text color,
1118 since each text element uses lookup(text.color) as its value.
1119
1120 =head2 Specifying fills
1121
1122 Fills can be used for the graph background color, the background color
1123 for the legend block and for the fills used for each data element.
1124
1125 You can specify a fill as a L<color value|Specifying colors> or as a
1126 general fill, see L<Imager::Fill> for details.
1127
1128 You don't need (or usually want) to call Imager::Fill::new yourself,
1129 since the various fill functions will call it for you, and
1130 Imager::Graph provides some hooks to make them more useful.
1131
1132 =over
1133
1134 =item *
1135
1136 with hatched fills, if you don't supply a 'fg' or 'bg' parameter,
1137 Imager::Graph will supply the current graph fg and bg colors.
1138
1139 =item *
1140
1141 with fountain fill, you can supply the xa_ratio, ya_ratio, xb_ratio
1142 and yb_ratio parameters, and they will be scaled in the fill area to
1143 define the fountain fills xa, ya, xb and yb parameters.
1144
1145 =back
1146
1147 As with colors, you can use lookup(name) or lookup(name1.name2) to
1148 have one element to inherit the fill of another.
1149
1150 Imager::Graph defaults the fill combine value to C<'normal'>.  This
1151 doesn't apply to simple color fills.
1152
1153 =head2 Specifying numbers
1154
1155 You can specify various numbers, usually representing the size of
1156 something, commonly text, but sometimes the length of a line or the
1157 size of a gap.
1158
1159 You can use the same lookup mechanism as with colors and fills, but
1160 you can also scale values.  For example, 'scale(0.5,text.size)' will
1161 return half the size of the normal text size.
1162
1163 As with colors, this is used internally to scale graph elements based
1164 on the base text size.  If you change the base text size then other
1165 graph elements will scale as well.
1166
1167 =head2 Specifying other elements
1168
1169 Other elements, such as fonts, or parameters for a filter, can also
1170 use the lookup(name) mechanism.
1171
1172 =head1 INTERNAL METHODS
1173
1174 Only useful if you need to fix bugs, add features or create a new
1175 graph class.
1176
1177 =over
1178
1179 =cut
1180
1181 my %style_defs =
1182   (
1183    back=> 'lookup(bg)',
1184    line=> 'lookup(fg)',
1185    aa => 1,
1186    text=>{
1187           color => 'lookup(fg)',
1188           font  => 'lookup(font)',
1189           size  => 14,
1190           aa    => 'lookup(aa)',
1191          },
1192    title=>{
1193            color  => 'lookup(text.color)',
1194            font   => 'lookup(text.font)',
1195            halign => 'center',
1196            valign => 'top',
1197            size   => 'scale(text.size,2.0)',
1198            aa     => 'lookup(text.aa)',
1199           },
1200    legend =>{
1201              color          => 'lookup(text.color)',
1202              font           => 'lookup(text.font)',
1203              aa             => 'lookup(text.aa)',
1204              size           => 'lookup(text.size)',
1205              patchsize      => 'scale(legend.size,0.9)',
1206              patchgap       => 'scale(legend.patchsize,0.3)',
1207              patchborder    => 'lookup(line)',
1208              halign         => 'right',
1209              valign         => 'top',
1210              padding        => 'scale(legend.size,0.3)',
1211              outsidepadding => 'scale(legend.padding,0.4)',
1212             },
1213    callout => {
1214                color    => 'lookup(text.color)',
1215                font     => 'lookup(text.font)',
1216                size     => 'lookup(text.size)',
1217                line     => 'lookup(line)',
1218                inside   => 'lookup(callout.size)',
1219                outside  => 'lookup(callout.size)',
1220                leadlen  => 'scale(0.8,callout.size)',
1221                gap      => 'scale(callout.size,0.3)',
1222                aa       => 'lookup(text.aa)',
1223                lineaa   => 'lookup(lineaa)',
1224               },
1225    label => {
1226              font          => 'lookup(text.font)',
1227              size          => 'lookup(text.size)',
1228              color         => 'lookup(text.color)',
1229              hpad          => 'lookup(label.pad)',
1230              vpad          => 'lookup(label.pad)',
1231              pad           => 'scale(label.size,0.2)',
1232              pcformat      => sub { sprintf "%s (%.0f%%)", $_[0], $_[1] },
1233              pconlyformat  => sub { sprintf "%.1f%%", $_[0] },
1234              aa            => 'lookup(text.aa)',
1235              lineaa        => 'lookup(lineaa)',
1236              },
1237    dropshadow => {
1238                   fill    => { solid => Imager::Color->new(0, 0, 0, 96) },
1239                   off     => 'scale(0.4,text.size)',
1240                   offx    => 'lookup(dropshadow.off)',
1241                   offy    => 'lookup(dropshadow.off)',
1242                   filter  => { type=>'conv',
1243                               # this needs a fairly heavy blur
1244                               coef=>[0.1, 0.2, 0.4, 0.6, 0.7, 0.9, 1.2,
1245                                      0.9, 0.7, 0.6, 0.4, 0.2, 0.1 ] },
1246                  },
1247    # controls the outline of graph elements representing data, eg. pie
1248    # slices, bars or columns
1249    outline => {
1250                line =>'lookup(line)',
1251                lineaa => 'lookup(lineaa)',
1252               },
1253    # controls the outline and background of the data area of the chart
1254    graph =>
1255    {
1256     fill => "lookup(bg)",
1257     outline => "lookup(fg)",
1258    },
1259    size=>256,
1260    width=>'scale(1.5,size)',
1261    height=>'lookup(size)',
1262
1263    # yes, the handling of fill and line AA is inconsistent, lack of
1264    # forethought, unfortunately
1265    fill => {
1266             aa => 'lookup(aa)',
1267            },
1268    lineaa => 'lookup(aa)',
1269
1270     line_markers =>[
1271       { shape => 'circle',   radius => 4 },
1272       { shape => 'square',   radius => 4 },
1273       { shape => 'diamond',  radius => 4 },
1274       { shape => 'triangle', radius => 4 },
1275       { shape => 'x',        radius => 4 },
1276       { shape => 'plus',     radius => 4 },
1277     ],
1278   );
1279
1280 =item _error($message)
1281
1282 Sets the error field of the object and returns an empty list or undef,
1283 depending on context.  Should be used for error handling, since it may
1284 provide some user hooks at some point.
1285
1286 The intended usage is:
1287
1288   some action
1289     or return $self->_error("error description");
1290
1291 You should almost always return the result of _error() or return
1292 immediately afterwards.
1293
1294 =cut
1295
1296 sub _error {
1297   my ($self, $error) = @_;
1298
1299   $self->{_errstr} = $error;
1300
1301   return;
1302 }
1303
1304
1305 =item _style_defs()
1306
1307 Returns the style defaults, such as the relationships between line
1308 color and text color.
1309
1310 Intended to be over-ridden by base classes to provide graph specific
1311 defaults.
1312
1313 =cut
1314
1315 sub _style_defs {
1316   \%style_defs;
1317 }
1318
1319 # Let's make the default something that looks really good, so folks will be interested enough to customize the style.
1320 my $def_style = 'fount_lin';
1321
1322 my %styles =
1323   (
1324    primary =>
1325    {
1326     fills=>
1327     [
1328      qw(FF0000 00FF00 0000FF C0C000 00C0C0 FF00FF)
1329     ],
1330     fg=>'000000',
1331     negative_bg=>'EEEEEE',
1332     bg=>'E0E0E0',
1333     legend=>
1334     {
1335      #patchborder=>'000000'
1336     },
1337    },
1338    primary_red =>
1339    {
1340     fills=>
1341     [
1342      qw(FF0000 00FF00 0000FF C0C000 00C0C0 FF00FF)
1343     ],
1344     fg=>'000000',
1345     negative_bg=>'EEEEEE',
1346     bg=>'C08080',
1347     legend=>
1348     {
1349      patchborder=>'000000'
1350     },
1351    },
1352    mono =>
1353    {
1354     fills=>
1355     [
1356      { hatch=>'slash2' },
1357      { hatch=>'slosh2' },
1358      { hatch=>'vline2' },
1359      { hatch=>'hline2' },
1360      { hatch=>'cross2' },
1361      { hatch=>'grid2' },
1362      { hatch=>'stipple3' },
1363      { hatch=>'stipple2' },
1364     ],
1365     channels=>1,
1366     bg=>'FFFFFF',
1367     fg=>'000000',
1368     negative_bg=>'EEEEEE',
1369     features=>{ outline=>1 },
1370     pie =>{
1371            blur=>undef,
1372           },
1373     aa => 0,
1374     line_markers =>
1375     [
1376      { shape => "x", radius => 4 },
1377      { shape => "plus", radius => 4 },
1378      { shape => "open_circle", radius => 4 },
1379      { shape => "open_diamond", radius => 5 },
1380      { shape => "open_square", radius => 4 },
1381      { shape => "open_triangle", radius => 4 },
1382      { shape => "x", radius => 8 },
1383      { shape => "plus", radius => 8 },
1384      { shape => "open_circle", radius => 8 },
1385      { shape => "open_diamond", radius => 10 },
1386      { shape => "open_square", radius => 8 },
1387      { shape => "open_triangle", radius => 8 },
1388     ],
1389    },
1390    fount_lin =>
1391    {
1392     fills=>
1393     [
1394      { fountain=>'linear',
1395        xa_ratio=>0.13, ya_ratio=>0.13, xb_ratio=>0.87, yb_ratio=>0.87,
1396        segments => Imager::Fountain->simple(positions=>[0, 1],
1397                                             colors=>[ NC('FFC0C0'), NC('FF0000') ]),
1398      },
1399      { fountain=>'linear',
1400        xa_ratio=>0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0,
1401        segments => Imager::Fountain->simple(positions=>[0, 1],
1402                                             colors=>[ NC('C0FFC0'), NC('00FF00') ]),
1403      },
1404      { fountain=>'linear',
1405        xa_ratio=>0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0,
1406        segments => Imager::Fountain->simple(positions=>[0, 1],
1407                                             colors=>[ NC('C0C0FF'), NC('0000FF') ]),
1408      },
1409      { fountain=>'linear',
1410        xa_ratio=>0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0,
1411        segments => Imager::Fountain->simple(positions=>[0, 1],
1412                                             colors=>[ NC('FFFFC0'), NC('FFFF00') ]),
1413      },
1414      { fountain=>'linear',
1415        xa_ratio=>0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0,
1416        segments => Imager::Fountain->simple(positions=>[0, 1],
1417                                             colors=>[ NC('C0FFFF'), NC('00FFFF') ]),
1418      },
1419      { fountain=>'linear',
1420        xa_ratio=>0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0,
1421        segments => Imager::Fountain->simple(positions=>[0, 1],
1422                                             colors=>[ NC('FFC0FF'), NC('FF00FF') ]),
1423      },
1424     ],
1425     colors  => [
1426      qw(FF0000 00FF00 0000FF C0C000 00C0C0 FF00FF)
1427     ],
1428     back=>{ fountain=>'linear',
1429             xa_ratio=>0, ya_ratio=>0,
1430             xb_ratio=>1.0, yb_ratio=>1.0,
1431             segments=>Imager::Fountain->simple
1432             ( positions=>[0, 1],
1433               colors=>[ NC('6060FF'), NC('60FF60') ]) },
1434     fg=>'000000',
1435     negative_bg=>'EEEEEE',
1436     bg=>'FFFFFF',
1437     features=>{ dropshadow=>1 },
1438    },
1439    fount_rad =>
1440    {
1441     fills=>
1442     [
1443      { fountain=>'radial',
1444        xa_ratio=>0.5, ya_ratio=>0.5, xb_ratio=>1.0, yb_ratio=>0.5,
1445        segments => Imager::Fountain->simple(positions=>[0, 1],
1446                                             colors=>[ NC('FF8080'), NC('FF0000') ]),
1447      },
1448      { fountain=>'radial',
1449        xa_ratio=>0.5, ya_ratio=>0.5, xb_ratio=>1.0, yb_ratio=>0.5,
1450        segments => Imager::Fountain->simple(positions=>[0, 1],
1451                                             colors=>[ NC('80FF80'), NC('00FF00') ]),
1452      },
1453      { fountain=>'radial',
1454        xa_ratio=>0.5, ya_ratio=>0.5, xb_ratio=>1.0, yb_ratio=>0.5,
1455        segments => Imager::Fountain->simple(positions=>[0, 1],
1456                                             colors=>[ NC('808080FF'), NC('0000FF') ]),
1457      },
1458      { fountain=>'radial',
1459        xa_ratio=>0.5, ya_ratio=>0.5, xb_ratio=>1.0, yb_ratio=>0.5,
1460        segments => Imager::Fountain->simple(positions=>[0, 1],
1461                                             colors=>[ NC('FFFF80'), NC('FFFF00') ]),
1462      },
1463      { fountain=>'radial',
1464        xa_ratio=>0.5, ya_ratio=>0.5, xb_ratio=>1.0, yb_ratio=>0.5,
1465        segments => Imager::Fountain->simple(positions=>[0, 1],
1466                                             colors=>[ NC('80FFFF'), NC('00FFFF') ]),
1467      },
1468      { fountain=>'radial',
1469        xa_ratio=>0.5, ya_ratio=>0.5, xb_ratio=>1.0, yb_ratio=>0.5,
1470        segments => Imager::Fountain->simple(positions=>[0, 1],
1471                                             colors=>[ NC('FF80FF'), NC('FF00FF') ]),
1472      },
1473     ],
1474     colors  => [
1475      qw(FF0000 00FF00 0000FF C0C000 00C0C0 FF00FF)
1476     ],
1477     back=>{ fountain=>'linear',
1478             xa_ratio=>0, ya_ratio=>0,
1479             xb_ratio=>1.0, yb_ratio=>1.0,
1480             segments=>Imager::Fountain->simple
1481             ( positions=>[0, 1],
1482               colors=>[ NC('6060FF'), NC('60FF60') ]) },
1483     fg=>'000000',
1484     negative_bg=>'EEEEEE',
1485     bg=>'FFFFFF',
1486    }
1487   );
1488
1489 $styles{'ocean'} = {
1490     fills  => [
1491              {
1492               fountain =>'linear',
1493               xa_ratio => 0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0,
1494               segments => Imager::Fountain->simple(
1495                                                     positions=>[0, 1],
1496                                                     colors=>[ NC('EFEDCF'), NC('E6E2AF') ]),
1497             },
1498              {
1499               fountain =>'linear',
1500               xa_ratio => 0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0,
1501               segments => Imager::Fountain->simple(
1502                                                     positions=>[0, 1],
1503                                                     colors=>[ NC('DCD7AB'), NC('A7A37E') ]),
1504             },
1505              {
1506               fountain =>'linear',
1507               xa_ratio => 0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0,
1508               segments => Imager::Fountain->simple(
1509                                                     positions=>[0, 1],
1510                                                     colors=>[ NC('B2E5D4'), NC('80B4A2') ]),
1511             },
1512             {
1513               fountain =>'linear',
1514               xa_ratio => 0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0,
1515               segments => Imager::Fountain->simple(
1516                                                     positions=>[0, 1],
1517                                                     colors=>[ NC('7aaab9'), NC('046380') ]),
1518             },
1519             {
1520               fountain =>'linear',
1521               xa_ratio => 0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0,
1522               segments => Imager::Fountain->simple(
1523                                                     positions=>[0, 1],
1524                                                     colors=>[ NC('c3b8e9'), NC('877EA7') ]),
1525             },
1526             {
1527               fountain =>'linear',
1528               xa_ratio => 0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0,
1529               segments => Imager::Fountain->simple(
1530                                                     positions=>[0, 1],
1531                                                     colors=>[ NC('A3DF9A'), NC('67A35E') ]),
1532             },
1533             {
1534               fountain =>'linear',
1535               xa_ratio => 0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0,
1536               segments => Imager::Fountain->simple(
1537                                                     positions=>[0, 1],
1538                                                     colors=>[ NC('E19C98'), NC('B4726F') ]),
1539             },
1540     ],
1541     colors  => [
1542      qw(E6E2AF A7A37E 80B4A2 046380 877EA7 67A35E B4726F)
1543     ],
1544     fg=>'000000',
1545     negative_bg=>'EEEEEE',
1546     bg=>'FFFFFF',
1547     features=>{ dropshadow=>1 },
1548
1549 };
1550
1551 $styles{'ocean_flat'} = {
1552     fills=>
1553     [
1554      qw(E6E2AF A7A37E 80B4A2 046380 877EA7 67A35E B4726F)
1555     ],
1556     colors  => [
1557      qw(E6E2AF A7A37E 80B4A2 046380 877EA7 67A35E B4726F)
1558     ],
1559     fg=>'000000',
1560     negative_bg=>'EEEEEE',
1561     bg=>'FFFFFF',
1562     features=>{ dropshadow=>1 },
1563
1564 };
1565
1566 =item $self->_style_setup(\%opts)
1567
1568 Uses the values from %opts, the custom style set by methods, the style
1569 set by the style parameter or the set_style() method and the built in
1570 chart defaults to build a working style.
1571
1572 The working style features member is also populated with the active
1573 features for the chart.
1574
1575 The working style is stored in the C<_style> member of $self.
1576
1577 =cut
1578
1579 sub _style_setup {
1580   my ($self, $opts) = @_;
1581   my $style_defs = $self->_style_defs;
1582   my $style;
1583
1584   my $pre_def_style = $self->_get_style($opts);
1585   my $api_style = $self->{'custom_style'} || {};
1586   $style = $styles{$pre_def_style} if $pre_def_style;
1587
1588   $style ||= $styles{$def_style};
1589
1590   my @search_list = ( $style_defs, $style, $api_style, $opts);
1591   my %work;
1592
1593   my @composite = $self->_composite();
1594   my %composite;
1595   @composite{@composite} = @composite;
1596
1597   for my $src (@search_list) {
1598     for my $key (keys %$src) {
1599       if ($composite{$key}) {
1600         $work{$key} = {} unless exists $work{$key};
1601         if (ref $src->{$key}) {
1602           # some keys have sub values, especially text
1603           @{$work{$key}}{keys %{$src->{$key}}} = values %{$src->{$key}};
1604         }
1605         else {
1606           # assume it's the text for a title or something
1607           $work{$key}{text} = $src->{$key};
1608         }
1609       }
1610       else {
1611         $work{$key} = $src->{$key}
1612           if defined $src->{$key}; # $opts with pmichauds new accessor handling
1613       }
1614     }
1615   }
1616
1617   # features are handled specially
1618   my %features;
1619   $work{features} = \%features;
1620   for my $src (@search_list) {
1621     if ($src->{features}) {
1622       if (ref $src->{features}) {
1623         if (ref($src->{features}) =~ /ARRAY/) {
1624           # just set those features
1625           for my $feature (@{$src->{features}}) {
1626             if ($feature =~ /^no(.+)$/) {
1627               delete $features{$1};
1628             }
1629             else {
1630               $features{$feature} = 1;
1631             }
1632           }
1633         }
1634         elsif (ref($src->{features}) =~ /HASH/) {
1635           if ($src->{features}{reset}) {
1636             $work{features} = {}; # only the ones the user specifies
1637           }
1638           @{$work{features}}{keys %{$src->{features}}} =
1639             values(%{$src->{features}});
1640         }
1641       }
1642       else {
1643         # just set that single feature
1644         if ($src->{features} =~ /^no(.+)$/) {
1645           delete $features{$1};
1646         }
1647         else {
1648           $features{$src->{features}} = 1;
1649         }
1650       }
1651     }
1652   }
1653
1654   $self->{_style} = \%work;
1655 }
1656
1657 =item $self->_get_thing($name)
1658
1659 Retrieve some general 'thing'.
1660
1661 Supports the 'lookup(foo)' mechanism.
1662
1663 Returns an empty list on failure.
1664
1665 =cut
1666
1667 sub _get_thing {
1668   my ($self, $name, @depth) = @_;
1669
1670   push(@depth, $name);
1671   my $what;
1672   if ($name =~ /^(\w+)\.(\w+)$/) {
1673     $what = $self->{_style}{$1}{$2};
1674   }
1675   else {
1676     $what = $self->{_style}{$name};
1677   }
1678   defined $what or
1679     return;
1680   if (ref $what) {
1681     return $what;
1682   }
1683   elsif ($what =~ /^lookup\((\w+(?:\.\w+)?)\)$/) {
1684     @depth < MAX_DEPTH
1685       or return $self->_error("too many levels of recursion in lookup(@depth)");
1686     return $self->_get_thing($1, @depth);
1687   }
1688   else {
1689     return $what;
1690   }
1691 }
1692
1693 =item $self->_get_number($name)
1694
1695 Retrieves a number from the style.  The value in the style can be the
1696 number, or one of two functions:
1697
1698 =over
1699
1700 =item lookup(newname)
1701
1702 Recursively looks up I<newname> in the style.
1703
1704 =item scale(value1,value2)
1705
1706 Each value can be a number or a name.  Names are recursively looked up
1707 in the style and the product is returned.
1708
1709 =back
1710
1711 =cut
1712
1713 sub _get_number {
1714   my ($self, $name, @depth) = @_;
1715
1716   push(@depth, $name);
1717   my $what;
1718   if ($name =~ /^(\w+)\.(\w+)$/) {
1719     $what = $self->{_style}{$1}{$2};
1720   }
1721   else {
1722     $what = $self->{_style}{$name};
1723   }
1724   defined $what or
1725     return $self->_error("$name is undef (@depth)");
1726
1727   if (ref $what) {
1728     if ($what =~ /CODE/) {
1729       $what = $what->($self, $name);
1730     }
1731   }
1732   else {
1733     if ($what =~ /^lookup\(([\w.]+)\)$/) {
1734       @depth < MAX_DEPTH
1735         or return $self->_error("too many levels of recursion in lookup (@depth)");
1736       return $self->_get_number($1, @depth);
1737     }
1738     elsif ($what =~ /^scale\(
1739                     ((?:[a-z][\w.]*)|$NUM_RE)
1740                     ,
1741                     ((?:[a-z][\w.]*)|$NUM_RE)\)$/x) {
1742       my ($left, $right) = ($1, $2);
1743       unless ($left =~ /^$NUM_RE$/) {
1744         @depth < MAX_DEPTH
1745           or return $self->_error("too many levels of recursion in scale (@depth)");
1746         $left = $self->_get_number($left, @depth);
1747       }
1748       unless ($right =~ /^$NUM_RE$/) {
1749         @depth < MAX_DEPTH
1750           or return $self->_error("too many levels of recursion in scale (@depth)");
1751         $right = $self->_get_number($right, @depth);
1752       }
1753       return $left * $right;
1754     }
1755     else {
1756       return $what+0;
1757     }
1758   }
1759 }
1760
1761 =item $self->_get_integer($name)
1762
1763 Retrieves an integer from the style.  This is a simple wrapper around
1764 _get_number() that rounds the result to an integer.
1765
1766 Returns an empty list on failure.
1767
1768 =cut
1769
1770 sub _get_integer {
1771   my ($self, $name, @depth) = @_;
1772
1773   my $number = $self->_get_number($name, @depth)
1774     or return;
1775
1776   return sprintf("%.0f", $number);
1777 }
1778
1779 =item _get_color($name)
1780
1781 Returns a color object of the given name from the style hash.
1782
1783 Uses Imager::Color->new to translate normal scalars into color objects.
1784
1785 Allows the lookup(name) mechanism.
1786
1787 Returns an empty list on failure.
1788
1789 =cut
1790
1791 sub _get_color {
1792   my ($self, $name, @depth) = @_;
1793
1794   push(@depth, $name);
1795   my $what;
1796   if ($name =~ /^(\w+)\.(\w+)$/) {
1797     $what = $self->{_style}{$1}{$2};
1798   }
1799   else {
1800     $what = $self->{_style}{$name};
1801   }
1802
1803   defined($what)
1804     or return $self->_error("$name was undefined (@depth)");
1805
1806   unless (ref $what) {
1807     if ($what =~ /^lookup\((\w+(?:\.\w+)?)\)$/) {
1808       @depth < MAX_DEPTH or
1809         return $self->_error("too many levels of recursion in lookup (@depth)");
1810
1811       return $self->_get_color($1, @depth);
1812     }
1813     $what = Imager::Color->new($what);
1814   }
1815
1816   $what;
1817 }
1818
1819 =item _translate_fill($what, $box)
1820
1821 Given the value of a fill, either attempts to convert it into a fill
1822 list (one of C<<color=>$color_value, filled=>1>> or C<<fill=>{ fill
1823 parameters }>>), or to lookup another fill that is referred to with
1824 the 'lookup(name)' mechanism.
1825
1826 This function does the fg and bg initialization for hatched fills, and
1827 translation of *_ratio for fountain fills (using the $box parameter).
1828
1829 Returns an empty list on failure.
1830
1831 =cut
1832
1833 sub _translate_fill {
1834   my ($self, $what, $box, @depth) = @_;
1835
1836   if (ref $what) {
1837     if (UNIVERSAL::isa($what, "Imager::Color")) {
1838       return ( color=>Imager::Color->new($what), filled=>1 );
1839     }
1840     else {
1841       # a general fill
1842       # default to normal combine mode
1843       my %work = ( combine => 'normal', %$what );
1844       if ($what->{hatch}) {
1845         if (!$work{fg}) {
1846           $work{fg} = $self->_get_color('fg')
1847             or return;
1848         }
1849         if (!$work{bg}) {
1850           $work{bg} = $self->_get_color('bg')
1851             or return;
1852         }
1853         return ( fill=>\%work );
1854       }
1855       elsif ($what->{fountain}) {
1856         for my $key (qw(xa ya xb yb)) {
1857           if (exists $work{"${key}_ratio"}) {
1858             if ($key =~ /^x/) {
1859               $work{$key} = $box->[0] + $work{"${key}_ratio"}
1860                 * ($box->[2] - $box->[0]);
1861             }
1862             else {
1863               $work{$key} = $box->[1] + $work{"${key}_ratio"}
1864                 * ($box->[3] - $box->[1]);
1865             }
1866           }
1867         }
1868         return ( fill=>\%work );
1869       }
1870       else {
1871         return ( fill=> \%work );
1872       }
1873     }
1874   }
1875   else {
1876     if ($what =~ /^lookup\((\w+(?:\.\w+)?)\)$/) {
1877       return $self->_get_fill($1, $box, @depth);
1878     }
1879     else {
1880       # assumed to be an Imager::Color single value
1881       return ( color=>Imager::Color->new($what), filled=>1 );
1882     }
1883   }
1884 }
1885
1886 =item _data_fill($index, $box)
1887
1888 Retrieves the fill parameters for a data area fill.
1889
1890 =cut
1891
1892 sub _data_fill {
1893   my ($self, $index, $box) = @_;
1894
1895   my $fills = $self->{_style}{fills};
1896   return $self->_translate_fill($fills->[$index % @$fills], $box,
1897                                 "data.$index");
1898 }
1899
1900 sub _data_color {
1901   my ($self, $index) = @_;
1902
1903   my $colors = $self->{'_style'}{'colors'} || [];
1904   my $fills  = $self->{'_style'}{'fills'} || [];
1905
1906   # Try to just use a fill, so non-fountain styles don't need
1907   # to have a duplicated set of fills and colors
1908   my $fill = $fills->[$index % @$fills];
1909   if (!ref $fill) {
1910     return $fill;
1911   }
1912
1913   if (@$colors) {
1914     return $colors->[$index % @$colors] || '000000';
1915   }
1916   return '000000';
1917 }
1918
1919 =item _get_fill($name, $box)
1920
1921 Retrieves fill parameters for a named fill.
1922
1923 =cut
1924
1925 sub _get_fill {
1926   my ($self, $name, $box, @depth) = @_;
1927
1928   push(@depth, $name);
1929   my $what;
1930   if ($name =~ /^(\w+)\.(\w+)$/) {
1931     $what = $self->{_style}{$1}{$2};
1932   }
1933   else {
1934     $what = $self->{_style}{$name};
1935   }
1936
1937   defined($what)
1938     or return $self->_error("no fill $name found");
1939
1940   return $self->_translate_fill($what, $box, @depth);
1941 }
1942
1943 =item _get_line($name)
1944
1945 Return color (and possibly other) parameters for drawing a line with
1946 the _line() method.
1947
1948 =cut
1949
1950 sub _get_line {
1951   my ($self, $name, @depth) = @_;
1952
1953   push (@depth, $name);
1954   my $what;
1955   if ($name =~ /^(\w+)\.(\w+)$/) {
1956     $what = $self->{_style}{$1}{$2};
1957   }
1958   else {
1959     $what = $self->{_style}{$name};
1960   }
1961
1962   defined($what)
1963     or return $self->_error("no line style $name found");
1964
1965   if (ref $what) {
1966     if (eval { $what->isa("Imager::Color") }) {
1967       return $what;
1968     }
1969     if (ref $what eq "HASH") {
1970       # allow each kep to be looked up
1971       my %work = %$what;
1972
1973       if ($work{color} =~ /^lookup\((.*)\)$/) {
1974         $work{color} = $self->_get_color($1, @depth);
1975       }
1976       for my $key (keys %work) {
1977         $key eq "color" and next;
1978
1979         if ($work{$key} =~ /^lookup\((.*)\)$/) {
1980           $work{$key} = $self->_get_thing($1);
1981         }
1982       }
1983
1984       return %work;
1985     }
1986     return ( color => Imager::Color->new(@$what) );
1987   }
1988   else {
1989     if ($what =~ /^lookup\((\w+(?:\.\w+)?)\)$/) {
1990       @depth < MAX_DEPTH
1991         or return $self->_error("too many levels of recursion in lookup (@depth)");
1992       return $self->_get_line($1, @depth);
1993     }
1994     else {
1995       # presumably a text color
1996       my $color = Imager::Color->new($what)
1997         or return $self->_error("Could not translate $what as a color: ".Imager->errstr);
1998
1999       return ( color => $color );
2000     }
2001   }
2002 }
2003
2004 =item _make_img()
2005
2006 Builds the image object for the graph and fills it with the background
2007 fill.
2008
2009 =cut
2010
2011 sub _make_img {
2012   my ($self) = @_;
2013
2014   my $width = $self->_get_number('width') || 256;
2015   my $height = $self->_get_number('height') || 256;
2016   my $channels = $self->{_style}{channels};
2017
2018   $channels ||= 3;
2019
2020   my $img = Imager->new(xsize=>$width, ysize=>$height, channels=>$channels)
2021     or return $self->_error("Error creating image: " . Imager->errstr);
2022
2023   $img->box($self->_get_fill('back', [ 0, 0, $width-1, $height-1]));
2024
2025   $self->{_image} = $img;
2026
2027   return $img;
2028 }
2029
2030 sub _get_image {
2031   my $self = shift;
2032
2033   return $self->{'_image'};
2034 }
2035
2036 =item _text_style($name)
2037
2038 Returns parameters suitable for calls to Imager::Font's bounding_box()
2039 and draw() methods intended for use in defining text styles.
2040
2041 Returns an empty list on failure.
2042
2043 Returns the following attributes: font, color, size, aa, sizew
2044 (optionally)
2045
2046 =cut
2047
2048 sub _text_style {
2049   my ($self, $name) = @_;
2050
2051   my %work;
2052
2053   if ($self->{_style}{$name}) {
2054     %work = %{$self->{_style}{$name}};
2055   }
2056   else {
2057     %work = %{$self->{_style}{text}};
2058   }
2059   $work{font}
2060     or return $self->_error("$name has no font parameter");
2061
2062   $work{font} = $self->_get_thing("$name.font")
2063     or return $self->_error("No $name.font defined, either set $name.font or font to a font");
2064   UNIVERSAL::isa($work{font}, "Imager::Font")
2065       or return $self->_error("$name.font is not a font");
2066   if ($work{color} && !ref $work{color}) {
2067     $work{color} = $self->_get_color("$name.color")
2068       or return;
2069   }
2070   $work{size} = $self->_get_number("$name.size");
2071   $work{sizew} = $self->_get_number("$name.sizew")
2072     if $work{sizew};
2073   $work{aa} = $self->_get_number("$name.aa");
2074
2075   %work;
2076 }
2077
2078 =item _text_bbox($text, $name)
2079
2080 Returns a bounding box for the specified $text as styled by $name.
2081
2082 Returns an empty list on failure.
2083
2084 =cut
2085
2086 sub _text_bbox {
2087   my ($self, $text, $name) = @_;
2088
2089   my %text_info = $self->_text_style($name)
2090     or return;
2091
2092   my @bbox = $text_info{font}->bounding_box(%text_info, string=>$text,
2093                                             canon=>1);
2094
2095   return @bbox[0..3];
2096 }
2097
2098 =item _line_style($name)
2099
2100 Return parameters suitable for calls to Imager's line(), polyline(),
2101 and box() methods.
2102
2103 For now this returns only color and aa parameters, but future releases
2104 of Imager may support extra parameters.
2105
2106 =cut
2107
2108 sub _line_style {
2109   my ($self, $name) = @_;
2110
2111   my %line;
2112   $line{color} = $self->_get_color("$name.line")
2113     or return;
2114   $line{aa} = $self->_get_number("$name.lineaa");
2115   defined $line{aa} or $line{aa} = $self->_get_number("aa");
2116
2117   return %line;
2118 }
2119
2120 sub _align_box {
2121   my ($self, $box, $chart_box, $name) = @_;
2122
2123   my $halign = $self->{_style}{$name}{halign}
2124     or $self->_error("no halign for $name");
2125   my $valign = $self->{_style}{$name}{valign};
2126
2127   if ($halign eq 'right') {
2128     $box->[0] += $chart_box->[2] - $box->[2];
2129   }
2130   elsif ($halign eq 'left') {
2131     $box->[0] = $chart_box->[0];
2132   }
2133   elsif ($halign eq 'center' || $halign eq 'centre') {
2134     $box->[0] = ($chart_box->[0] + $chart_box->[2] - $box->[2])/2;
2135   }
2136   else {
2137     return $self->_error("invalid halign $halign for $name");
2138   }
2139
2140   if ($valign eq 'top') {
2141     $box->[1] = $chart_box->[1];
2142   }
2143   elsif ($valign eq 'bottom') {
2144     $box->[1] = $chart_box->[3] - $box->[3];
2145   }
2146   elsif ($valign eq 'center' || $valign eq 'centre') {
2147     $box->[1] = ($chart_box->[1] + $chart_box->[3] - $box->[3])/2;
2148   }
2149   else {
2150     return $self->_error("invalid valign $valign for $name");
2151   }
2152   $box->[2] += $box->[0];
2153   $box->[3] += $box->[1];
2154 }
2155
2156 sub _remove_box {
2157   my ($self, $chart_box, $object_box) = @_;
2158
2159   my $areax;
2160   my $areay;
2161   if ($object_box->[0] - $chart_box->[0]
2162       < $chart_box->[2] - $object_box->[2]) {
2163     $areax = ($object_box->[2] - $chart_box->[0])
2164       * ($chart_box->[3] - $chart_box->[1]);
2165   }
2166   else {
2167     $areax = ($chart_box->[2] - $object_box->[0])
2168       * ($chart_box->[3] - $chart_box->[1]);
2169   }
2170
2171   if ($object_box->[1] - $chart_box->[1]
2172       < $chart_box->[3] - $object_box->[3]) {
2173     $areay = ($object_box->[3] - $chart_box->[1])
2174       * ($chart_box->[2] - $chart_box->[0]);
2175   }
2176   else {
2177     $areay = ($chart_box->[3] - $object_box->[1])
2178       * ($chart_box->[2] - $chart_box->[0]);
2179   }
2180
2181   if ($areay < $areax) {
2182     if ($object_box->[1] - $chart_box->[1]
2183         < $chart_box->[3] - $object_box->[3]) {
2184       $chart_box->[1] = $object_box->[3];
2185     }
2186     else {
2187       $chart_box->[3] = $object_box->[1];
2188     }
2189   }
2190   else {
2191     if ($object_box->[0] - $chart_box->[0]
2192         < $chart_box->[2] - $object_box->[2]) {
2193       $chart_box->[0] = $object_box->[2];
2194     }
2195     else {
2196       $chart_box->[2] = $object_box->[0];
2197     }
2198   }
2199 }
2200
2201 sub _draw_legend {
2202   my ($self, $img, $labels, $chart_box) = @_;
2203
2204   my $orient = $self->_get_thing('legend.orientation');
2205   defined $orient or $orient = 'vertical';
2206
2207   if ($orient eq 'vertical') {
2208     return $self->_draw_legend_vertical($img, $labels, $chart_box);
2209   }
2210   elsif ($orient eq 'horizontal') {
2211     return $self->_draw_legend_horizontal($img, $labels, $chart_box);
2212   }
2213   else {
2214     return $self->_error("Unknown legend.orientation $orient");
2215   }
2216 }
2217
2218 sub _draw_legend_horizontal {
2219   my ($self, $img, $labels, $chart_box) = @_;
2220
2221   defined(my $padding = $self->_get_integer('legend.padding'))
2222     or return;
2223   my $patchsize = $self->_get_integer('legend.patchsize')
2224     or return;
2225   defined(my $gap = $self->_get_integer('legend.patchgap'))
2226     or return;
2227
2228   my $minrowsize = $patchsize + $gap;
2229   my ($width, $height) = (0,0);
2230   my $row_height = $minrowsize;
2231   my $pos = 0;
2232   my @sizes;
2233   my @offsets;
2234   for my $label (@$labels) {
2235     my @text_box = $self->_text_bbox($label, 'legend')
2236       or return;
2237     push(@sizes, \@text_box);
2238     my $entry_width = $patchsize + $gap + $text_box[2];
2239     if ($pos == 0) {
2240       # never re-wrap the first entry
2241       push @offsets, [ 0, $height ];
2242     }
2243     else {
2244       if ($pos + $gap + $entry_width > $chart_box->[2]) {
2245         $pos = 0;
2246         $height += $row_height;
2247       }
2248       push @offsets, [ $pos, $height ];
2249     }
2250     my $entry_right = $pos + $entry_width;
2251     $pos += $gap + $entry_width;
2252     $entry_right > $width and $width = $entry_right;
2253     if ($text_box[3] > $row_height) {
2254       $row_height = $text_box[3];
2255     }
2256   }
2257   $height += $row_height;
2258   my @box = ( 0, 0, $width + $padding * 2, $height + $padding * 2 );
2259   my $outsidepadding = 0;
2260   if ($self->{_style}{legend}{border}) {
2261     defined($outsidepadding = $self->_get_integer('legend.outsidepadding'))
2262       or return;
2263     $box[2] += 2 * $outsidepadding;
2264     $box[3] += 2 * $outsidepadding;
2265   }
2266   $self->_align_box(\@box, $chart_box, 'legend')
2267     or return;
2268   if ($self->{_style}{legend}{fill}) {
2269     $img->box(xmin=>$box[0]+$outsidepadding,
2270               ymin=>$box[1]+$outsidepadding,
2271               xmax=>$box[2]-$outsidepadding,
2272               ymax=>$box[3]-$outsidepadding,
2273              $self->_get_fill('legend.fill', \@box));
2274   }
2275   $box[0] += $outsidepadding;
2276   $box[1] += $outsidepadding;
2277   $box[2] -= $outsidepadding;
2278   $box[3] -= $outsidepadding;
2279   my %text_info = $self->_text_style('legend')
2280     or return;
2281   my $patchborder;
2282   if ($self->{_style}{legend}{patchborder}) {
2283     $patchborder = $self->_get_color('legend.patchborder')
2284       or return;
2285   }
2286
2287   my $dataindex = 0;
2288   for my $label (@$labels) {
2289     my ($left, $top) = @{$offsets[$dataindex]};
2290     $left += $box[0] + $padding;
2291     $top += $box[1] + $padding;
2292     my $textpos = $left + $patchsize + $gap;
2293     my @patchbox = ( $left, $top,
2294                      $left + $patchsize, $top + $patchsize );
2295     my @fill = $self->_data_fill($dataindex, \@patchbox)
2296       or return;
2297     $img->box(xmin=>$left, ymin=>$top, xmax=>$left + $patchsize,
2298                ymax=>$top + $patchsize, @fill);
2299     if ($self->{_style}{legend}{patchborder}) {
2300       $img->box(xmin=>$left, ymin=>$top, xmax=>$left + $patchsize,
2301                 ymax=>$top + $patchsize,
2302                 color=>$patchborder);
2303     }
2304     $img->string(%text_info, x=>$textpos, 'y'=>$top + $patchsize,
2305                  text=>$label);
2306
2307     ++$dataindex;
2308   }
2309   if ($self->{_style}{legend}{border}) {
2310     my $border_color = $self->_get_color('legend.border')
2311       or return;
2312     $img->box(xmin=>$box[0], ymin=>$box[1], xmax=>$box[2], ymax=>$box[3],
2313               color=>$border_color);
2314   }
2315   $self->_remove_box($chart_box, \@box);
2316   1;
2317 }
2318
2319 sub _draw_legend_vertical {
2320   my ($self, $img, $labels, $chart_box) = @_;
2321
2322   defined(my $padding = $self->_get_integer('legend.padding'))
2323     or return;
2324   my $patchsize = $self->_get_integer('legend.patchsize')
2325     or return;
2326   defined(my $gap = $self->_get_integer('legend.patchgap'))
2327     or return;
2328   my $minrowsize = $patchsize + $gap;
2329   my ($width, $height) = (0,0);
2330   my @sizes;
2331   for my $label (@$labels) {
2332     my @box = $self->_text_bbox($label, 'legend')
2333       or return;
2334     push(@sizes, \@box);
2335     $width = $box[2] if $box[2] > $width;
2336     if ($minrowsize > $box[3]) {
2337       $height += $minrowsize;
2338     }
2339     else {
2340       $height += $box[3];
2341     }
2342   }
2343   my @box = (0, 0,
2344              $width + $patchsize + $padding * 2 + $gap,
2345              $height + $padding * 2 - $gap);
2346   my $outsidepadding = 0;
2347   if ($self->{_style}{legend}{border}) {
2348     defined($outsidepadding = $self->_get_integer('legend.outsidepadding'))
2349       or return;
2350     $box[2] += 2 * $outsidepadding;
2351     $box[3] += 2 * $outsidepadding;
2352   }
2353   $self->_align_box(\@box, $chart_box, 'legend')
2354     or return;
2355   if ($self->{_style}{legend}{fill}) {
2356     $img->box(xmin=>$box[0]+$outsidepadding,
2357               ymin=>$box[1]+$outsidepadding,
2358               xmax=>$box[2]-$outsidepadding,
2359               ymax=>$box[3]-$outsidepadding,
2360              $self->_get_fill('legend.fill', \@box));
2361   }
2362   $box[0] += $outsidepadding;
2363   $box[1] += $outsidepadding;
2364   $box[2] -= $outsidepadding;
2365   $box[3] -= $outsidepadding;
2366   my $ypos = $box[1] + $padding;
2367   my $patchpos = $box[0]+$padding;
2368   my $textpos = $patchpos + $patchsize + $gap;
2369   my %text_info = $self->_text_style('legend')
2370     or return;
2371   my $patchborder;
2372   if ($self->{_style}{legend}{patchborder}) {
2373     $patchborder = $self->_get_color('legend.patchborder')
2374       or return;
2375   }
2376   my $dataindex = 0;
2377   for my $label (@$labels) {
2378     my @patchbox = ( $patchpos - $patchsize/2, $ypos - $patchsize/2,
2379                      $patchpos + $patchsize * 3 / 2, $ypos + $patchsize*3/2 );
2380
2381     my @fill;
2382     if ($self->_draw_flat_legend()) {
2383       @fill = (color => $self->_data_color($dataindex), filled => 1);
2384     }
2385     else {
2386       @fill = $self->_data_fill($dataindex, \@patchbox)
2387         or return;
2388     }
2389     $img->box(xmin=>$patchpos, ymin=>$ypos, xmax=>$patchpos + $patchsize,
2390                ymax=>$ypos + $patchsize, @fill);
2391     if ($self->{_style}{legend}{patchborder}) {
2392       $img->box(xmin=>$patchpos, ymin=>$ypos, xmax=>$patchpos + $patchsize,
2393                 ymax=>$ypos + $patchsize,
2394                 color=>$patchborder);
2395     }
2396     $img->string(%text_info, x=>$textpos, 'y'=>$ypos + $patchsize,
2397                  text=>$label);
2398
2399     my $step = $patchsize + $gap;
2400     if ($minrowsize < $sizes[$dataindex][3]) {
2401       $ypos += $sizes[$dataindex][3];
2402     }
2403     else {
2404       $ypos += $minrowsize;
2405     }
2406     ++$dataindex;
2407   }
2408   if ($self->{_style}{legend}{border}) {
2409     my $border_color = $self->_get_color('legend.border')
2410       or return;
2411     $img->box(xmin=>$box[0], ymin=>$box[1], xmax=>$box[2], ymax=>$box[3],
2412               color=>$border_color);
2413   }
2414   $self->_remove_box($chart_box, \@box);
2415   1;
2416 }
2417
2418 sub _draw_title {
2419   my ($self, $img, $chart_box) = @_;
2420
2421   my $title = $self->{_style}{title}{text};
2422   my @box = $self->_text_bbox($title, 'title')
2423     or return;
2424   my $yoff = $box[1];
2425   @box[0,1] = (0,0);
2426   $self->_align_box(\@box, $chart_box, 'title');
2427   my %text_info = $self->_text_style('title')
2428     or return;
2429   $img->string(%text_info, x=>$box[0], 'y'=>$box[3] + $yoff, text=>$title);
2430   $self->_remove_box($chart_box, \@box);
2431   1;
2432 }
2433
2434 sub _small_extent {
2435   my ($self, $box) = @_;
2436
2437   if ($box->[2] - $box->[0] > $box->[3] - $box->[1]) {
2438     return $box->[3] - $box->[1];
2439   }
2440   else {
2441     return $box->[2] - $box->[0];
2442   }
2443 }
2444
2445 sub _draw_flat_legend {
2446   return 0;
2447 }
2448
2449 =item _composite()
2450
2451 Returns a list of style fields that are stored as composites, and
2452 should be merged instead of just being replaced.
2453
2454 =cut
2455
2456 sub _composite {
2457   qw(title legend text label dropshadow outline callout graph);
2458 }
2459
2460 sub _filter_region {
2461   my ($self, $img, $left, $top, $right, $bottom, $filter) = @_;
2462
2463   unless (ref $filter) {
2464     my $name = $filter;
2465     $filter = $self->_get_thing($name)
2466       or return;
2467     $filter->{type}
2468       or return $self->_error("no type for filter $name");
2469   }
2470
2471   $left > 0 or $left = 0;
2472   $top > 0 or $top = 0;
2473
2474   my $masked = $img->masked(left=>$left, top=>$top,
2475                             right=>$right, bottom=>$bottom);
2476   $masked->filter(%$filter);
2477 }
2478
2479 =item _line(x1 => $x1, y1 => $y1, ..., style => $style)
2480
2481 Wrapper for line drawing, implements styles Imager doesn't.
2482
2483 Currently styles are limited to horizontal and vertical lines.
2484
2485 =cut
2486
2487 sub _line {
2488   my ($self, %opts) = @_;
2489
2490   my $img = delete $opts{img}
2491     or die "No img supplied to _line()";
2492   my $style = delete $opts{style} || "solid";
2493
2494   if ($style eq "solid" || ($opts{x1} != $opts{x2} && $opts{y1} != $opts{y2})) {
2495     return $img->line(%opts);
2496   }
2497   elsif ($style eq 'dashed' || $style eq 'dotted') {
2498     my ($x1, $y1, $x2, $y2) = delete @opts{qw/x1 y1 x2 y2/};
2499     # the line is vertical or horizontal, so swapping doesn't hurt
2500     $x1 > $x2 and ($x1, $x2) = ($x2, $x1);
2501     $y1 > $y2 and ($y1, $y2) = ($y2, $y1);
2502     my ($stepx, $stepy) = ( 0, 0 );
2503     my $step_size = $style eq "dashed" ? 8 : 2;
2504     my ($counter, $count_end);
2505     if ($x1 == $x2) {
2506       $stepy = $step_size;
2507       ($counter, $count_end) = ($y1, $y2);
2508     }
2509     else {
2510       $stepx = $step_size;
2511       ($counter, $count_end) = ($x1, $x2);
2512     }
2513     my ($x, $y) = ($x1, $y1);
2514     while ($counter < $count_end) {
2515       if ($style eq "dotted") {
2516         $img->setpixel(x => $x, y => $y, color => $opts{color});
2517       }
2518       else {
2519         my $xe = $stepx ? $x + $stepx / 2 - 1 : $x;
2520         $xe > $x2 and $xe = $x2;
2521         my $ye = $stepy ? $y + $stepy / 2 - 1 : $y;
2522         $ye > $y2 and $ye = $y2;
2523         $img->line(x1 => $x, y1 => $y, x2 => $xe, y2 => $ye, %opts);
2524       }
2525       $counter += $step_size;
2526       $x += $stepx;
2527       $y += $stepy;
2528     }
2529
2530     return 1;
2531   }
2532   else {
2533     $self->_error("Unknown line style $style");
2534     return;
2535   }
2536 }
2537
2538 =item _box(xmin ..., style => $style)
2539
2540 A wrapper for drawing styled box outlines.
2541
2542 =cut
2543
2544 sub _box {
2545   my ($self, %opts) = @_;
2546
2547   my $style = delete $opts{style} || "solid";
2548   my $img = delete $opts{img}
2549     or die "No img supplied to _box";
2550
2551   if ($style eq "solid") {
2552     return $img->box(%opts);
2553   }
2554   else {
2555     my $box = delete $opts{box};
2556     # replicate Imager's defaults
2557     my %work_opts = ( xmin => 0, ymin => 0, xmax => $img->getwidth() - 1, ymax => $img->getheight() -1, %opts, style => $style, img => $img );
2558     my ($xmin, $ymin, $xmax, $ymax) = delete @work_opts{qw/xmin ymin xmax ymax/};
2559     if ($box) {
2560       ($xmin, $ymin, $xmax, $ymax) = @$box;
2561     }
2562     $xmin > $xmax and ($xmin, $xmax) = ($xmax, $xmin);
2563     $ymin > $ymax and ($ymin, $ymax) = ($ymax, $ymin);
2564
2565     if ($xmax - $xmin > 1) {
2566       $self->_line(x1 => $xmin+1, y1 => $ymin, x2 => $xmax-1, y2 => $ymin, %work_opts);
2567       $self->_line(x1 => $xmin+1, y1 => $ymax, x2 => $xmax-1, y2 => $ymax, %work_opts);
2568     }
2569     $self->_line(x1 => $xmin, y1 => $ymin, x2 => $xmin, y2 => $ymax, %work_opts);
2570     return $self->_line(x1 => $xmax, y1 => $ymin, x2 => $xmax, y2 => $ymax, %work_opts);
2571   }
2572 }
2573
2574 =item _feature_enabled($feature_name)
2575
2576 Check if the given feature is enabled in the work style.
2577
2578 =cut
2579
2580 sub _feature_enabled {
2581   my ($self, $name) = @_;
2582
2583   return $self->{_style}{features}{$name};
2584 }
2585
2586 sub _line_marker {
2587   my ($self, $index) = @_;
2588
2589   my $markers = $self->{'_style'}{'line_markers'};
2590   if (!$markers) {
2591     return;
2592   }
2593   my $marker = $markers->[$index % @$markers];
2594
2595   return $marker;
2596 }
2597
2598 sub _draw_line_marker {
2599   my $self = shift;
2600   my ($x1, $y1, $series_counter) = @_;
2601
2602   my $img = $self->_get_image();
2603
2604   my $style = $self->_line_marker($series_counter);
2605   return unless $style;
2606
2607   my $type = $style->{'shape'};
2608   my $radius = $style->{'radius'};
2609
2610   my $line_aa = $self->_get_number("lineaa");
2611   my $fill_aa = $self->_get_number("fill.aa");
2612
2613   if ($type eq 'circle') {
2614     my @fill = $self->_data_fill($series_counter, [$x1 - $radius, $y1 - $radius, $x1 + $radius, $y1 + $radius]);
2615     $img->circle(x => $x1, y => $y1, r => $radius, aa => $fill_aa, filled => 1, @fill);
2616   }
2617   elsif ($type eq 'open_circle') {
2618     my $color = $self->_data_color($series_counter);
2619     $img->circle(x => $x1, y => $y1, r => $radius, aa => $fill_aa, filled => 0, color => $color);
2620   }
2621   elsif ($type eq 'open_square') {
2622     my $color = $self->_data_color($series_counter);
2623     $img->box(xmin => $x1 - $radius, ymin => $y1 - $radius, xmax => $x1 + $radius, ymax => $y1 + $radius, filled => 0, color => $color);
2624   }
2625   elsif ($type eq 'open_triangle') {
2626     my $color = $self->_data_color($series_counter);
2627     $img->polyline(
2628         points => [
2629                     [$x1 - $radius, $y1 + $radius],
2630                     [$x1 + $radius, $y1 + $radius],
2631                     [$x1, $y1 - $radius],
2632                     [$x1 - $radius, $y1 + $radius],
2633                   ],
2634         color => $color, aa => $line_aa);
2635   }
2636   elsif ($type eq 'open_diamond') {
2637     my $color = $self->_data_color($series_counter);
2638     $img->polyline(
2639         points => [
2640                     [$x1 - $radius, $y1],
2641                     [$x1, $y1 + $radius],
2642                     [$x1 + $radius, $y1],
2643                     [$x1, $y1 - $radius],
2644                     [$x1 - $radius, $y1],
2645                   ],
2646                   color => $color, aa => $line_aa);
2647   }
2648   elsif ($type eq 'square') {
2649     my @fill = $self->_data_fill($series_counter, [$x1 - $radius, $y1 - $radius, $x1 + $radius, $y1 + $radius]);
2650     $img->box(xmin => $x1 - $radius, ymin => $y1 - $radius, xmax => $x1 + $radius, ymax => $y1 + $radius, @fill);
2651   }
2652   elsif ($type eq 'diamond') {
2653     # The gradient really doesn't work for diamond
2654     my $color = $self->_data_color($series_counter);
2655     $img->polygon(
2656         points => [
2657                     [$x1 - $radius, $y1],
2658                     [$x1, $y1 + $radius],
2659                     [$x1 + $radius, $y1],
2660                     [$x1, $y1 - $radius],
2661                   ],
2662         filled => 1, color => $color, aa => $fill_aa);
2663   }
2664   elsif ($type eq 'triangle') {
2665     # The gradient really doesn't work for triangle
2666     my $color = $self->_data_color($series_counter);
2667     $img->polygon(
2668         points => [
2669                     [$x1 - $radius, $y1 + $radius],
2670                     [$x1 + $radius, $y1 + $radius],
2671                     [$x1, $y1 - $radius],
2672                   ],
2673         filled => 1, color => $color, aa => $fill_aa);
2674
2675   }
2676   elsif ($type eq 'x') {
2677     my $color = $self->_data_color($series_counter);
2678     $img->line(x1 => $x1 - $radius, y1 => $y1 -$radius, x2 => $x1 + $radius, y2 => $y1+$radius, aa => $line_aa, color => $color) || die $img->errstr;
2679     $img->line(x1 => $x1 + $radius, y1 => $y1 -$radius, x2 => $x1 - $radius, y2 => $y1+$radius, aa => $line_aa, color => $color) || die $img->errstr;
2680   }
2681   elsif ($type eq 'plus') {
2682     my $color = $self->_data_color($series_counter);
2683     $img->line(x1 => $x1, y1 => $y1 -$radius, x2 => $x1, y2 => $y1+$radius, aa => $line_aa, color => $color) || die $img->errstr;
2684     $img->line(x1 => $x1 + $radius, y1 => $y1, x2 => $x1 - $radius, y2 => $y1, aa => $line_aa, color => $color) || die $img->errstr;
2685   }
2686 }
2687
2688 1;
2689
2690 __END__
2691
2692 =back
2693
2694 =head1 SEE ALSO
2695
2696 Imager::Graph::Pie(3), Imager(3), perl(1).
2697
2698 =head1 AUTHOR
2699
2700 Tony Cook <tony@develop-help.com>
2701
2702 =head1 LICENSE
2703
2704 Imager::Graph is licensed under the same terms as perl itself.
2705
2706 =head1 BLAME
2707
2708 Addi for producing a cool imaging module. :)
2709
2710 =cut