Gtk2::Ex::CrossHair - crosshair lines drawn following the mouse

 use Gtk2::Ex::CrossHair;
 my $crosshair = Gtk2::Ex::CrossHair->new (widgets => [$w1,$w2]);
 $crosshair->signal_connect (moved => sub { print_pos() });

 $crosshair->start ($event);
 $crosshair->end ();

    Glib::Object
      Gtk2::Ex::CrossHair

        +-----------------+
        |         |       | +-----------------+
        |         | mouse | |                 |
        |         |/      | |                 |
        | --------+------ | | --------------- |
        |         |       | |                 |
        |         |       | |                 |
        |         |       | +-----------------+
        |         |       |
        +-----------------+

    <object class="Gtk2__Ex__CrossHair" id="mycross">
      <property name="widget">drawingwidget</property>
      <property name="foreground-name">orange</property>
      <signal name="moved" handler="do_cross_moved"/>
    </object>

# Copyright 2007, 2008, 2009, 2010, 2011 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 = 22;

# In each CrossHair the private fields are
#
#   xy_widget
#       The widget to report in the 'moved' signal, or undef.
#
#   root_x,root_y
#       The current or pending x,y of the crosshair in root coordinates.
#       root_x is undef if the crosshair is outside any widget and therefore
#       not to be drawn (in "keyboard" mode rather than implicit-grab button
#       mode).
#
#       xy_widget and root_x,root_y are set immediately by _maybe_move() for
#       a mouse motion etc, but the actual drawing of them is later in the
#       sync_call_handler().
#
#   wcursor
#       Gtk2::Ex::WidgetCursor object putting an invisible cursor in the
#       crosshair widgets.
#
# 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->scalar
                  ('widgets',
                   'Widgets',
                   'Arrayref of widgets to act on.',
                   Glib::G_PARAM_READWRITE),

                  Glib::ParamSpec->object
                  ('widget',
                   'Widget',
                   'Single widget to act on.',
                   'Gtk2::Widget',
                   Glib::G_PARAM_READWRITE),

                  Glib::ParamSpec->object
                  ('add-widget',
                   'Add widget',
                   'Add a widget to act on.',
                   'Gtk2::Widget',
                   'writable'),

                  Glib::ParamSpec->boolean
                  ('active',
                   'Active',
                   'Whether to display the crosshair.',
                   0,
                   Glib::G_PARAM_READWRITE),

                  Glib::ParamSpec->scalar
                  ('foreground',
                   (do { # translation from Gtk2::TextTag
                     my $str = 'Foreground colour';
                     eval { require Locale::Messages;
                            Locale::Messages::dgettext('gtk20-properties',$str)
                            } || $str }),
                   'The colour to draw the crosshair, either a string name (including hex RGB), a Gtk2::Gdk::Color, or undef for the widget\'s style foreground.',
                   Glib::G_PARAM_READWRITE),

                  Glib::ParamSpec->string
                  ('foreground-name',
                   (do { # translation from Gtk2::TextTag
                     my $str = 'Foreground colour name';
                     eval { require Locale::Messages;
                            Locale::Messages::dgettext('gtk20-properties',$str)
                            } || $str }),
                   'The colour to draw the crosshair, as a string colour name.',
                   (eval {Glib->VERSION(1.240);1}
                    ? undef # default
                    : ''),  # no undef/NULL before Perl-Glib 1.240
                   Glib::G_PARAM_READWRITE),

                  Glib::ParamSpec->boxed
                  ('foreground-gdk',
                   'Foreground colour object',
                   'The colour to draw the crosshair, as a Gtk2::Gdk::Color object with red,greed,blue fields set (a pixel is looked up on each target widget).',
                   'Gtk2::Gdk::Color',
                   Glib::G_PARAM_READWRITE),

                  Glib::ParamSpec->int
                  ('line-width',
                   'Line width',
                   'The width of the cross lines drawn.',
                   0, POSIX::INT_MAX(),  # limits
                   0,                    # default
                   Glib::G_PARAM_READWRITE),
                ];


sub INIT_INSTANCE {
  my ($self) = @_;
  ### CrossHair INIT_INSTANCE
  $self->{'button'} = 0;
  $self->{'widgets'} = [];
}

