[libchart-strip-perl.git] 05/26: import current version from unstable

dom at earth.li dom at earth.li
Sat Oct 29 22:44:51 UTC 2016


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 1d64bf3aeb670243b549689a8748d3515ce794e6
Author: Dominic Hargreaves <dom at earth.li>
Date:   Tue Feb 26 21:48:39 2008 +0000

    import current version from unstable
---
 CHANGES          |   3 +
 MANIFEST         |   1 +
 META.yml         |   2 +-
 Strip.pm         | 398 ++++++++++++++++++++++++++++++++++----------------
 debian/changelog |   6 +
 t/test3.t        | 433 +++++++++++++++++++++++++++++++++++++++++++++++++++++++
 6 files changed, 719 insertions(+), 124 deletions(-)

diff --git a/CHANGES b/CHANGES
index 0a5e6f5..5f6f52f 100644
--- a/CHANGES
+++ b/CHANGES
@@ -1,4 +1,7 @@
 
+1.05
+	xtic changes and speedups
+
 1.04
 	added missing files to MANIFEST
 
diff --git a/MANIFEST b/MANIFEST
index 3f66eb7..6641e60 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -6,6 +6,7 @@ Makefile.PL
 Strip.pm
 t/test1.t
 t/test2.t
+t/test3.t
 eg/index.html
 eg/Makefile
 eg/ex1.pl
diff --git a/META.yml b/META.yml
index c450404..53e3946 100644
--- a/META.yml
+++ b/META.yml
@@ -1,7 +1,7 @@
 # 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.04
+version:      1.05
 version_from: Strip.pm
 installdirs:  site
 requires:
diff --git a/Strip.pm b/Strip.pm
index e1db111..69f396f 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.14 2006/05/27 18:20:39 jaw Exp jaw $
+# $Id: Strip.pm,v 1.15 2006/06/25 17:48:59 jaw Exp jaw $
 
-$Chart::Strip::VERSION = "1.04";
+$Chart::Strip::VERSION = "1.05";
 
 =head1 NAME
 
@@ -185,6 +185,20 @@ use Carp;
 use POSIX;
 use strict;
 
