File Coverage

blib/lib/CGI/Graph/Plot/points.pm

Criterion	Covered	Total	%
statement	1	3	33.3
branch			n/a
condition			n/a
subroutine	1	1	100.0
pod			n/a
total	2	4	50.0

package CGI::Graph::Plot::points;

use GD;
use CGI::Graph::Plot;
use GD::Graph::points;

@ISA = ("CGI::Graph::Plot");

my %default = ( x_tick_number  => 8,
                y_tick_number  => 8,
                y_label_skip   => 2,
                r_margin       => 7,
		label_offset   => 65,
		label_size     => 12,
		tick_size      => 4,
		precision      => 14,
                header_size    => 15,   # default
                space_size     => 18,   # values for
                data_size      => 100   # text box
              );

#
# calls parent class to intialize values, then updates selection values if
# necessary. If called from the CGI that is generating the image, then the
# bounds should not be calculated and the selection values not updated (since
# these have already been done).
#

sub new {
        my ($pkg, $vars) = @_;
        my $class = ref($pkg) || $pkg;
	$vars->{graph_type} = 'points';
        my $self = $class->SUPER::new($vars);

        # for a point graph, if the Y axis is not numerical,
        # find a numerical data set
        if ($self->{Y} !~ /^[ir]_/) {
		my @header = $self->{table}->header;
                foreach (1..$#header) {
                        $self->{Y} = $header[$_];
                        last if ($self->{Y} =~ /^[ir]_/);
                }
                die "No numerical Y data available!\n" if ($self->{Y} !~ /^[ir]_/);
        }

        # for calls within Draw.cgi, return now
        if ($self->{rand}) {
                return bless $self, $class;
        }

        $self->graphBounds();

        my @selected = split("",$self->{selected});
        if ($self->{select}) {
                $selected[$self->{select}-1]=($selected[$self->{select}-1])?0:1;
        }

	elsif ($self->{select_list} eq 'Visible' || $self->{unselect_list} eq 'Visible') {
	        my ($Xref,$Yref) = $self->valuesInRange();
	        my @drawY = @$Yref;

		foreach (0..$#drawY) {
			if (defined $drawY[$_]) {
				$selected[$self->{table}->elm($_,'_row')-1] =
					($self->{select_list} eq 'Visible')?1:0;
			}
		}
	}

       	$self->{selected} = join("",@selected);
	$self->write_selected();

        return bless $self, $class;
}

#
# determines upper and lower bounds for the grid.
#

sub gridBounds {
        my $self = shift;

        my @X = $self->{table}->col($self->{X});
        my @Y = $self->{table}->col($self->{Y});
        @X = $self->count(@X);

        return (0,$X[-1],CGI::Graph::Plot::bounds(@Y)) unless ($self->{X} =~/^[ir]_/);
        return (CGI::Graph::Plot::bounds(@X),CGI::Graph::Plot::bounds(@Y));
}

#
# determines upper and lower bounds for the main graph image or map.
#

sub graphBounds {
        my $self = shift;

        my @X = $self->{table}->col($self->{X});
        my @Y = $self->{table}->col($self->{Y});

        @X = $self->count(@X);

        my ($x_min,$x_max) = ($self->{X} =~/^[ir]_/) ?
		CGI::Graph::Plot::bounds(@X) : (0,$X[-1]);

        my ($y_min,$y_max) = CGI::Graph::Plot::bounds(@Y);

	# for zoom level 1, update self using present min/max values
        if ($self->{zoom} == 1) {
                $self->resize();
                ($self->{x_min},$self->{x_max},$self->{y_min},$self->{y_max}) =
			($x_min,$x_max,$y_min,$y_max);
                return;
        }

	# for zoom levels other than 1, adjust the min/max
        else {
                my ($xc,$yc,$span) = $self->resize();

                my $deltaX = $x_max-$x_min;
                $x_max2 = sprintf("%.".$default{precision}."f",
			$x_min+($xc+$span/2)*($deltaX)/$self->{divisions});
                $x_min2 = sprintf("%.".$default{precision}."f",
			$x_min+($xc-$span/2)*($deltaX)/$self->{divisions});

                my $deltaY = $y_max-$y_min;
                $y_max2 = sprintf("%.".$default{precision}."f",
			$y_min+($yc+$span/2)*($deltaY)/$self->{divisions});
                $y_min2 = sprintf("%.".$default{precision}."f",
			$y_min+($yc-$span/2)*($deltaY)/$self->{divisions});

                ($self->{x_min},$self->{x_max},$self->{y_min},$self->{y_max}) =
			($x_min2,$x_max2,$y_min2,$y_max2);
                return;
        }
}

