This is an automated email from the git hooks/post-receive script.

dom pushed a commit to branch master
in repository libchart-strip-perl.git.

commit d7faa3872ab8034977215b90407b6500fef7ff5b
Author: Dominic Hargreaves <d...@earth.li>
Date:   Wed Jun 17 21:16:04 2009 +0000

    new upstream release
---
 CHANGES          |   7 +
 MANIFEST         |   1 +
 META.yml         |  31 ++--
 Strip.pm         | 488 ++++++++++++++++++++++++++++++++++++++++---------------
 debian/changelog |   6 +-
 eg/Makefile      |   2 +-
 eg/ex6.png       | Bin 0 -> 4872 bytes
 eg/index.html    |   1 +
 8 files changed, 395 insertions(+), 141 deletions(-)

diff --git a/CHANGES b/CHANGES
index 5f6f52f..a03b1b8 100644
--- a/CHANGES
+++ b/CHANGES
@@ -1,4 +1,11 @@
 
+1.07
+        drop shadows
+        smooth curves
+
+1.06
+       ylabel placement calculation
+
 1.05
        xtic changes and speedups
 
diff --git a/MANIFEST b/MANIFEST
index 6641e60..2cedd48 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -19,4 +19,5 @@ eg/ex2.png
 eg/ex3.png
 eg/ex4.png
 eg/ex5.png
+eg/ex6.png
 META.yml                                 Module meta-data (added by MakeMaker)
diff --git a/META.yml b/META.yml
index 53e3946..7f27be9 100644
--- a/META.yml
+++ b/META.yml
@@ -1,11 +1,22 @@
-# http://module-build.sourceforge.net/META-spec.html
-#XXXXXXX This is a prototype!!!  It will change in the future!!! XXXXX#
-name:         Chart-Strip
-version:      1.05
-version_from: Strip.pm
-installdirs:  site
+--- #YAML:1.0
+name:               Chart-Strip
+version:            1.07
+abstract:           Draw strip chart type graphs.
+author:
+    - Jeff Weisberg <http://www.tcp4me.com/>
+license:            unknown
+distribution_type:  module
+configure_requires:
+    ExtUtils::MakeMaker:  0
+build_requires:
+    ExtUtils::MakeMaker:  0
 requires:
-    GD:                            0
-
-distribution_type: module
-generated_by: ExtUtils::MakeMaker version 6.30
+    GD:  0
+no_index:
+    directory:
+        - t
+        - inc
+generated_by:       ExtUtils::MakeMaker version 6.50
+meta-spec:
+    url:      http://module-build.sourceforge.net/META-spec-v1.4.html
+    version:  1.4
diff --git a/Strip.pm b/Strip.pm
index 69f396f..f79e7af 100644
--- a/Strip.pm
+++ b/Strip.pm
@@ -5,9 +5,9 @@
 # Date: 2002-Nov-01 16:11 (EST)
 # Function: draw strip charts
 #
-# $Id: Strip.pm,v 1.15 2006/06/25 17:48:59 jaw Exp jaw $
+# $Id: Strip.pm,v 1.21 2009/03/28 17:34:54 jaw Exp $
 
-$Chart::Strip::VERSION = "1.05";
+$Chart::Strip::VERSION = "1.07";
 
 =head1 NAME
 
@@ -67,42 +67,42 @@ The height of the image.
 =item C<title>
 
 The title of the graph. Will be placed centered at the top.
-    
+
 =item C<x_label>
 
 The label for the x axis. Will be placed centered at the bottom.
-    
+
 =item C<y_label>
 
 The label for the y axis. Will be placed vertically along the left side.
-    
+
 =item C<draw_grid>
 
 Should a grid be drawn on the graph?
-    
+
 =item C<draw_border>
 
 Should a border be drawn around the edge of the image?
-    
+
 =item C<draw_tic_labels>
 
 Should value labels be shown?
-    
+
 =item C<draw_data_labels>
 
 Should each data set be labeled?
-    
+
 =item C<transparent>
 
 Should the background be transparent?
-    
+
 =item C<grid_on_top>
 
 Should the grid be drawn over the data (1) or below the data (0)?
 
 =item C<binary>
 
-Use powers of 2 instead of powers of 10 for the y axis labels.    
+Use powers of 2 instead of powers of 10 for the y axis labels.
 
 =item C<data_label_style>
 
@@ -130,24 +130,24 @@ in the data options or per point. If no width is 
specified a reasonable default
 
 The data should be an array ref of data points. Each data point
 should be a hash ref containing:
-    
+
     {
-       time  => $time_t,  # must be a unix time_t 
+       time  => $time_t,  # must be a unix time_t
        value => $value,   # the data value
        color => $color,   # optional, used for this one point
     }
 
 or, range style graphs should contain:
-    
+
     {
-       time  => $time_t,  # must be a unix time_t 
+       time  => $time_t,  # must be a unix time_t
        min   => $low,     # the minimum data value
        max   => $high,    # the maximum data value
        color => $color,   # optional, used for this one point
     }
 
 and the options may contain:
-    
+
     {
        style => 'line',             # graph style: line, filled, range, 
points, box
        color => 'FF00FF',           # color used for the graph
@@ -158,6 +158,16 @@ points style graphs may specify the point diameter, as 
C<diam>
 
 box style graphs may specify the box width, as C<width>
 
+line and filled graphs may specify a C<smooth> parameter, to connect
+points using smooth curves instead of straight lines. A value of C<1>
+is recommended, larger values will be less smooth.
+
+line, points, box, and filled graphs may specify a drop shadow,
+consisting of a hashref containing C<dx>, C<dy>, C<dw>, and optionally, 
C<color>
+
+    shadow => { dx => 3, dy => 3, dw => 3, color => 'CCCCCC' }
+
+
 =head2 Outputing The Image
 
 =over 4
@@ -173,7 +183,7 @@ Will return the jpeg image
 =item $chart->gd()
 
 Will return the underlying GD object.
-    
+
 =back
 
 =cut
@@ -198,7 +208,6 @@ my $MT_SU = 3;      # sunday
 my $MT_M1 = 4; # 1st
 my $MT_Y1 = 5; # new years
 
-
 sub new {
     my $class = shift;
     my %param = @_;
@@ -211,7 +220,7 @@ sub new {
        margin_right  => 8,
        margin_top    => 8,
        n_y_tics      => 4, # aprox.
-       
+
        transparent      => 1,
        grid_on_top      => 1,
        draw_grid        => 1,
@@ -221,27 +230,33 @@ sub new {
        limit_factor     => 0,
        data_label_style => 'text',  # or 'box'
        thickness        => 1,
-       
+        tm_time                 => \&POSIX::localtime, # or gmtime, or...
+        shadow_color    => '#CCCCCC',
+# GD can only antialias on a truecolor image, and only if thickness==1
+# yes, I know what the GD documentation says. I also know what the src says...
+        antialias       => 0,
+        truecolor       => 0,
+
        # title
        # x_label
        # y_label
-       
+
        # user specified params override defaults
        %param,
-           
+
     }, $class;
 
     $me->adjust();
 
-    my $im = GD::Image->new( $me->{width}, $me->{height} );
+    my $im = GD::Image->new( $me->{width}, $me->{height}, $me->{truecolor} );
     $me->{img} = $im;
-    
-    # Nor long the sun his daily course withheld, 
-    # But added colors to the world reveal'd: 
-    # When early Turnus, wak'ning with the light, 
+
+    # Nor long the sun his daily course withheld,
+    # But added colors to the world reveal'd:
+    # When early Turnus, wak'ning with the light,
     #   -- Virgil, Aeneid
     # allocate some useful colors, 1st is used for bkg
-    $me->color({ color => $me->{background_color} }) if 
$me->{background_color};
+    my $bkg = $me->color({ color => $me->{background_color} }) if 
$me->{background_color};
     $me->{color}{white} = $im->colorAllocate(255,255,255);
     $me->{color}{black} = $im->colorAllocate(0,0,0);
     $me->{color}{blue}  = $im->colorAllocate(0, 0, 255);
@@ -256,8 +271,11 @@ sub new {
     $im->transparent($me->{color}{white})
        if $me->{transparent};
 
-    $im->rectangle(0, 0, $me->{width}-1, $me->{height}-1,
-                  $me->color({ color => ($me->{border_color} || 'black') }))
+    $im->filledRectangle( 0, 0, $me->{width}-1, $me->{height}-1, ($bkg || 
$me->{color}{white}));
+
+    my $bc = $me->{border_color} ? $me->img_color($me->{border_color}) : 
$me->{color}{black};
+
+    $im->rectangle(0, 0, $me->{width}-1, $me->{height}-1, $bc )
        if $me->{draw_border};
 
     $me;
@@ -269,13 +287,14 @@ sub add_data {
     my $opts = shift;
 
     $me->analyze( $data, $opts );
-    
+
     unless( $opts->{style} ){
        $opts->{style} = defined $data->[0]{min} ? 'range' : 'line';
     }
-    
+
     push @{$me->{data}}, {data => $data, opts => $opts};
-    
+    $me->{has_shadow} = 1 if $opts->{shadow};
+
     $me;
 }
 
@@ -286,13 +305,13 @@ sub plot {
 
     return unless $me->{data};
     return if $me->{all_done};
-    
+
     $me->adjust();
     $me->clabels();
     $me->xlabel();
     $me->ylabel();
     $me->title();
-    
+
     if( $me->{draw_tic_labels} ){
        # move margin for xtics before we do ytics
        $me->{margin_bottom} += 12;
@@ -301,14 +320,21 @@ sub plot {
 
     $me->ytics();
     $me->xtics();
+
+    # draw shadows
+    foreach my $d ( @{$me->{data}} ){
+        next unless $d->{opts}{shadow};
+        $me->plot_data( $d->{data}, $d->{opts}, $d->{opts}{shadow} );
+    }
+
     $me->axii();
     $me->drawgrid() unless $me->{grid_on_top};
-    
+
     # plot
     foreach my $d ( @{$me->{data}} ){
-       $me->plot_data( $d->{data}, $d->{opts} );
+       $me->plot_data( $d->{data}, $d->{opts}, undef );
     }
-    
+
     $me->drawgrid() if $me->{grid_on_top};
 
     $me->{all_done} = 1;
@@ -317,7 +343,7 @@ sub plot {
 
 
 # The axis of the earth sticks out visibly through the centre of each and 
every town or city.
-#   -- Oliver Wendell Holmes, The Autocrat of the Breakfast-Table    
+#   -- Oliver Wendell Holmes, The Autocrat of the Breakfast-Table
 sub axii {
     my $me = shift;
     my $im = $me->{img};
@@ -325,7 +351,7 @@ sub axii {
     # draw axii
     $im->line( $me->xpt(-1), $me->ypt(-1), $me->xpt(-1), 
$me->ypt($me->{ymax}), $me->{color}{black});
     $im->line( $me->xpt(-1), $me->ypt(-1), $me->xpt($me->{xmax}), 
$me->ypt(-1), $me->{color}{black});
-    
+
     # 'Talking of axes,' said the Duchess, 'chop off her head!'
     #   -- Alice in Wonderland
     $me;
@@ -361,7 +387,7 @@ sub jpeg {
     $me->plot();
     $me->{img}->jpeg( @_ );
 }
-    
+
 
 # xpt, ypt - convert graph space => image space
 sub xpt {
@@ -393,13 +419,13 @@ sub ydatapt {
 
     $pt = $pt < $me->{yd_min} ? $me->{yd_min} : $pt;
     $pt = $pt > $me->{yd_max} ? $me->{yd_max} : $pt;
-    
+
     $me->ypt( ($pt - $me->{yd_min}) * $me->{yd_scale} );
 }
 
 sub adjust {
     my $me = shift;
-    
+
     # I have touched the highest point of all my greatness;
     #   -- Shakespeare, King Henry VIII
     $me->{xmax} = $me->{width}  - $me->{margin_right}  - $me->{margin_left};
@@ -408,11 +434,11 @@ sub adjust {
     if( $me->{data} ){
        $me->{xd_scale} = ($me->{xd_min} == $me->{xd_max}) ? 1
            : $me->{xmax} / ($me->{xd_max} - $me->{xd_min});
-       
+
        $me->{yd_scale} = ($me->{yd_min} == $me->{yd_max}) ? 1
            : $me->{ymax} / ($me->{yd_max} - $me->{yd_min});
     }
-    
+
     $me;
 }
 
@@ -425,7 +451,7 @@ sub analyze {
     $st = $data->[0]{time};    # start time
     $et = $data->[-1]{time};   # end time
     $pt = $st;
-    
+
     foreach my $s (@$data){
        croak "data point out of order" if $s->{time} < $pt;
        my $a = defined $s->{min} ? $s->{min} : $s->{value};
@@ -433,7 +459,7 @@ sub analyze {
        $a ||= 0 unless $me->{skip_undefined} || $opts->{skip_undefined};
        $b ||= 0 unless $me->{skip_undefined} || $opts->{skip_undefined};
        ($a, $b) = ($b, $a) if $a > $b;
-       
+
        $min = $a if defined($a) && ( !defined($min) || $a < $min );
        $max = $b if defined($b) && ( !defined($max) || $b > $max );
        $pt  = $s->{time};
@@ -451,7 +477,40 @@ sub analyze {
        # boxes are drawn from y=0
        $min = 0 if $min > 0;
     }
-    
+
+    if( $opts->{smooth} || $me->{smooth} ){
+        # calculate derivative at each point (which may or may not be evenly 
spaced)
+        for my $i (0 .. @$data-1){
+            my $here  = $data->[$i];
+            my $left  = $i ? $data->[$i-1] : $data->[$i];
+            my $right = ($i!=@$data-1) ? $data->[$i+1] : $data->[$i];
+
+            my $dxl = $here->{time}   - $left->{time};
+            my $dxr = $right->{time}  - $here->{time};
+            my $dyl = $here->{value}  - $left->{value};
+            my $dyr = $right->{value} - $here->{value};
+
+            if( $dxr && $dxl ){
+                my $dl = $dyl / $dxl;
+                my $dr = $dyr / $dxr;
+                if( $dl < 0 && $dr > 0 || $dl > 0 && $dr < 0 ){
+                    # local extrema
+                    $data->[$i]{dydx} = 0;
+                }else{
+                    my $dm = ( $dl * $dxr + $dr * $dxl ) / ($dxr + $dxl);
+                    # mathematicaly, $dm is the best estimate of the 
derivative, and gives the smoothest curve
+                    # but, this way looks nicer...
+                    my $d = (sort { abs($a) <=> abs($b) } ($dl, $dr, $dm))[0];
+                    $data->[$i]{dydx} = ($d + $dm) / 2;
+                }
+            }elsif($dxr){
+                $data->[$i]{dydx} = $dyr / $dxr;
+            }elsif($dxl){
+                $data->[$i]{dydx} = $dyl / $dxl;
+            }
+        }
+    }
+
     $me->{xd_min} = $st  if $st && (!defined($me->{xd_min}) || $st  < 
$me->{xd_min});
     $me->{xd_max} = $et  if $et && (!defined($me->{xd_max}) || $et  > 
$me->{xd_max});
     $me->{yd_min} = $min if         !defined($me->{yd_min}) || $min < 
$me->{yd_min};
@@ -484,6 +543,21 @@ sub set_x_range {
     $me->adjust();
 }
 
+sub img_color {
+    my $me    = shift;
+    my $color = shift;
+
+    $color =~ s/^#//;
+    $color =~ s/\s//g;
+
+    return $me->{color}{$color} if $me->{color}{$color};
+    my($r,$g,$b) = map {hex} unpack('a2 a2 a2', $color);
+    my $i = $me->{img}->colorAllocate( $r, $g, $b );
+    $me->{color}{$color} = $i;
+
+    return $i;
+}
+
 # choose proper color for plot
 sub color {
     my $me   = shift;
@@ -495,14 +569,9 @@ sub color {
     #   -- Monty Python, Holy Grail
     my $c = $data->{color} || $opts->{color};
     if( $c ){
-       return $me->{color}{$c} if $me->{color}{$c};
-       my($r,$g,$b) = map {hex} unpack('a2 a2 a2', $c);
-       my $i = $me->{img}->colorAllocate( $r, $g, $b );
-
-       $me->{color}{$c} = $i;
-       return $i;
+        return $me->img_color( $c );
     }
-    
+
     return $me->{color}{green};
 }
 
@@ -542,7 +611,8 @@ sub ylabel {
     return unless $me->{y_label};
     $me->{margin_left} += 12;
     $me->adjust();
-    $loc = ($me->{height} + length($me->{y_label}) * 6) / 2;
+    my $m = ($me->{height} - $me->{margin_top} - $me->{margin_bottom}) / 2 + 
$me->{margin_top};
+    $loc = $m + length($me->{y_label}) * 6 / 2;
     $me->{img}->stringUp(gdSmallFont, 2, $loc, $me->{y_label}, 
$me->{color}{black});
     # small => 12,6; tiny => 10,5
 }
@@ -556,10 +626,11 @@ sub pretty {
     my $st = shift;
     my( $ay, $sc, $b, $prec );
 
+    return $me->{fmt_value}->($y) if $me->{fmt_value};
     $sc = '';
     $ay = abs($y);
     $b = $me->{binary} ? 1024 : 1000;
-    
+
     if( $ay < 1 ){
        if( $ay < 1/$b**3 ){
            return "0";
@@ -611,7 +682,7 @@ sub ytics {
     $min = $me->{yd_min};
     $max = $me->{yd_max};
     $maxw = 0;
-    
+
     if( $min == $max ){
        # not a very interesting graph...
        my $lb = $me->pretty($min, 1);  # QQQ
@@ -635,11 +706,11 @@ sub ytics {
            my $label = $me->pretty($y, $st);
            my $w = 5 * length($label) + 6;
            $maxw = $w if $w > $maxw;
-           
+
            push @tics, [$yy, $label, $w];
        }
     }
-    
+
     if( $me->{draw_tic_labels} ){
        # move margin
        $me->{margin_left} += $maxw;
@@ -652,7 +723,7 @@ sub ytics {
 sub drawgrid {
     my $me = shift;
     my $im = $me->{img};
-    
+
     foreach my $tic (@{$me->{grid}{y}}){
        # ytics + horiz lines
        my $yy = $tic->[0];
@@ -696,7 +767,7 @@ sub drawgrid {
                # too close to edge, shift
                $a = $me->xdatapt($t) - $me->{width} + length($label) * 6 + 2;
            }
-           
+
            $im->string(gdSmallFont, $me->xdatapt($t)-$a, $me->ypt(-6),
                               $label, $ll ? $me->{color}{red} : 
$me->{color}{black} );
        }
@@ -711,7 +782,7 @@ sub xtic_range_data {
     my $range_days = $range_hrs / 24;
 
     # return: step, labeltype, marktype, lti, tmod
-    
+
     if( $range < 720 ){
        (60, $LT_HM, $MT_HR, 1, 1);             # tics: 1 min
     }
@@ -763,7 +834,7 @@ sub xtic_range_data {
     elsif( $range_days < 2000 ){
        (3600*24*31, $LT_DM, $MT_NO, 4, 6);     # tics: 6 month
     }
-    
+
     else{
        # NB: years less than 366 days are corrected for below
        (3600*24*366, $LT_YR, $MT_NO, 4, 12);   # tics: 1 yr
@@ -773,14 +844,14 @@ sub xtic_range_data {
 sub xtic_align_initial {
     my $me   = shift;
     my $step = shift;
-    
+
     my $t = ($step < 3600) ? (int($me->{xd_min} / $step) * $step)
        : (int($me->{xd_min} / 3600) * 3600);
 
     if( $step >= 3600*24*365 ){
        while(1){
            # search for 1jan
-           my @lt = localtime $t;
+           my @lt = $me->{tm_time}($t);
            last if $lt[4] == 0 && $lt[3] == 1 && $lt[2] == 0;
            # jump fwd: 1M, 1D, or 1H
            my $dt = ($lt[4] != 11) ? 24*30 : ($lt[3] < 30) ? 24 : 1;
@@ -790,7 +861,7 @@ sub xtic_align_initial {
     elsif( $step >= 3600*24*31 ){
        while(1){
            # find 1st of mon
-           my @lt = localtime $t;
+           my @lt = $me->{tm_time}($t);
            last if $lt[3] == 1 && $lt[2] == 0;
            my $dt = ($lt[3] < 28) ? 24 : 1;
            $t += $dt * 3600;
@@ -799,7 +870,7 @@ sub xtic_align_initial {
     elsif( $step >= 3600*24 ){
        while(1){
            # search for midnight
-           my @lt = localtime $t;
+           my @lt = $me->{tm_time}($t);
            last unless $lt[2];
            $t += 3600;
        }
@@ -818,17 +889,17 @@ sub xtics {
     my $range      = $me->{xd_max} - $me->{xd_min};
     my $range_hrs  = $range / 3600;
     my $range_days = $range_hrs / 24;
-    
+
     my ($step, $labtyp, $marktyp, $lti, $tmod) = $me->xtic_range_data( $range 
);
     my $t = $me->xtic_align_initial( $step );
 
     # print "days: $range_days, lt: $labtyp, lti: $lti, tmod: $tmod, st: 
$step\n";
     # print STDERR "t: $t ", scalar(localtime $t), "\n";
-    
+
     for( ; $t<$me->{xd_max}; $t+=$step ){
        my $redmark = 0;
        next if $t < $me->{xd_min};
-       my @lt  = localtime $t;
+       my @lt  = $me->{tm_time}($t);
        my @rlt = @lt;
        # months go from 0. days from 1. absurd!
        $lt[3]--;
@@ -849,7 +920,7 @@ sub xtics {
            $t -= $dt;
            redo;
        }
-       
+
        next if $lt[$lti] % $tmod;
        next if $lt[3] && $lti > 3;
        next if $lt[2] && $lti > 2;
@@ -862,7 +933,7 @@ sub xtics {
        $redmark = 1 if $marktyp == $MT_SU && !$lt[6];                  # sunday
        $redmark = 1 if $marktyp == $MT_M1 && !$lt[3];                  # 1st 
of month
        $redmark = 1 if $marktyp == $MT_Y1 && !$lt[3] && !$lt[4];       # 1 jan
-       
+
        my $label;
        # NB: strftime obeys LC_TIME for localized day/month names
        # (if locales are supported in the OS and perl)
@@ -896,7 +967,7 @@ sub xtics {
        push @tics, [$t, $redmark, $label];
     }
     $me->{grid}{x} = \@tics;
-    
+
 }
 
 # it shall be inventoried, and every particle and utensil
@@ -909,7 +980,7 @@ sub clabels {
     my $me = shift;
 
     return unless $me->{draw_data_labels};
-    
+
     my $rs = 0;
     my $rm = 0;
     if( $me->{data_label_style} eq 'box' ){
@@ -928,7 +999,7 @@ sub clabels {
        next unless $l;
        my $w = length($l) * 5 + 6;
        $w += $rm + $rs;
-       
+
        if( $tw + $w > $me->{width} - $me->{margin_left} - $me->{margin_right} 
){
            $r ++;
            $tw = 0;
@@ -960,31 +1031,32 @@ sub plot_data {
     my $me = shift;
     my $data = shift;
     my $opts = shift;
+    my $shadow = shift;
 
     return unless $data && @$data;
-    
+
     # 'What did they draw?' said Alice, quite forgetting her promise.
     #   -- Alice in Wonderland
     if( $opts->{style} eq 'line' ){
        # 'You can draw water out of a water-well,' said the Hatter
        #   -- Alice in Wonderland
-       $me->draw_line( $data, $opts );
+       $me->draw_line( $data, $opts, $shadow );
     }
     elsif( $opts->{style} eq 'filled' ){
        # I should think you could draw treacle out of a treacle-well
        #    -- Alice in Wonderland
-       $me->draw_filled( $data, $opts );
+       $me->draw_filled( $data, $opts, $shadow );
     }
     elsif( $opts->{style} eq 'range' ){
        # did you ever see such a thing as a drawing of a muchness?
        #    -- Alice in Wonderland
-       $me->draw_range( $data, $opts );
+       $me->draw_range( $data, $opts, $shadow );
     }elsif( $opts->{style} eq 'points' ){
         # and they drew all manner of things--everything that begins with an 
M--'
        #    -- Alice in Wonderland
-       $me->draw_points( $data, $opts );
+       $me->draw_points( $data, $opts, $shadow );
     }elsif( $opts->{style} eq 'box' ){
-       $me->draw_boxes( $data, $opts );
+       $me->draw_boxes( $data, $opts, $shadow );
     }else{
        croak "unknown graph style--cannot draw";
     }
@@ -998,77 +1070,128 @@ sub draw_filled {
     my $me   = shift;
     my $data = shift;
     my $opts = shift;
+    my $shadow = shift;
 
     my $im = $me->{img};
     my $limit = $me->{limit_factor} * ($me->{xd_max} - $me->{xd_min}) / @$data;
     my $skipundef = $opts->{skip_undefined} || $me->{skip_undefined};
-    my($px, $py, $pxdpt, $pydpt);
+    my $thick     = $opts->{thickness} || $me->{thickness};
+    my $smooth    = $opts->{smooth} || $me->{smooth};
+    my $shcolor   = $shadow ? $me->img_color($shadow->{color} || 
$me->{shadow_color} ) : undef;
+    my($px, $py, $pxdpt, $pydpt, $pdydx);
     my $ypt0 = $me->ypt(0);
-    
+
+    $thick += $shadow->{dw} if $shadow;
+    $me->set_thickness( $thick ) if $thick;
+
     foreach my $s ( @$data ){
        my $x = $s->{time};
        my $y = $s->{value};
-       
+
        next if $x < $me->{xd_min} || $x > $me->{xd_max};
 
        my $xdpt  = $me->xdatapt($x);
        my $ydpt  = $me->ydatapt($y);
+        my $dydx;
+
+        if( $shadow ){
+            $xdpt += $shadow->{dx};
+            $ydpt += $shadow->{dy};
+        }
 
        if( defined($y) || !$skipundef ){
-           
+            my $color = $shadow ? $shcolor : $me->color($s, $opts);
+
            if( defined($px) && ($xdpt - $pxdpt > 1) && (!$limit || $x - $px <= 
$limit) ){
-               my $poly = GD::Polygon->new;
-               $poly->addPt($pxdpt, $ypt0);
-               $poly->addPt($pxdpt, $pydpt);
-               $poly->addPt($xdpt,  $ydpt);
-               $poly->addPt($xdpt,  $ypt0);
-               $im->filledPolygon($poly, $me->color($s, $opts));
+                if( $smooth ){
+                    next unless defined $s->{dydx};
+                    $dydx  = - $s->{dydx} * $me->{yd_scale} / $me->{xd_scale};
+                    $me->curve($pxdpt, $pydpt, $pdydx,
+                               $xdpt,  $ydpt,  $dydx,
+                               $smooth, \&curve_filled, [$color, $ypt0]);
+                }else{
+                    my $poly = GD::Polygon->new;
+                    $poly->addPt($pxdpt, $ypt0);
+                    $poly->addPt($pxdpt, $pydpt);
+                    $poly->addPt($xdpt,  $ydpt);
+                    $poly->addPt($xdpt,  $ypt0);
+                    $im->filledPolygon($poly, $color);
+                }
            }else{
                $im->line( $xdpt, $ypt0,
                           $xdpt, $ydpt,
-                          $me->color($s, $opts) );
+                           $color);
            }
            $px = $x; $pxdpt = $xdpt;
            $py = $y; $pydpt = $ydpt;
+            $pdydx = $dydx;
        }else{
            $px = undef;
        }
     }
+    $me->set_thickness( 1 ) if $thick;
 }
 
 sub draw_line {
     my $me   = shift;
     my $data = shift;
     my $opts = shift;
+    my $shadow = shift;
 
     my $im = $me->{img};
     my $limit = $me->{limit_factor} * ($me->{xd_max} - $me->{xd_min}) / @$data;
     my $thick = $opts->{thickness} || $me->{thickness};
     my $skipundef = $opts->{skip_undefined} || $me->{skip_undefined};
-    my($px, $py, $pxdpt, $pydpt);
+    my $smooth    = $opts->{smooth} || $me->{smooth};
+    my($px, $py, $pxdpt, $pydpt, $pdydx);
 
+    $thick += $shadow->{dw} if $shadow;
     $me->set_thickness( $thick ) if $thick;
-    
+
+    my $shcolor = $shadow ? $me->img_color($shadow->{color} || 
$me->{shadow_color} ) : undef;
+
     foreach my $s ( @$data ){
        my $x = $s->{time};
        my $y = $s->{value};
 
        next if $x < $me->{xd_min} || $x > $me->{xd_max};
-       
+
        my $xdpt  = $me->xdatapt($x);
        my $ydpt  = $me->ydatapt($y);
+        my $dydx  = $smooth ? - $s->{dydx} * $me->{yd_scale} / $me->{xd_scale} 
: undef;
+
+        if( $shadow ){
+            $xdpt += $shadow->{dx};
+            $ydpt += $shadow->{dy};
+        }
 
        if( defined($y) || !$skipundef ){
+            my $color = $shadow ? $shcolor : $me->color($s, $opts);
+
+            if( $me->{antialias} && $thick == 1 ){
+                # GD cannot antialias a thick line
+                $im->setAntiAliased($color);
+                $color = gdAntiAliased;
+            }
+
            if( defined($px) && (!$limit || $x - $px <= $limit) ){
-               $im->line( $pxdpt, $pydpt,
-                          $xdpt,  $ydpt,
-                          $me->color($s, $opts) );
+                if( $smooth ){
+                    next unless defined $s->{dydx};
+                    $me->curve($pxdpt, $pydpt, $pdydx,
+                               $xdpt,  $ydpt,  $dydx,
+                               $smooth, \&curve_line, [$color]);
+                }else{
+                    $im->line( $pxdpt, $pydpt,
+                               $xdpt,  $ydpt,
+                               $color );
+                }
            }else{
                $im->setPixel($xdpt,  $ydpt,
-                             $me->color($s, $opts) );
+                             $color );
            }
            $px = $x; $pxdpt = $xdpt;
            $py = $y; $pydpt = $ydpt;
+            $pdydx = $dydx;
        }else{
            $px = undef;
        }
@@ -1076,29 +1199,116 @@ sub draw_line {
     $me->set_thickness( 1 ) if $thick;
 }
 
+# GD has only circular arcs, not bezier or cubic splines
+# bezier math is easier than trying to use circular arcs
+sub curve {
+    my $me = shift;
+    my( $x0, $y0, $dydx0,
+        $x1, $y1, $dydx1,
+        $smooth, $fnc, $args ) = @_;
+
+    # pick bezier control points
+    #   smooth = (.5 - 1) gives nice curves
+    #   smooth > 1 gives straighter segments
+    #   smooth <= .5 takes the graph on a drug trip
+    my $dxt = ($x1 - $x0) / ($smooth * 3);
+    my $cx0 = $x0 + $dxt;
+    my $cx1 = $x1 - $dxt;
+    my $cy0 = $y0 + $dydx0 * $dxt;
+    my $cy1 = $y1 - $dydx1 * $dxt;
+
+    # bezier coefficients
+    my $ax =     - $x0 + 3 * $cx0 - 3 * $cx1 + $x1;
+    my $ay =     - $y0 + 3 * $cy0 - 3 * $cy1 + $y1;
+    my $bx =   3 * $x0 - 6 * $cx0 + 3 * $cx1;
+    my $by =   3 * $y0 - 6 * $cy0 + 3 * $cy1;
+    my $cx = - 3 * $x0 + 3 * $cx0;
+    my $cy = - 3 * $y0 + 3 * $cy0;
+    my $dx =       $x0;
+    my $dy =       $y0;
+
+    # draw bezier curve
+    my $px = $x0;
+    my $py = $y0;
+
+    # my $im = $me->{img};
+    # $im->line($x0,$y0, $cx0,$cy0, $me->img_color('00ff00'));
+    # $im->line($x1,$y1, $cx1,$cy1, $me->img_color('00ff00'));
+    # $im->line($cx0,$cy0, $cx1,$cy1, $me->img_color('0000ff'));
+
+    my $ymax = $me->{height} - $me->{margin_bottom};
+    my $ymin = $me->{margin_top};
+
+    my $T = ($x1 - $x0) + abs($y1 - $y0);
+    for my $tt (1 .. $T){
+        my $t = $tt / $T;
+        my $x = $ax * $t**3 + $bx * $t**2 + $cx * $t + $dx;
+        my $y = $ay * $t**3 + $by * $t**2 + $cy * $t + $dy;
+
+        # QQQ - handle out-of-bounds segments how?
+        if( $y >= $ymin && $y <= $ymax && $py >= $ymin && $py <= $ymax ){
+            $fnc->($me, $px,$py, $x,$y, 0, @$args);
+        }else{
+            $fnc->($me, $px,$py, $x,$y, [$ymin, $ymax], @$args);
+        }
+        $px = $x; $py = $y;
+    }
+}
+
+sub curve_line {
+    my $me = shift;
+    my ($px, $py, $x, $y, $oob, $color) = @_;
+
+    return if $oob;
+    $me->{img}->line($px,$py, $x,$y, $color);
+}
+
+sub curve_filled {
+    my $me = shift;
+    my ($px, $py, $x, $y, $oob, $color, $y0) = @_;
+
+    if( $oob ){
+        my($ymin, $ymax) = @$oob;
+        $y  = $ymin if $y  < $ymin;
+        $py = $ymin if $py < $ymin;
+        $y  = $ymax if $y  > $ymax;
+        $py = $ymax if $py > $ymax;
+    }
+
+    my $poly = GD::Polygon->new;
+    $poly->addPt($px, $y0);
+    $poly->addPt($px, $py);
+    $poly->addPt($x,  $y);
+    $poly->addPt($x,  $y0);
+    $me->{img}->filledPolygon($poly, $color);
+}
+
+
 sub draw_range {
     my $me   = shift;
     my $data = shift;
     my $opts = shift;
-    
+    my $shadow = shift;
+
+    return if $shadow;
     my $im = $me->{img};
     my $limit = $me->{limit_factor} * ($me->{xd_max} - $me->{xd_min}) / @$data;
     my $skipundef = $opts->{skip_undefined} || $me->{skip_undefined};
     my($px, $pn, $pm, $pxdpt);
-    
+
     foreach my $s ( @$data ){
        my $x = $s->{time};
        my $a = defined $s->{min} ? $s->{min} : $s->{value};
        my $b = defined $s->{max} ? $s->{max} : $s->{value};
        my $xdpt  = $me->xdatapt($x);
-       
+
        next if $x < $me->{xd_min} || $x > $me->{xd_max};
-       
+
        $a = $b if !defined($a) && $skipundef;
        $b = $a if !defined($b) && $skipundef;
-       
+
        if( defined($a) || !$skipundef ){
-           
+
            if( defined($px) && ($xdpt - $pxdpt > 1) && (!$limit || $x - $px <= 
$limit) ){
                my $poly = GD::Polygon->new;
                $poly->addPt($pxdpt, $me->ydatapt($pn));
@@ -1123,21 +1333,29 @@ sub draw_points {
     my $me   = shift;
     my $data = shift;
     my $opts = shift;
-    
+    my $shadow = shift;
+
     my $im = $me->{img};
     my $skipundef = $opts->{skip_undefined} || $me->{skip_undefined};
-    
+    my $shcolor   = $shadow ? $me->img_color($shadow->{color} || 
$me->{shadow_color} ) : undef;
+
     foreach my $s ( @$data ){
        my $x = $s->{time};
        my $y = $s->{value};
        my $d = $s->{diam} || $opts->{diam} || 4;
-       my $c = $me->color($s, $opts);
+       my $c = $shadow ? $shcolor : $me->color($s, $opts);
 
        next if $x < $me->{xd_min} || $x > $me->{xd_max};
        next if !defined($y) && $skipundef;
        my $xdpt = $me->xdatapt($x);
        my $ydpt = $me->ydatapt($y);
-       
+
+        if( $shadow ){
+            $d    += $shadow->{dw};
+            $xdpt += $shadow->{dx};
+            $ydpt += $shadow->{dy};
+        }
+
        while( $d > 0 ){
            $im->arc( $xdpt, $ydpt,
                      $d, $d, 0, 360,
@@ -1161,39 +1379,47 @@ sub draw_boxes {
     my $me   = shift;
     my $data = shift;
     my $opts = shift;
-    
+    my $shadow = shift;
+
     my $im = $me->{img};
     my $defwid = def_box_width($data->[0]{time}, $data->[-1]{time}, 
scalar(@$data));
     my $thick  = $opts->{thickness} || $me->{thickness};
     my $skipundef = $opts->{skip_undefined} || $me->{skip_undefined};
-    
+    my $shcolor = $shadow ? $me->img_color($shadow->{color} || 
$me->{shadow_color} ) : undef;
+
+    $thick += $shadow->{dw} if $shadow;
     $me->set_thickness( $thick ) if $thick;
-    
+
     foreach my $s ( @$data ){
        my $x = $s->{time};
        my $y = $s->{value};
        my $w = $s->{width} || $opts->{width} || $me->{boxwidth} || $defwid;
-       my $c = $me->color($s, $opts);
        my $y0 = $opts->{boxbase} || $me->{boxbase} || 0;
-       
+        my $c = $shadow ? $shcolor : $me->color($s, $opts);
+
        next if $x < $me->{xd_min} || $x > $me->{xd_max};
        next if !defined($y) && $skipundef;
 
        # because GD cares...
-       my $ya = $y > $y0 ? $y : $y0;
-       my $yb = $y > $y0 ? $y0 : $y;
-       
+       my $ya = $me->ydatapt($y > $y0 ? $y : $y0);
+       my $yb = $me->ydatapt($y > $y0 ? $y0 : $y);
+        my $xa = $me->xdatapt($x - $w/2);
+        my $xb = $me->xdatapt($x + $w/2);
+
+        if( $shadow ){
+            $xa += $shadow->{dx};
+            $xb += $shadow->{dx};
+            $ya += $shadow->{dy};
+            $yb += $shadow->{dy};
+        }
+
        if( $opts->{filled} || $s->{filled} ){
-           $im->filledRectangle( $me->xdatapt($x - $w/2), $me->ydatapt($ya),
-                                 $me->xdatapt($x + $w/2), $me->ydatapt($yb),
-                                 $c);
+           $im->filledRectangle( $xa, $ya, $xb, $yb, $c);
        }else{
-           $im->rectangle( $me->xdatapt($x - $w/2), $me->ydatapt($ya),
-                           $me->xdatapt($x + $w/2), $me->ydatapt($yb),
-                           $c);
+           $im->rectangle( $xa, $ya, $xb, $yb, $c);
        }
     }
-    
+
     $me->set_thickness( 1 ) if $thick;
 }
 
@@ -1201,14 +1427,22 @@ sub draw_boxes {
 =head1 EXAMPLE IMAGES
 
     http://argus.tcp4me.com/shots.html
-    http://search.cpan.org/src/JAW/Chart-Strip-1.05/eg/
+    http://search.cpan.org/src/JAW/Chart-Strip-1.07/eg/
+
+=head1 LICENSE
+
+This software may be copied and distributed under the terms
+found in the Perl "Artistic License".
+
+A copy of the "Artistic License" may be found in the standard
+Perl distribution.
 
 =head1 BUGS
 
 There are no known bugs in the module.
 
 =head1 SEE ALSO
-    
+
     Yellowstone National Park.
 
 =head1 AUTHOR
diff --git a/debian/changelog b/debian/changelog
index a16dcd2..21e0b4b 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,8 +1,8 @@
-libchart-strip-perl (1.05-3) UNRELEASED; urgency=low
+libchart-strip-perl (1.07-1) UNRELEASED; urgency=low
 
-  * NOT RELEASED YET
+  * New upstream release
 
- -- Dominic Hargreaves <d...@earth.li>  Tue, 26 Feb 2008 22:04:41 +0000
+ -- Dominic Hargreaves <d...@earth.li>  Wed, 17 Jun 2009 22:15:39 +0100
 
 libchart-strip-perl (1.05-2) unstable; urgency=low
 
diff --git a/eg/Makefile b/eg/Makefile
index a9b7574..a2b3816 100644
--- a/eg/Makefile
+++ b/eg/Makefile
@@ -1,5 +1,5 @@
 
-all: ex1.png ex2.png ex3.png ex4.png ex5.png
+all: ex1.png ex2.png ex3.png ex4.png ex5.png ex6.png
 
 .SUFFIXES: .pl .png
 .pl.png:
diff --git a/eg/ex6.png b/eg/ex6.png
new file mode 100644
index 0000000..88355f4
Binary files /dev/null and b/eg/ex6.png differ
diff --git a/eg/index.html b/eg/index.html
index 517c22b..101f854 100644
--- a/eg/index.html
+++ b/eg/index.html
@@ -7,6 +7,7 @@
 <IMG SRC="ex3.png"><P>
 <IMG SRC="ex4.png"><P>
 <IMG SRC="ex5.png"><P>
+<IMG SRC="ex6.png"><P>
 
 </BODY>
 </HTML>

-- 
Alioth's /usr/local/bin/git-commit-notice on 
/srv/git.debian.org/git/pkg-perl/packages/libchart-strip-perl.git.git

_______________________________________________
Pkg-perl-cvs-commits mailing list
Pkg-perl-cvs-commits@lists.alioth.debian.org
http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-perl-cvs-commits

Reply via email to