+my $LT_HM = 1;	# time
+my $LT_HR = 2;	# time/day
+my $LT_DW = 3;	# day/date
+my $LT_DM = 4;	# date/yr
+my $LT_YR = 5;	# year
+
+my $MT_NO = 0;	# none
+my $MT_HR = 1;	# hrs
+my $MT_MN = 2;	# midnight
+my $MT_SU = 3;	# sunday
+my $MT_M1 = 4;	# 1st
+my $MT_Y1 = 5;	# new years
+
+
 sub new {
     my $class = shift;
     my %param = @_;
@@ -239,11 +253,11 @@ sub new {
     $im->setStyle(gdTransparent, $me->{color}{gray}, gdTransparent, gdTransparent);
 
     $im->interlaced('true');
-    $me->{img}->transparent($me->{color}{white})
+    $im->transparent($me->{color}{white})
 	if $me->{transparent};
 
-    $me->{img}->rectangle(0, 0, $me->{width}-1, $me->{height}-1,
-	     $me->color({ color => ($me->{border_color} || 'black') }))
+    $im->rectangle(0, 0, $me->{width}-1, $me->{height}-1,
+		   $me->color({ color => ($me->{border_color} || 'black') }))
 	if $me->{draw_border};
 
     $me;
@@ -552,7 +566,7 @@ sub pretty {
 	}
 	elsif( $ay < 1/$b**2 ){
 	    $y *= $b ** 3; $st *= $b ** 3;
-	    $sc = 'p';
+	    $sc = 'n';
 	}
 	elsif( $ay < 1/$b ){
 	    $y *= $b**2; $st *= $b**2;
@@ -563,7 +577,11 @@ sub pretty {
 	    $sc = 'm';
 	}
     }else{
-	if( $ay >= $b**3 ){
+	if( $ay >= $b**4 ){
+	    $y /= $b**4;  $st /= $b**4;
+	    $sc = 'T';
+	}
+	elsif( $ay >= $b**3 ){
 	    $y /= $b**3;  $st /= $b**3;
 	    $sc = 'G';
 	}
@@ -628,24 +646,25 @@ sub ytics {
 	$me->adjust();
     }
 
-    $me->{grid}{y} = [ @tics ];
+    $me->{grid}{y} = \@tics;
 }
 
 sub drawgrid {
     my $me = shift;
+    my $im = $me->{img};
     
     foreach my $tic (@{$me->{grid}{y}}){
 	# ytics + horiz lines
 	my $yy = $tic->[0];
-	$me->{img}->line($me->xpt(-1), $yy, $me->xpt(-4), $yy,
+	$im->line($me->xpt(-1), $yy, $me->xpt(-4), $yy,
 			 $me->{color}{black});
-	$me->{img}->line($me->xpt(0), $yy, $me->{width} - $me->{margin_right}, $yy,
+	$im->line($me->xpt(0), $yy, $me->{width} - $me->{margin_right}, $yy,
 			 gdStyled) if $me->{draw_grid};
 
 	if( $me->{draw_tic_labels} ){
 	    my $label = $tic->[1];
 	    my $w = $tic->[2];
-	    $me->{img}->string(gdTinyFont, $me->xpt(-$w), $yy-4,
+	    $im->string(gdTinyFont, $me->xpt(-$w), $yy-4,
 			       $label,
 			       $me->{color}{black});
 	}
@@ -655,17 +674,18 @@ sub drawgrid {
 	# xtics + vert lines
 	my( $t, $ll, $label ) = @$tic;
 
-	if( $ll ){
+	# supress solid line if adjacent to axis
+	if( $ll && ($t != $me->{xd_min}) ){
 	    # solid line, red label
-	    $me->{img}->line($me->xdatapt($t), $me->{margin_top},
+	    $im->line($me->xdatapt($t), $me->{margin_top},
 			     $me->xdatapt($t), $me->ypt(-4),
 			     $me->{color}{black} );
 	}else{
 	    # tic and grid
-	    $me->{img}->line($me->xdatapt($t), $me->ypt(-1),
+	    $im->line($me->xdatapt($t), $me->ypt(-1),
 			     $me->xdatapt($t), $me->ypt(-4),
 			     $me->{color}{black} );
-	    $me->{img}->line($me->xdatapt($t), $me->{margin_top},
+	    $im->line($me->xdatapt($t), $me->{margin_top},
 			     $me->xdatapt($t), $me->ypt(0),
 			     gdStyled ) if $me->{draw_grid};
 	}
@@ -677,88 +697,206 @@ sub drawgrid {
 		$a = $me->xdatapt($t) - $me->{width} + length($label) * 6 + 2;
 	    }
 	    
-	    $me->{img}->string(gdSmallFont, $me->xdatapt($t)-$a, $me->ypt(-6),
+	    $im->string(gdSmallFont, $me->xdatapt($t)-$a, $me->ypt(-6),
 			       $label, $ll ? $me->{color}{red} : $me->{color}{black} );
 	}
     }
 }
 
-# this is much too ickky, please re-write
+sub xtic_range_data {
+    my $me    = shift;	# not used
+    my $range = shift;
+
+    my $range_hrs  = $range / 3600;
+    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
+    }
+    elsif( $range < 1800 ){
+	(300, $LT_HM, $MT_HR, 1, 5);		# tics: 5 min
+    }
+    elsif( $range_hrs < 2 ){
+	(600, $LT_HM, $MT_HR, 1, 10);		# tics: 10 min
+    }
+    elsif( $range_hrs < 6 ){
+	(1800, $LT_HR, $MT_MN, 1, 30);		# tics: 30 min
+    }
+    elsif( $range_hrs < 13 ){
+	(3600, $LT_HR, $MT_MN, 2, 1);		# tics: 1 hr
+    }
+    elsif( $range_hrs < 25 ){
+	(3600, $LT_HR, $MT_MN, 2, 2);		# tics: 2 hrs
+    }
+    elsif( $range_hrs < 50 ){
+	(3600, $LT_HR, $MT_MN, 2, 4);		# tics: 4 hrs
+    }
+    elsif( $range_hrs < 75 ){
+	(3600, $LT_HR, $MT_MN, 2, 6);		# tics: 6 hrs
+    }
+
+    # NB: days shorter or longer than 24 hours are corrected for below
+    elsif( $range_days < 15 ){
+	(3600*24, $LT_DW, $MT_SU, 3, 1);	# tics 1 day
+    }
+    elsif( $range_days < 22 ){
+	(3600*24, $LT_DM, $MT_M1, 3, 2);	# tics: 2 days
+    }
+    elsif( $range_days < 80 ){
+	(3600*24, $LT_DM, $MT_M1, 3, 7);	# tics: 7 days
+    }
+    elsif( $range_days < 168 ){
+	(3600*24, $LT_DM, $MT_Y1, 3, 14);	# tics: 14 days
+    }
+    # NB: months shorter than 31 days are corrected for below
+    elsif( $range_days < 370 ){
+	(3600*24*31, $LT_DM, $MT_Y1, 4, 1);	# tics: 1 month
+    }
+    elsif( $range_days < 500 ){
+	(3600*24*31, $LT_DM, $MT_Y1, 4, 2);	# tics: 2 month
+    }
+    elsif( $range_days < 1000 ){
+	(3600*24*31, $LT_DM, $MT_Y1, 4, 3);	# tics: 3 month
+    }
+    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
+    }
+}
+
+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;
+	    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;
+	    $t += $dt * 3600;
+	}
+    }
+    elsif( $step >= 3600*24*31 ){
+	while(1){
+	    # find 1st of mon
+	    my @lt = localtime $t;
+	    last if $lt[3] == 1 && $lt[2] == 0;
+	    my $dt = ($lt[3] < 28) ? 24 : 1;
+	    $t += $dt * 3600;
+	}
+    }
+    elsif( $step >= 3600*24 ){
+	while(1){
+	    # search for midnight
+	    my @lt = localtime $t;
+	    last unless $lt[2];
+	    $t += 3600;
+	}
+    }
+
+    $t;
+}
+
 sub xtics {
     my $me = shift;
-    my( $r, $step, $rd, $n2, $n3, $n4, $lt, $low, $t, @tics );
+    my @tics;
 
     # this is good for (roughly) 10 mins - 10 yrs
     return if $me->{xd_max} == $me->{xd_min};
-    $r = ($me->{xd_max} - $me->{xd_min} ) / 3600;	# => hours
-    $rd   = $r / 24;					# days
-    $step = 3600;
-    $n2   = 24; $n3 = $n4 = 1;
-    $low  = int($me->{xd_min} / 3600) * 3600;
+
+    my $range      = $me->{xd_max} - $me->{xd_min};
+    my $range_hrs  = $range / 3600;
+    my $range_days = $range_hrs / 24;
     
-    if( $r < 2 ){ 		# less than 2 hrs
-	$low = int($me->{xd_min} / 600) * 600;
-	$n2 = 1;
-	$lt = 1;
-	$step = 10 * 60;
-    }elsif( $r < 48 ){		# less than 2 days
-	$n2  = ($r < 13) ? 1 : ($r < 24) ? 2 : 4;
-	$lt  = 1;
-    }
-    elsif( $r < 360 ){		# less than ~ 2 weeks
-	$lt  = 2;
-    }elsif( $rd < 1500 ){	# less than ~ 4yrs
-	$n3  = ($rd < 80)  ? 7 : ($rd < 168) ? 14 : 32;
-	$n4  = ($rd < 370) ? 1 : ($rd < 500) ? 2 : 4;
-	$lt  = 3;
-    }else{
-	$n3 = 32; $n4 = 12;
-	$lt  = 4;
-    }
+    my ($step, $labtyp, $marktyp, $lti, $tmod) = $me->xtic_range_data( $range );
+    my $t = $me->xtic_align_initial( $step );
 
-    # print STDERR "xtics min=$me->{xd_min} max=$me->{xd_max}  r=$r, st=$step, low=$low, $n2/$n3/$n4\n";
-    for( $t=$low; $t<$me->{xd_max}; $t+=$step ){
-	my $ll;
+    # 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;
-	next if $lt[2] % $n2;
-	next if ($lt[3] - 1) % $n3 || (($n3!=1) && $lt[3] > 22 );
-	next if $lt[4] % $n4;
-	if( $lt == 1 && !$lt[2] && !$lt[1] ||      # midnight
-	    $lt == 2 && !$lt[6] ||                 # sunday
-	    $lt == 3 && $lt[3] == 1 && $rd < 60 || # 1st of month
-	    $lt == 3 && $lt[3] == 1 && $lt[4] == 0 # Jan 1
-	    ){
-	    $ll = 1;
+	my @lt  = localtime $t;
+	my @rlt = @lt;
+	# months go from 0. days from 1. absurd!
+	$lt[3]--;
+	# mathematically, 28 is divisible by 7. but that just looks silly.
+	$lt[3] = 22 if $lt[3] > 22 && $lti==3 && $tmod >= 7;
+
+	if( $step >= 3600*24 && $lt[2] ){
+	    # handle daylight saving time changes - resync to midnight
+	    my $dt = ($lt[2] > 12 ? $lt[2] - 24 : $lt[2]) * 3600;
+	    $dt += $lt[1] * 60;
+	    $t -= $dt;
+	    redo;
+	}
+	if( $step >= 3600*24*31 && $lt[3] ){
+	    # some months are not 31 days!
+	    # also corrects years that do not leap
+	    my $dt = $lt[3] * 3600*24;
+	    $t -= $dt;
+	    redo;
 	}
 	
+	next if $lt[$lti] % $tmod;
+	next if $lt[3] && $lti > 3;
+	next if $lt[2] && $lti > 2;
+	next if $lt[1] && $lti > 1;
+	next if $lt[0] && $lti > 0;
+
+
+	$redmark = 1 if $marktyp == $MT_HR && !$lt[1];			# on the hour
+	$redmark = 1 if $marktyp == $MT_MN && !$lt[2] && !$lt[1];	# midnight
+	$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;
-	if( $lt == 1){
-	    $label = sprintf "%d:%0.2d", $lt[2], $lt[1];	# time
+	# NB: strftime obeys LC_TIME for localized day/month names
+	# (if locales are supported in the OS and perl)
+	if( $labtyp == $LT_HM ){
+	    $label = sprintf "%d:%0.2d", $rlt[2], $rlt[1];	# time
 	}
-	if( $lt == 2 ){
-	    if( $ll ){
-		# NB: strftime obeys LC_TIME for localized day/month names
-		# (if locales are supported in the OS and perl)
-		$label = strftime("%d/%b", @lt);	# date DD/Mon
+	if( $labtyp == $LT_HR ){
+	    if( $redmark ){
+		$label = strftime("%d/%b", @rlt);		# date DD/Mon
 	    }else{
-		$label = strftime("%a", @lt);		# day of week
+		$label = sprintf "%d:%0.2d", $rlt[2], $rlt[1];	# time
 	    }
 	}
-	if( $lt == 3){
-	    if( $lt[3] == 1 && $lt[4] == 0 ){
-		$label = $lt[5] + 1900;			# year
+	if( $labtyp == $LT_DW ){
+	    if( $redmark ){
+		$label = strftime("%d/%b", @rlt);	# date DD/Mon
 	    }else{
-		$label = strftime("%d/%b", @lt);	# date DD/Mon
+		$label = strftime("%a", @rlt);		# day of week
 	    }
 	}
-	if( $lt == 4){
-	    $label = $lt[5] + 1900; # year
+	if( $labtyp == $LT_DM ){
+	    if( !$lt[3] && !$lt[4] ){
+		$label = $rlt[5] + 1900;		# year
+	    }else{
+		$label = strftime("%d/%b", @rlt);	# date DD/Mon
+	    }
+	}
+	if( $labtyp == $LT_YR ){
+	    $label = $rlt[5] + 1900; 			# year
 	}
-	push @tics, [$t, $ll, $label];
+	push @tics, [$t, $redmark, $label];
     }
-    $me->{grid}{x} = [@tics];
-        
+    $me->{grid}{x} = \@tics;
+    
 }
 
 # it shall be inventoried, and every particle and utensil
@@ -864,32 +1002,37 @@ sub draw_filled {
     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);
+    my($px, $py, $pxdpt, $pydpt);
+    my $ypt0 = $me->ypt(0);
     
     foreach my $s ( @$data ){
 	my $x = $s->{time};
 	my $y = $s->{value};
-
+	
 	next if $x < $me->{xd_min} || $x > $me->{xd_max};
 
-	if( defined($y) || !$skipundef ){
+	my $xdpt  = $me->xdatapt($x);
+	my $ydpt  = $me->ydatapt($y);
 
-	    if( defined($px) && ($me->xdatapt($x) - $me->xdatapt($px) > 1) ){
-		$px = $x - $limit if $limit && $x - $px > $limit;
-		
+	if( defined($y) || !$skipundef ){
+	    
+	    if( defined($px) && ($xdpt - $pxdpt > 1) && (!$limit || $x - $px <= $limit) ){
 		my $poly = GD::Polygon->new;
-		$poly->addPt($me->xdatapt($px), $me->ypt(0));
-		$poly->addPt($me->xdatapt($px), $me->ydatapt($py));
-		$poly->addPt($me->xdatapt($x),  $me->ydatapt($y));
-		$poly->addPt($me->xdatapt($x),  $me->ypt(0));
+		$poly->addPt($pxdpt, $ypt0);
+		$poly->addPt($pxdpt, $pydpt);
+		$poly->addPt($xdpt,  $ydpt);
+		$poly->addPt($xdpt,  $ypt0);
 		$im->filledPolygon($poly, $me->color($s, $opts));
 	    }else{
-		$im->line( $me->xdatapt($x), $me->ypt(0),
-			   $me->xdatapt($x), $me->ydatapt($y),
+		$im->line( $xdpt, $ypt0,
+			   $xdpt, $ydpt,
 			   $me->color($s, $opts) );
 	    }
+	    $px = $x; $pxdpt = $xdpt;
+	    $py = $y; $pydpt = $ydpt;
+	}else{
+	    $px = undef;
 	}
-	$px = $x; $py = $y;
     }
 }
 
@@ -902,7 +1045,7 @@ sub draw_line {
     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);
+    my($px, $py, $pxdpt, $pydpt);
 
     $me->set_thickness( $thick ) if $thick;
     
@@ -911,19 +1054,24 @@ sub draw_line {
 	my $y = $s->{value};
 
 	next if $x < $me->{xd_min} || $x > $me->{xd_max};
+	
+	my $xdpt  = $me->xdatapt($x);
+	my $ydpt  = $me->ydatapt($y);
 
 	if( defined($y) || !$skipundef ){
-	    if( defined($py) ){
-		$px = $x - $limit if $limit && $x - $px > $limit;
-		$im->line( $me->xdatapt($px), $me->ydatapt($py),
-			   $me->xdatapt($x),  $me->ydatapt($y),
+	    if( defined($px) && (!$limit || $x - $px <= $limit) ){
+		$im->line( $pxdpt, $pydpt,
+			   $xdpt,  $ydpt,
 			   $me->color($s, $opts) );
 	    }else{
-		$im->setPixel($me->xdatapt($x),  $me->ydatapt($y),
+		$im->setPixel($xdpt,  $ydpt,
 			      $me->color($s, $opts) );
 	    }
+	    $px = $x; $pxdpt = $xdpt;
+	    $py = $y; $pydpt = $ydpt;
+	}else{
+	    $px = undef;
 	}
-	$px = $x; $py = $y;
     }
     $me->set_thickness( 1 ) if $thick;
 }
@@ -932,40 +1080,42 @@ sub draw_range {
     my $me   = shift;
     my $data = shift;
     my $opts = 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, $pn, $pm);
+    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};
-
-	  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) && ($me->xdatapt($x) - $me->xdatapt($px) > 1) ){
-		  my $poly = GD::Polygon->new;
-		  $px = $x - $limit if $limit && $x - $px > $limit;
-		  
-		  $poly->addPt($me->xdatapt($px), $me->ydatapt($pn));
-		  $poly->addPt($me->xdatapt($px), $me->ydatapt($pm));
-		  $poly->addPt($me->xdatapt($x),  $me->ydatapt($b));
-		  $poly->addPt($me->xdatapt($x),  $me->ydatapt($a));
-		  $im->filledPolygon($poly, $me->color($s, $opts));
-	      }else{
-		  $im->line( $me->xdatapt($x),  $me->ydatapt($b),
-			     $me->xdatapt($x),  $me->ydatapt($a),
-			     $me->color($s, $opts) );
-	      }
-	  }
-	  $px = $x; $pn = $a; $pm = $b;
+	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));
+		$poly->addPt($pxdpt, $me->ydatapt($pm));
+		$poly->addPt($xdpt,  $me->ydatapt($b));
+		$poly->addPt($xdpt,  $me->ydatapt($a));
+		$im->filledPolygon($poly, $me->color($s, $opts));
+	    }else{
+		$im->line( $xdpt,  $me->ydatapt($b),
+			   $xdpt,  $me->ydatapt($a),
+			   $me->color($s, $opts) );
+	    }
+	    $px = $x; $pn = $a; $pm = $b;
+	    $pxdpt = $xdpt;
+	}else{
+	    $px = undef;
+	}
     }
 }
 
@@ -985,9 +1135,11 @@ sub draw_points {
 
 	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);
 	
 	while( $d > 0 ){
-	    $im->arc( $me->xdatapt($x),  $me->ydatapt($y),
+	    $im->arc( $xdpt, $ydpt,
 		      $d, $d, 0, 360,
 		      $c );
 	    $d -= 2;
@@ -1049,7 +1201,7 @@ sub draw_boxes {
 =head1 EXAMPLE IMAGES
 
     http://argus.tcp4me.com/shots.html
-    http://search.cpan.org/src/JAW/Chart-Strip-1.04/eg/
+    http://search.cpan.org/src/JAW/Chart-Strip-1.05/eg/
 
 =head1 BUGS
 
diff --git a/debian/changelog b/debian/changelog
index a8f6427..02c5b38 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,3 +1,9 @@
+libchart-strip-perl (1.05-1) unstable; urgency=low
+
+  * New upstream release
+
+ -- Dominic Hargreaves <dom at earth.li>  Mon,  4 Jun 2007 18:47:35 +0100
+
 libchart-strip-perl (1.04-1) unstable; urgency=low
 
   * New upstream release
diff --git a/t/test3.t b/t/test3.t
new file mode 100644
index 0000000..562e3ff
--- /dev/null
+++ b/t/test3.t
@@ -0,0 +1,433 @@
+
+# test new xtic code
+use Chart::Strip;
+use strict;
+
+my $MK = 0;
+my $H = 3600;
+my $D = $H * 24;
+my @t;
+
+eval {
+    # tests assume US/eastern, en_us. skip if we can't make compat.
+    require POSIX;
+    POSIX->import();
+    $ENV{TZ} = 'EST5EDT';
+    setlocale( LC_ALL(), "C" );
+    tzset();
+    if( localtime(1151726400) ne 'Sat Jul  1 00:00:00 2006' ){
+	die "tests not configured for this timezone/locale\n";
+    }
+};
+if($@){
+    print "1..0 # Skipped: cannot make timezone/locale compatible\n";
+    exit;
+}
+
+if( localtime(1175400000) ne 'Sun Apr  1 00:00:00 2007' ){
+    # the US govmit changed the daylight saving time rules.
+    # most OSes don't know that
+    # expect the fallout from this to be much worse than y2k.
+
+    print "1..0 # Skipped: OS has out of date daylight saving time rules\n";
+    exit;
+}
+
+# return xtic data for specified time range
+sub gen {
+    my $t0  = shift;
+    my $dur = shift;
+    
+    my $c = Chart::Strip->new();
+    $c->add_data( [ {time => $t0,        value => 1},
+		    {time => $t0 + $dur, value => 1}],
+		  { style => 'line' });
+    $c->plot();
+    $c->{grid}{x};
+}
+
+sub test {
+    my $t  = shift;
+    my $mk = shift;
+
+    if( !ref $t ){
+	print "$t\n" if $mk;
+	return 'ok';
+    }
+    
+    my $t0  = $t->{start};
+    my $dur = $t->{dur};
+    my $exp = $t->{exp};
+    
+    $dur = $1 * $D if $dur =~ /(\d+)D/;
+    $dur = $1 * $H if $dur =~ /(\d+)H/;
+    
+    my $res = gen( $t0, $dur );
+
+    my $err;
+    $err = 1 if @$res != @$exp;
+
+    if( $mk ){
+	my $pv;
+	for my $r (@$res){
+	    my $dt = $pv ? $r->[0] - $pv : '';
+	    print "$t->{dur}\t$t0\t$r->[0]\t$r->[1]\t$r->[2]\t$dt\n";
+	    $pv = $r->[0];
+	}
+	print "\n";
+    }
+    
+    for my $e (@$exp){
+	my $terr;
+	my $r = shift @$res;
+	$terr = 1 unless $e->[0] == $r->[0];
+	$terr = 1 unless $e->[1] == $r->[1];
+	$terr = 1 unless $e->[2] eq $r->[2];
+	$err ||= $terr;
+
+	print STDERR "error: @$e != @$r\n"
+	  if $terr;
+    }
+
+
+    $err ? 'not ok' : 'ok';
+}
+
+
+my $pd = '';
+while(<DATA>){
+    chop;
+    my @l = split;
+    my $dur = $l[0];
+    my $t0  = $l[1];
+    my $exp = [@l[2,3,4,5]];
+
+    if( /^\#/ ){
+	# preserve comments
+	push @t, $_;
+	next;
+    }
+    next unless $dur;
+    
+    if($dur eq $pd){
+	push @{$t[-1]{exp}}, $exp;
+    }else{
+	push @t, { dur => $dur, start => $t0, exp => [$exp] };
+    }
+    $pd = $dur;
+}
+
+print "1..", scalar @t, "\n" unless $MK;
+my $n = 1;
+foreach my $t (@t){
+    my $r = test($t, $MK);
+    print "$r ", $n++, "\n" unless $MK;
+}
+
+# duration start expected result: tic-time, redmark, label, delta(not-used)
+__END__
+2100D	1151726400	1167627600	0	2007	
+2100D	1151726400	1199163600	0	2008	31536000
+2100D	1151726400	1230786000	0	2009	31622400
+2100D	1151726400	1262322000	0	2010	31536000
+2100D	1151726400	1293858000	0	2011	31536000
+2100D	1151726400	1325394000	0	2012	31536000
+
+1500D	1151726400	1151726400	0	01/Jul	
+1500D	1151726400	1167627600	0	2007	15901200
+1500D	1151726400	1183262400	0	01/Jul	15634800
+1500D	1151726400	1199163600	0	2008	15901200
+1500D	1151726400	1214884800	0	01/Jul	15721200
+1500D	1151726400	1230786000	0	2009	15901200
+1500D	1151726400	1246420800	0	01/Jul	15634800
+1500D	1151726400	1262322000	0	2010	15901200
+1500D	1151726400	1277956800	0	01/Jul	15634800
+
+750D	1151726400	1151726400	0	01/Jul	
+750D	1151726400	1159675200	0	01/Oct	7948800
+750D	1151726400	1167627600	1	2007	7952400
+750D	1151726400	1175400000	0	01/Apr	7776000
+750D	1151726400	1183262400	0	01/Jul	7858800
+750D	1151726400	1191211200	0	01/Oct	7948800
+750D	1151726400	1199163600	1	2008	7952400
+750D	1151726400	1207022400	0	01/Apr	7862400
+750D	1151726400	1214884800	0	01/Jul	7858800
+
+400D	1151726400	1151726400	0	01/Jul	
+400D	1151726400	1157083200	0	01/Sep	5356800
+400D	1151726400	1162357200	0	01/Nov	5274000
+400D	1151726400	1167627600	1	2007	5270400
+400D	1151726400	1172725200	0	01/Mar	5097600
+400D	1151726400	1177992000	0	01/May	5266800
+400D	1151726400	1183262400	0	01/Jul	5270400
+
+200D	1151726400	1151726400	0	01/Jul	
+200D	1151726400	1154404800	0	01/Aug	2678400
+200D	1151726400	1157083200	0	01/Sep	2678400
+200D	1151726400	1159675200	0	01/Oct	2592000
+200D	1151726400	1162357200	0	01/Nov	2682000
+200D	1151726400	1164949200	0	01/Dec	2592000
+200D	1151726400	1167627600	1	2007	2678400
+
+100D	1151726400	1151726400	0	01/Jul	
+100D	1151726400	1152936000	0	15/Jul	1209600
+100D	1151726400	1154404800	0	01/Aug	1468800
+100D	1151726400	1155614400	0	15/Aug	1209600
+100D	1151726400	1157083200	0	01/Sep	1468800
+100D	1151726400	1158292800	0	15/Sep	1209600
+100D	1151726400	1159675200	0	01/Oct	1382400
+
+50D	1151726400	1151726400	1	01/Jul	
+50D	1151726400	1152331200	0	08/Jul	604800
+50D	1151726400	1152936000	0	15/Jul	604800
+50D	1151726400	1153540800	0	22/Jul	604800
+50D	1151726400	1154404800	1	01/Aug	864000
+50D	1151726400	1155009600	0	08/Aug	604800
+50D	1151726400	1155614400	0	15/Aug	604800
+
+20D	1151726400	1151726400	1	01/Jul	
+20D	1151726400	1151899200	0	03/Jul	172800
+20D	1151726400	1152072000	0	05/Jul	172800
+20D	1151726400	1152244800	0	07/Jul	172800
+20D	1151726400	1152417600	0	09/Jul	172800
+20D	1151726400	1152590400	0	11/Jul	172800
+20D	1151726400	1152763200	0	13/Jul	172800
+20D	1151726400	1152936000	0	15/Jul	172800
+20D	1151726400	1153108800	0	17/Jul	172800
+20D	1151726400	1153281600	0	19/Jul	172800
+
+12D	1151726400	1151726400	0	Sat	
+12D	1151726400	1151812800	1	02/Jul	86400
+12D	1151726400	1151899200	0	Mon	86400
+12D	1151726400	1151985600	0	Tue	86400
+12D	1151726400	1152072000	0	Wed	86400
+12D	1151726400	1152158400	0	Thu	86400
+12D	1151726400	1152244800	0	Fri	86400
+12D	1151726400	1152331200	0	Sat	86400
+12D	1151726400	1152417600	1	09/Jul	86400
+12D	1151726400	1152504000	0	Mon	86400
+12D	1151726400	1152590400	0	Tue	86400
+12D	1151726400	1152676800	0	Wed	86400
+
+6D	1151726400	1151726400	0	Sat	
+6D	1151726400	1151812800	1	02/Jul	86400
+6D	1151726400	1151899200	0	Mon	86400
+6D	1151726400	1151985600	0	Tue	86400
+6D	1151726400	1152072000	0	Wed	86400
+6D	1151726400	1152158400	0	Thu	86400
+
+3D	1151726400	1151726400	1	01/Jul	
+3D	1151726400	1151748000	0	6:00	21600
+3D	1151726400	1151769600	0	12:00	21600
+3D	1151726400	1151791200	0	18:00	21600
+3D	1151726400	1151812800	1	02/Jul	21600
+3D	1151726400	1151834400	0	6:00	21600
+3D	1151726400	1151856000	0	12:00	21600
+3D	1151726400	1151877600	0	18:00	21600
+3D	1151726400	1151899200	1	03/Jul	21600
+3D	1151726400	1151920800	0	6:00	21600
+3D	1151726400	1151942400	0	12:00	21600
+3D	1151726400	1151964000	0	18:00	21600
+
+2D	1151726400	1151726400	1	01/Jul	
+2D	1151726400	1151740800	0	4:00	14400
+2D	1151726400	1151755200	0	8:00	14400
+2D	1151726400	1151769600	0	12:00	14400
+2D	1151726400	1151784000	0	16:00	14400
+2D	1151726400	1151798400	0	20:00	14400
+2D	1151726400	1151812800	1	02/Jul	14400
+2D	1151726400	1151827200	0	4:00	14400
+2D	1151726400	1151841600	0	8:00	14400
+2D	1151726400	1151856000	0	12:00	14400
+2D	1151726400	1151870400	0	16:00	14400
+2D	1151726400	1151884800	0	20:00	14400
+
+18H	1151726400	1151726400	1	01/Jul	
+18H	1151726400	1151733600	0	2:00	7200
+18H	1151726400	1151740800	0	4:00	7200
+18H	1151726400	1151748000	0	6:00	7200
+18H	1151726400	1151755200	0	8:00	7200
+18H	1151726400	1151762400	0	10:00	7200
+18H	1151726400	1151769600	0	12:00	7200
+18H	1151726400	1151776800	0	14:00	7200
+18H	1151726400	1151784000	0	16:00	7200
+
+9H	1151726400	1151726400	1	01/Jul	
+9H	1151726400	1151730000	0	1:00	3600
+9H	1151726400	1151733600	0	2:00	3600
+9H	1151726400	1151737200	0	3:00	3600
+9H	1151726400	1151740800	0	4:00	3600
+9H	1151726400	1151744400	0	5:00	3600
+9H	1151726400	1151748000	0	6:00	3600
+9H	1151726400	1151751600	0	7:00	3600
+9H	1151726400	1151755200	0	8:00	3600
+
+# check near leap year (near 1Mar2004)
+6H	1078106400	1078106400	0	21:00	
+6H	1078106400	1078110000	0	22:00	3600
+6H	1078106400	1078113600	0	23:00	3600
+6H	1078106400	1078117200	1	01/Mar	3600
+6H	1078106400	1078120800	0	1:00	3600
+6H	1078106400	1078124400	0	2:00	3600
+
+22H	1078074000	1078074000	0	12:00	
+22H	1078074000	1078081200	0	14:00	7200
+22H	1078074000	1078088400	0	16:00	7200
+22H	1078074000	1078095600	0	18:00	7200
+22H	1078074000	1078102800	0	20:00	7200
+22H	1078074000	1078110000	0	22:00	7200
+22H	1078074000	1078117200	1	01/Mar	7200
+22H	1078074000	1078124400	0	2:00	7200
+22H	1078074000	1078131600	0	4:00	7200
+22H	1078074000	1078138800	0	6:00	7200
+22H	1078074000	1078146000	0	8:00	7200
+
+14D	1077512400	1077512400	0	Mon	
+14D	1077512400	1077598800	0	Tue	86400
+14D	1077512400	1077685200	0	Wed	86400
+14D	1077512400	1077771600	0	Thu	86400
+14D	1077512400	1077858000	0	Fri	86400
+14D	1077512400	1077944400	0	Sat	86400
+14D	1077512400	1078030800	1	29/Feb	86400
+14D	1077512400	1078117200	0	Mon	86400
+14D	1077512400	1078203600	0	Tue	86400
+14D	1077512400	1078290000	0	Wed	86400
+14D	1077512400	1078376400	0	Thu	86400
+14D	1077512400	1078462800	0	Fri	86400
+14D	1077512400	1078549200	0	Sat	86400
+14D	1077512400	1078635600	1	07/Mar	86400
+
+20D	1077512400	1077512400	0	23/Feb	
+20D	1077512400	1077685200	0	25/Feb	172800
+20D	1077512400	1077858000	0	27/Feb	172800
+20D	1077512400	1078030800	0	29/Feb	172800
+20D	1077512400	1078117200	1	01/Mar	86400
+20D	1077512400	1078290000	0	03/Mar	172800
+20D	1077512400	1078462800	0	05/Mar	172800
+20D	1077512400	1078635600	0	07/Mar	172800
+20D	1077512400	1078808400	0	09/Mar	172800
+20D	1077512400	1078981200	0	11/Mar	172800
+20D	1077512400	1079154000	0	13/Mar	172800
+
+# and near non-leap year (near 1Mar2005)
+6H	1109642400	1109642400	0	21:00	
+6H	1109642400	1109646000	0	22:00	3600
+6H	1109642400	1109649600	0	23:00	3600
+6H	1109642400	1109653200	1	01/Mar	3600
+6H	1109642400	1109656800	0	1:00	3600
+6H	1109642400	1109660400	0	2:00	3600
+
+22H	1109610000	1109610000	0	12:00	
+22H	1109610000	1109617200	0	14:00	7200
+22H	1109610000	1109624400	0	16:00	7200
+22H	1109610000	1109631600	0	18:00	7200
+22H	1109610000	1109638800	0	20:00	7200
+22H	1109610000	1109646000	0	22:00	7200
+22H	1109610000	1109653200	1	01/Mar	7200
+22H	1109610000	1109660400	0	2:00	7200
+22H	1109610000	1109667600	0	4:00	7200
+22H	1109610000	1109674800	0	6:00	7200
+22H	1109610000	1109682000	0	8:00	7200
+
+14D	1109048400	1109048400	0	Tue	
+14D	1109048400	1109134800	0	Wed	86400
+14D	1109048400	1109221200	0	Thu	86400
+14D	1109048400	1109307600	0	Fri	86400
+14D	1109048400	1109394000	0	Sat	86400
+14D	1109048400	1109480400	1	27/Feb	86400
+14D	1109048400	1109566800	0	Mon	86400
+14D	1109048400	1109653200	0	Tue	86400
+14D	1109048400	1109739600	0	Wed	86400
+14D	1109048400	1109826000	0	Thu	86400
+14D	1109048400	1109912400	0	Fri	86400
+14D	1109048400	1109998800	0	Sat	86400
+14D	1109048400	1110085200	1	06/Mar	86400
+14D	1109048400	1110171600	0	Mon	86400
+
+20D	1109048400	1109134800	0	23/Feb	
+20D	1109048400	1109307600	0	25/Feb	172800
+20D	1109048400	1109480400	0	27/Feb	172800
+20D	1109048400	1109653200	1	01/Mar	172800
+20D	1109048400	1109826000	0	03/Mar	172800
+20D	1109048400	1109998800	0	05/Mar	172800
+20D	1109048400	1110171600	0	07/Mar	172800
+20D	1109048400	1110344400	0	09/Mar	172800
+20D	1109048400	1110517200	0	11/Mar	172800
+20D	1109048400	1110690000	0	13/Mar	172800
+
+# check near time change (2Apr)
+4H	1143954000	1143954000	1	02/Apr	
+4H	1143954000	1143955800	0	0:30	1800
+4H	1143954000	1143957600	0	1:00	1800
+4H	1143954000	1143959400	0	1:30	1800
+4H	1143954000	1143961200	0	3:00	1800
+4H	1143954000	1143963000	0	3:30	1800
+4H	1143954000	1143964800	0	4:00	1800
+4H	1143954000	1143966600	0	4:30	1800
+
+8H	1143954000	1143954000	1	02/Apr	
+8H	1143954000	1143957600	0	1:00	3600
+8H	1143954000	1143961200	0	3:00	3600
+8H	1143954000	1143964800	0	4:00	3600
+8H	1143954000	1143968400	0	5:00	3600
+8H	1143954000	1143972000	0	6:00	3600
+8H	1143954000	1143975600	0	7:00	3600
+8H	1143954000	1143979200	0	8:00	3600
+
+2D	1143954000	1143954000	1	02/Apr	
+2D	1143954000	1143964800	0	4:00	10800
+2D	1143954000	1143979200	0	8:00	14400
+2D	1143954000	1143993600	0	12:00	14400
+2D	1143954000	1144008000	0	16:00	14400
+2D	1143954000	1144022400	0	20:00	14400
+2D	1143954000	1144036800	1	03/Apr	14400
+2D	1143954000	1144051200	0	4:00	14400
+2D	1143954000	1144065600	0	8:00	14400
+2D	1143954000	1144080000	0	12:00	14400
+2D	1143954000	1144094400	0	16:00	14400
+2D	1143954000	1144108800	0	20:00	14400
+2D	1143954000	1144123200	1	04/Apr	14400
+
+4D	1143954000	1143954000	1	02/Apr	
+4D	1143954000	1144036800	0	Mon	82800
+4D	1143954000	1144123200	0	Tue	86400
+4D	1143954000	1144209600	0	Wed	86400
+4D	1143954000	1144296000	0	Thu	86400
+
+# check near time change (29Oct)
+4H	1162094400	1162094400	1	29/Oct	
+4H	1162094400	1162096200	0	0:30	1800
+4H	1162094400	1162098000	0	1:00	1800
+4H	1162094400	1162099800	0	1:30	1800
+4H	1162094400	1162101600	0	1:00	1800
+4H	1162094400	1162103400	0	1:30	1800
+4H	1162094400	1162105200	0	2:00	1800
+4H	1162094400	1162107000	0	2:30	1800
+
+8H	1162094400	1162094400	1	29/Oct	
+8H	1162094400	1162098000	0	1:00	3600
+8H	1162094400	1162101600	0	1:00	3600
+8H	1162094400	1162105200	0	2:00	3600
+8H	1162094400	1162108800	0	3:00	3600
+8H	1162094400	1162112400	0	4:00	3600
+8H	1162094400	1162116000	0	5:00	3600
+8H	1162094400	1162119600	0	6:00	3600
+
+2D	1162094400	1162094400	1	29/Oct	
+2D	1162094400	1162112400	0	4:00	18000
+2D	1162094400	1162126800	0	8:00	14400
+2D	1162094400	1162141200	0	12:00	14400
+2D	1162094400	1162155600	0	16:00	14400
+2D	1162094400	1162170000	0	20:00	14400
+2D	1162094400	1162184400	1	30/Oct	14400
+2D	1162094400	1162198800	0	4:00	14400
+2D	1162094400	1162213200	0	8:00	14400
+2D	1162094400	1162227600	0	12:00	14400
+2D	1162094400	1162242000	0	16:00	14400
+2D	1162094400	1162256400	0	20:00	14400
+
+4D	1162094400	1162094400	1	29/Oct	
+4D	1162094400	1162184400	0	Mon	90000
+4D	1162094400	1162270800	0	Tue	86400
+4D	1162094400	1162357200	0	Wed	86400
+

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



More information about the Pkg-perl-cvs-commits mailing list