#
# initializes the graph for the graphMap and drawGraph functions.
#

sub setGraph {
        my ($self,$graph) = @_;

        $graph->set(
		x_number_format   => \&shorten,
		y_number_format   => \&shorten,
                x_label           => substr($self->{X},2),
		x_label_position  => .5,
                y_label           => substr($self->{Y},2),
                x_min_value       => $self->{x_min},
                x_max_value       => $self->{x_max},
                y_min_value       => $self->{y_min},
                y_max_value       => $self->{y_max},
                r_margin          => $default{r_margin},
                x_tick_number     => $default{x_tick_number},
                y_tick_number     => $default{y_tick_number},
                y_label_skip      => $default{y_label_skip}
        );

	# for non-numerical X data
	unless ($self->{X} =~ /^[ir]_/) {
	        $graph->set(
			x_number_format   => \&x_erase,
                	x_tick_number     => 1,
			x_labels_vertical => 1
	        );
	}

	return $graph;
}

#
# generates an image map which allows individual points to be selected. Also
# displays properties of the points in a textbox.
#

sub graphMap {
	my ($self,$name,$mapName,$info) = @_;

	# obtain X and Y values to be drawn
        my($Xref,$Yref) = $self->valuesInRange();
        my @drawX = @$Xref;
        my @drawY = @$Yref;

	# set up graph and plot points
        my $graph = GD::Graph::points->new($self->{width},$self->{height});
	$graph = $self->setGraph($graph);
        my @data = ([@drawX],[@drawY]);
        my $gd = $graph->plot(\@data);

	my @info = $self->{table}->col($info);
	my @row = $self->{table}->col('_row');
        my @setlist = $graph->get_hotspot;
        my @header = $self->{table}->header;
        my $index= 0;

        my $mapInfo = $self->mapInfo();
        my $final = "\n\n";

        for $setnum (1.. $#setlist) {

                foreach $set (@{$setlist[$setnum]}) {

			# set up string used for text box
                        my $text;
                        for ($i=0; $i<$self->{table}->nofCol-1; $i++) {
                                $text.= sprintf("%-$default{header_size}.".
					"$default{space_size}s",substr($header[$i],2));
                                $text.= sprintf("%-.$default{data_size}s",
					$self->{table}->elm($index,$i));
                                $text.="\\n";
                        }
                        #escape ' characters
                        $text=~s/\'/\\\'/;

                        $final.= "
			$final.= "shape=$$set[0] coords=$$set[1],";
                        $final.= "$$set[4],$$set[2],$$set[3] ";
			# note that there is an error in documentation
			# arguments are in wrong order
                        $final.= "href=\"$name?select=$row[$index]&$mapInfo";
                        $final.= " onMouseOver=\"myform.myarea.value='$text'; ";
			$final.= "return true;\">\n";

                        $index++;
                }
        }
        $final.= "\n";

        return $final;
}

#
# returns a graph image (as a gd object) with selected points highlighted
#

sub drawGraph {
        my ($self) = @_;

        my($Xref,$Yref,$Sref) = $self->valuesInRange();
        my @drawX = @$Xref;
        my @drawY = @$Yref;
	my @selectDraw = @$Sref;

        my $graph = GD::Graph::points->new($self->{width}, $self->{height});
	$graph = $self->setGraph($graph);
        my @data = ([@drawX],[@drawY]);

	my @dataColor = GD::Graph::colour::hex2rgb($self->{dataColor});
        GD::Graph::colour::add_colour(myColor => \@dataColor);
        $graph->set(dclrs => ["myColor"]);

        my $gd = $graph->plot(\@data);
	my @setlist = $graph->get_hotspot;

        my @selectColor = GD::Graph::colour::hex2rgb($self->{selectColor});
        $selectColor = $gd->colorAllocate(@selectColor);
	my $index=0;

	# draw rectangle around each selected point
	for $setnum (1.. $#setlist) {
	        foreach $set (@{$setlist[$setnum]}) {

	                if ($$set[0] eq 'rect' && $selectDraw[$index]) {
	                        $gd->rectangle($$set[1],$$set[4],
					$$set[2],$$set[3],$selectColor);
	                        $gd->rectangle($$set[1]+1,$$set[4]+1,
					$$set[2]-1,$$set[3]-1,$selectColor);
	                }

	                $index++;
	        }
	}

	$gd = &addLabels($self,$gd,$graph) unless ($self->{X} =~ /^[ir]_/);

	return $gd;
}

