1package Imager::Graph; 2require 5.006; 3 4=head1 NAME 5 6Imager::Graph - Perl extension for producing Graphs using the Imager library. 7 8=head1 SYNOPSIS 9 10 use Imager::Graph::Sub_class; 11 my $chart = Imager::Graph::Sub_class->new; 12 my $img = $chart->draw(data=> \@data, ...) 13 or die $chart->error; 14 $img->write(file => 'image.png'); 15 16=head1 DESCRIPTION 17 18Imager::Graph provides style information to its base classes. It 19defines the colors, text display information and fills based on both 20built-in styles and modifications supplied by the user to the draw() 21method. 22 23=over 24 25=cut 26 27use strict; 28use vars qw($VERSION); 29use Imager qw(:handy); 30use Imager::Fountain; 31 32$VERSION = '0.10'; 33 34# the maximum recursion depth in determining a color, fill or number 35use constant MAX_DEPTH => 10; 36 37my $NUM_RE = '(?:[+-]?(?:\d+(?:\.\d*)?|\.\d+)(?:[eE][+-]\d+?)?)'; 38 39=item new 40 41This is a simple constructor. No parameters required. 42 43=cut 44 45sub new { 46 bless {}, $_[0]; 47} 48 49=item set_graph_size($size) 50 51Sets the size of the graph (in pixels) within the image. The size of the image defaults to 1.5 * $graph_size. 52 53=cut 54 55sub set_graph_size { 56 $_[0]->{'custom_style'}->{'size'} = $_[1]; 57} 58 59=item set_image_width($width) 60 61Sets the width of the image in pixels. 62 63=cut 64 65sub set_image_width { 66 $_[0]->{'custom_style'}->{'width'} = $_[1]; 67} 68 69=item set_image_height($height) 70 71Sets the height of the image in pixels. 72 73=cut 74 75sub set_image_height { 76 $_[0]->{'custom_style'}->{'height'} = $_[1]; 77} 78 79=item add_data_series([8, 6, 7, 5, 3, 0, 9], 'Series Name'); 80 81Adds a data series to the graph. For L<Imager::Graph::Pie>, only one data series can be added. 82 83=cut 84 85sub add_data_series { 86 my $self = shift; 87 my $data_ref = shift; 88 my $series_name = shift; 89 90 my $graph_data = $self->{'graph_data'} || []; 91 92 push @$graph_data, { data => $data_ref, series_name => $series_name }; 93 if (defined $series_name) { 94 push @{$self->{'labels'}}, $series_name; 95 } 96 97 $self->{'graph_data'} = $graph_data; 98 return; 99} 100 101sub _get_data_series { 102 my ($self, $opts) = @_; 103 104 # return the data supplied to draw() if any. 105 if ($opts->{data}) { 106 # one or multiple series? 107 my $data = $opts->{data}; 108 if (@$data && ref $data->[0] && ref $data->[0] =~ /ARRAY/) { 109 return $data; 110 } 111 else { 112 return [ { data => $data } ]; 113 } 114 } 115 116 return $self->{'graph_data'}; 117} 118 119=item set_labels(['label1', 'label2' ... ]) 120 121Labels the specific data points. For line/bar graphs, this is the x-axis. For pie graphs, it is the label for the wedges. 122 123=cut 124 125sub set_labels { 126 $_[0]->{'labels'} = $_[1]; 127} 128 129sub _get_labels { 130 my ($self, $opts) = @_; 131 132 $opts->{labels} 133 and return $opts->{labels}; 134 135 return $_[0]->{'labels'} 136} 137 138=item set_title($title) 139 140Sets the title of the graph. Requires setting a font. 141 142=cut 143 144sub set_title { 145 $_[0]->{'custom_style'}->{'title'}->{'text'} = $_[1]; 146} 147 148=item set_font($font) 149 150Sets the font to use for text. Takes an L<Imager::Font> object. 151 152=cut 153 154sub set_font { 155 $_[0]->{'custom_style'}->{'font'} = $_[1]; 156} 157 158=item set_style($style_name) 159 160Sets the style to be used for the graph. Imager::Graph comes with several pre-defined styles: fount_lin (default), fount_rad, mono, primary_red, and primary. 161 162=cut 163 164sub set_style { 165 $_[0]->{'style'} = $_[1]; 166} 167 168sub _get_style { 169 my ($self, $opts) = @_; 170 171 $opts->{style} 172 and return $opts->{style}; 173 174 return $self->{'style'}; 175} 176 177=item error 178 179Returns an error message. Only valid if the draw() method returns false. 180 181=cut 182 183sub error { 184 $_[0]->{_errstr}; 185} 186 187=item draw 188 189Creates a new image, draws the chart onto that image and returns it. 190 191Optionally, instead of using the api methods to configure your chart, 192you can supply a C<data> parameter in the format 193required by that particular graph, and if your graph will use any 194text, a C<font> parameter 195 196You can also supply many different parameters which control the way 197the graph looks. These are supplied as keyword, value pairs, where 198the value can be a hashref containing sub values. 199 200The C<style> parameter will selects a basic color set, and possibly 201sets other related parameters. See L</"STYLES">. 202 203 my $font = Imager::Font->new(file => 'ImUgly.ttf'); 204 my $img = $chart->draw( 205 data => \@data, 206 font => $font, 207 title => { 208 text => "Hello, World!", 209 size => 36, 210 color => 'FF0000' 211 } 212 ); 213 214When referring to a single sub-value this documentation will refer to 215'title.color' rather than 'the color element of title'. 216 217Returns the graph image on success, or false on failure. 218 219=back 220 221=head1 STYLES 222 223The currently defined styles are: 224 225=over 226 227=item primary 228 229a light grey background with no outlines. Uses primary colors for the 230data fills. 231 232=item primary_red 233 234a light red background with no outlines. Uses primary colors for the 235data fills. 236 237Graphs drawn using this style should save well as a gif, even though 238some graphs may perform a slight blur. 239 240This was the default style, but the red was too loud. 241 242=item mono 243 244designed for monochrome output, such as most laser printers, this uses 245hatched fills for the data, and no colors. The returned image is a 246one channel image (which can be overridden with the C<channels> 247parameter.) 248 249You can also override the colors used by all components for background 250or drawing by supplying C<fg> and/or C<bg> parameters. ie. if you 251supply C<<fg=>'FF0000', channels=>3>> then the hash fills and anything 252else will be drawn in red. Another use might be to set a transparent 253background, by supplying C<<bg=>'00000000', channels=>4>>. 254 255This style outlines the legend if present and outlines the hashed fills. 256 257=item fount_lin 258 259designed as a "pretty" style this uses linear fountain fills for the 260background and data fills, and adds a drop shadow. 261 262You can override the value used for text and outlines by setting the 263C<fg> parameter. 264 265This is the default style. 266 267=item fount_rad 268 269also designed as a "pretty" style this uses radial fountain fills for 270the data and a linear blue to green fill for the background. 271 272=back 273 274=head1 Style API 275 276To set or override styles, you can use the following methods: 277 278=over 4 279 280=item set_image_background 281 282=cut 283 284sub set_image_background { 285 $_[0]->{'custom_style'}->{'back'} = $_[1]; 286} 287 288=item set_channels 289 290=cut 291 292sub set_channels { 293 $_[0]->{'custom_style'}->{'channels'} = $_[1]; 294} 295 296=item set_line_color 297 298=cut 299 300sub set_line_color { 301 $_[0]->{'custom_style'}->{'line'} = $_[1]; 302} 303 304=item set_title_font_size 305 306=cut 307 308sub set_title_font_size { 309 $_[0]->{'custom_style'}->{'title'}->{'size'} = $_[1]; 310} 311 312=item set_title_font_color 313 314=cut 315 316sub set_title_font_color { 317 $_[0]->{'custom_style'}->{'title'}->{'color'} = $_[1]; 318} 319 320=item set_title_horizontal_align 321 322=cut 323 324sub set_title_horizontal_align { 325 $_[0]->{'custom_style'}->{'title'}->{'halign'} = $_[1]; 326} 327 328=item set_title_vertical_align 329 330=cut 331 332sub set_title_vertical_align { 333 $_[0]->{'custom_style'}->{'title'}->{'valign'} = $_[1]; 334} 335 336=item set_text_font_color 337 338=cut 339 340sub set_text_font_color { 341 $_[0]->{'custom_style'}->{'text'}->{'color'} = $_[1]; 342} 343 344=item set_text_font_size 345 346=cut 347 348sub set_text_font_size { 349 $_[0]->{'custom_style'}->{'text'}->{'size'} = $_[1]; 350} 351 352=item set_graph_background_color 353 354=cut 355 356sub set_graph_background_color { 357 $_[0]->{'custom_style'}->{'bg'} = $_[1]; 358} 359 360=item set_graph_foreground_color 361 362=cut 363 364sub set_graph_foreground_color { 365 $_[0]->{'custom_style'}->{'fg'} = $_[1]; 366} 367 368=item set_legend_font_color 369 370=cut 371 372sub set_legend_font_color { 373 $_[0]->{'custom_style'}->{'legend'}->{'color'} = $_[1]; 374} 375 376=item set_legend_font 377 378=cut 379 380sub set_legend_font { 381 $_[0]->{'custom_style'}->{'legend'}->{'font'} = $_[1]; 382} 383 384=item set_legend_font_size 385 386=cut 387 388sub set_legend_font_size { 389 $_[0]->{'custom_style'}->{'legend'}->{'size'} = $_[1]; 390} 391 392=item set_legend_patch_size 393 394=cut 395 396sub set_legend_patch_size { 397 $_[0]->{'custom_style'}->{'legend'}->{'patchsize'} = $_[1]; 398} 399 400=item set_legend_patch_gap 401 402=cut 403 404sub set_legend_patch_gap { 405 $_[0]->{'custom_style'}->{'legend'}->{'patchgap'} = $_[1]; 406} 407 408=item set_legend_horizontal_align 409 410=cut 411 412sub set_legend_horizontal_align { 413 $_[0]->{'custom_style'}->{'legend'}->{'halign'} = $_[1]; 414} 415 416=item set_legend_vertical_align 417 418=cut 419 420sub set_legend_vertical_align { 421 $_[0]->{'custom_style'}->{'legend'}->{'valign'} = $_[1]; 422} 423 424=item set_legend_padding 425 426=cut 427 428sub set_legend_padding { 429 $_[0]->{'custom_style'}->{'legend'}->{'padding'} = $_[1]; 430} 431 432=item set_legend_outside_padding 433 434=cut 435 436sub set_legend_outside_padding { 437 $_[0]->{'custom_style'}->{'legend'}->{'outsidepadding'} = $_[1]; 438} 439 440=item set_legend_fill 441 442=cut 443 444sub set_legend_fill { 445 $_[0]->{'custom_style'}->{'legend'}->{'fill'} = $_[1]; 446} 447 448=item set_legend_border 449 450=cut 451 452sub set_legend_border { 453 $_[0]->{'custom_style'}->{'legend'}->{'border'} = $_[1]; 454} 455 456=item set_legend_orientation 457 458=cut 459 460sub set_legend_orientation { 461 $_[0]->{'custom_style'}->{'legend'}->{'orientation'} = $_[1]; 462} 463 464=item set_callout_font_color 465 466=cut 467 468sub set_callout_font_color { 469 $_[0]->{'custom_style'}->{'callout'}->{'color'} = $_[1]; 470} 471 472=item set_callout_font 473 474=cut 475 476sub set_callout_font { 477 $_[0]->{'custom_style'}->{'callout'}->{'font'} = $_[1]; 478} 479 480=item set_callout_font_size 481 482=cut 483 484sub set_callout_font_size { 485 $_[0]->{'custom_style'}->{'callout'}->{'size'} = $_[1]; 486} 487 488=item set_callout_line_color 489 490=cut 491 492sub set_callout_line_color { 493 $_[0]->{'custom_style'}->{'callout'}->{'line'} = $_[1]; 494} 495 496=item set_callout_leader_inside_length 497 498=cut 499 500sub set_callout_leader_inside_length { 501 $_[0]->{'custom_style'}->{'callout'}->{'inside'} = $_[1]; 502} 503 504=item set_callout_leader_outside_length 505 506=cut 507 508sub set_callout_leader_outside_length { 509 $_[0]->{'custom_style'}->{'callout'}->{'outside'} = $_[1]; 510} 511 512=item set_callout_leader_length 513 514=cut 515 516sub set_callout_leader_length { 517 $_[0]->{'custom_style'}->{'callout'}->{'leadlen'} = $_[1]; 518} 519 520=item set_callout_gap 521 522=cut 523 524sub set_callout_gap { 525 $_[0]->{'custom_style'}->{'callout'}->{'gap'} = $_[1]; 526} 527 528=item set_label_font_color 529 530=cut 531 532sub set_label_font_color { 533 $_[0]->{'custom_style'}->{'label'}->{'color'} = $_[1]; 534} 535 536=item set_label_font 537 538=cut 539 540sub set_label_font { 541 $_[0]->{'custom_style'}->{'label'}->{'font'} = $_[1]; 542} 543 544=item set_label_font_size 545 546=cut 547 548sub set_label_font_size { 549 $_[0]->{'custom_style'}->{'label'}->{'size'} = $_[1]; 550} 551 552=item set_drop_shadow_fill_color 553 554=cut 555 556sub set_drop_shadow_fill_color { 557 $_[0]->{'custom_style'}->{'dropshadow'}->{'fill'} = $_[1]; 558} 559 560=item set_drop_shadow_offset 561 562=cut 563 564sub set_drop_shadow_offset { 565 $_[0]->{'custom_style'}->{'dropshadow'}->{'off'} = $_[1]; 566} 567 568=item set_drop_shadowXOffset 569 570=cut 571 572sub set_drop_shadowXOffset { 573 $_[0]->{'custom_style'}->{'dropshadow'}->{'offx'} = $_[1]; 574} 575 576=item set_drop_shadowYOffset 577 578=cut 579 580sub set_drop_shadowYOffset { 581 $_[0]->{'custom_style'}->{'dropshadow'}->{'offy'} = $_[1]; 582} 583 584=item set_drop_shadow_filter 585 586=cut 587 588sub set_drop_shadow_filter { 589 $_[0]->{'custom_style'}->{'dropshadow'}->{'filter'} = $_[1]; 590} 591 592=item set_outline_color 593 594=cut 595 596sub set_outline_color { 597 $_[0]->{'custom_style'}->{'outline'}->{'line'} = $_[1]; 598} 599 600=item set_data_area_fills 601 602=cut 603 604sub set_data_area_fills { 605 $_[0]->{'custom_style'}->{'fills'} = $_[1]; 606} 607 608=item set_data_line_colors 609 610=cut 611 612sub set_data_line_colors { 613 $_[0]->{'custom_style'}->{'colors'} = $_[1]; 614} 615 616=back 617 618=head1 FEATURES 619 620Each graph type has a number of features. These are used to add 621various items that are displayed in the graph area. 622 623Features can be controlled by calling methods on the graph object, or 624by passing a C<features> parameter to draw(). 625 626Some common features are: 627 628=over 629 630=item show_legend() 631 632Feature: legend 633X<legend><features, legend> 634 635adds a box containing boxes filled with the data fills, with 636the labels provided to the draw method. The legend will only be 637displayed if both the legend feature is enabled and labels are 638supplied. 639 640=cut 641 642sub show_legend { 643 $_[0]->{'custom_style'}->{'features'}->{'legend'} = 1; 644} 645 646=item show_outline() 647 648Feature: outline 649X<outline>X<features, outline> 650 651If enabled, draw a border around the elements representing data in the 652graph, eg. around each pie segments on a pie chart, around each bar on 653a bar chart. 654 655=cut 656 657sub show_outline { 658 $_[0]->{'custom_style'}->{'features'}->{'outline'} = 1; 659} 660 661=item show_labels() 662 663Feature: labels 664X<labels>X<features, labels> 665 666labels each data fill, usually by including text inside the data fill. 667If the text does not fit in the fill, they could be displayed in some 668other form, eg. as callouts in a pie graph. 669 670For pie charts there isn't much point in enabling both the C<legend> 671and C<labels> features. 672 673For other charts, the labels label the independent variable, while the 674legend describes the color used to plot the dependent variables. 675 676=cut 677 678sub show_labels { 679 $_[0]->{'custom_style'}->{'features'}->{'labels'} = 1; 680} 681 682=item show_drop_shadow() 683 684Feature: dropshadow 685X<dropshadow>X<features, dropshadow> 686 687a simple drop shadow is shown behind some of the graph elements. 688 689=cut 690 691sub show_drop_shadow { 692 $_[0]->{'custom_style'}->{'features'}->{'dropshadow'} = 1; 693} 694 695=item reset_features() 696 697Unsets all of the features. 698 699Note: this disables all features, even those enabled by default for a 700style. They can then be enabled by calling feature methods or by 701supplying a C<feature> parameter to the draw() method. 702 703=cut 704 705sub reset_features { 706 $_[0]->{'custom_style'}->{'features'} = {}; 707 $_[0]->{'custom_style'}->{'features'}->{'reset'} = 1; 708} 709 710=back 711 712Additionally, features can be set by passing them into the draw() 713method, named as above: 714 715=over 716 717=item * 718 719if supplied as an array reference, then any element C<no>I<featurename> will 720disable that feature, while an element I<featurename> will enable it. 721 722=item * 723 724if supplied as a scalar, it is treated as if it were a reference to 725an array containing only that scalar. 726 727=item * 728 729if supplied as a hash reference, then a C<reset> key with a true value 730will avoid inheriting any default features, a key I<feature> with a 731false value will disable that feature and a key I<feature> with a true 732value will enable that feature. 733 734=back 735 736Each graph also has features specific to that graph. 737 738=head1 COMMON PARAMETERS 739 740When referring to a single sub-value this documentation will refer to 741'title.color' rather than 'the color element of title'. 742 743Normally, except for the font parameter, these are controlled by 744styles, but these are the style parameters I'd mostly likely expect 745you want to use: 746 747=over 748 749=item font 750 751the Imager font object used to draw text on the chart. 752 753=item back 754 755the background fill for the graph. Default depends on the style. 756 757=item size 758 759the base size of the graph image. Default: 256 760 761=item width 762 763the width of the graph image. Default: 1.5 * size (384) 764 765=item height 766 767the height of the graph image. Default: size (256) 768 769=item channels 770 771the number of channels in the image. Default: 3 (the 'mono' style 772sets this to 1). 773 774=item line 775 776the color used for drawing lines, such as outlines or callouts. 777Default depends on the current style. Set to undef to remove the 778outline from a style. 779 780=item title 781 782the text used for a graph title. Default: no title. Note: this is 783the same as the title=>{ text => ... } field. 784 785=over 786 787=item halign 788 789horizontal alignment of the title in the graph, one of 'left', 790'center' or 'right'. Default: center 791 792=item valign 793 794vertical alignment of the title, one of 'top', 'center' or 'right'. 795Default: top. It's probably a bad idea to set this to 'center' unless 796you have a very short title. 797 798=back 799 800=item text 801 802This contains basic defaults used in drawing text. 803 804=over 805 806=item color 807 808the default color used for all text, defaults to the fg color. 809 810=item size 811 812the base size used for text, also used to scale many graph elements. 813Default: 14. 814 815=back 816 817=back 818 819=head1 BEYOND STYLES 820 821In most cases you will want to use just the styles, but you may want 822to exert more control over the way your chart looks. This section 823describes the options you can use to control the way your chart looks. 824 825Hopefully you don't need to read this. 826 827=over 828 829=item back 830 831The background of the graph. 832 833=item bg 834 835=item fg 836 837Used to define basic background and foreground colors for the graph. 838The bg color may be used for the background of the graph, and is used 839as a default for the background of hatched fills. The fg is used as 840the default for line and text colors. 841 842=item font 843 844The default font used by the graph. Normally you should supply this 845if your graph as any text. 846 847=item line 848 849The default line color. 850 851=item text 852 853defaults for drawing text. Other textual graph elements will inherit 854or modify these values. 855 856=over 857 858=item color 859 860default text color, defaults to the I<fg> color. 861 862=item size 863 864default text size. Default: 14. This is used to scale many graph 865elements, including padding and leader sizes. Other text elements 866will either use or scale this value. 867 868=item font 869 870default font object. Inherited from I<font>, which should have been 871supplied by the caller. 872 873=back 874 875=item title 876 877If you supply a scalar value for this element, it will be stored in 878the I<text> field. 879 880Defines the text, font and layout information for the title. 881 882=over 883 884=item color 885 886The color of the title, inherited from I<text.color>. 887 888=item font 889 890The font object used for the title, inherited from I<text.font>. 891 892=item size 893 894size of the title text. Default: double I<text.size> 895 896=item halign 897 898=item valign 899 900The horizontal and vertical alignment of the title. 901 902=back 903 904=item legend 905 906defines attributes of the graph legend, if present. 907 908=over 909 910=item color 911 912=item font 913 914=item size 915 916text attributes for the labels used in the legend. 917 918=item patchsize 919 920the width and height of the color patch in the legend. Defaults to 92190% of the legend text size. 922 923=item patchgap 924 925the minimum gap between patches in pixels. Defaults to 30% of the 926patchsize. 927 928=item patchborder 929 930the color of the border drawn around each patch. Inherited from I<line>. 931 932=item halign 933 934=item valign 935 936the horizontal and vertical alignment of the legend within the graph. 937Defaults to 'right' and 'top'. 938 939=item padding 940 941the gap between the legend patches and text and the outside of its 942box, or to the legend border, if any. 943 944=item outsidepadding 945 946the gap between the border and the outside of the legend's box. This 947is only used if the I<legend.border> attribute is defined. 948 949=item fill 950 951the background fill for the legend. Default: none 952 953=item border 954 955the border color of the legend. Default: none (no border is drawn 956around the legend.) 957 958=item orientation 959 960The orientation of the legend. If this is C<vertical> the the patches 961and labels are stacked on top of each other. If this is C<horizontal> 962the patchs and labels are word wrapped across the image. Default: 963vertical. 964 965=back 966 967For example to create a horizontal legend with borderless patches, 968darker than the background, you might do: 969 970 my $im = $chart->draw 971 (..., 972 legend => 973 { 974 patchborder => undef, 975 orientation => 'horizontal', 976 fill => { solid => Imager::Color->new(0, 0, 0, 32), } 977 }, 978 ...); 979 980=item callout 981 982defines attributes for graph callouts, if any are present. eg. if the 983pie graph cannot fit the label into the pie graph segement it will 984present it as a callout. 985 986=over 987 988=item color 989 990=item font 991 992=item size 993 994the text attributes of the callout label. Inherited from I<text>. 995 996=item line 997 998the color of the callout lines. Inherited from I<line> 999 1000=item inside 1001 1002=item outside 1003 1004the length of the leader on the inside and the outside of the fill, 1005usually at some angle. Both default to the size of the callout text. 1006 1007=item leadlen 1008 1009the length of the horizontal portion of the leader. Default: 1010I<callout.size>. 1011 1012=item gap 1013 1014the gap between the callout leader and the callout text. Defaults to 101530% of the text callout size. 1016 1017=back 1018 1019=item label 1020 1021defines attributes for labels drawn into the data areas of a graph. 1022 1023=over 1024 1025=item color 1026 1027=item font 1028 1029=item size 1030 1031The text attributes of the labels. Inherited from I<text>. 1032 1033=back 1034 1035=item dropshadow 1036 1037the attributes of the graph's drop shadow 1038 1039=over 1040 1041=item fill 1042 1043the fill used for the drop shadow. Default: '404040' (dark gray) 1044 1045=item off 1046 1047the offset of the drop shadow. A convenience value inherited by offx 1048and offy. Default: 40% of I<text.size>. 1049 1050=item offx 1051 1052=item offy 1053 1054the horizontal and vertical offsets of the drop shadow. Both 1055inherited from I<dropshadow.off>. 1056 1057=item filter 1058 1059the filter description passed to Imager's filter method to blur the 1060drop shadow. Default: an 11 element convolution filter. 1061 1062=back 1063 1064=item outline 1065 1066describes the lines drawn around filled data areas, such as the 1067segments of a pie chart. 1068 1069=over 1070 1071=item line 1072 1073the line color of the outlines, inherited from I<line>. 1074 1075=back 1076 1077=item fills 1078 1079a reference to an array containing fills for each data item. 1080 1081You can mix fill types, ie. using a simple color for the first item, a 1082hatched fill for the second and a fountain fill for the next. 1083 1084=back 1085 1086=head1 HOW VALUES WORK 1087 1088Internally rather than specifying literal color, fill, or font objects 1089or literal sizes for each element, Imager::Graph uses a number of 1090special values to inherit or modify values taken from other graph 1091element names. 1092 1093=head2 Specifying colors 1094 1095You can specify colors by either supplying an Imager::Color object, by 1096supplying lookup of another color, or by supplying a single value that 1097Imager::Color::new can use as an initializer. The most obvious is 1098just a 6 or 8 digit hex value representing the red, green, blue and 1099optionally alpha channels of the image. 1100 1101You can lookup another color by using the lookup() "function", for 1102example if you give a color as "lookup(fg)" then Imager::Graph will 1103look for the fg element in the current style (or as overridden by 1104you.) This is used internally by Imager::Graph to set up the 1105relationships between the colors of various elements, for example the 1106default style information contains: 1107 1108 text=>{ 1109 color=>'lookup(fg)', 1110 ... 1111 }, 1112 legend =>{ 1113 color=>'lookup(text.color)', 1114 ... 1115 }, 1116 1117So by setting the I<fg> color, you also set the default text color, 1118since each text element uses lookup(text.color) as its value. 1119 1120=head2 Specifying fills 1121 1122Fills can be used for the graph background color, the background color 1123for the legend block and for the fills used for each data element. 1124 1125You can specify a fill as a L<color value|Specifying colors> or as a 1126general fill, see L<Imager::Fill> for details. 1127 1128You don't need (or usually want) to call Imager::Fill::new yourself, 1129since the various fill functions will call it for you, and 1130Imager::Graph provides some hooks to make them more useful. 1131 1132=over 1133 1134=item * 1135 1136with hatched fills, if you don't supply a 'fg' or 'bg' parameter, 1137Imager::Graph will supply the current graph fg and bg colors. 1138 1139=item * 1140 1141with fountain fill, you can supply the xa_ratio, ya_ratio, xb_ratio 1142and yb_ratio parameters, and they will be scaled in the fill area to 1143define the fountain fills xa, ya, xb and yb parameters. 1144 1145=back 1146 1147As with colors, you can use lookup(name) or lookup(name1.name2) to 1148have one element to inherit the fill of another. 1149 1150Imager::Graph defaults the fill combine value to C<'normal'>. This 1151doesn't apply to simple color fills. 1152 1153=head2 Specifying numbers 1154 1155You can specify various numbers, usually representing the size of 1156something, commonly text, but sometimes the length of a line or the 1157size of a gap. 1158 1159You can use the same lookup mechanism as with colors and fills, but 1160you can also scale values. For example, 'scale(0.5,text.size)' will 1161return half the size of the normal text size. 1162 1163As with colors, this is used internally to scale graph elements based 1164on the base text size. If you change the base text size then other 1165graph elements will scale as well. 1166 1167=head2 Specifying other elements 1168 1169Other elements, such as fonts, or parameters for a filter, can also 1170use the lookup(name) mechanism. 1171 1172=head1 INTERNAL METHODS 1173 1174Only useful if you need to fix bugs, add features or create a new 1175graph class. 1176 1177=over 1178 1179=cut 1180 1181my %style_defs = 1182 ( 1183 back=> 'lookup(bg)', 1184 line=> 'lookup(fg)', 1185 aa => 1, 1186 text=>{ 1187 color => 'lookup(fg)', 1188 font => 'lookup(font)', 1189 size => 14, 1190 aa => 'lookup(aa)', 1191 }, 1192 title=>{ 1193 color => 'lookup(text.color)', 1194 font => 'lookup(text.font)', 1195 halign => 'center', 1196 valign => 'top', 1197 size => 'scale(text.size,2.0)', 1198 aa => 'lookup(text.aa)', 1199 }, 1200 legend =>{ 1201 color => 'lookup(text.color)', 1202 font => 'lookup(text.font)', 1203 aa => 'lookup(text.aa)', 1204 size => 'lookup(text.size)', 1205 patchsize => 'scale(legend.size,0.9)', 1206 patchgap => 'scale(legend.patchsize,0.3)', 1207 patchborder => 'lookup(line)', 1208 halign => 'right', 1209 valign => 'top', 1210 padding => 'scale(legend.size,0.3)', 1211 outsidepadding => 'scale(legend.padding,0.4)', 1212 }, 1213 callout => { 1214 color => 'lookup(text.color)', 1215 font => 'lookup(text.font)', 1216 size => 'lookup(text.size)', 1217 line => 'lookup(line)', 1218 inside => 'lookup(callout.size)', 1219 outside => 'lookup(callout.size)', 1220 leadlen => 'scale(0.8,callout.size)', 1221 gap => 'scale(callout.size,0.3)', 1222 aa => 'lookup(text.aa)', 1223 lineaa => 'lookup(lineaa)', 1224 }, 1225 label => { 1226 font => 'lookup(text.font)', 1227 size => 'lookup(text.size)', 1228 color => 'lookup(text.color)', 1229 hpad => 'lookup(label.pad)', 1230 vpad => 'lookup(label.pad)', 1231 pad => 'scale(label.size,0.2)', 1232 pcformat => sub { sprintf "%s (%.0f%%)", $_[0], $_[1] }, 1233 pconlyformat => sub { sprintf "%.1f%%", $_[0] }, 1234 aa => 'lookup(text.aa)', 1235 lineaa => 'lookup(lineaa)', 1236 }, 1237 dropshadow => { 1238 fill => { solid => Imager::Color->new(0, 0, 0, 96) }, 1239 off => 'scale(0.4,text.size)', 1240 offx => 'lookup(dropshadow.off)', 1241 offy => 'lookup(dropshadow.off)', 1242 filter => { type=>'conv', 1243 # this needs a fairly heavy blur 1244 coef=>[0.1, 0.2, 0.4, 0.6, 0.7, 0.9, 1.2, 1245 0.9, 0.7, 0.6, 0.4, 0.2, 0.1 ] }, 1246 }, 1247 # controls the outline of graph elements representing data, eg. pie 1248 # slices, bars or columns 1249 outline => { 1250 line =>'lookup(line)', 1251 lineaa => 'lookup(lineaa)', 1252 }, 1253 # controls the outline and background of the data area of the chart 1254 graph => 1255 { 1256 fill => "lookup(bg)", 1257 outline => "lookup(fg)", 1258 }, 1259 size=>256, 1260 width=>'scale(1.5,size)', 1261 height=>'lookup(size)', 1262 1263 # yes, the handling of fill and line AA is inconsistent, lack of 1264 # forethought, unfortunately 1265 fill => { 1266 aa => 'lookup(aa)', 1267 }, 1268 lineaa => 'lookup(aa)', 1269 1270 line_markers =>[ 1271 { shape => 'circle', radius => 4 }, 1272 { shape => 'square', radius => 4 }, 1273 { shape => 'diamond', radius => 4 }, 1274 { shape => 'triangle', radius => 4 }, 1275 { shape => 'x', radius => 4 }, 1276 { shape => 'plus', radius => 4 }, 1277 ], 1278 ); 1279 1280=item _error($message) 1281 1282Sets the error field of the object and returns an empty list or undef, 1283depending on context. Should be used for error handling, since it may 1284provide some user hooks at some point. 1285 1286The intended usage is: 1287 1288 some action 1289 or return $self->_error("error description"); 1290 1291You should almost always return the result of _error() or return 1292immediately afterwards. 1293 1294=cut 1295 1296sub _error { 1297 my ($self, $error) = @_; 1298 1299 $self->{_errstr} = $error; 1300 1301 return; 1302} 1303 1304 1305=item _style_defs() 1306 1307Returns the style defaults, such as the relationships between line 1308color and text color. 1309 1310Intended to be over-ridden by base classes to provide graph specific 1311defaults. 1312 1313=cut 1314 1315sub _style_defs { 1316 \%style_defs; 1317} 1318 1319# Let's make the default something that looks really good, so folks will be interested enough to customize the style. 1320my $def_style = 'fount_lin'; 1321 1322my %styles = 1323 ( 1324 primary => 1325 { 1326 fills=> 1327 [ 1328 qw(FF0000 00FF00 0000FF C0C000 00C0C0 FF00FF) 1329 ], 1330 fg=>'000000', 1331 negative_bg=>'EEEEEE', 1332 bg=>'E0E0E0', 1333 legend=> 1334 { 1335 #patchborder=>'000000' 1336 }, 1337 }, 1338 primary_red => 1339 { 1340 fills=> 1341 [ 1342 qw(FF0000 00FF00 0000FF C0C000 00C0C0 FF00FF) 1343 ], 1344 fg=>'000000', 1345 negative_bg=>'EEEEEE', 1346 bg=>'C08080', 1347 legend=> 1348 { 1349 patchborder=>'000000' 1350 }, 1351 }, 1352 mono => 1353 { 1354 fills=> 1355 [ 1356 { hatch=>'slash2' }, 1357 { hatch=>'slosh2' }, 1358 { hatch=>'vline2' }, 1359 { hatch=>'hline2' }, 1360 { hatch=>'cross2' }, 1361 { hatch=>'grid2' }, 1362 { hatch=>'stipple3' }, 1363 { hatch=>'stipple2' }, 1364 ], 1365 channels=>1, 1366 bg=>'FFFFFF', 1367 fg=>'000000', 1368 negative_bg=>'EEEEEE', 1369 features=>{ outline=>1 }, 1370 pie =>{ 1371 blur=>undef, 1372 }, 1373 aa => 0, 1374 line_markers => 1375 [ 1376 { shape => "x", radius => 4 }, 1377 { shape => "plus", radius => 4 }, 1378 { shape => "open_circle", radius => 4 }, 1379 { shape => "open_diamond", radius => 5 }, 1380 { shape => "open_square", radius => 4 }, 1381 { shape => "open_triangle", radius => 4 }, 1382 { shape => "x", radius => 8 }, 1383 { shape => "plus", radius => 8 }, 1384 { shape => "open_circle", radius => 8 }, 1385 { shape => "open_diamond", radius => 10 }, 1386 { shape => "open_square", radius => 8 }, 1387 { shape => "open_triangle", radius => 8 }, 1388 ], 1389 }, 1390 fount_lin => 1391 { 1392 fills=> 1393 [ 1394 { fountain=>'linear', 1395 xa_ratio=>0.13, ya_ratio=>0.13, xb_ratio=>0.87, yb_ratio=>0.87, 1396 segments => Imager::Fountain->simple(positions=>[0, 1], 1397 colors=>[ NC('FFC0C0'), NC('FF0000') ]), 1398 }, 1399 { fountain=>'linear', 1400 xa_ratio=>0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0, 1401 segments => Imager::Fountain->simple(positions=>[0, 1], 1402 colors=>[ NC('C0FFC0'), NC('00FF00') ]), 1403 }, 1404 { fountain=>'linear', 1405 xa_ratio=>0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0, 1406 segments => Imager::Fountain->simple(positions=>[0, 1], 1407 colors=>[ NC('C0C0FF'), NC('0000FF') ]), 1408 }, 1409 { fountain=>'linear', 1410 xa_ratio=>0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0, 1411 segments => Imager::Fountain->simple(positions=>[0, 1], 1412 colors=>[ NC('FFFFC0'), NC('FFFF00') ]), 1413 }, 1414 { fountain=>'linear', 1415 xa_ratio=>0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0, 1416 segments => Imager::Fountain->simple(positions=>[0, 1], 1417 colors=>[ NC('C0FFFF'), NC('00FFFF') ]), 1418 }, 1419 { fountain=>'linear', 1420 xa_ratio=>0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0, 1421 segments => Imager::Fountain->simple(positions=>[0, 1], 1422 colors=>[ NC('FFC0FF'), NC('FF00FF') ]), 1423 }, 1424 ], 1425 colors => [ 1426 qw(FF0000 00FF00 0000FF C0C000 00C0C0 FF00FF) 1427 ], 1428 back=>{ fountain=>'linear', 1429 xa_ratio=>0, ya_ratio=>0, 1430 xb_ratio=>1.0, yb_ratio=>1.0, 1431 segments=>Imager::Fountain->simple 1432 ( positions=>[0, 1], 1433 colors=>[ NC('6060FF'), NC('60FF60') ]) }, 1434 fg=>'000000', 1435 negative_bg=>'EEEEEE', 1436 bg=>'FFFFFF', 1437 features=>{ dropshadow=>1 }, 1438 }, 1439 fount_rad => 1440 { 1441 fills=> 1442 [ 1443 { fountain=>'radial', 1444 xa_ratio=>0.5, ya_ratio=>0.5, xb_ratio=>1.0, yb_ratio=>0.5, 1445 segments => Imager::Fountain->simple(positions=>[0, 1], 1446 colors=>[ NC('FF8080'), NC('FF0000') ]), 1447 }, 1448 { fountain=>'radial', 1449 xa_ratio=>0.5, ya_ratio=>0.5, xb_ratio=>1.0, yb_ratio=>0.5, 1450 segments => Imager::Fountain->simple(positions=>[0, 1], 1451 colors=>[ NC('80FF80'), NC('00FF00') ]), 1452 }, 1453 { fountain=>'radial', 1454 xa_ratio=>0.5, ya_ratio=>0.5, xb_ratio=>1.0, yb_ratio=>0.5, 1455 segments => Imager::Fountain->simple(positions=>[0, 1], 1456 colors=>[ NC('808080FF'), NC('0000FF') ]), 1457 }, 1458 { fountain=>'radial', 1459 xa_ratio=>0.5, ya_ratio=>0.5, xb_ratio=>1.0, yb_ratio=>0.5, 1460 segments => Imager::Fountain->simple(positions=>[0, 1], 1461 colors=>[ NC('FFFF80'), NC('FFFF00') ]), 1462 }, 1463 { fountain=>'radial', 1464 xa_ratio=>0.5, ya_ratio=>0.5, xb_ratio=>1.0, yb_ratio=>0.5, 1465 segments => Imager::Fountain->simple(positions=>[0, 1], 1466 colors=>[ NC('80FFFF'), NC('00FFFF') ]), 1467 }, 1468 { fountain=>'radial', 1469 xa_ratio=>0.5, ya_ratio=>0.5, xb_ratio=>1.0, yb_ratio=>0.5, 1470 segments => Imager::Fountain->simple(positions=>[0, 1], 1471 colors=>[ NC('FF80FF'), NC('FF00FF') ]), 1472 }, 1473 ], 1474 colors => [ 1475 qw(FF0000 00FF00 0000FF C0C000 00C0C0 FF00FF) 1476 ], 1477 back=>{ fountain=>'linear', 1478 xa_ratio=>0, ya_ratio=>0, 1479 xb_ratio=>1.0, yb_ratio=>1.0, 1480 segments=>Imager::Fountain->simple 1481 ( positions=>[0, 1], 1482 colors=>[ NC('6060FF'), NC('60FF60') ]) }, 1483 fg=>'000000', 1484 negative_bg=>'EEEEEE', 1485 bg=>'FFFFFF', 1486 } 1487 ); 1488 1489$styles{'ocean'} = { 1490 fills => [ 1491 { 1492 fountain =>'linear', 1493 xa_ratio => 0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0, 1494 segments => Imager::Fountain->simple( 1495 positions=>[0, 1], 1496 colors=>[ NC('EFEDCF'), NC('E6E2AF') ]), 1497 }, 1498 { 1499 fountain =>'linear', 1500 xa_ratio => 0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0, 1501 segments => Imager::Fountain->simple( 1502 positions=>[0, 1], 1503 colors=>[ NC('DCD7AB'), NC('A7A37E') ]), 1504 }, 1505 { 1506 fountain =>'linear', 1507 xa_ratio => 0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0, 1508 segments => Imager::Fountain->simple( 1509 positions=>[0, 1], 1510 colors=>[ NC('B2E5D4'), NC('80B4A2') ]), 1511 }, 1512 { 1513 fountain =>'linear', 1514 xa_ratio => 0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0, 1515 segments => Imager::Fountain->simple( 1516 positions=>[0, 1], 1517 colors=>[ NC('7aaab9'), NC('046380') ]), 1518 }, 1519 { 1520 fountain =>'linear', 1521 xa_ratio => 0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0, 1522 segments => Imager::Fountain->simple( 1523 positions=>[0, 1], 1524 colors=>[ NC('c3b8e9'), NC('877EA7') ]), 1525 }, 1526 { 1527 fountain =>'linear', 1528 xa_ratio => 0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0, 1529 segments => Imager::Fountain->simple( 1530 positions=>[0, 1], 1531 colors=>[ NC('A3DF9A'), NC('67A35E') ]), 1532 }, 1533 { 1534 fountain =>'linear', 1535 xa_ratio => 0, ya_ratio=>0, xb_ratio=>1.0, yb_ratio=>1.0, 1536 segments => Imager::Fountain->simple( 1537 positions=>[0, 1], 1538 colors=>[ NC('E19C98'), NC('B4726F') ]), 1539 }, 1540 ], 1541 colors => [ 1542 qw(E6E2AF A7A37E 80B4A2 046380 877EA7 67A35E B4726F) 1543 ], 1544 fg=>'000000', 1545 negative_bg=>'EEEEEE', 1546 bg=>'FFFFFF', 1547 features=>{ dropshadow=>1 }, 1548 1549}; 1550 1551$styles{'ocean_flat'} = { 1552 fills=> 1553 [ 1554 qw(E6E2AF A7A37E 80B4A2 046380 877EA7 67A35E B4726F) 1555 ], 1556 colors => [ 1557 qw(E6E2AF A7A37E 80B4A2 046380 877EA7 67A35E B4726F) 1558 ], 1559 fg=>'000000', 1560 negative_bg=>'EEEEEE', 1561 bg=>'FFFFFF', 1562 features=>{ dropshadow=>1 }, 1563 1564}; 1565 1566=item $self->_style_setup(\%opts) 1567 1568Uses the values from %opts, the custom style set by methods, the style 1569set by the style parameter or the set_style() method and the built in 1570chart defaults to build a working style. 1571 1572The working style features member is also populated with the active 1573features for the chart. 1574 1575The working style is stored in the C<_style> member of $self. 1576 1577=cut 1578 1579sub _style_setup { 1580 my ($self, $opts) = @_; 1581 my $style_defs = $self->_style_defs; 1582 my $style; 1583 1584 my $pre_def_style = $self->_get_style($opts); 1585 my $api_style = $self->{'custom_style'} || {}; 1586 $style = $styles{$pre_def_style} if $pre_def_style; 1587 1588 $style ||= $styles{$def_style}; 1589 1590 my @search_list = ( $style_defs, $style, $api_style, $opts); 1591 my %work; 1592 1593 my @composite = $self->_composite(); 1594 my %composite; 1595 @composite{@composite} = @composite; 1596 1597 for my $src (@search_list) { 1598 for my $key (keys %$src) { 1599 if ($composite{$key}) { 1600 $work{$key} = {} unless exists $work{$key}; 1601 if (ref $src->{$key}) { 1602 # some keys have sub values, especially text 1603 @{$work{$key}}{keys %{$src->{$key}}} = values %{$src->{$key}}; 1604 } 1605 else { 1606 # assume it's the text for a title or something 1607 $work{$key}{text} = $src->{$key}; 1608 } 1609 } 1610 else { 1611 $work{$key} = $src->{$key} 1612 if defined $src->{$key}; # $opts with pmichauds new accessor handling 1613 } 1614 } 1615 } 1616 1617 # features are handled specially 1618 my %features; 1619 $work{features} = \%features; 1620 for my $src (@search_list) { 1621 if ($src->{features}) { 1622 if (ref $src->{features}) { 1623 if (ref($src->{features}) =~ /ARRAY/) { 1624 # just set those features 1625 for my $feature (@{$src->{features}}) { 1626 if ($feature =~ /^no(.+)$/) { 1627 delete $features{$1}; 1628 } 1629 else { 1630 $features{$feature} = 1; 1631 } 1632 } 1633 } 1634 elsif (ref($src->{features}) =~ /HASH/) { 1635 if ($src->{features}{reset}) { 1636 $work{features} = {}; # only the ones the user specifies 1637 } 1638 @{$work{features}}{keys %{$src->{features}}} = 1639 values(%{$src->{features}}); 1640 } 1641 } 1642 else { 1643 # just set that single feature 1644 if ($src->{features} =~ /^no(.+)$/) { 1645 delete $features{$1}; 1646 } 1647 else { 1648 $features{$src->{features}} = 1; 1649 } 1650 } 1651 } 1652 } 1653 1654 $self->{_style} = \%work; 1655} 1656 1657=item $self->_get_thing($name) 1658 1659Retrieve some general 'thing'. 1660 1661Supports the 'lookup(foo)' mechanism. 1662 1663Returns an empty list on failure. 1664 1665=cut 1666 1667sub _get_thing { 1668 my ($self, $name, @depth) = @_; 1669 1670 push(@depth, $name); 1671 my $what; 1672 if ($name =~ /^(\w+)\.(\w+)$/) { 1673 $what = $self->{_style}{$1}{$2}; 1674 } 1675 else { 1676 $what = $self->{_style}{$name}; 1677 } 1678 defined $what or 1679 return; 1680 if (ref $what) { 1681 return $what; 1682 } 1683 elsif ($what =~ /^lookup\((\w+(?:\.\w+)?)\)$/) { 1684 @depth < MAX_DEPTH 1685 or return $self->_error("too many levels of recursion in lookup(@depth)"); 1686 return $self->_get_thing($1, @depth); 1687 } 1688 else { 1689 return $what; 1690 } 1691} 1692 1693=item $self->_get_number($name) 1694 1695Retrieves a number from the style. The value in the style can be the 1696number, or one of two functions: 1697 1698=over 1699 1700=item lookup(newname) 1701 1702Recursively looks up I<newname> in the style. 1703 1704=item scale(value1,value2) 1705 1706Each value can be a number or a name. Names are recursively looked up 1707in the style and the product is returned. 1708 1709=back 1710 1711=cut 1712 1713sub _get_number { 1714 my ($self, $name, @depth) = @_; 1715 1716 push(@depth, $name); 1717 my $what; 1718 if ($name =~ /^(\w+)\.(\w+)$/) { 1719 $what = $self->{_style}{$1}{$2}; 1720 } 1721 else { 1722 $what = $self->{_style}{$name}; 1723 } 1724 defined $what or 1725 return $self->_error("$name is undef (@depth)"); 1726 1727 if (ref $what) { 1728 if ($what =~ /CODE/) { 1729 $what = $what->($self, $name); 1730 } 1731 } 1732 else { 1733 if ($what =~ /^lookup\(([\w.]+)\)$/) { 1734 @depth < MAX_DEPTH 1735 or return $self->_error("too many levels of recursion in lookup (@depth)"); 1736 return $self->_get_number($1, @depth); 1737 } 1738 elsif ($what =~ /^scale\( 1739 ((?:[a-z][\w.]*)|$NUM_RE) 1740 , 1741 ((?:[a-z][\w.]*)|$NUM_RE)\)$/x) { 1742 my ($left, $right) = ($1, $2); 1743 unless ($left =~ /^$NUM_RE$/) { 1744 @depth < MAX_DEPTH 1745 or return $self->_error("too many levels of recursion in scale (@depth)"); 1746 $left = $self->_get_number($left, @depth); 1747 } 1748 unless ($right =~ /^$NUM_RE$/) { 1749 @depth < MAX_DEPTH 1750 or return $self->_error("too many levels of recursion in scale (@depth)"); 1751 $right = $self->_get_number($right, @depth); 1752 } 1753 return $left * $right; 1754 } 1755 else { 1756 return $what+0; 1757 } 1758 } 1759} 1760 1761=item $self->_get_integer($name) 1762 1763Retrieves an integer from the style. This is a simple wrapper around 1764_get_number() that rounds the result to an integer. 1765 1766Returns an empty list on failure. 1767 1768=cut 1769 1770sub _get_integer { 1771 my ($self, $name, @depth) = @_; 1772 1773 my $number = $self->_get_number($name, @depth) 1774 or return; 1775 1776 return sprintf("%.0f", $number); 1777} 1778 1779=item _get_color($name) 1780 1781Returns a color object of the given name from the style hash. 1782 1783Uses Imager::Color->new to translate normal scalars into color objects. 1784 1785Allows the lookup(name) mechanism. 1786 1787Returns an empty list on failure. 1788 1789=cut 1790 1791sub _get_color { 1792 my ($self, $name, @depth) = @_; 1793 1794 push(@depth, $name); 1795 my $what; 1796 if ($name =~ /^(\w+)\.(\w+)$/) { 1797 $what = $self->{_style}{$1}{$2}; 1798 } 1799 else { 1800 $what = $self->{_style}{$name}; 1801 } 1802 1803 defined($what) 1804 or return $self->_error("$name was undefined (@depth)"); 1805 1806 unless (ref $what) { 1807 if ($what =~ /^lookup\((\w+(?:\.\w+)?)\)$/) { 1808 @depth < MAX_DEPTH or 1809 return $self->_error("too many levels of recursion in lookup (@depth)"); 1810 1811 return $self->_get_color($1, @depth); 1812 } 1813 $what = Imager::Color->new($what); 1814 } 1815 1816 $what; 1817} 1818 1819=item _translate_fill($what, $box) 1820 1821Given the value of a fill, either attempts to convert it into a fill 1822list (one of C<<color=>$color_value, filled=>1>> or C<<fill=>{ fill 1823parameters }>>), or to lookup another fill that is referred to with 1824the 'lookup(name)' mechanism. 1825 1826This function does the fg and bg initialization for hatched fills, and 1827translation of *_ratio for fountain fills (using the $box parameter). 1828 1829Returns an empty list on failure. 1830 1831=cut 1832 1833sub _translate_fill { 1834 my ($self, $what, $box, @depth) = @_; 1835 1836 if (ref $what) { 1837 if (UNIVERSAL::isa($what, "Imager::Color")) { 1838 return ( color=>Imager::Color->new($what), filled=>1 ); 1839 } 1840 else { 1841 # a general fill 1842 # default to normal combine mode 1843 my %work = ( combine => 'normal', %$what ); 1844 if ($what->{hatch}) { 1845 if (!$work{fg}) { 1846 $work{fg} = $self->_get_color('fg') 1847 or return; 1848 } 1849 if (!$work{bg}) { 1850 $work{bg} = $self->_get_color('bg') 1851 or return; 1852 } 1853 return ( fill=>\%work ); 1854 } 1855 elsif ($what->{fountain}) { 1856 for my $key (qw(xa ya xb yb)) { 1857 if (exists $work{"${key}_ratio"}) { 1858 if ($key =~ /^x/) { 1859 $work{$key} = $box->[0] + $work{"${key}_ratio"} 1860 * ($box->[2] - $box->[0]); 1861 } 1862 else { 1863 $work{$key} = $box->[1] + $work{"${key}_ratio"} 1864 * ($box->[3] - $box->[1]); 1865 } 1866 } 1867 } 1868 return ( fill=>\%work ); 1869 } 1870 else { 1871 return ( fill=> \%work ); 1872 } 1873 } 1874 } 1875 else { 1876 if ($what =~ /^lookup\((\w+(?:\.\w+)?)\)$/) { 1877 return $self->_get_fill($1, $box, @depth); 1878 } 1879 else { 1880 # assumed to be an Imager::Color single value 1881 return ( color=>Imager::Color->new($what), filled=>1 ); 1882 } 1883 } 1884} 1885 1886=item _data_fill($index, $box) 1887 1888Retrieves the fill parameters for a data area fill. 1889 1890=cut 1891 1892sub _data_fill { 1893 my ($self, $index, $box) = @_; 1894 1895 my $fills = $self->{_style}{fills}; 1896 return $self->_translate_fill($fills->[$index % @$fills], $box, 1897 "data.$index"); 1898} 1899 1900sub _data_color { 1901 my ($self, $index) = @_; 1902 1903 my $colors = $self->{'_style'}{'colors'} || []; 1904 my $fills = $self->{'_style'}{'fills'} || []; 1905 1906 # Try to just use a fill, so non-fountain styles don't need 1907 # to have a duplicated set of fills and colors 1908 my $fill = $fills->[$index % @$fills]; 1909 if (!ref $fill) { 1910 return $fill; 1911 } 1912 1913 if (@$colors) { 1914 return $colors->[$index % @$colors] || '000000'; 1915 } 1916 return '000000'; 1917} 1918 1919=item _get_fill($name, $box) 1920 1921Retrieves fill parameters for a named fill. 1922 1923=cut 1924 1925sub _get_fill { 1926 my ($self, $name, $box, @depth) = @_; 1927 1928 push(@depth, $name); 1929 my $what; 1930 if ($name =~ /^(\w+)\.(\w+)$/) { 1931 $what = $self->{_style}{$1}{$2}; 1932 } 1933 else { 1934 $what = $self->{_style}{$name}; 1935 } 1936 1937 defined($what) 1938 or return $self->_error("no fill $name found"); 1939 1940 return $self->_translate_fill($what, $box, @depth); 1941} 1942 1943=item _get_line($name) 1944 1945Return color (and possibly other) parameters for drawing a line with 1946the _line() method. 1947 1948=cut 1949 1950sub _get_line { 1951 my ($self, $name, @depth) = @_; 1952 1953 push (@depth, $name); 1954 my $what; 1955 if ($name =~ /^(\w+)\.(\w+)$/) { 1956 $what = $self->{_style}{$1}{$2}; 1957 } 1958 else { 1959 $what = $self->{_style}{$name}; 1960 } 1961 1962 defined($what) 1963 or return $self->_error("no line style $name found"); 1964 1965 if (ref $what) { 1966 if (eval { $what->isa("Imager::Color") }) { 1967 return $what; 1968 } 1969 if (ref $what eq "HASH") { 1970 # allow each kep to be looked up 1971 my %work = %$what; 1972 1973 if ($work{color} =~ /^lookup\((.*)\)$/) { 1974 $work{color} = $self->_get_color($1, @depth); 1975 } 1976 for my $key (keys %work) { 1977 $key eq "color" and next; 1978 1979 if ($work{$key} =~ /^lookup\((.*)\)$/) { 1980 $work{$key} = $self->_get_thing($1); 1981 } 1982 } 1983 1984 return %work; 1985 } 1986 return ( color => Imager::Color->new(@$what) ); 1987 } 1988 else { 1989 if ($what =~ /^lookup\((\w+(?:\.\w+)?)\)$/) { 1990 @depth < MAX_DEPTH 1991 or return $self->_error("too many levels of recursion in lookup (@depth)"); 1992 return $self->_get_line($1, @depth); 1993 } 1994 else { 1995 # presumably a text color 1996 my $color = Imager::Color->new($what) 1997 or return $self->_error("Could not translate $what as a color: ".Imager->errstr); 1998 1999 return ( color => $color ); 2000 } 2001 } 2002} 2003 2004=item _make_img() 2005 2006Builds the image object for the graph and fills it with the background 2007fill. 2008 2009=cut 2010 2011sub _make_img { 2012 my ($self) = @_; 2013 2014 my $width = $self->_get_number('width') || 256; 2015 my $height = $self->_get_number('height') || 256; 2016 my $channels = $self->{_style}{channels}; 2017 2018 $channels ||= 3; 2019 2020 my $img = Imager->new(xsize=>$width, ysize=>$height, channels=>$channels) 2021 or return $self->_error("Error creating image: " . Imager->errstr); 2022 2023 $img->box($self->_get_fill('back', [ 0, 0, $width-1, $height-1])); 2024 2025 $self->{_image} = $img; 2026 2027 return $img; 2028} 2029 2030sub _get_image { 2031 my $self = shift; 2032 2033 return $self->{'_image'}; 2034} 2035 2036=item _text_style($name) 2037 2038Returns parameters suitable for calls to Imager::Font's bounding_box() 2039and draw() methods intended for use in defining text styles. 2040 2041Returns an empty list on failure. 2042 2043Returns the following attributes: font, color, size, aa, sizew 2044(optionally) 2045 2046=cut 2047 2048sub _text_style { 2049 my ($self, $name) = @_; 2050 2051 my %work; 2052 2053 if ($self->{_style}{$name}) { 2054 %work = %{$self->{_style}{$name}}; 2055 } 2056 else { 2057 %work = %{$self->{_style}{text}}; 2058 } 2059 $work{font} 2060 or return $self->_error("$name has no font parameter"); 2061 2062 $work{font} = $self->_get_thing("$name.font") 2063 or return $self->_error("No $name.font defined, either set $name.font or font to a font"); 2064 UNIVERSAL::isa($work{font}, "Imager::Font") 2065 or return $self->_error("$name.font is not a font"); 2066 if ($work{color} && !ref $work{color}) { 2067 $work{color} = $self->_get_color("$name.color") 2068 or return; 2069 } 2070 $work{size} = $self->_get_number("$name.size"); 2071 $work{sizew} = $self->_get_number("$name.sizew") 2072 if $work{sizew}; 2073 $work{aa} = $self->_get_number("$name.aa"); 2074 2075 %work; 2076} 2077 2078=item _text_bbox($text, $name) 2079 2080Returns a bounding box for the specified $text as styled by $name. 2081 2082Returns an empty list on failure. 2083 2084=cut 2085 2086sub _text_bbox { 2087 my ($self, $text, $name) = @_; 2088 2089 my %text_info = $self->_text_style($name) 2090 or return; 2091 2092 my @bbox = $text_info{font}->bounding_box(%text_info, string=>$text, 2093 canon=>1); 2094 2095 return @bbox[0..3]; 2096} 2097 2098=item _line_style($name) 2099 2100Return parameters suitable for calls to Imager's line(), polyline(), 2101and box() methods. 2102 2103For now this returns only color and aa parameters, but future releases 2104of Imager may support extra parameters. 2105 2106=cut 2107 2108sub _line_style { 2109 my ($self, $name) = @_; 2110 2111 my %line; 2112 $line{color} = $self->_get_color("$name.line") 2113 or return; 2114 $line{aa} = $self->_get_number("$name.lineaa"); 2115 defined $line{aa} or $line{aa} = $self->_get_number("aa"); 2116 2117 return %line; 2118} 2119 2120sub _align_box { 2121 my ($self, $box, $chart_box, $name) = @_; 2122 2123 my $halign = $self->{_style}{$name}{halign} 2124 or $self->_error("no halign for $name"); 2125 my $valign = $self->{_style}{$name}{valign}; 2126 2127 if ($halign eq 'right') { 2128 $box->[0] += $chart_box->[2] - $box->[2]; 2129 } 2130 elsif ($halign eq 'left') { 2131 $box->[0] = $chart_box->[0]; 2132 } 2133 elsif ($halign eq 'center' || $halign eq 'centre') { 2134 $box->[0] = ($chart_box->[0] + $chart_box->[2] - $box->[2])/2; 2135 } 2136 else { 2137 return $self->_error("invalid halign $halign for $name"); 2138 } 2139 2140 if ($valign eq 'top') { 2141 $box->[1] = $chart_box->[1]; 2142 } 2143 elsif ($valign eq 'bottom') { 2144 $box->[1] = $chart_box->[3] - $box->[3]; 2145 } 2146 elsif ($valign eq 'center' || $valign eq 'centre') { 2147 $box->[1] = ($chart_box->[1] + $chart_box->[3] - $box->[3])/2; 2148 } 2149 else { 2150 return $self->_error("invalid valign $valign for $name"); 2151 } 2152 $box->[2] += $box->[0]; 2153 $box->[3] += $box->[1]; 2154} 2155 2156sub _remove_box { 2157 my ($self, $chart_box, $object_box) = @_; 2158 2159 my $areax; 2160 my $areay; 2161 if ($object_box->[0] - $chart_box->[0] 2162 < $chart_box->[2] - $object_box->[2]) { 2163 $areax = ($object_box->[2] - $chart_box->[0]) 2164 * ($chart_box->[3] - $chart_box->[1]); 2165 } 2166 else { 2167 $areax = ($chart_box->[2] - $object_box->[0]) 2168 * ($chart_box->[3] - $chart_box->[1]); 2169 } 2170 2171 if ($object_box->[1] - $chart_box->[1] 2172 < $chart_box->[3] - $object_box->[3]) { 2173 $areay = ($object_box->[3] - $chart_box->[1]) 2174 * ($chart_box->[2] - $chart_box->[0]); 2175 } 2176 else { 2177 $areay = ($chart_box->[3] - $object_box->[1]) 2178 * ($chart_box->[2] - $chart_box->[0]); 2179 } 2180 2181 if ($areay < $areax) { 2182 if ($object_box->[1] - $chart_box->[1] 2183 < $chart_box->[3] - $object_box->[3]) { 2184 $chart_box->[1] = $object_box->[3]; 2185 } 2186 else { 2187 $chart_box->[3] = $object_box->[1]; 2188 } 2189 } 2190 else { 2191 if ($object_box->[0] - $chart_box->[0] 2192 < $chart_box->[2] - $object_box->[2]) { 2193 $chart_box->[0] = $object_box->[2]; 2194 } 2195 else { 2196 $chart_box->[2] = $object_box->[0]; 2197 } 2198 } 2199} 2200 2201sub _draw_legend { 2202 my ($self, $img, $labels, $chart_box) = @_; 2203 2204 my $orient = $self->_get_thing('legend.orientation'); 2205 defined $orient or $orient = 'vertical'; 2206 2207 if ($orient eq 'vertical') { 2208 return $self->_draw_legend_vertical($img, $labels, $chart_box); 2209 } 2210 elsif ($orient eq 'horizontal') { 2211 return $self->_draw_legend_horizontal($img, $labels, $chart_box); 2212 } 2213 else { 2214 return $self->_error("Unknown legend.orientation $orient"); 2215 } 2216} 2217 2218sub _draw_legend_horizontal { 2219 my ($self, $img, $labels, $chart_box) = @_; 2220 2221 defined(my $padding = $self->_get_integer('legend.padding')) 2222 or return; 2223 my $patchsize = $self->_get_integer('legend.patchsize') 2224 or return; 2225 defined(my $gap = $self->_get_integer('legend.patchgap')) 2226 or return; 2227 2228 my $minrowsize = $patchsize + $gap; 2229 my ($width, $height) = (0,0); 2230 my $row_height = $minrowsize; 2231 my $pos = 0; 2232 my @sizes; 2233 my @offsets; 2234 for my $label (@$labels) { 2235 my @text_box = $self->_text_bbox($label, 'legend') 2236 or return; 2237 push(@sizes, \@text_box); 2238 my $entry_width = $patchsize + $gap + $text_box[2]; 2239 if ($pos == 0) { 2240 # never re-wrap the first entry 2241 push @offsets, [ 0, $height ]; 2242 } 2243 else { 2244 if ($pos + $gap + $entry_width > $chart_box->[2]) { 2245 $pos = 0; 2246 $height += $row_height; 2247 } 2248 push @offsets, [ $pos, $height ]; 2249 } 2250 my $entry_right = $pos + $entry_width; 2251 $pos += $gap + $entry_width; 2252 $entry_right > $width and $width = $entry_right; 2253 if ($text_box[3] > $row_height) { 2254 $row_height = $text_box[3]; 2255 } 2256 } 2257 $height += $row_height; 2258 my @box = ( 0, 0, $width + $padding * 2, $height + $padding * 2 ); 2259 my $outsidepadding = 0; 2260 if ($self->{_style}{legend}{border}) { 2261 defined($outsidepadding = $self->_get_integer('legend.outsidepadding')) 2262 or return; 2263 $box[2] += 2 * $outsidepadding; 2264 $box[3] += 2 * $outsidepadding; 2265 } 2266 $self->_align_box(\@box, $chart_box, 'legend') 2267 or return; 2268 if ($self->{_style}{legend}{fill}) { 2269 $img->box(xmin=>$box[0]+$outsidepadding, 2270 ymin=>$box[1]+$outsidepadding, 2271 xmax=>$box[2]-$outsidepadding, 2272 ymax=>$box[3]-$outsidepadding, 2273 $self->_get_fill('legend.fill', \@box)); 2274 } 2275 $box[0] += $outsidepadding; 2276 $box[1] += $outsidepadding; 2277 $box[2] -= $outsidepadding; 2278 $box[3] -= $outsidepadding; 2279 my %text_info = $self->_text_style('legend') 2280 or return; 2281 my $patchborder; 2282 if ($self->{_style}{legend}{patchborder}) { 2283 $patchborder = $self->_get_color('legend.patchborder') 2284 or return; 2285 } 2286 2287 my $dataindex = 0; 2288 for my $label (@$labels) { 2289 my ($left, $top) = @{$offsets[$dataindex]}; 2290 $left += $box[0] + $padding; 2291 $top += $box[1] + $padding; 2292 my $textpos = $left + $patchsize + $gap; 2293 my @patchbox = ( $left, $top, 2294 $left + $patchsize, $top + $patchsize ); 2295 my @fill = $self->_data_fill($dataindex, \@patchbox) 2296 or return; 2297 $img->box(xmin=>$left, ymin=>$top, xmax=>$left + $patchsize, 2298 ymax=>$top + $patchsize, @fill); 2299 if ($self->{_style}{legend}{patchborder}) { 2300 $img->box(xmin=>$left, ymin=>$top, xmax=>$left + $patchsize, 2301 ymax=>$top + $patchsize, 2302 color=>$patchborder); 2303 } 2304 $img->string(%text_info, x=>$textpos, 'y'=>$top + $patchsize, 2305 text=>$label); 2306 2307 ++$dataindex; 2308 } 2309 if ($self->{_style}{legend}{border}) { 2310 my $border_color = $self->_get_color('legend.border') 2311 or return; 2312 $img->box(xmin=>$box[0], ymin=>$box[1], xmax=>$box[2], ymax=>$box[3], 2313 color=>$border_color); 2314 } 2315 $self->_remove_box($chart_box, \@box); 2316 1; 2317} 2318 2319sub _draw_legend_vertical { 2320 my ($self, $img, $labels, $chart_box) = @_; 2321 2322 defined(my $padding = $self->_get_integer('legend.padding')) 2323 or return; 2324 my $patchsize = $self->_get_integer('legend.patchsize') 2325 or return; 2326 defined(my $gap = $self->_get_integer('legend.patchgap')) 2327 or return; 2328 my $minrowsize = $patchsize + $gap; 2329 my ($width, $height) = (0,0); 2330 my @sizes; 2331 for my $label (@$labels) { 2332 my @box = $self->_text_bbox($label, 'legend') 2333 or return; 2334 push(@sizes, \@box); 2335 $width = $box[2] if $box[2] > $width; 2336 if ($minrowsize > $box[3]) { 2337 $height += $minrowsize; 2338 } 2339 else { 2340 $height += $box[3]; 2341 } 2342 } 2343 my @box = (0, 0, 2344 $width + $patchsize + $padding * 2 + $gap, 2345 $height + $padding * 2 - $gap); 2346 my $outsidepadding = 0; 2347 if ($self->{_style}{legend}{border}) { 2348 defined($outsidepadding = $self->_get_integer('legend.outsidepadding')) 2349 or return; 2350 $box[2] += 2 * $outsidepadding; 2351 $box[3] += 2 * $outsidepadding; 2352 } 2353 $self->_align_box(\@box, $chart_box, 'legend') 2354 or return; 2355 if ($self->{_style}{legend}{fill}) { 2356 $img->box(xmin=>$box[0]+$outsidepadding, 2357 ymin=>$box[1]+$outsidepadding, 2358 xmax=>$box[2]-$outsidepadding, 2359 ymax=>$box[3]-$outsidepadding, 2360 $self->_get_fill('legend.fill', \@box)); 2361 } 2362 $box[0] += $outsidepadding; 2363 $box[1] += $outsidepadding; 2364 $box[2] -= $outsidepadding; 2365 $box[3] -= $outsidepadding; 2366 my $ypos = $box[1] + $padding; 2367 my $patchpos = $box[0]+$padding; 2368 my $textpos = $patchpos + $patchsize + $gap; 2369 my %text_info = $self->_text_style('legend') 2370 or return; 2371 my $patchborder; 2372 if ($self->{_style}{legend}{patchborder}) { 2373 $patchborder = $self->_get_color('legend.patchborder') 2374 or return; 2375 } 2376 my $dataindex = 0; 2377 for my $label (@$labels) { 2378 my @patchbox = ( $patchpos - $patchsize/2, $ypos - $patchsize/2, 2379 $patchpos + $patchsize * 3 / 2, $ypos + $patchsize*3/2 ); 2380 2381 my @fill; 2382 if ($self->_draw_flat_legend()) { 2383 @fill = (color => $self->_data_color($dataindex), filled => 1); 2384 } 2385 else { 2386 @fill = $self->_data_fill($dataindex, \@patchbox) 2387 or return; 2388 } 2389 $img->box(xmin=>$patchpos, ymin=>$ypos, xmax=>$patchpos + $patchsize, 2390 ymax=>$ypos + $patchsize, @fill); 2391 if ($self->{_style}{legend}{patchborder}) { 2392 $img->box(xmin=>$patchpos, ymin=>$ypos, xmax=>$patchpos + $patchsize, 2393 ymax=>$ypos + $patchsize, 2394 color=>$patchborder); 2395 } 2396 $img->string(%text_info, x=>$textpos, 'y'=>$ypos + $patchsize, 2397 text=>$label); 2398 2399 my $step = $patchsize + $gap; 2400 if ($minrowsize < $sizes[$dataindex][3]) { 2401 $ypos += $sizes[$dataindex][3]; 2402 } 2403 else { 2404 $ypos += $minrowsize; 2405 } 2406 ++$dataindex; 2407 } 2408 if ($self->{_style}{legend}{border}) { 2409 my $border_color = $self->_get_color('legend.border') 2410 or return; 2411 $img->box(xmin=>$box[0], ymin=>$box[1], xmax=>$box[2], ymax=>$box[3], 2412 color=>$border_color); 2413 } 2414 $self->_remove_box($chart_box, \@box); 2415 1; 2416} 2417 2418sub _draw_title { 2419 my ($self, $img, $chart_box) = @_; 2420 2421 my $title = $self->{_style}{title}{text}; 2422 my @box = $self->_text_bbox($title, 'title') 2423 or return; 2424 my $yoff = $box[1]; 2425 @box[0,1] = (0,0); 2426 $self->_align_box(\@box, $chart_box, 'title'); 2427 my %text_info = $self->_text_style('title') 2428 or return; 2429 $img->string(%text_info, x=>$box[0], 'y'=>$box[3] + $yoff, text=>$title); 2430 $self->_remove_box($chart_box, \@box); 2431 1; 2432} 2433 2434sub _small_extent { 2435 my ($self, $box) = @_; 2436 2437 if ($box->[2] - $box->[0] > $box->[3] - $box->[1]) { 2438 return $box->[3] - $box->[1]; 2439 } 2440 else { 2441 return $box->[2] - $box->[0]; 2442 } 2443} 2444 2445sub _draw_flat_legend { 2446 return 0; 2447} 2448 2449=item _composite() 2450 2451Returns a list of style fields that are stored as composites, and 2452should be merged instead of just being replaced. 2453 2454=cut 2455 2456sub _composite { 2457 qw(title legend text label dropshadow outline callout graph); 2458} 2459 2460sub _filter_region { 2461 my ($self, $img, $left, $top, $right, $bottom, $filter) = @_; 2462 2463 unless (ref $filter) { 2464 my $name = $filter; 2465 $filter = $self->_get_thing($name) 2466 or return; 2467 $filter->{type} 2468 or return $self->_error("no type for filter $name"); 2469 } 2470 2471 $left > 0 or $left = 0; 2472 $top > 0 or $top = 0; 2473 2474 my $masked = $img->masked(left=>$left, top=>$top, 2475 right=>$right, bottom=>$bottom); 2476 $masked->filter(%$filter); 2477} 2478 2479=item _line(x1 => $x1, y1 => $y1, ..., style => $style) 2480 2481Wrapper for line drawing, implements styles Imager doesn't. 2482 2483Currently styles are limited to horizontal and vertical lines. 2484 2485=cut 2486 2487sub _line { 2488 my ($self, %opts) = @_; 2489 2490 my $img = delete $opts{img} 2491 or die "No img supplied to _line()"; 2492 my $style = delete $opts{style} || "solid"; 2493 2494 if ($style eq "solid" || ($opts{x1} != $opts{x2} && $opts{y1} != $opts{y2})) { 2495 return $img->line(%opts); 2496 } 2497 elsif ($style eq 'dashed' || $style eq 'dotted') { 2498 my ($x1, $y1, $x2, $y2) = delete @opts{qw/x1 y1 x2 y2/}; 2499 # the line is vertical or horizontal, so swapping doesn't hurt 2500 $x1 > $x2 and ($x1, $x2) = ($x2, $x1); 2501 $y1 > $y2 and ($y1, $y2) = ($y2, $y1); 2502 my ($stepx, $stepy) = ( 0, 0 ); 2503 my $step_size = $style eq "dashed" ? 8 : 2; 2504 my ($counter, $count_end); 2505 if ($x1 == $x2) { 2506 $stepy = $step_size; 2507 ($counter, $count_end) = ($y1, $y2); 2508 } 2509 else { 2510 $stepx = $step_size; 2511 ($counter, $count_end) = ($x1, $x2); 2512 } 2513 my ($x, $y) = ($x1, $y1); 2514 while ($counter < $count_end) { 2515 if ($style eq "dotted") { 2516 $img->setpixel(x => $x, y => $y, color => $opts{color}); 2517 } 2518 else { 2519 my $xe = $stepx ? $x + $stepx / 2 - 1 : $x; 2520 $xe > $x2 and $xe = $x2; 2521 my $ye = $stepy ? $y + $stepy / 2 - 1 : $y; 2522 $ye > $y2 and $ye = $y2; 2523 $img->line(x1 => $x, y1 => $y, x2 => $xe, y2 => $ye, %opts); 2524 } 2525 $counter += $step_size; 2526 $x += $stepx; 2527 $y += $stepy; 2528 } 2529 2530 return 1; 2531 } 2532 else { 2533 $self->_error("Unknown line style $style"); 2534 return; 2535 } 2536} 2537 2538=item _box(xmin ..., style => $style) 2539 2540A wrapper for drawing styled box outlines. 2541 2542=cut 2543 2544sub _box { 2545 my ($self, %opts) = @_; 2546 2547 my $style = delete $opts{style} || "solid"; 2548 my $img = delete $opts{img} 2549 or die "No img supplied to _box"; 2550 2551 if ($style eq "solid") { 2552 return $img->box(%opts); 2553 } 2554 else { 2555 my $box = delete $opts{box}; 2556 # replicate Imager's defaults 2557 my %work_opts = ( xmin => 0, ymin => 0, xmax => $img->getwidth() - 1, ymax => $img->getheight() -1, %opts, style => $style, img => $img ); 2558 my ($xmin, $ymin, $xmax, $ymax) = delete @work_opts{qw/xmin ymin xmax ymax/}; 2559 if ($box) { 2560 ($xmin, $ymin, $xmax, $ymax) = @$box; 2561 } 2562 $xmin > $xmax and ($xmin, $xmax) = ($xmax, $xmin); 2563 $ymin > $ymax and ($ymin, $ymax) = ($ymax, $ymin); 2564 2565 if ($xmax - $xmin > 1) { 2566 $self->_line(x1 => $xmin+1, y1 => $ymin, x2 => $xmax-1, y2 => $ymin, %work_opts); 2567 $self->_line(x1 => $xmin+1, y1 => $ymax, x2 => $xmax-1, y2 => $ymax, %work_opts); 2568 } 2569 $self->_line(x1 => $xmin, y1 => $ymin, x2 => $xmin, y2 => $ymax, %work_opts); 2570 return $self->_line(x1 => $xmax, y1 => $ymin, x2 => $xmax, y2 => $ymax, %work_opts); 2571 } 2572} 2573 2574=item _feature_enabled($feature_name) 2575 2576Check if the given feature is enabled in the work style. 2577 2578=cut 2579 2580sub _feature_enabled { 2581 my ($self, $name) = @_; 2582 2583 return $self->{_style}{features}{$name}; 2584} 2585 2586sub _line_marker { 2587 my ($self, $index) = @_; 2588 2589 my $markers = $self->{'_style'}{'line_markers'}; 2590 if (!$markers) { 2591 return; 2592 } 2593 my $marker = $markers->[$index % @$markers]; 2594 2595 return $marker; 2596} 2597 2598sub _draw_line_marker { 2599 my $self = shift; 2600 my ($x1, $y1, $series_counter) = @_; 2601 2602 my $img = $self->_get_image(); 2603 2604 my $style = $self->_line_marker($series_counter); 2605 return unless $style; 2606 2607 my $type = $style->{'shape'}; 2608 my $radius = $style->{'radius'}; 2609 2610 my $line_aa = $self->_get_number("lineaa"); 2611 my $fill_aa = $self->_get_number("fill.aa"); 2612 2613 if ($type eq 'circle') { 2614 my @fill = $self->_data_fill($series_counter, [$x1 - $radius, $y1 - $radius, $x1 + $radius, $y1 + $radius]); 2615 $img->circle(x => $x1, y => $y1, r => $radius, aa => $fill_aa, filled => 1, @fill); 2616 } 2617 elsif ($type eq 'open_circle') { 2618 my $color = $self->_data_color($series_counter); 2619 $img->circle(x => $x1, y => $y1, r => $radius, aa => $fill_aa, filled => 0, color => $color); 2620 } 2621 elsif ($type eq 'open_square') { 2622 my $color = $self->_data_color($series_counter); 2623 $img->box(xmin => $x1 - $radius, ymin => $y1 - $radius, xmax => $x1 + $radius, ymax => $y1 + $radius, filled => 0, color => $color); 2624 } 2625 elsif ($type eq 'open_triangle') { 2626 my $color = $self->_data_color($series_counter); 2627 $img->polyline( 2628 points => [ 2629 [$x1 - $radius, $y1 + $radius], 2630 [$x1 + $radius, $y1 + $radius], 2631 [$x1, $y1 - $radius], 2632 [$x1 - $radius, $y1 + $radius], 2633 ], 2634 color => $color, aa => $line_aa); 2635 } 2636 elsif ($type eq 'open_diamond') { 2637 my $color = $self->_data_color($series_counter); 2638 $img->polyline( 2639 points => [ 2640 [$x1 - $radius, $y1], 2641 [$x1, $y1 + $radius], 2642 [$x1 + $radius, $y1], 2643 [$x1, $y1 - $radius], 2644 [$x1 - $radius, $y1], 2645 ], 2646 color => $color, aa => $line_aa); 2647 } 2648 elsif ($type eq 'square') { 2649 my @fill = $self->_data_fill($series_counter, [$x1 - $radius, $y1 - $radius, $x1 + $radius, $y1 + $radius]); 2650 $img->box(xmin => $x1 - $radius, ymin => $y1 - $radius, xmax => $x1 + $radius, ymax => $y1 + $radius, @fill); 2651 } 2652 elsif ($type eq 'diamond') { 2653 # The gradient really doesn't work for diamond 2654 my $color = $self->_data_color($series_counter); 2655 $img->polygon( 2656 points => [ 2657 [$x1 - $radius, $y1], 2658 [$x1, $y1 + $radius], 2659 [$x1 + $radius, $y1], 2660 [$x1, $y1 - $radius], 2661 ], 2662 filled => 1, color => $color, aa => $fill_aa); 2663 } 2664 elsif ($type eq 'triangle') { 2665 # The gradient really doesn't work for triangle 2666 my $color = $self->_data_color($series_counter); 2667 $img->polygon( 2668 points => [ 2669 [$x1 - $radius, $y1 + $radius], 2670 [$x1 + $radius, $y1 + $radius], 2671 [$x1, $y1 - $radius], 2672 ], 2673 filled => 1, color => $color, aa => $fill_aa); 2674 2675 } 2676 elsif ($type eq 'x') { 2677 my $color = $self->_data_color($series_counter); 2678 $img->line(x1 => $x1 - $radius, y1 => $y1 -$radius, x2 => $x1 + $radius, y2 => $y1+$radius, aa => $line_aa, color => $color) || die $img->errstr; 2679 $img->line(x1 => $x1 + $radius, y1 => $y1 -$radius, x2 => $x1 - $radius, y2 => $y1+$radius, aa => $line_aa, color => $color) || die $img->errstr; 2680 } 2681 elsif ($type eq 'plus') { 2682 my $color = $self->_data_color($series_counter); 2683 $img->line(x1 => $x1, y1 => $y1 -$radius, x2 => $x1, y2 => $y1+$radius, aa => $line_aa, color => $color) || die $img->errstr; 2684 $img->line(x1 => $x1 + $radius, y1 => $y1, x2 => $x1 - $radius, y2 => $y1, aa => $line_aa, color => $color) || die $img->errstr; 2685 } 2686} 2687 26881; 2689 2690__END__ 2691 2692=back 2693 2694=head1 SEE ALSO 2695 2696Imager::Graph::Pie(3), Imager(3), perl(1). 2697 2698=head1 AUTHOR 2699 2700Tony Cook <tony@develop-help.com> 2701 2702=head1 LICENSE 2703 2704Imager::Graph is licensed under the same terms as perl itself. 2705 2706=head1 BLAME 2707 2708Addi for producing a cool imaging module. :) 2709 2710=cut 2711