view release on metacpan or  search on metacpan

lib/Gtk2/Ex/Graph/GD.pm  view on Meta::CPAN

}

sub signal_connect {
	my ($self, $signal, $callback) = @_;
	$self->{signals}->{$signal} = $callback;
}

sub _create_eventbox {
	my ($self) = @_;
	my $eventbox = Gtk2::EventBox->new;
	# $eventbox->add_events (['pointer-motion-mask', 'pointer-motion-hint-mask', 'button-press-mask']);
	$eventbox->add_events ('pointer-motion-mask');
	$eventbox->signal_connect ('motion-notify-event' => 
		sub {
			my ($widget, $event) = @_;
			my ($x, $y) = ($event->x, $event->y);
			my @imageallocatedsize = $self->{graphimage}->allocation->values;
			$x -= ($imageallocatedsize[2] - $self->{imagesize}->[0])/2;
			$y -= ($imageallocatedsize[3] - $self->{imagesize}->[1])/2;
			if ($self->{graphtype} eq 'bars') {
				my $hotspot = $self->_check_bars_hotspot($x,$y);
				if ($hotspot) {
					my ($measure, $xvalue, $yvalue) = @$hotspot;
					my $tooltipstring = $measure 
						? "($measure, $xvalue, $yvalue)" 
						: "($xvalue, $yvalue)";
					$self->_show_tooltip($tooltipstring);
					&{ $self->{signals}->{'mouse-over'} } ($hotspot)
							if $self->{signals}->{'mouse-over'};
				}
			} elsif ($self->{graphtype} eq 'lines' or $self->{graphtype} eq 'linespoints') {
				my $hotspot = $self->_check_lines_hotspot($x,$y);
				if ($hotspot) {
					my ($measure, $xvalue0, $yvalue0, $xvalue1, $yvalue1) = @$hotspot;
					my $tooltipstring = $measure 
						? "($measure, ($xvalue0, $yvalue0), ($xvalue1, $yvalue1))"
						: "(($xvalue0, $yvalue0), ($xvalue1, $yvalue1))";
					$self->_show_tooltip($tooltipstring);
					&{ $self->{signals}->{'mouse-over'} } ($hotspot)
							if $self->{signals}->{'mouse-over'};
				}
			}
		}
	);
	$eventbox->signal_connect ('button-press-event' => 
		sub {
			my ($widget, $event) = @_;
			my ($x, $y) = ($event->x, $event->y);
			my @imageallocatedsize = $self->{graphimage}->allocation->values;
			$x -= ($imageallocatedsize[2] - $self->{imagesize}->[0])/2;
			$y -= ($imageallocatedsize[3] - $self->{imagesize}->[1])/2;
			my $hotspot;
			if ($self->{graphtype} eq 'bars') {
				$hotspot = $self->_check_bars_hotspot($x,$y);
			} elsif ($self->{graphtype} eq 'lines' or $self->{graphtype} eq 'linespoints') {
				$hotspot = $self->_check_lines_hotspot($x,$y);
			}
			&{ $self->{signals}->{'clicked'} } ($hotspot)
					if $self->{signals}->{'clicked'} && $hotspot;
			return FALSE unless $event->button == 3;
			$self->{optionsmenu}->popup(
				undef, # parent menu shell
				undef, # parent menu item
				undef, # menu pos func
				undef, # data
				$event->button,
				$event->time
			);
		}
	);
	return $eventbox;
}

sub set {
	my ($self, %hash) = @_;
	$self->{graphhash} = \%hash;
	$self->{graph}->set(%hash);
}

sub _set_type {
	my ($self, $type) = @_;
	my ($width, $height) = @{$self->{imagesize}};
	$self->{graphtype} = $type;
	my $graph;
	if ($type eq 'bars') {
		$graph = GD::Graph::bars->new($width, $height);
	} elsif ($type eq 'lines') {
		$graph = GD::Graph::lines->new($width, $height);
	} elsif ($type eq 'linespoints') {
		$graph = GD::Graph::linespoints->new($width, $height);
	} elsif ($type eq 'area') {
		$graph = GD::Graph::area->new($width, $height);
	} elsif ($type eq 'pie') {
		$graph = GD::Graph::pie->new($width, $height);
	}
	$self->{graph} = undef;
	$self->{graph} = $graph;
}

sub _refresh {
	my ($self) = @_;
	$self->{graph}->set(%{$self->{graphhash}}) if $self->{graphhash};
	$self->set_legend(@{$self->{graphlegend}}) if $#{@{$self->{graphlegend}}} >= 0;
	$self->get_image($self->{graphdata});
}