sub FINALIZE_INSTANCE {
  my ($self) = @_;
  ### CrossHair finalize: "$self"
  $self->end;
}

sub _pw_list {
  my ($self) = @_;
  return values %{$self->{'perwidget'}};
}
sub _pw {
  my ($self, $widget) = @_;
  ### _pw: "@{[$widget||'[undef]']}"
  return $self->{'perwidget'}->{refaddr($widget)};
}

sub GET_PROPERTY {
  my ($self, $pspec) = @_;
  my $pname = $pspec->get_name;
  ### CrossHair GET_PROPERTY: $pname

  if ($pname eq 'widget') {
    my $widgets = $self->{'widgets'};
    if (@$widgets > 1) {
      croak 'Cannot get single \'widget\' property when using multiple widgets';
    }
    return $widgets->[0];
  }
  if ($pname eq 'foreground_name') {
    my $foreground = $self->{'foreground'};
    if (Scalar::Util::blessed($foreground)
        && $foreground->isa('Gtk2::Gdk::Color')) {
      $foreground = $foreground->to_string; # string "#RRRRGGGGBBBB"
    }
    return $foreground;
  }
  if ($pname eq 'foreground_gdk') {
    my $foreground = $self->{'foreground'};
    ### $foreground
    if (defined $foreground
        && ! Scalar::Util::blessed($foreground)) {
      # Perl-Glib 1.220 doesn't copy a boxed return like Gtk2::Gdk::Color,
      # must keep the block of memory in a field
      $foreground = $self->{'_foreground_gdk'}
        = Gtk2::Gdk::Color->parse($foreground);
    }
    return $foreground;
  }
  return $self->{$pname};
}

sub SET_PROPERTY {
  my ($self, $pspec, $newval) = @_;
  my $pname = $pspec->get_name;
  my $oldval = $self->{$pname};
  ### CrossHair SET_PROPERTY: $pname

  if ($pname eq 'widget') {
    $pname = 'widgets';
    $newval = [ $newval ];
    $self->notify ('widgets');
  } elsif ($pname eq 'add_widget') {
    $pname = 'widgets';
    $newval = [ @{$self->{'widgets'}}, $newval ];
    $self->notify ('widget');
    $self->notify ('widgets');
  }

  if ($pname eq 'widgets') {
    my $widgets = $newval;
    ### old widgets: "$self->{'widgets'}   @{$self->{'widgets'}}"
    ### new widgets: "$widgets   @$widgets"

    _undraw ($self);

    my $old_perwidget = $self->{'perwidget'};
    my %new_perwidget;
    $self->{'perwidget'} = \%new_perwidget;

    foreach my $widget (@$widgets) {
      my $key = refaddr($widget);
      ### perwidget key: refaddr($widget)
      unless ($new_perwidget{$key} = $old_perwidget->{$key}) {
        _pw_new($self,$widget);
      }
    }
    undef $old_perwidget; # discard pw's of old widgets
    ### perwidget keys now: keys %{$self->{'perwidget'}}

    @{$self->{'widgets'}} = @$newval;  # copy contents

    my $xy_widget = $self->{'xy_widget'};
    my $root_x = $self->{'root_x'};
    my $root_y = $self->{'root_y'};
    if ($xy_widget && ! _pw($self,$xy_widget)) {
      ### xy_widget removed
      unless ($self->{'xy_widget'} = $xy_widget = List::Util::first
              {_widget_contains_root_xy ($_, $root_x, $root_y)} @$widgets) {
        # no drawing when not in any widget, per _do_leave_notify()
        undef $root_x;
        undef $root_y;
      }
    }
    _maybe_move ($self, $xy_widget, $root_x, $root_y);
    _wcursor_update ($self); # new widget set
    $self->notify ('widget');

    ### now widgets: "$self->{'widgets'}   @{$self->{'widgets'}}"
    return;
  }

  if ($pname eq 'active') {
    # the extra '$self->notify' calls by running 'start' and 'end' here are
    # ok, Glib suppresses duplicates while in SET_PROPERTY
    if ($newval && ! $oldval) {
      $self->start;
    } elsif ($oldval && ! $newval) {
      $self->end;
    }

  } elsif ($pname =~ /^foreground/ || $pname eq 'line_width') {
    if ($pname =~ /^foreground/) {
      # must copy if 'foreground_gdk' since $newval points to a malloced
      # copy or something, copy scalar 'foreground' too just in case
      if (Scalar::Util::blessed($newval)
          && $newval->isa('Gtk2::Gdk::Color')) {
        $newval = $newval->copy;
      }
      $pname = 'foreground';
      $self->notify('foreground');
      $self->notify('foreground-name');
      $self->notify('foreground-gdk');
    }
    _undraw ($self);
    foreach my $pw (_pw_list($self)) {
      delete $pw->{'gc'}; # new gc's for colour or width
    }
    $self->{$pname} = $newval;
    _draw ($self);
  }

  $self->{$pname} = $newval;  # per default GET_PROPERTY
}

