- add a new style "primary" which is primary_red with a light grey
[imager-graph.git] / Graph.pm
index 7a2f404..68d938a 100644 (file)
--- a/Graph.pm
+++ b/Graph.pm
@@ -19,15 +19,6 @@ defines the colors, text display information and fills based on both
 built-in styles and modifications supplied by the user to the draw()
 method.
 
-For best results you need a version of Imager after 0.38.  At the time
-of writing this is only available via CVS:
-
-  cvs -d :pserver:anoncvs@cvs.imager.perl.org:/u02/cvsroot login
-  cvs -d :pserver:anoncvs@cvs.imager.perl.org:/u02/cvsroot co Imager
-
-This provides extra file format support, fountain (gradient), hatch
-and image fills, and masked images.
-
 =over
 
 =cut
@@ -97,15 +88,22 @@ The currently defined styles are:
 
 =over
 
+=item primary
+
+a light grey background with no outlines.  Uses primary colors for the
+data fills.
+
+This is the default style.
+
 =item primary_red
 
 a light red background with no outlines.  Uses primary colors for the
-data fills.  This style is compatible with all versions of Imager.
+data fills.
 
 Graphs drawn using this style should save well as a gif, even though
 some graphs may perform a slight blur.
 
-This is the default style.
+This was the default style, but the red was too loud.
 
 =item mono
 
@@ -122,8 +120,6 @@ background, by supplying C<<bg=>'00000000', channels=>4>>.
 
 This style outlines the legend if present and outlines the hashed fills.
 
-This and following styles require versions of Imager after 0.38.
-
 =item fount_lin
 
 designed as a "pretty" style this uses linear fountain fills for the
@@ -389,8 +385,28 @@ the background fill for the legend.  Default: none
 the border color of the legend.  Default: none (no border is drawn
 around the legend.)
 
+=item orientation
+
+The orientation of the legend.  If this is C<vertical> the the patches
+and labels are stacked on top of each other.  If this is C<horizontal>
+the patchs and labels are word wrapped across the image.  Default:
+vertical.
+
 =back
 
+For example to create a horizontal legend with borderless patches,
+darker than the background, you might do:
+
+  my $im = $chart->draw
+    (...,
+    legend =>
+    {
+      patchborder => undef,
+      orientation => 'horizontal',
+      fill => { solid => Imager::Color->new(0, 0, 0, 32), }
+    },
+    ...);
+
 =item callout
 
 defines attributes for graph callouts, if any are present.  eg. if the
@@ -537,8 +553,7 @@ Fills can be used for the graph background color, the background color
 for the legend block and for the fills used for each data element.
 
 You can specify a fill as a L<color value|Specifying colors> or as a
-general fill, see L<Imager::Fill> for details.  To use a general fill
-you need a version of Imager after 0.38.
+general fill, see L<Imager::Fill> for details.
 
 You don't need (or usually want) to call Imager::Fill::new yourself,
 since the various fill functions will call it for you, and
@@ -562,6 +577,9 @@ define the fountain fills xa, ya, xb and yb parameters.
 As with colors, you can use lookup(name) or lookup(name1.name2) to
 have one element to inherit the fill of another.
 
+Imager::Graph defaults the fill combine value to C<'normal'>.  This
+doesn't apply to simple color fills.
+
 =head2 Specifying numbers
 
 You can specify various numbers, usually representing the size of
@@ -687,10 +705,23 @@ sub _style_defs {
   \%style_defs;
 }
 
