view release on metacpan or  search on metacpan

Chart/Plot.pm  view on Meta::CPAN

	$brush->line( 0, 4, 8, 4, $clr ),
	$brush->line( 4, 0, 4, 8, $clr ),
	return $brush
		if ($mtype == 3);

# Cross, diagonal
	$brush->line( 0, 0, 8, 8, $clr ),
	$brush->line( 8, 0, 0, 8, $clr ),
	return $brush
		if ($mtype == 4);

# Diamond, filled
	$brush->line( 0, 4, 4, 8, $clr ),
	$brush->line( 4, 8, 8, 4, $clr ),
	$brush->line( 8, 4, 4, 0, $clr ),
	$brush->line( 4, 0, 0, 4, $clr ),
	$brush->fillToBorder( 4, 4, $clr, $clr ),
	return $brush
		if ($mtype == 5);

# Diamond, open
	$brush->line( 0, 4, 4, 8, $clr ),
	$brush->line( 4, 8, 8, 4, $clr ),
	$brush->line( 8, 4, 4, 0, $clr ),
	$brush->line( 4, 0, 0, 4, $clr ),
	return $brush
		if ($mtype == 6);

# Circle, filled
	$brush->arc( 4, 4, 8 , 8, 0, 360, $clr ),
	$brush->fillToBorder( 4, 4, $clr, $clr ),
	return $brush,
		if ($mtype == 7);

# must be Circle, open
	$brush->arc( 4, 4, 8, 8, 0, 360, $clr ),
	return $brush
		if ($mtype == 8);
#
#	dot - contributed by Andrea Spinelli
	$brush->setPixel( 4,4, $clr ),
	return  $brush
 		if ( $mtype == 10 );
}

sub getIcon {
	my ($obj, $icon, $isbar) = @_;
	my $pat = GD::Image->can('newFromGif') ? 
		'png|jpe?g|gif' : 'png|jpe?g';

	$obj->{errmsg} = 
	'Unrecognized icon file format. File qualifier must be .png, .jpg, ' . 
		(GD::Image->can('newFromGif') ? '.jpeg, or .gif.' : 'or .jpeg.'),
	return undef
		unless ($icon=~/\.($pat)$/i);

	$obj->{errmsg} = "Unable to open icon file $icon.",
	return undef
		unless open(ICON, "<$icon");

	my $iconimg = ($icon=~/\.png$/i) ? GD::Image->newFromPng(*ICON) :
	  ($icon=~/\.gif$/i) ? GD::Image->newFromGif(*ICON) :
	    GD::Image->newFromJpeg(*ICON);
	close(ICON);
	$obj->{errmsg} = "GD cannot read icon file $icon.",
	return undef
		unless $iconimg;

	my ($iconw, $iconh) = $iconimg->getBounds();
	$obj->{errmsg} = "Icon image $icon too wide for chart image.",
	return undef
		if (($isbar && ($iconw > $obj->{brushWidth})) ||
			($iconw > $obj->{plotWidth}));
		
	$obj->{errmsg} = "Icon image $icon too tall for chart image.",
	return undef
		if ($iconh > $obj->{plotHeight});
	return $iconimg;
}

sub drawIcons {
	my ($obj, $iconimg, $pxl, $pyb, $pxr, $pyt) = @_;
#
#	force the icon into the defined image area
#
	my ($iconw, $iconh) = $iconimg->getBounds();
	my $img = $obj->{img};
	if ($pxl == $pxr) {
		$pxl -= int($iconw/2);

		my $srcY = 0;
		my $h = $iconh;
#
#	handle candlestick points
		$img->copy($iconimg, $pxl, $pyb, 0, $srcY, $iconw, $h),
		return 1
			if ($pyt == 0);

		while ($pyb > $pyt) {	
			$h = $pyb - $pyt,
			$srcY = $iconh - $h,
				if ($iconh > ($pyb - $pyt));
			$pyb -= $h;
			$img->copy($iconimg, $pxl, $pyb, 0, $srcY, $iconw, $h);
		}
		return 1;
	}
#
#	must be histogram
	$pyb -= int($iconh/2); # this might need adjusting

	my $limX = $iconw;
	while ($pxl < $pxr) {	
		$limX = ($pxr - $pxl) if ($iconw > ($pxr - $pxl));
		$img->copy($iconimg, $pxl, $pyb, 0, 0, $limX, $iconh);
		$pxl += $limX;
	}
	1;
}

