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 =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.05';
  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 $img = $graph->draw(data=>\@data,
  74                          title=>{ text=>"Hello, World!",
  75                                   size=>36,
  76                                   color=>'FF0000' });
  77
  78 When referring to a single sub-value this documentation will refer to
  79 'title.color' rather than 'the color element of title'.
  80
  81 Returns the graph image on success, or false on failure.
  82
  83 =back
  84
  85 =head1 STYLES
  86
  87 The currently defined styles are:
  88
  89 =over
  90
  91 =item primary_red
  92
  93 a light red background with no outlines.  Uses primary colors for the
  94 data fills.  This style is compatible with all versions of Imager.
  95
  96 Graphs drawn using this style should save well as a gif, even though
  97 some graphs may perform a slight blur.
  98
  99 This is the default style.
 100
 101 =item mono
 102
 103 designed for monochrome output, such as most laser printers, this uses
 104 hatched fills for the data, and no colors.  The returned image is a
 105 one channel image (which can be overridden with the C<channels>
 106 parameter.)
 107
 108 You can also override the colors used by all components for background
 109 or drawing by supplying C<fg> and/or C<bg> parameters.  ie.  if you
 110 supply C<<fg=>'FF0000', channels=>3>> then the hash fills and anything
 111 else will be drawn in red.  Another use might be to set a transparent
 112 background, by supplying C<<bg=>'00000000', channels=>4>>.
 113
 114 This style outlines the legend if present and outlines the hashed fills.
 115
 116 This and following styles require versions of Imager after 0.38.
 117
 118 =item fount_lin
 119
 120 designed as a "pretty" style this uses linear fountain fills for the
 121 background and data fills, and adds a drop shadow.
 122
 123 You can override the value used for text and outlines by setting the
 124 C<fg> parameter.
 125
 126 =item fount_rad
 127
 128 also designed as a "pretty" style this uses radial fountain fills for
 129 the data and a linear blue to green fill for the background.
 130
 131 =back
 132
 133 =head1 FEATURES
 134
 135 Each graph type has a number of features.  These are used to add
 136 various items that are displayed in the graph area.  Some common
 137 features are:
 138
 139 =over
 140
 141 =item legend
 142
 143 adds a box containing boxes filled with the data filess, with
 144 the labels provided to the draw method.  The legend will only be
 145 displayed if both the legend feature is enabled and labels are
 146 supplied.
 147
 148 =item labels
 149
 150 labels each data fill, usually by including text inside the data fill.
 151 If the text does not fit in the fill, they could be displayed in some
 152 other form, eg. as callouts in a pie graph.  There usually isn't much
 153 point in including both labels and a legend.
 154
 155 =item dropshadow
 156
 157 a simple drop shadow is shown behind some of the graph elements.
 158
 159 =back
 160
 161 Each graph also has features specific to that graph.
 162
 163 =head1 COMMON PARAMETERS
 164
 165 When referring to a single sub-value this documentation will refer to
 166 'title.color' rather than 'the color element of title'.
 167
 168 Normally, except for the font parameter, these are controlled by
 169 styles, but these are the style parameters I'd mostly likely expect
 170 you want to use:
 171
 172 =over
 173
 174 =item font
 175
 176 the Imager font object used to draw text on the chart.
 177
 178 =item back
 179
 180 the background fill for the graph.  Default depends on the style.
 181
 182 =item size
 183
 184 the base size of the graph image.  Default: 256
 185
 186 =item width
 187
 188 the width of the graph image.  Default: 1.5 * size (384)
 189
 190 =item height
 191
 192 the height of the graph image.  Default: size (256)
 193
 194 =item channels
 195
 196 the number of channels in the image.  Default: 3 (the 'mono' style
 197 sets this to 1).
 198
 199 =item line
 200
 201 the color used for drawing lines, such as outlines or callouts.
 202 Default depends on the current style.  Set to undef to remove the
 203 outline from a style.
 204
 205 =item title
 206
 207 the text used for a graph title.  Default: no title.  Note: this is
 208 the same as the title=>{ text => ... } field.
 209
 210 =over
 211
 212 =item halign
 213
 214 horizontal alignment of the title in the graph, one of 'left',
 215 'center' or 'right'. Default: center
 216
 217 =item valign
 218
 219 vertical alignment of the title, one of 'top', 'center' or 'right'.
 220 Default: top.  It's probably a bad idea to set this to 'center' unless
 221 you have a very short title.
 222
 223 =back
 224
 225 =item text
 226
 227 This contains basic defaults used in drawing text.
 228
 229 =over
 230
 231 =item color
 232
 233 the default color used for all text, defaults to the fg color.
 234
 235 =item size
 236
 237 the base size used for text, also used to scale many graph elements.
 238 Default: 14.
 239
 240 =back
 241
 242 =back
 243
 244 =head1 BEYOND STYLES
 245
 246 In most cases you will want to use just the styles, but you may want
 247 to exert more control over the way your chart looks.  This section
 248 describes the options you can use to control the way your chart looks.
 249
 250 Hopefully you don't need to read this.
 251
 252 =over
 253
 254 =item back
 255
 256 The background of the graph.
 257
 258 =item bg
 259
 260 =item fg
 261
 262 Used to define basic background and foreground colors for the graph.
 263 The bg color may be used for the background of the graph, and is used
 264 as a default for the background of hatcheed fills.  The fg is used as
 265 the default for line and text colors.
 266
 267 =item font
 268
 269 The default font used by the graph.  Normally you should supply this
 270 if your graph as any text.
 271
 272 =item line
 273
 274 The default line color.
 275
 276 =item text
 277
 278 defaults for drawing text.  Other textual graph elements will inherit
 279 or modify these values.
 280
 281 =over
 282
 283 =item color
 284
 285 default text color, defaults to the I<fg> color.
 286
 287 =item size
 288
 289 default text size. Default: 14.  This is used to scale many graph
 290 elements, including padding and leader sizes.  Other text elements
 291 will either use or scale this value.
 292
 293 =item font
 294
 295 default font object.  Inherited from I<font>, which should have been
 296 supplied by the caller.
 297
 298 =back
 299
 300 =item title
 301
 302 If you supply a scalar value for this element, it will be stored in
 303 the I<text> field.
 304
 305 Defines the text, font and layout information for the title.
 306
 307 =over
 308
 309 =item color
 310
 311 The color of the title, inherited from I<text.color>.
 312
 313 =item font
 314
 315 The font object used for the title, inherited from I<text.font>.
 316
 317 =item size
 318
 319 size of the title text. Default: double I<text.size>
 320
 321 =item halign
 322
 323 =item valign
 324
 325 The horizontal and vertical alignment of the title.
 326
 327 =back
 328
 329 =item legend
 330
 331 defines attributes of the graph legend, if present.
 332
 333 =over
 334
 335 =item color
 336
 337 =item font
 338
 339 =item size
 340
 341 text attributes for the labels used in the legend.
 342
 343 =item patchsize
 344
 345 the width and height of the color patch in the legend.  Defaults to
 346 90% of the legend text size.
 347
 348 =item patchgap
 349
 350 the minimum gap between patches in pixels.  Defaults to 30% of the
 351 patchsize.
 352
 353 =item patchborder
 354
 355 the color of the border drawn around each patch.  Inherited from I<line>.
 356
 357 =item halign
 358
 359 =item valign
 360
 361 the horizontal and vertical alignment of the legend within the graph.
 362 Defaults to 'right' and 'top'.
 363
 364 =item padding
 365
 366 the gap between the legend patches and text and the outside of it's
 367 box, or to the legend border, if any.
 368
 369 =item outsidepadding
 370
 371 the gap between the border and the outside of the legend's box.  This
 372 is only used if the I<legend.border> attribute is defined.
 373
 374 =item fill
 375
 376 the background fill for the legend.  Default: none
 377
 378 =item border
 379
 380 the border color of the legend.  Default: none (no border is drawn
 381 around the legend.)
 382
 383 =back
 384
 385 =item callout
 386
 387 defines attributes for graph callouts, if any are present.  eg. if the
 388 pie graph cannot fit the label into the pie graph segement it will
 389 present it as a callout.
 390
 391 =over
 392
 393 =item color
 394
 395 =item font
 396
 397 =item size
 398
 399 the text attributes of the callout label.  Inherited from I<text>.
 400
 401 =item line
 402
 403 the color of the callout lines.  Inherited from I<line>
 404
 405 =item inside
 406
 407 =item outside
 408
 409 the length of the leader on the inside and the outside of the fill,
 410 usually at some angle.  Both default to the size of the callout text.
 411
 412 =item leadlen
 413
 414 the length of the horizontal portion of the leader.  Default:
 415 I<callout.size>.
 416
 417 =item gap
 418
 419 the gap between the callout leader and the callout text.  Defaults to
 420 30% of the text callout size.
 421
 422 =back
 423
 424 =item label
 425
 426 defines attributes for labels drawn into the data areas of a graph.
 427
 428 =over
 429
 430 =item color
 431
 432 =item font
 433
 434 =item size
 435
 436 The text attributes of the labels.  Inherited from I<text>.
 437
 438 =back
 439
 440 =item dropshadow
 441
 442 the attributes of the graph's drop shadow
 443
 444 =over
 445
 446 =item fill
 447
 448 the fill used for the drop shadow.  Default: '404040' (dark gray)
 449
 450 =item off
 451
 452 the offset of the drop shadow.  A convenience value inherited by offx
 453 and offy.  Default: 40% of I<text.size>.
 454
 455 =item offx
 456
 457 =item offy
 458
 459 the horizontal and vertical offsets of the drop shadow.  Both
 460 inherited from I<dropshadow.off>.
 461
 462 =item filter
 463
 464 the filter description passed to Imager's filter method to blur the
 465 drop shadow.  Default: an 11 element convolution filter.
 466
 467 =back
 468
 469 =item outline
 470
 471 describes the lines drawn around filled data areas, such as the
 472 segments of a pie chart.
 473
 474 =over
 475
 476 =item line
 477
 478 the line color of the outlines, inherited from I<line>.
 479
 480 =back
 481
 482 =item fills
 483
 484 a reference to an array containing fills for each data item.
 485
 486 You can mix fill types, ie. using a simple color for the first item, a
 487 hatched fill for the second and a fountain fill for the next.
 488
 489 =back
 490
 491 =head1 HOW VALUES WORK
 492
 493 Internally rather than specifying literal color, fill, or font objects
 494 or literal sizes for each element, Imager::Graph uses a number of
 495 special values to inherit or modify values taken from other graph
 496 element names.
 497
 498 =head2 Specifying colors
 499
 500 You can specify colors by either supplying an Imager::Color object, by
 501 supplying lookup of another color, or by supplying a single value that
 502 Imager::Color::new can use as an initializer.  The most obvious is
 503 just a 6 or 8 digit hex value representing the red, green, blue and
 504 optionally alpha channels of the image.
 505
 506 You can lookup another color by using the lookup() "function", for
 507 example if you give a color as "lookup(fg)" then Imager::Graph will
 508 look for the fg element in the current style (or as overridden by
 509 you.)  This is used internally by Imager::Graph to set up the
 510 relationships between the colors of various elements, for example the
 511 default style information contains:
 512
 513    text=>{
 514           color=>'lookup(fg)',
 515           ...
 516          },
 517    legend =>{
 518              color=>'lookup(text.color)',
 519              ...
 520             },
 521
 522 So by setting the I<fg> color, you also set the default text color,
 523 since each text element uses lookup(text.color) as its value.
 524
 525 =head2 Specifying fills
 526
 527 Fills can be used for the graph background color, the background color
 528 for the legend block and for the fills used for each data element.
 529
 530 You can specify a fill as a L<color value|Specifying colors> or as a
 531 general fill, see L<Imager::Fill> for details.  To use a general fill
 532 you need a version of Imager after 0.38.
 533
 534 You don't need (or usually want) to call Imager::Fill::new yourself,
 535 since the various fill functions will call it for you, and
 536 Imager::Graph provides some hooks to make them more useful.
 537
 538 =over
 539
 540 =item *
 541
 542 with hatched fills, if you don't supply a 'fg' or 'bg' parameter,
 543 Imager::Graph will supply the current graph fg and bg colors.
 544
 545 =item *
 546
 547 with fountain fill, you can supply the xa_ratio, ya_ratio, xb_ratio
 548 and yb_ratio parameters, and they will be scaled in the fill area to
 549 define the fountain fills xa, ya, xb and yb parameters.
 550
 551 =back
 552
 553 As with colors, you can use lookup(name) or lookup(name1.name2) to
 554 have one element to inherit the fill of another.
 555
 556 =head2 Specifying numbers
 557
 558 You can specify various numbers, usually representing the size of
 559 something, commonly text, but sometimes the length of a line or the
 560 size of a gap.
 561
 562 You can use the same lookup mechanism as with colors and fills, but
 563 you can also scale values.  For example, 'scale(0.5,text.size)' will
 564 return half the size of the normal text size.
 565
 566 As with colors, this is used internally to scale graph elements based
 567 on the base text size.  If you change the base text size then other
 568 graph elements will scale as well.
 569
 570 =head2 Specifying other elements
 571
 572 Other elements, such as fonts, or parameters for a filter, can also
 573 use the lookup(name) mechanism.
 574
 575 =head1 INTERNAL METHODS
 576
 577 Only useful if you need to fix bugs, add features or create a new
 578 graph class.
 579
 580 =over
 581
 582 =cut
 583
 584 my %style_defs =
 585   (
 586    back=> 'lookup(bg)',
 587    line=> 'lookup(fg)',
 588    text=>{
 589           color => 'lookup(fg)',
 590           font  => 'lookup(font)',
 591           size  => 14,
 592          },
 593    title=>{
 594            color  => 'lookup(text.color)',
 595            font   => 'lookup(text.font)',
 596            halign => 'center',
 597            valign => 'top',
 598            size   => 'scale(text.size,2.0)',
 599           },
 600    legend =>{
 601              color          => 'lookup(text.color)',
 602              font           => 'lookup(text.font)',
 603              size           => 'lookup(text.size)',
 604              patchsize      => 'scale(legend.size,0.9)',
 605              patchgap       => 'scale(legend.patchsize,0.3)',
 606              patchborder    => 'lookup(line)',
 607              halign         => 'right',
 608              valign         => 'top',
 609              padding        => 'scale(legend.size,0.3)',
 610              outsidepadding => 'scale(legend.padding,0.4)',
 611             },
 612    callout => {
 613                color    => 'lookup(text.color)',
 614                font     => 'lookup(text.font)',
 615                size     => 'lookup(text.size)',
 616                line     => 'lookup(line)',
 617                inside   => 'lookup(callout.size)',
 618                outside  => 'lookup(callout.size)',
 619                leadlen  => 'scale(0.8,callout.size)',
 620                gap      => 'scale(callout.size,0.3)',
 621               },
 622    label => {
 623              font          => 'lookup(text.font)',
 624              size          => 'lookup(text.size)',
 625              color         => 'lookup(text.color)',
 626              hpad          => 'lookup(label.pad)',
 627              vpad          => 'lookup(label.pad)',
 628              pad           => 'scale(label.size,0.2)',
 629              pcformat      => sub { sprintf "%s (%.0f%%)", $_[0], $_[1] },
 630              pconlyformat  => sub { sprintf "%.1f%%", $_[0] },
 631              },
 632    dropshadow => {
 633                   fill    => '404040',
 634                   off     => 'scale(0.4,text.size)',
 635                   offx    => 'lookup(dropshadow.off)',
 636                   offy    => 'lookup(dropshadow.off)',
 637                   filter  => { type=>'conv',
 638                               # this needs a fairly heavy blur
 639                               coef=>[0.1, 0.2, 0.4, 0.6, 0.7, 0.9, 1.2,
 640                                      0.9, 0.7, 0.6, 0.4, 0.2, 0.1 ] },
 641                  },
 642    outline => {
 643                line =>'lookup(line)',
 644               },
 645    size=>256,
 646    width=>'scale(1.5,size)',
 647    height=>'lookup(size)',
 648   );
 649
 650 =item _error($message)
 651
 652 Sets the error field of the object and returns an empty list or undef,
 653 depending on context.  Should be used for error handling, since it may
 654 provide some user hooks at some point.
 655
 656 =cut
 657
 658 sub _error {
 659   my ($self, $error) = @_;
 660
 661   $self->{_errstr} = $error;
 662
 663   return;
 664 }
 665
 666
 667 =item _style_defs()
 668
 669 Returns the style defaults, such as the relationships between line
 670 color and text color.
 671
 672 Intended to be over-ridden by base classes to provide graph specific
 673 defaults.
 674
 675 =cut
 676
 677 sub _style_defs {
 678   \%style_defs;
 679 }
 680
 681 my $def_style = 'primary_red';
 682
 683 my %styles =
 684   (
 685    primary_red =>
 686    {
 687     fills=>
 688     [
 689      qw(FF0000 00FF00 0000FF C0C000 00C0C0 FF00FF)
 690     ],
 691     fg=>'000000',
 692     bg=>'C08080',
 693     legend=>
 694     {
 695      patchborder=>'000000'
 696     },
 697    },
 698    mono =>
 699    {
 700     fills=>
 701     [
 702      { hatch=>'slash2' },
 703      { hatch=>'slosh2' },
 704      { hatch=>'vline2' },
 705      { hatch=>'hline2' },
 706      { hatch=>'cross2' },
 707      { hatch=>'grid2' },
 708      { hatch=>'stipple3' },
 709      { hatch=>'stipple2' },
 710     ],
 711     channels=>1,
 712     bg=>'FFFFFF',
 713     fg=>'000000',
 714     features=>{ outline=>1 },
 715     pie =>{
 716            blur=>undef,
 717           },
 718    },
 719    fount_lin =>
 720    {
 721     fills=>
 722     [
 723      { fountain=>'linear',
 724        xa_ratio=>0.13, ya_ratio=>0.13, xb_ratio=>0.87, yb_ratio=>0.87,
 725        repeat=>'sawtooth',
 726        segments => Imager::Fountain->simple(positions=>[0, 1],
 727                                             colors=>[ NC('FFC0C0'), NC('FF0000') ]),
 728      },
 729      { fountain=>'linear',
 730        xa_ratio=>0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0,
 731        segments => Imager::Fountain->simple(positions=>[0, 1],
 732                                             colors=>[ NC('C0FFC0'), NC('00FF00') ]),
 733      },
 734      { fountain=>'linear',
 735        xa_ratio=>0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0,
 736        segments => Imager::Fountain->simple(positions=>[0, 1],
 737                                             colors=>[ NC('C0C0FF'), NC('0000FF') ]),
 738      },
 739      { fountain=>'linear',
 740        xa_ratio=>0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0,
 741        segments => Imager::Fountain->simple(positions=>[0, 1],
 742                                             colors=>[ NC('FFFFC0'), NC('FFFF00') ]),
 743      },
 744      { fountain=>'linear',
 745        xa_ratio=>0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0,
 746        segments => Imager::Fountain->simple(positions=>[0, 1],
 747                                             colors=>[ NC('C0FFFF'), NC('00FFFF') ]),
 748      },
 749      { fountain=>'linear',
 750        xa_ratio=>0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0,
 751        segments => Imager::Fountain->simple(positions=>[0, 1],
 752                                             colors=>[ NC('FFC0FF'), NC('FF00FF') ]),
 753      },
 754     ],
 755     back=>{ fountain=>'linear',
 756             xa_ratio=>0, ya_ratio=>0,
 757             xb_ratio=>1.0, yb_ratio=>1.0,
 758             segments=>Imager::Fountain->simple
 759             ( positions=>[0, 1],
 760               colors=>[ NC('6060FF'), NC('60FF60') ]) },
 761     fg=>'000000',
 762     bg=>'FFFFFF',
 763     features=>{ dropshadow=>1 },
 764    },
 765    fount_rad =>
 766    {
 767     fills=>
 768     [
 769      { fountain=>'radial',
 770        xa_ratio=>0.5, ya_ratio=>0.5, xb_ratio=>1.0, yb_ratio=>0.5,
 771        segments => Imager::Fountain->simple(positions=>[0, 1],
 772                                             colors=>[ NC('FF8080'), NC('FF0000') ]),
 773      },
 774      { fountain=>'radial',
 775        xa_ratio=>0.5, ya_ratio=>0.5, xb_ratio=>1.0, yb_ratio=>0.5,
 776        segments => Imager::Fountain->simple(positions=>[0, 1],
 777                                             colors=>[ NC('80FF80'), NC('00FF00') ]),
 778      },
 779      { fountain=>'radial',
 780        xa_ratio=>0.5, ya_ratio=>0.5, xb_ratio=>1.0, yb_ratio=>0.5,
 781        segments => Imager::Fountain->simple(positions=>[0, 1],
 782                                             colors=>[ NC('808080FF'), NC('0000FF') ]),
 783      },
 784      { fountain=>'radial',
 785        xa_ratio=>0.5, ya_ratio=>0.5, xb_ratio=>1.0, yb_ratio=>0.5,
 786        segments => Imager::Fountain->simple(positions=>[0, 1],
 787                                             colors=>[ NC('FFFF80'), NC('FFFF00') ]),
 788      },
 789      { fountain=>'radial',
 790        xa_ratio=>0.5, ya_ratio=>0.5, xb_ratio=>1.0, yb_ratio=>0.5,
 791        segments => Imager::Fountain->simple(positions=>[0, 1],
 792                                             colors=>[ NC('80FFFF'), NC('00FFFF') ]),
 793      },
 794      { fountain=>'radial',
 795        xa_ratio=>0.5, ya_ratio=>0.5, xb_ratio=>1.0, yb_ratio=>0.5,
 796        segments => Imager::Fountain->simple(positions=>[0, 1],
 797                                             colors=>[ NC('FF80FF'), NC('FF00FF') ]),
 798      },
 799     ],
 800     back=>{ fountain=>'linear',
 801             xa_ratio=>0, ya_ratio=>0,
 802             xb_ratio=>1.0, yb_ratio=>1.0,
 803             segments=>Imager::Fountain->simple
 804             ( positions=>[0, 1],
 805               colors=>[ NC('6060FF'), NC('60FF60') ]) },
 806     fg=>'000000',
 807     bg=>'FFFFFF',
 808    }
 809   );
 810
 811 =item $self->_style_setup(\%opts)
 812
 813 Uses the values from %opts to build a customized hash describing the
 814 way the graph should be drawn.
 815
 816 =cut
 817
 818 sub _style_setup {
 819   my ($self, $opts) = @_;
 820   my $style_defs = $self->_style_defs;
 821   my $style;
 822   $style = $styles{$opts->{style}} if $opts->{style};
 823   $style ||= $styles{$def_style};
 824
 825   my @search_list = ( $style_defs, $style, $opts);
 826   my %work;
 827
 828   my @composite = $self->_composite();
 829   my %composite;
 830   @composite{@composite} = @composite;
 831
 832   for my $src (@search_list) {
 833     for my $key (keys %$src) {
 834       if ($composite{$key}) {
 835         $work{$key} = {} unless exists $work{$key};
 836         if (ref $src->{$key}) {
 837           # some keys have sub values, especially text
 838           @{$work{$key}}{keys %{$src->{$key}}} = values %{$src->{$key}};
 839         }
 840         else {
 841           # assume it's the text for a title or something
 842           $work{$key}{text} = $src->{$key};
 843         }
 844       }
 845       else {
 846         $work{$key} = $src->{$key};
 847       }
 848     }
 849   }
 850
 851   # features are handled specially
 852   $work{features} = {};
 853   for my $src (@search_list) {
 854     if ($src->{features}) {
 855       if (ref $src->{features}) {
 856         if (ref($src->{features}) =~ /ARRAY/) {
 857           # just set those features
 858           for my $feature (@{$src->{features}}) {
 859             $work{features}{$feature} = 1;
 860           }
 861         }
 862         elsif (ref($src->{features}) =~ /HASH/) {
 863           if ($src->{features}{reset}) {
 864             $work{features} = {}; # only the ones the user specifies
 865           }
 866           @{$work{features}}{keys %{$src->{features}}} =
 867             values(%{$src->{features}});
 868         }
 869       }
 870       else {
 871         # just set that single feature
 872         $work{features}{$src->{features}} = 1;
 873       }
 874     }
 875   }
 876   #use Data::Dumper;
 877   #print Dumper(\%work);
 878
 879   $self->{_style} = \%work;
 880 }
 881
 882 =item $self->_get_thing($name)
 883
 884 Retrieve some general 'thing'.
 885
 886 Supports the 'lookup(foo)' mechanism.
 887
 888 =cut
 889
 890 sub _get_thing {
 891   my ($self, $name, @depth) = @_;
 892
 893   push(@depth, $name);
 894   my $what;
 895   if ($name =~ /^(\w+)\.(\w+)$/) {
 896     $what = $self->{_style}{$1}{$2};
 897   }
 898   else {
 899     $what = $self->{_style}{$name};
 900   }
 901   defined $what or
 902     return;
 903   if (ref $what) {
 904     return $what;
 905   }
 906   elsif ($what =~ /^lookup\((\w+(?:\.\w+)?)\)$/) {
 907     @depth < MAX_DEPTH
 908       or return $self->_error("too many levels of recursion in lookup(@depth)");
 909     return $self->_get_thing($1, @depth);
 910   }
 911   else {
 912     return $what;
 913   }
 914 }
 915
 916 =item $self->_get_number($name)
 917
 918 Retrieves a number from the style.  The value in the style can be the
 919 number, or one of two functions:
 920
 921 =over
 922
 923 =item lookup(newname)
 924
 925 Recursively looks up I<newname> in the style.
 926
 927 =item scale(value1,value2)
 928
 929 Each value can be a number or a name.  Names are recursively looks up
 930 in the style and the product is returned.
 931
 932 =back
 933
 934 =cut
 935
 936 sub _get_number {
 937   my ($self, $name, @depth) = @_;
 938
 939   push(@depth, $name);
 940   my $what;
 941   if ($name =~ /^(\w+)\.(\w+)$/) {
 942     $what = $self->{_style}{$1}{$2};
 943   }
 944   else {
 945     $what = $self->{_style}{$name};
 946   }
 947   defined $what or
 948     return $self->_error("$name is undef (@depth)");
 949
 950   if (ref $what) {
 951     if ($what =~ /CODE/) {
 952       $what = $what->($self, $name);
 953     }
 954   }
 955   else {
 956     if ($what =~ /^lookup\(([\w.]+)\)$/) {
 957       @depth < MAX_DEPTH
 958         or return $self->_error("too many levels of recursion in lookup (@depth)");
 959       return $self->_get_number($1, @depth);
 960     }
 961     elsif ($what =~ /^scale\(
 962                     ((?:[a-z][\w.]*)|$NUM_RE)
 963                     ,
 964                     ((?:[a-z][\w.]*)|$NUM_RE)\)$/x) {
 965       my ($left, $right) = ($1, $2);
 966       unless ($left =~ /^$NUM_RE$/) {
 967         @depth < MAX_DEPTH
 968           or return $self->_error("too many levels of recursion in scale (@depth)");
 969         $left = $self->_get_number($left, @depth);
 970       }
 971       unless ($right =~ /^$NUM_RE$/) {
 972         @depth < MAX_DEPTH
 973           or return $self->_error("too many levels of recursion in scale (@depth)");
 974         $right = $self->_get_number($right, @depth);
 975       }
 976       return $left * $right;
 977     }
 978     else {
 979       return $what+0;
 980     }
 981   }
 982 }
 983
 984 =item $self->_get_integer($name)
 985
 986 Retrieves an integer from the style.  This is a simple wrapper around
 987 _get_number() that rounds the result to an integer.
 988
 989 =cut
 990
 991 sub _get_integer {
 992   my ($self, $name, @depth) = @_;
 993
 994   my $number = $self->_get_number($name, @depth)
 995     or return;
 996
 997   return sprintf("%.0f", $number);
 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_integer('legend.padding'))
1291     or return;
1292   my $patchsize = $self->_get_integer('legend.patchsize')
1293     or return;
1294   defined(my $gap = $self->_get_integer('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 LICENSE
1457
1458 Imager::Graph is licensed under the same terms as perl itself.
1459
1460 =head1 BLAME
1461
1462 Addi for producing a cool imaging module. :)
1463
1464 =cut