Graph.pm

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