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