sub _pw_new {
  my ($self, $widget) = @_;
  ### _pw_new(): "$widget"

  # 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;
  my $wevents = Gtk2::Ex::WidgetEvents->new
    ($widget, ['button-motion-mask',
               'button-release-mask',
               'pointer-motion-mask',
               'enter-notify-mask',
               'leave-notify-mask']);

  my $ref_weak_self = Gtk2::Ex::Xor::_ref_weak ($self);
  $self->{'perwidget'}->{refaddr($widget)}
    = { wevents => $wevents,
        static_ids => Glib::Ex::SignalIds->new
        ($widget, $widget->signal_connect (style_set => \&_do_style_set,
                                           $ref_weak_self)),
      };

  if ($self->{'active'}) {
    _pw_start ($self, $widget);
    _draw ($self, [$widget]);
  }
}

sub start {
  my ($self, $event) = @_;
  ### CrossHair start()

  my $button = $self->{'button'} = (ref $event && $event->can('button')
                                    ? $event->button : 0);
  if ($self->{'active'}) { return; }

  $self->{'active'} = 1;
  my $widgets = $self->{'widgets'};
  _wcursor_update ($self);

  # initial root_x,root_y from event if given, or by round trip on the first
  # realized of $widgets otherwise
  #
  my ($root_x, $root_y);
  if (ref $event) {
    ($root_x, $root_y) = $event->root_coords;
  } else {
    foreach my $widget (@$widgets) {
      my $root_window = $widget->get_root_window || next;
      ### root_window: "$root_window"
      (undef, $root_x, $root_y) = $root_window->get_pointer;
      last;
    }
  }
  ### root x,y: $root_x, $root_y

  my $xy_widget;
  if ($button) {
    # button mode, use reported event widget as $xy_widget, if it's one of
    # ours
    my $eventwidget = Gtk2->get_event_widget ($event);
    $xy_widget = List::Util::first {$_ == $eventwidget} @$widgets;

  } elsif (defined $root_x) {
    # Non-button mode, initial $xy_widget as whichever of $widgets contains
    # the pointer, if any.  After this enter and leave events maintain.
    $xy_widget = List::Util::first
      {_widget_contains_root_xy ($_, $root_x, $root_y)} @$widgets;
    if (! defined $xy_widget) {
      # no drawing when not in any widget, per _do_leave_notify()
      undef $root_x;
      undef $root_y;
    }
  }

  $self->{'xy_widget'} = $xy_widget;
  $self->{'root_x'} = $root_x;
  $self->{'root_y'} = $root_y;

  foreach my $widget (@$widgets) {
    _pw_start ($self, $widget);
  }

  $self->notify('active');
  _sync_call_handler (\$self); # initial drawing immediately
}

sub _wcursor_update {
  my ($self) = @_;
  ### CrossHair _wcursor_update(): "$self"
  $self->{'wcursor'} = $self->{'active'} && do {
    require Gtk2::Ex::WidgetCursor;
    Gtk2::Ex::WidgetCursor->new
        (widgets => $self->{'widgets'},
         cursor  => 'invisible',
         active  => 1)
      };
}

sub _pw_start {
  my ($self, $widget) = @_;
  ### CrossHair _pw_start(): "$widget"

  my $ref_weak_self = Gtk2::Ex::Xor::_ref_weak ($self);
  _pw($self,$widget)->{'dynamic_ids'} = 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));
}