-my $def_style = 'primary_red';
+my $def_style = 'primary';
 
 my %styles =
   (
+   primary =>
+   {
+    fills=>
+    [
+     qw(FF0000 00FF00 0000FF C0C000 00C0C0 FF00FF)
+    ],
+    fg=>'000000',
+    bg=>'E0E0E0',
+    legend=>
+    {
+     #patchborder=>'000000'
+    },
+   },
    primary_red =>
    {
     fills=>
@@ -731,7 +762,6 @@ my %styles =
     [
      { fountain=>'linear',
        xa_ratio=>0.13, ya_ratio=>0.13, xb_ratio=>0.87, yb_ratio=>0.87,
-       repeat=>'sawtooth',
        segments => Imager::Fountain->simple(positions=>[0, 1],
                                            colors=>[ NC('FFC0C0'), NC('FF0000') ]),
      },
@@ -935,7 +965,7 @@ Recursively looks up I<newname> in the style.
 
 =item scale(value1,value2)
 
-Each value can be a number or a name.  Names are recursively looks up
+Each value can be a number or a name.  Names are recursively looked up
 in the style and the product is returned.
 
 =back
@@ -990,6 +1020,22 @@ sub _get_number {
   }
 }
 
+=item $self->_get_integer($name)
+
+Retrieves an integer from the style.  This is a simple wrapper around
+_get_number() that rounds the result to an integer.
+
+=cut
+
+sub _get_integer {
+  my ($self, $name, @depth) = @_;
+
+  my $number = $self->_get_number($name, @depth)
+    or return;
+
+  return sprintf("%.0f", $number);
+}
+
 =item _get_color($name)
 
 Returns a color object of the given name from the style hash.
@@ -1049,8 +1095,9 @@ sub _translate_fill {
     }
     else {
       # a general fill
+      # default to normal combine mode
+      my %work = ( combine => 'normal', %$what );
       if ($what->{hatch}) {
-       my %work = %$what;
        if (!$work{fg}) {
          $work{fg} = $self->_get_color('fg')
            or return;
@@ -1062,7 +1109,6 @@ sub _translate_fill {
        return ( fill=>\%work );
       }
       elsif ($what->{fountain}) {
-       my %work = %$what;
        for my $key (qw(xa ya xb yb)) {
          if (exists $work{"${key}_ratio"}) {
            if ($key =~ /^x/) {
@@ -1078,7 +1124,7 @@ sub _translate_fill {
        return ( fill=>\%work );
       }
       else {
-       return ( fill=> $what );
+       return ( fill=> \%work );
       }
     }
   }
@@ -1280,11 +1326,128 @@ sub _remove_box {
 sub _draw_legend {
   my ($self, $img, $labels, $chart_box) = @_;
 
-  defined(my $padding = $self->_get_number('legend.padding'))
+  my $orient = $self->_get_thing('legend.orientation');
+  defined $orient or $orient = 'vertical';
+
+  if ($orient eq 'vertical') {
+    return $self->_draw_legend_vertical($img, $labels, $chart_box);
+  }
+  elsif ($orient eq 'horizontal') {
+    return $self->_draw_legend_horizontal($img, $labels, $chart_box);
+  }
+  else {
+    return $self->_error("Unknown legend.orientation $orient");
+  }
+}
+
+sub _draw_legend_horizontal {
+  my ($self, $img, $labels, $chart_box) = @_;
+
+  defined(my $padding = $self->_get_integer('legend.padding'))
+    or return;
+  my $patchsize = $self->_get_integer('legend.patchsize')
+    or return;
+  defined(my $gap = $self->_get_integer('legend.patchgap'))
+    or return;
+
+  my $minrowsize = $patchsize + $gap;
+  my ($width, $height) = (0,0);
+  my $row_height = $minrowsize;
+  my $pos = 0;
+  my @sizes;
+  my @offsets;
+  for my $label (@$labels) {
+    my @text_box = $self->_text_bbox($label, 'legend');
+    push(@sizes, \@text_box);
+    my $entry_width = $patchsize + $gap + $text_box[2];
+    if ($pos == 0) {
+      # never re-wrap the first entry
+      push @offsets, [ 0, $height ];
+    }
+    else {
+      if ($pos + $gap + $entry_width > $chart_box->[2]) {
+       $pos = 0;
+       $height += $row_height;
+      }
+      push @offsets, [ $pos, $height ];
+    }
+    my $entry_right = $pos + $entry_width;
+    $pos += $gap + $entry_width;
+    $entry_right > $width and $width = $entry_right;
+    if ($text_box[3] > $row_height) {
+      $row_height = $text_box[3];
+    }
+  }
+  $height += $row_height;
+  my @box = ( 0, 0, $width + $padding * 2, $height + $padding * 2 );
+  my $outsidepadding = 0;
+  if ($self->{_style}{legend}{border}) {
+    defined($outsidepadding = $self->_get_integer('legend.outsidepadding'))
+      or return;
+    $box[2] += 2 * $outsidepadding;
+    $box[3] += 2 * $outsidepadding;
+  }
+  $self->_align_box(\@box, $chart_box, 'legend')
+    or return;
+  if ($self->{_style}{legend}{fill}) {
+    $img->box(xmin=>$box[0]+$outsidepadding, 
+              ymin=>$box[1]+$outsidepadding, 
+              xmax=>$box[2]-$outsidepadding, 
+              ymax=>$box[3]-$outsidepadding,
+            $self->_get_fill('legend.fill', \@box));
+  }
+  $box[0] += $outsidepadding;
+  $box[1] += $outsidepadding;
+  $box[2] -= $outsidepadding;
+  $box[3] -= $outsidepadding;
+  my %text_info = $self->_text_style('legend')
+    or return;
+  my $patchborder;
+  if ($self->{_style}{legend}{patchborder}) {
+    $patchborder = $self->_get_color('legend.patchborder')
+      or return;
+  }
+  
+  my $dataindex = 0;
+  for my $label (@$labels) {
+    my ($left, $top) = @{$offsets[$dataindex]};
+    $left += $box[0] + $padding;
+    $top += $box[1] + $padding;
+    my $textpos = $left + $patchsize + $gap;
+    my @patchbox = ( $left, $top,
+                     $left + $patchsize, $top + $patchsize );
+    my @fill = $self->_data_fill($dataindex, \@patchbox)
+      or return;
+    $img->box(xmin=>$left, ymin=>$top, xmax=>$left + $patchsize,
+              ymax=>$top + $patchsize, @fill);
+    if ($self->{_style}{legend}{patchborder}) {
+      $img->box(xmin=>$left, ymin=>$top, xmax=>$left + $patchsize,
+               ymax=>$top + $patchsize,
+               color=>$patchborder);
+    }
+    $img->string(%text_info, x=>$textpos, 'y'=>$top + $patchsize, 
+                 text=>$label);
+
+    ++$dataindex;
+  }
+  if ($self->{_style}{legend}{border}) {
+    my $border_color = $self->_get_color('legend.border')
+      or return;
+    $img->box(xmin=>$box[0], ymin=>$box[1], xmax=>$box[2], ymax=>$box[3],
+             color=>$border_color);
+  }
+  $self->_remove_box($chart_box, \@box);
+  1;
+}
+
+sub _draw_legend_vertical {
+  my ($self, $img, $labels, $chart_box) = @_;
+
+  defined(my $padding = $self->_get_integer('legend.padding'))
     or return;
-  my $patchsize = $self->_get_number('legend.patchsize')
+  my $patchsize = $self->_get_integer('legend.patchsize')
     or return;
-  defined(my $gap = $self->_get_number('legend.patchgap'))
+  defined(my $gap = $self->_get_integer('legend.patchgap'))
     or return;
   my $minrowsize = $patchsize + $gap;
   my ($width, $height) = (0,0);
@@ -1305,7 +1468,7 @@ sub _draw_legend {
             $height + $padding * 2 - $gap);
   my $outsidepadding = 0;
   if ($self->{_style}{legend}{border}) {
-    defined($outsidepadding = $self->_get_number('legend.outsidepadding'))
+    defined($outsidepadding = $self->_get_integer('legend.outsidepadding'))
       or return;
     $box[2] += 2 * $outsidepadding;
     $box[3] += 2 * $outsidepadding;