#
# returns a gd object similar to drawGraph, but with axes hidden
#

sub drawGrid {
	my ($self,$dataColor,$selectColor,$lineColor,$windowColor) = @_;

        my($Xref,$Yref,$Sref) = $self->valuesInRange();
        my @X = @$Xref;
        my @Y = @$Yref;
        my @selectDraw = @$Sref;

	# create a graph that is larger than necessary
        my $graph = GD::Graph::points->new(2*$self->{grid_width},2*$self->{grid_height});

        my @data = ([@X],[@Y]);

        $graph->set(
		fgclr		  => "white", # hide axes
                x_tick_number     => 1,
                x_min_value       => $self->{x_min},
                x_max_value       => $self->{x_max},
                y_min_value       => $self->{y_min},
                y_max_value       => $self->{y_max},
                r_margin          => $default{r_margin},
                y_tick_number     => $default{y_tick_number},
                y_label_skip      => $default{y_label_skip}
        );

	my @dataColor = GD::Graph::colour::hex2rgb($self->{dataColor});
        GD::Graph::colour::add_colour(myColor => \@dataColor);
        $graph->set(dclrs => ["myColor"]);

        my $gd = $graph->plot(\@data);
        my @setlist = $graph->get_hotspot;

        my @selectColor = GD::Graph::colour::hex2rgb($self->{selectColor});
        $selectColor = $gd->colorAllocate(@selectColor);

        my $index=0;

	# draw rectangle around each selected point
        for $setnum (1.. $#setlist) {
                foreach $set (@{$setlist[$setnum]}) {

	                if ($$set[0] eq 'rect' && $selectDraw[$index]) {
                                $gd->filledRectangle($$set[1],$$set[4],
					$$set[2],$$set[3],$selectColor);
	                        $gd->rectangle($$set[1]+1,$$set[4]+1,
					$$set[2]-1,$$set[3]-1,$selectColor);
                        }

                        $index++;
                }
        }

	# create new blank image of correct size
        my $image = new GD::Image($self->{grid_width},$self->{grid_height});
        my $white = $image->colorAllocate(255,255,255);

	# copy only the area of the graph that has data plotted
        $image->copyResized($gd,0,0,$graph->{left},$graph->{top},$self->{grid_width},
		$self->{grid_height},$graph->{right}-$graph->{left},
		$graph->{bottom}-$graph->{top});

        $image = $self->gridLines($image);
        return $image;
}

#
# formats numerical axis labels to avoid excessively long labels
#

sub shorten {
	my $value = shift;
	return sprintf ("%g", $value);
}

#
# returns labels containing only spaces to make room for manually drawn labels
#

sub x_erase {
	return (sprintf "%".$default{label_size}."s");
}

#
# adds tick marks and non-numerical labels
#

sub addLabels {
	my ($self,$gd,$graph) = @_;

        my @X = $self->{table}->col($self->{X});

	# allocate same blue as rest of graph axes and labels
        my $blue = $gd->colorAllocate(0,0,125);

	# determine which X labels are needed
        my $start = $self->{x_min};
        $start = int($self->{x_min}+1) unless
		($self->{x_min} == int($self->{x_min}));
        my $end = int($self->{x_max});

        my @XNR=(""); # non-redundant X values, first value for zero

	# shorten X labels
        for (0.. $#X) {
                if ($X[$_] ne $X[$_-1]) {
                        push (@XNR,sprintf ("%.$default{label_size}s",$X[$_]));
                }
        }

	# write each label under the corresponding point
        foreach ($start..$end) {
		# find coordinates of points on x-axis
                my ($x,$y) = $graph->val_to_pixel($_,$self->{y_min},1);
 		# draw tick mark
                $gd->line($x,$y-$default{tick_size},$x,$y,$blue);
                $gd->stringUp(gdTinyFont,$x-$default{tick_size},
			$y+$default{label_offset},$XNR[$_],$blue);
        }

        return $gd;
}

1;