piwi 0.8+20041206-3 / usr / share / piwi / Functions / ps.pl

sub postscript($$$$)
{
	my $DataRef = shift;
	my $Template = shift;
	my $FileName = shift;
	my $width = shift || 900;

	my @data = @{$DataRef};

	#

	my $cpt = 0;
	my $LIMIT = 33;

	my $total = 0;
	foreach my $value ( @{$data[1]} )
	{
		if ( ! defined( $value ) ) { debug( "postscript : \$value is not defined" ); $value = 0; };

		if ( $cpt < $LIMIT )
		{
			$total += $value;
			$cpt ++
		}
	}
	if ( ! $total ) { return 0; };

	#

	local $::image_width = $width;

	  # Set histogram width :
	local $::histo_width = $::image_width - 100;

	#

	  # get number of elements :
	local $element_nb = 0;
	foreach my $value ( @{$data[1]} )
	{
		  # % with 2 decimals :
		if ( $element_nb < $LIMIT )
		{
			$data[2]->[$element_nb] = int( $value / $total * 10000 )/100;
			$element_nb ++;
		}
	}

	#

	my $wrap = 0; # nb of element per collumn
	my $spin = 0; # nb of collumns

	if ( ( $element_nb <= 22 ) and ! ( $element_nb % 2 ) )
	{
		$wrap = $element_nb / 2;
		$spin = 2;
	}
	else
	{
		$wrap = int( $element_nb / 3 );
		if ( $element_nb % 3 ) { $wrap ++; };

		$spin = 3;
		if ( $element_nb < 3 ) {$spin = $element_nb;};
	}

	#

	  # Legend for both pie chart and bar histogram :
	local $::COMMENT = '';
	for( my $cpt2 = 0 ; $cpt2 < $cpt ; $cpt2 ++ )
	{
		  # x+=200 every $wrap element :
		  # y is the same every $wrap element :
		my $x = 50 + int( ( $::image_width - 10 ) / $spin ) * int( $cpt2 / $wrap );
		my $y = 200 - 18 * ( $cpt2 % $wrap );

		my $label = substr( $data[0]->[$cpt2] , 0, int( 60 / $spin ) );
		$label =~ s/\\//g;

		  # Keep the nb of open '(' the same as ')' or ghostscript could die : (like 7.05.6 (2003-02-05) does)
		my $tmp_str = $label;
		$tmp_str =~ s/[^\(\)]//g;
		my $braces_nb = length( $tmp_str );
		$tmp_str =~ s/[^\(]//g;

		my $open_braces_nb = length( $tmp_str );
		my $close_braces_nb = $braces_nb - $open_braces_nb;
		my $diff = $open_braces_nb - $close_braces_nb;
		for( my $i = 1 ; $i <= $diff ; $i++ )
		{
			  # Remove one open brace
			$label =~ s/\(//;
			$open_braces_nb --;
		}

		  # I suppose this bug also exists in the opposite case :
		$diff = $open_braces_nb - $close_braces_nb;
		for( my $i = 1 ; $i <= -$diff ; $i++ )
		{
			  # Remove one close brace
			$label =~ s/\)//;
			$close_braces_nb --;
		}

		#

		$label .= ' (';
		$label .= $data[1]->[$cpt2];
		$label .= '/';
		$label .= $data[2]->[$cpt2];
		$label .= '%)';

		$::COMMENT .= "$x $y $cpt2 ($label) comment\n";
	}

	#

	local $::DATA = ''; # pie-chart labels
	local $::HISTO1 = ''; # histogram bars
	local $::HISTO2 = ''; # values printed on bars (numbers)
	my ( $id1, $id2 ) = ( 0, 0 );
	for( my $cpt2 = 0 ; $cpt2 < $cpt ; $cpt2 ++ )
	{
		# $cpt2 is not only color index but also x position index
		my $label = $data[0]->[$cpt2];

		  # angle calculation, for pie chart only :
		$id1 = $id1 + int( ( $data[2]->[$cpt2] )*360/100 );
		$::DATA .= "30 $id1 $id2 $cpt2 ($label) draw_pie\n";
		$id2 = $id1;

		  # histogram only : (bar and value above the bar)
		$::HISTO1 .= 2 * ( $data[2]->[$cpt2] ).' '.$cpt2." histo\n";
		$::HISTO2 .= 2 * ( $data[2]->[$cpt2] + $spin*( $cpt2  % 2 ) ).' '.$cpt2." (".( $data[1]->[$cpt2] ).") value\n";
	}

	#

	  # Histogram bar width is function of element number :
	local $::COLUMN_WIDTH = int( $::histo_width / 1.25 / ( ( $element_nb > 5 )?$element_nb:5 ) ); # 10 elements => 40
	local $::HALF_WIDTH = int( $::COLUMN_WIDTH / 2 );

	#

	local *TEMP_PS_FILE;
	open( TEMP_PS_FILE, ">$FileName" ) || error( 'Impossible to write PostScript file to disk' );
	select( TEMP_PS_FILE );
	ParseComponent( $Template );
	select( STDOUT );
	close( TEMP_PS_FILE );

	undef $cpt;
	undef @data;

	return 1;
}

sub histogram_position_list($)
{
	my $array_name = shift;

	my $interval = int( $::histo_width / $::element_nb ); # 10 elements => 50

	  # x position for each value :
	my $positions = '';
	for( my $i = 0 ; $i < $::element_nb ; $i ++ )
	{
		$positions .= 10 + $i*$interval;
		$positions .= "\n";
	}

	print "/$array_name [\n$positions] def\n";
}

1;