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