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