Graph.pm

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