sub _init_tooltip {
	my ($self) = @_;
	my $tooltip_label = Gtk2::Label->new;
	my $tooltip = Gtk2::Window->new('popup');
	$tooltip->set_decorated(0);
	$tooltip->set_position('mouse'); # We'll choose this to start with.
	$tooltip->modify_bg ('normal', Gtk2::Gdk::Color->parse('yellow')); # The obligatory yellow
	$tooltip->add($tooltip_label);
	$self->{tooltip}->{window} = $tooltip;
	$self->{tooltip}->{displayed} = FALSE;
	$self->{tooltip}->{label} = $tooltip_label;	
}

sub set_legend {
	my ($self, @legend_keys) = @_;
	return if ($self->{graphtype} eq 'pie');
	$self->{graph}->set_legend(@legend_keys);
	$self->{graphlegend} = \@legend_keys;
}

sub get_image {
	my ($self, $data) = @_;
	$self->{graphdata} = $data;
	my $graph = $self->{graph};
	$graph->plot($data) or warn $graph->error;
	my $loader = Gtk2::Gdk::PixbufLoader->new;
	$loader->write ($graph->gd->png);
	$loader->close;
	my $image = Gtk2::Image->new_from_pixbuf($loader->get_pixbuf);
	$self->{graphimage} = $image;
	my $hotspotlist;
	if ($self->{graphtype} eq 'bars' or
		$self->{graphtype} eq 'lines' or
		$self->{graphtype} eq 'linespoints') {
		foreach my $hotspot ($graph->get_hotspot) {
			push @$hotspotlist, $hotspot if $hotspot;
		}
	}
	$self->{hotspotlist} = $hotspotlist;
	my $eventbox = $self->{eventbox};
	my @children = $eventbox->get_children;
	foreach my $child (@children) {
		$eventbox->remove($child);
	}
	$eventbox->add ($image);

	$eventbox->signal_connect ('button-press-event' => 
		sub {
			my ($widget, $event) = @_;
			return TRUE;
			return FALSE unless $event->button == 3;
			$self->{optionsmenu}->popup(
				undef, # parent menu shell
				undef, # parent menu item
				undef, # menu pos func
				undef, # data
				$event->button,
				$event->time
			);
		}
	);	
	$eventbox->show_all;
	return $eventbox;
}

sub _show_tooltip {
	my ($self, $tooltipstring) = @_;
	$self->{tooltip}->{label}->set_label($tooltipstring);
	if (!$self->{tooltip}->{displayed}) {
		$self->{tooltip}->{window}->show_all;
		my ($thisx, $thisy) = $self->{tooltip}->{window}->window->get_origin;
		# I want the window to be a bit away from the mouse pointer.
		# Just a personal choice
		$self->{tooltip}->{window}->move($thisx, $thisy-20);
		$self->{tooltip}->{displayed} = TRUE;
	}	
}

sub _check_lines_hotspot {
	my ($self, $x, $y) = @_;
	my $i=0;
	my $hotspotlist = $self->{hotspotlist};
	foreach my $datameasure (@$hotspotlist){
		my $j=0;
		foreach my $hotspot (@$datameasure) {
			my ($name, @coords) = @$hotspot;
			if (_on_the_line($x, $y, @coords)) {
				my $xvalue0 = $self->{graphdata}->[0]->[$j-1];
				my $yvalue0 = $self->{graphdata}->[$i+1]->[$j-1];
				my $xvalue1 = $self->{graphdata}->[0]->[$j];
				my $yvalue1 = $self->{graphdata}->[$i+1]->[$j];
				my $measure = $self->{graphlegend}->[$i];
				return [$measure, $xvalue0, $yvalue0, $xvalue1, $yvalue1];
			}
			$j++;
		} 
		$i++;	
	}
	$self->{tooltip}->{window}->hide;
	$self->{tooltip}->{displayed} = FALSE;
}

sub _on_the_line {
	my ($x, $y, @linecoords) = @_;
	if (($x <= $linecoords[0] and  $x <= $linecoords[2]) or
		($x >= $linecoords[0] and  $x >= $linecoords[2]) or
		($y <= $linecoords[1] and  $y <= $linecoords[3]) or
		($y >= $linecoords[1] and  $y >= $linecoords[3]) ){
		return FALSE;
	}
	my $slope_diff = 
		($linecoords[1]-$linecoords[3])/($linecoords[0]-$linecoords[2])