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