sub end {
  my ($self) = @_;
  if (! $self->{'active'}) { return; }

  $self->signal_emit ('moved', undef, undef, undef);
  _undraw ($self);
  foreach my $pw (_pw_list($self)) {
    delete $pw->{'dynamic_ids'};
  }
  $self->{'active'} = 0;
  _wcursor_update ($self);
  $self->notify('active');
}


#-----------------------------------------------------------------------------

# '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 ($self->{'active'}) {
      _maybe_move ($self, $widget, _event_root_coords ($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
  _undraw ($self, [$widget]);
  _draw ($self, [$widget]);
}

# '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 (! $self->{'button'}) {
      # not button drag mode
      _maybe_move ($self, $widget, $event->root_coords);
    }
  }
  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 (! $self->{'button'}) {
      # not button drag mode
      _maybe_move ($self, undef, undef, undef);
    }
  }
  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 ($event->button == $self->{'button'}) {
      $self->end ($event);
    }
  }
  return 0; # Gtk2::EVENT_PROPAGATE
}

sub _maybe_move {
  my ($self, $widget, $root_x, $root_y) = @_;
  #### _maybe_move: "@{[$widget||'[undef]']}", $root_x, $root_y

  $self->{'xy_widget'} = $widget;
  $self->{'root_x'} = $root_x;
  $self->{'root_y'} = $root_y;

  $self->{'sync_call'} ||= do {
    require Gtk2::Ex::SyncCall;
    ### new SyncCall on: "$self->{'widgets'}->[0]"
    if (my $widget = List::Util::first {$_->realized} @{$self->{'widgets'}}) {
      Gtk2::Ex::SyncCall->sync ($widget,
                                \&_sync_call_handler,
                                Gtk2::Ex::Xor::_ref_weak ($self));
    } else {
      $self->signal_emit ('moved', undef, undef, undef);
      undef;
    }
  };
}
sub _sync_call_handler {
  my ($ref_weak_self) = @_;
  my $self = $$ref_weak_self || return;
  ### CrossHair _sync_call_handler()

  $self->{'sync_call'} = undef;
  if (! $self->{'active'}) { return; }  # turned off before sync returned

  _undraw ($self);  # erase old
  _draw ($self);    # draw new

  my ($xy_widget, $x, $y);
  if ($xy_widget = $self->{'xy_widget'}) {
    ($x, $y) = @{_pw($self,$xy_widget)}{'x','y'};
  }
  $self->signal_emit ('moved', $xy_widget, $x, $y);
}

sub _do_expose_event {
  my ($widget, $event, $ref_weak_self) = @_;
  ### CrossHair _do_expose_event()
  if (my $self = $$ref_weak_self) {
    _draw ($self, [$widget], $event->region);
  }
  return 0; # Gtk2::EVENT_PROPAGATE
}

sub _undraw {
  my ($self, $widgets) = @_;
  $widgets ||= $self->{'widgets'};
  ### _undraw(): "@$widgets"

  my @widgets = grep { exists(_pw($self,$_)->{'x'}) } @$widgets;
  _draw ($self, \@widgets);
  foreach my $widget (@widgets) {
    # position undetermined as well as undrawn
    delete _pw($self,$widget)->{'x'};
  }
  ### _undraw() done
}

