view release on metacpan or  search on metacpan

Chart/Plot.pm  view on Meta::CPAN

			$arc : $start;

#	print "Plotting $text with $pct % angle $arc\n";
	($x, $y) = computeCoords($xc, $yc, $vr, $hr, $arc, $piefactor);
	($fx, $fy) = computeCoords($xc, $yc, $vr * 0.6, $hr* 0.6, $bisect, 
		$piefactor);
	$img->line($xc, $yc, $x, $y, $obj->{black});
	$img->fill($fx, $fy, $color);
#
#	draw front face line if visible
	if ($visible) {
		$img->line($x, $y, $x, $y+20, $obj->{black})
			if ($start == $arc);
		($fx, $fy) = computeCoords($xc, $yc+10, $vr, $hr, $start, $piefactor);
		$fx += ($start == $arc) ? 2 : -2;
		$img->fill($fx, $fy, $color);
	}
#
#	render text
#
	if ($text) {
		my ($gx, $gy) = computeCoords($xc, $yc, $vr, $hr, $bisect, $piefactor);
		$gy -= $sfh if (($bisect > 3.1415926/2) && ($bisect <= (1.5 * 3.1415926)));

		$gy += 20 if ($obj->{threed} && 
			(($bisect < 3.1415926/2) || ($bisect >= (1.5 * 3.1415926))));
		$gx -= ((length($text)+1) * $sfw) 
			if (($gx < $xc) && ($bisect > 3.1415926/4));
		$gx -= (length($text) * $sfw/2) 
			if (($gx > $xc) && ($bisect > (1.75 * 3.1415926)));
		$gx += $sfw if ($gx > $xc);
		$gx -= (length($text) * $sfw/2) 
			if (($gx == $xc) || ($bisect <= 3.1415926/4));

		$obj->string($showvals, 0,$gx, $gy, $text, $tfw);
	}
	return $arc;
}

sub computeCoords {
	my ($xc, $yc, $vr, $hr, $arc, $piefactor) = @_;

	return (
		int($xc + $piefactor * $vr * cos($arc + (3.1415926/2))), 
		int($yc + $piefactor * ($vr/$hr) * $vr * sin($arc+ (3.1415926/2)))
	);
}

sub tan {
	my ($angle) = @_;
	
	return (sin($angle)/cos($angle));
}

sub cotan {
	my ($angle) = @_;
	
	return (cos($angle)/sin($angle));
}

sub updateImagemap {
	my ($obj, $shape, $alt, $plotNum, $x, $y, $z, @pts) = @_;
	$y = '' unless defined($y);
	$z = '' unless defined($z);
#
#	do different for Perl map
#
	return $obj->updatePerlImagemap($plotNum, $x, $y, $z, $shape, @pts)
		if (uc $obj->{mapType} eq 'PERL');

	my $imgURL = $obj->{mapURL};
	my $imgScript = $obj->{mapScript};
#
#	if modifier is supplied, call it before applying any of our
#	transforms
#
	if ($obj->{mapModifier}) {
		my $maphash = {
			URL => $imgURL,
			Script => $imgScript,
			Name => $obj->{genMap},
			PLOTNUM => $plotNum,
			X => $x, Y => $y, Z => $z,
			AltText => $alt
		};
		&{$obj->{mapModifier}}($maphash);
		$imgURL = $maphash->{URL};
		$imgScript = $maphash->{Script};
		$alt = $maphash->{AltText};
	}
#
#	render image map element:
#	hotspot is an 8 pixel diameter circle centered on datapoint for
#	lines, points, areas, and candlesticks.
#	the user can provide both a URL to be invoked, and/or a 
#	script function to be locally executed, when the hotspot is clicked.
#	Special variable names $PLOTNUM, $X, $Y, $Z can be specified
#	anywhere in the URL/script string to be interpolated to the
#	the equivalent input values
#
	$shape = uc $shape;
	$x =~ s/([^;\/?:@&=+\$,A-Za-z0-9\-_.!~*'()])/$escapes{$1}/g;
	$y =~ s/([^;\/?:@&=+\$,A-Za-z0-9\-_.!~*'()])/$escapes{$1}/g;
	$z =~ s/([^;\/?:@&=+\$,A-Za-z0-9\-_.!~*'()])/$escapes{$1}/g;
	$plotNum =~ s/([^;\/?:@&=+\$,A-Za-z0-9\-_.!~*'()])/$escapes{$1}/g;
	my $imgmap = $obj->{imgMap};
#
#	interpolate special variables
#
	$imgURL=~s/:PLOTNUM\b/$plotNum/g,
	$imgURL=~s/:X\b/$x/g,
	$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;
}