sub plot3DAxes {

Chart/Plot.pm  view on Meta::CPAN

	$imgURL=~s/:Y\b/$y/g,
	$imgURL=~s/:Z\b/$z/g
		if ($imgURL);
#
#	interpolate special variables
#
	$imgScript=~s/:PLOTNUM\b/$plotNum/g,
	$imgScript=~s/:X\b/$x/g,
	$imgScript=~s/:Y\b/$y/g,
	$imgScript=~s/:Z\b/$z/g
		if ($imgScript);

	$imgmap .= "\n<AREA TITLE=\"$alt\" " .
		(($obj->{mapURL}) ? " HREF=\"$imgURL\" " : ' NOHREF ');
	$imgmap .= " $imgScript "
		if ($imgScript);

	$imgmap .= " SHAPE=$shape COORDS=\"" . join(',', @pts) . '">';
	$obj->{imgMap} = $imgmap;
	return 1;
}

sub updatePerlImagemap {
	my ($obj, $plotNum, $x, $y, $z, $shape, @pts) = @_;
#
#	render image map element:
#	hotspot is an 8 pixel diameter circle centered on datapoint for
#	lines, points, areas, and candlesticks.
#
	my $imgmap = $obj->{imgMap};
	$imgmap .= ",\n" unless ($imgmap eq '');
	$imgmap .= 
"\{
	plotnum => $plotNum,
	X => '$x',
	Y => '$y',
	Z => '$z',
	shape => '$shape',
	coordinates => [ " . join(',', @pts) . "]
}";
	$obj->{imgMap} = $imgmap;
	return 1;
}

sub addLogo {
	my ($obj) = @_;
	my $pat = GD::Image->can('newFromGif') ? 'png|jpe?g|gif' : 'png|jpe?g';
	my ($logo, $imgw, $imgh) = ($obj->{logo}, $obj->{width}, $obj->{height});
	my $img = $obj->{img};

	$obj->{errmsg} = 
	'Unrecognized logo file format. File qualifier must be .png, .jpg, ' .
		(GD::Image->can('newFromGif') ? '.jpeg, or .gif.' :	'or .jpeg.'),
	return undef
		unless ($logo=~/\.($pat)$/i);

	$obj->{errmsg} = 'Unable to open logo file.',
	return undef
		unless open(LOGO, "<$logo");

	my $logoimg = ($logo=~/\.png$/i) ? GD::Image->newFromPng(*LOGO) :
	  ($logo=~/\.gif$/i) ? GD::Image->newFromGif(*LOGO) :
	    GD::Image->newFromJpeg(*LOGO);
	close(LOGO);
	
	$obj->{errmsg} = 'GD cannot read logo file.',
	return undef
		unless $logoimg;

	my ($logow, $logoh) = $logoimg->getBounds();
#
#	force the logo into the defined image area
#
	my $srcX = ($logow > $imgw) ? ($logow - $imgw)>>1 : 0;
	my $srcY = ($logoh > $imgh) ? ($logoh - $imgh)>>1 : 0;
	my $dstX = ($logow > $imgw) ? 0 : ($imgw - $logow)>>1;
	my $dstY = ($logoh > $imgh) ? 0 : ($imgh - $logoh)>>1;
	my $h = ($logoh > $imgh) ? $imgh : $logoh;
	my $w = ($logow > $imgw) ? $imgw : $logow;
	$img->copy($logoimg, $dstX, $dstY, $srcX, $srcY, $w-1, $h-1);
	return 1;
}

#
#	use plotHistoAxes to make axes

sub setGanttPoints {
	my ($obj, $taskary, $starts, $ends, $assignees, $pcts, @depends) = @_;
	my $props = pop @depends;
	my @data = ();
	my %taskhash = ();
	my %starthash = ();
	my $yh = -1E38;
	my $xh = 0;
	my $i;
	for ($i = 0; $i <= $#$taskary; $i++) {
		next unless (defined($$taskary[$i]) && 
			defined($$starts[$i]) && 
			defined($$ends[$i]));
		
		$obj->{errmsg} = 'Duplicate task name.',
		return undef
			if $taskhash{uc $$taskary[$i]};
		
		my $startdate = convert_temporal($$starts[$i], $obj->{timeRange});
		my $enddate = convert_temporal($$ends[$i], $obj->{timeRange});
		$obj->{errmsg} = 'Invalid start date.',
		return undef
			unless defined($startdate);
		$yh = $enddate if ($enddate > $yh);
		
		$obj->{errmsg} = 'Invalid end date.',
		return undef
			unless (defined($enddate) && ($enddate >= $startdate));
		
		$obj->{errmsg} = 'Invalid completion percentage.',
		return undef
			unless ((! $$pcts[$i]) || 
				(($$pcts[$i]=~/^\d+(\.\d+)?$/) &&
				($$pcts[$i] >= 0) && ($$pcts[$i] <= 100)));