# $widgets is an arrayref of widgets to draw, or undef for all
sub _draw {
  my ($self, $widgets, $clip_region) = @_;
  $self->{'active'} || return;
  $widgets ||= $self->{'widgets'};
  my $root_x = $self->{'root_x'};
  my $root_y = $self->{'root_y'};

  foreach my $widget (@$widgets) {
    ### _draw(): "$widget"
    my $pw = _pw($self,$widget);
    my $win = $widget->Gtk2_Ex_Xor_window || next; # perhaps unrealized

    if (! exists $pw->{'x'}) {
      ### establish draw position: "$widget", $root_x, $root_y
      @{$pw}{'x','y'}
        = (defined $root_x
           ? Gtk2::Ex::WidgetBits::xy_root_to_widget ($widget, $root_x, $root_y)
           : ());
      ### at: $pw->{'x'}, $pw->{'y'}
    }

    my $x = $pw->{'x'};
    if (! defined $x) { next; }
    my $y = $pw->{'y'};

    my $gc = ($pw->{'gc'} ||= do {
      ### create gc
      my $line_width = $self->get('line_width');
      my $line_style = $self->{'line_style'} || 'double-dash';
      Gtk2::Ex::Xor::shared_gc
          (widget         => $widget,
           foreground_xor => $self->{'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); }
  }
}

# '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) = @_;
  ### CrossHair _do_style_set: "$widget"
  my $self = $$ref_weak_self || return;
  delete _pw($self,$widget)->{'gc'}; # possible new colour
}


#------------------------------------------------------------------------------
# generic helpers

sub _event_root_coords {
  my ($event) = @_;

  # Do a get_pointer() to support 'pointer-motion-hint-mask'.
  # Maybe should use $display->get_state here instead of just get_pointer,
  # but crosshair and lasso at present only work with the mouse, not an
  # arbitrary input device.
  if ($event->can('is_hint')
      && $event->is_hint
      && (my $window = $event->window)) {
    return ($window->get_screen->get_root_window->get_pointer)[1,2];
  } else {
    return $event->root_coords;
  }
}

# Return true if $x,$y in root window coordinates is within $widget's
# allocated rectangle.
# FIXME: Would like to exclude parts of $widget which are overlapped by
# other widgets and/or windows.
#
sub _widget_contains_root_xy {
  my ($widget, $root_x, $root_y) = @_;
  my ($wx, $wy) = Gtk2::Ex::WidgetBits::xy_root_to_widget ($widget, $root_x, $root_y)
    or return 0;  # $widget unrealized
  return _widget_contains_xy ($widget, $wx, $wy);
}

# Return true if $x,$y in widget coordinates is within $widget's allocated
# rectangle.  The rectangle $widget->allocation gives the size (its x,y
# position relative to the windowed parent is ignored).
#
sub _widget_contains_xy {
  my ($widget, $x, $y) = @_;
  ### _widget_contains_xy(): $x,$y
  return ($x >= 0 && $y >= 0
          && do {
            my $alloc = $widget->allocation;
            $x < $alloc->width && $y < $alloc->height });
}

# sub _rect_contains_xy {
#   my ($rect, $x) = @_;
#   return ($rect->x <= $x
#           && $rect->y <= $y
#           && $rect->x + $rect->width  >= $x
#           && $rect->y + $rect->height >= $y);
# }

# sub _xy_widget_to_root {
#   my ($widget, $x, $y) = @_;
#   my ($root_x, $root_y) = Gtk2::Ex::WidgetBits::get_root_position ($widget);
#   if (! defined $root_x) {
#     return;  # if $widget unrealized
#   } else {
#     return ($root_x + $x, $root_y + $y);
#   }
# }

# _widget_translate_coordinates_toplevel() is the same as
# gtk_widget_translate_coordinates, but allows widgets $src and $dst to be
# under different toplevels.
#
# sub _widget_translate_coordinates_toplevel {
#   my ($src, $dst, $x, $y) = @_;
#   if (my @ret = $src->translate_coordinates ($dst, $x, $y)) {
#     return @ret;
#   }
#   require Gtk2::Ex::WidgetBits;
#   my ($src_x, $src_y) = Gtk2::Ex::WidgetBits::get_root_position ($src);
#   if (! defined $src_x) {
#     # $src not realized
#     return;
#   }
#   my ($dst_x, $dst_y) = Gtk2::Ex::WidgetBits::get_root_position ($dst);
#   if (! defined $dst_x) {
#     # $dst not realized
#     return;
#   }
#   return ($src_x + $x - $dst_x,
#           $src_y + $y - $dst_y);
# }


#------------------------------------------------------------------------------


# Not sure about these yet:
#
#                   Glib::ParamSpec->enum
#                   ('line-style',
#                    'line-style',
#                    'blurb',
#                    'Gtk2::Gdk::LineStyle',
#                    DEFAULT_LINE_STYLE,
#                    Glib::G_PARAM_READWRITE),
#
# =item C<line_style> (default C<on-off-dash>)
#
# Attributes for the graphics context (C<Gtk2::Gdk::GC>) used to draw.  New
# settings here only take effect on the next C<start>.  For example,
#
#     $crosshair->{'line_style'} = 'solid';



1;
__END__