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