# Copyright 2007, 2008, 2009, 2010 Kevin Ryde
# This file is part of Gtk2-Ex-Xor.
#
# Gtk2-Ex-Xor is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Gtk2-Ex-Xor is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
# more details.
#
# You should have received a copy of the GNU General Public License along
# with Gtk2-Ex-Xor. If not, see <http://www.gnu.org/licenses/>.
package Gtk2::Ex::CrossHair;
use 5.008;
use strict;
use warnings;
use Carp;
use List::Util;
use Scalar::Util 1.18 'refaddr'; # 1.18 for pure-perl refaddr() fix
use POSIX ();
# 1.200 for Gtk2::GC auto-release
use Gtk2 1.200;
use Glib::Ex::SignalIds;
use Gtk2::Ex::Xor;
use Gtk2::Ex::WidgetBits 31; # v.31 for xy_root_to_widget()
# uncomment this to run the ### lines
#use Smart::Comments;
our $VERSION = 19;
# The _pw() func gives a hash of per-widget data. Its fields are
#
# static_ids
# Glib::Ex::SignalIds of signal connections made for as long as the
# widget is in the crosshair.
# dynamic_ids
# Glib::Ex::SignalIds of signal connections made only while the
# crosshair is active.
# gc
# A Gtk2::GC shared gc to draw with. Created by the _draw() code when
# needed, deleted by style-set etc for colour changes etc.
# x,y
# Position in widget coordinates at which the crosshair is drawn in
# the widget. 'x' doesn't exist in the hash if the position is not
# yet decided. 'x' is undef if the cross is entirely outside the
# widget and thus there's nothing to draw.
#
# The per-widget data could be in a Tie::RefHash or inside-out thingie or
# similar to keep out of the target widgets. Would that be worthwhile? The
# widget already has a handy hash to put things in, may as well use that
# than load extra code.
#
use Glib::Object::Subclass
'Glib::Object',
signals => { moved => { param_types => ['Gtk2::Widget',
'Glib::Scalar',
'Glib::Scalar'],
return_type => undef },
},
properties => [ Glib::ParamSpec->object
('widget',
'widget',
'Single widget to act on.',
'Gtk2::Widget',
Glib::G_PARAM_READWRITE),
Glib::ParamSpec->boolean
('drawn',
'drawn',
'Whether to display the crosshair.',
0,
'readable'),
Glib::ParamSpec->object
('crosshair',
'crosshair',
'', # Blurb
'Gtk2::Widget', # actually 'Gtk2::Ex::CrossHair'
'writable'),
];
# sub INIT_INSTANCE {
# my ($self) = @_;
# ### CrossHair-PerWidget INIT_INSTANCE
# }
sub FINALIZE_INSTANCE {
my ($self) = @_;
$self->undraw;
}
sub SET_PROPERTY {
my ($self, $pspec, $newval) = @_;
my $pname = $pspec->get_name;
### CrossHair SET_PROPERTY: $pname
if ($pname eq 'widget' || $pname eq 'crosshair') {
my $old_draw = $self->undraw;
delete $self->{'gc'};
# per default GET_PROPERTY
Scalar::Util::weaken ($self->{$pname} = $newval);
if ($pname eq 'widget') {
my $widget = $self->{'widget'};
$self->{'static_ids'} = $widget && Glib::Ex::SignalIds->new
($widget,
$widget->signal_connect (style_set => \&_do_style_set,
Gtk2::Ex::Xor::_ref_weak($self)));
# These are events needed in button drag mode, ie. when start() is
# called with a button event. The alternative would be to turn them
# on by a new Gtk2::Gdk->pointer_grab() to change the implicit grab,
# though 'button-release-mask' is best turned on in advance in case
# we're lagged and it happens before we change the event mask.
#
# 'exposure-mask' is not here since if nothing else is drawing then
# there's no need for the crosshair to redraw over its changes.
#
require Gtk2::Ex::WidgetEvents;
$self->{'wevents'} = $widget && Gtk2::Ex::WidgetEvents->new
($widget, ['button-motion-mask',
'button-release-mask',
'pointer-motion-mask',
'enter-notify-mask',
'leave-notify-mask']);
}
if (my $crosshair = $self->{'crosshair'}) {
_maybe_move ($self, $crosshair->{'root_x'}, $crosshair->{'root_y'});
}
if ($old_draw) {
$self->draw;
}
} else {
$self->{$pname} = $newval; # per default GET_PROPERTY
}
}
sub start {
my ($self) = @_;
### CrossHair _pw_start(): "$widget"
my $widget = $self->{'widget'};
my $ref_weak_self = Gtk2::Ex::Xor::_ref_weak ($self);
$self->{'dynamic_ids'} = $widget && Glib::Ex::SignalIds->new
($widget,
$widget->signal_connect (motion_notify_event => \&_do_motion_notify,
$ref_weak_self),
$widget->signal_connect (button_release_event => \&_do_button_release,
$ref_weak_self),
$widget->signal_connect (enter_notify_event => \&_do_enter_notify,
$ref_weak_self),
$widget->signal_connect (leave_notify_event => \&_do_leave_notify,
$ref_weak_self),
$widget->signal_connect_after (expose_event => \&_do_expose_event,
$ref_weak_self),
$widget->signal_connect_after (size_allocate => \&_do_size_allocate,
$ref_weak_self));
$self->draw;
}
sub end {
my ($self) = @_;
delete $self->{'dynamic_ids'};
}
#-----------------------------------------------------------------------------
# 'motion-notify-event' on a target widget
sub _do_motion_notify {
my ($widget, $event, $ref_weak_self) = @_;
### CrossHair _do_motion_notify(): "$widget ".$event->x_root.",".$event->y_root
if (my $self = $$ref_weak_self) {
if (my $crosshair = $self->{'crosshair'}) {
if ($crosshair->{'active'}) {
$crosshair->_maybe_move ($self, $event);
}
}
}
return 0; # Gtk2::EVENT_PROPAGATE
}
# 'size-allocate' signal on a widget
sub _do_size_allocate {
my ($widget, $alloc, $ref_weak_self) = @_;
my $self = $$ref_weak_self || return;
### CrossHair _do_size_allocate: "$widget"
# if the widget position has changed then must draw lines at new spots
$self->redraw;
}
# 'enter-notify-event' signal on the widgets
sub _do_enter_notify {
my ($widget, $event, $ref_weak_self) = @_;
### CrossHair _do_enter_notify(): "$widget ".$event->x_root.",".$event->y_root
if (my $self = $$ref_weak_self) {
if (my $crosshair = $self->{'crosshair'}) {
if (! $crosshair->{'button'}) {
# not button drag mode
$crosshair->_maybe_move ($self, $event);
}
}
}
return 0; # Gtk2::EVENT_PROPAGATE
}
# 'leave-notify-event' signal on one of the widgets
sub _do_leave_notify {
my ($widget, $event, $ref_weak_self) = @_;
### CrossHair _do_leave_notify(): "$widget " . $event->x_root . "," . $event->y_root
if (my $self = $$ref_weak_self) {
if (my $crosshair = $self->{'crosshair'}) {
if (! $crosshair->{'button'}) {
# not button drag mode
$crosshair->_maybe_move ($self, $event);
}
}
}
return 0; # Gtk2::EVENT_PROPAGATE
}
# 'button-release-event' signal on one of the widgets
sub _do_button_release {
my ($widget, $event, $ref_weak_self) = @_;
if (my $self = $$ref_weak_self) {
if (my $crosshair = $self->{'crosshair'}) {
if ($event->button == $crosshair->{'button'}) {
$crosshair->end ($event);
}
}
}
return 0; # Gtk2::EVENT_PROPAGATE
}
sub _do_expose_event {
my ($widget, $event, $ref_weak_self) = @_;
### CrossHair-PerWidget _do_expose_event()
if (my $self = $$ref_weak_self) {
$self->draw ($self, $event->region);
}
return 0; # Gtk2::EVENT_PROPAGATE
}
# 'style-set' signal handler on each widget
# A style change normally provokes a full redraw. Think it's enough to rely
# on that for redrawing the crosshair against a possible new background, so
# just refresh the gc.
sub _do_style_set {
my ($widget, $prev_style, $ref_weak_self) = @_;
### PerWidget _do_style_set: "$widget"
my $self = $$ref_weak_self || return;
delete $self->{'gc'}; # possible new colours
}
sub change_gc {
my ($self) = @_;
$self->undraw;
delete $self->{'gc'};
$self->draw;
}
sub redraw {
my ($self) = @_;
if ($self->undraw) {
$self->draw;
}
}
sub undraw {
my ($self) = @_;
my $old = $self->{'drawn'};
if ($old) {
_draw ($self);
$self->{'drawn'} = 0;
# position undetermined as well as undrawn
delete $self->{'x'};
}
### PerWidget undraw() done
return $old;
}
# $widgets is an arrayref of widgets to draw, or undef for all
sub draw {
my ($self, $clip_region) = @_;
### PerWidget draw(): "$self->{'widget'}"
my $crosshair = $self->{'crosshair'} || return;
$crosshair->{'active'} || return;
my $widget = $self->{'widget'} || return;
my $win = $widget->Gtk2_Ex_Xor_window || return; # perhaps unrealized
my $root_x = $crosshair->{'root_x'};
my $root_y = $crosshair->{'root_y'};
$self->{'drawn'} = 1;
if (! exists $self->{'x'}) {
### establish draw position: "$widget", $root_x, $root_y
@{$self}{'x','y'}
= (defined $root_x
? Gtk2::Ex::WidgetBits::xy_root_to_widget ($widget, $root_x, $root_y)
: ());
### at: $self->{'x'}, $self->{'y'}
}
my $x = $self->{'x'};
defined $x || return;
my $y = $self->{'y'};
my $gc = ($self->{'gc'} ||= do {
### create gc
my $line_width = $crosshair->get('line_width');
my $line_style = $crosshair->{'line_style'} || 'double-dash';
Gtk2::Ex::Xor::shared_gc
(widget => $widget,
foreground_xor => $crosshair->{'foreground'},
background => 0, # no change
line_width => $line_width,
line_style => $line_style,
fill => 'stippled',
cap_style => 'projecting',
($line_style eq 'solid' ? ()
: (dash_list => [ ($line_width || 1) * 4 ])),
# subwindow_mode => 'include_inferiors',
);
});
if ($win != $widget->window) {
# if the operative Gtk2_Ex_Xor_window is not the main widget window,
# then adjust from widget coordinates to the $win subwindow
my ($wx, $wy) = $win->get_position;
### subwindow offset: "$wx,$wy"
$x -= $wx;
$y -= $wy;
}
my ($x_lo, $y_lo, $x_hi, $y_hi);
if ($widget->get_flags & 'no-window') {
my $alloc = $widget->allocation;
$x_lo = $alloc->x;
$x_hi = $alloc->x + $alloc->width - 1;
$y_lo = $alloc->y;
$y_hi = $alloc->y + $alloc->height - 1;
$x += $x_lo;
$y += $y_lo;
} else {
($x_hi, $y_hi) = $win->get_size;
$x_lo = 0;
$y_lo = 0;
}
if ($clip_region) { $gc->set_clip_region ($clip_region); }
$win->draw_segments
($gc,
$x_lo,$y, $x_hi,$y, # horizontal
$x,$y_lo, $x,$y_hi); # vertical
if ($clip_region) { $gc->set_clip_region (undef); }
}
#------------------------------------------------------------------------------
1;
__END__