# Copyright 2010, 2011, 2012 Kevin Ryde

# This file is part of Math-Image.
#
# Math-Image 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.
#
# Math-Image 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 Math-Image.  If not, see <http://www.gnu.org/licenses/>.


package App::MathImage::Gtk2::Ex::Statusbar::PointerPosition;
use 5.008;
use strict;
use warnings;
use Gtk2 1.220;
use Scalar::Util 1.18 'refaddr'; # 1.18 for pure-perl refaddr() fix
use Gtk2::Ex::SyncCall 12; # v.12 workaround gtk 2.12 bug

our $VERSION = 108;

# uncomment this to run the ### lines
#use Smart::Comments;

use Gtk2::Ex::Statusbar::Message;
use Glib::Object::Subclass
  'Gtk2::Ex::Statusbar::Message',
  properties => [ Glib::ParamSpec->object
                  ('widget',
                   (do {
                     my $str = 'Widget';
                     # translated from gtk20-properties.mo
                     eval { require Locale::Messages;
                            Locale::Messages::dgettext('gtk20-properties',$str)
                            } || $str }),
                   'Blurb.',
                   'Gtk2::Widget',
                   Glib::G_PARAM_READWRITE),
                ],
  signals => { 'message-string' => { param_types => [ 'Gtk2::Widget',
                                                      'Glib::Int',
                                                      'Glib::Int' ],
                                     return_type => 'Glib::String',
                                     flags       => ['run-last'],
                                   },
             };

# sub INIT_INSTANCE {
#   my ($self) = @_;
# }

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

  $self->{$pname} = $newval;
  if ($pname eq 'widget') {
    Scalar::Util::weaken ($self->{'widget'});

    # Must listen to enter-notify since that's the only event when the widget
    # is realized underneath the mouse pointer -- there's no motion-notify in
    # that case.
    #
    my $widget = $self->{'widget'};
    $self->{'widget_ids'} = $widget && do {
      Scalar::Util::weaken (my $weak_self = $self);
      require Glib::Ex::SignalIds;
      Glib::Ex::SignalIds->new
          ($widget,
           $widget->signal_connect ('motion_notify_event',
                                    \&_do_enter_or_motion_notify,
                                    \$weak_self),
           $widget->signal_connect ('enter_notify_event',
                                    \&_do_enter_or_motion_notify,
                                    \$weak_self),
           $widget->signal_connect ('leave_notify_event',
                                    \&_do_leave_notify,
                                    \$weak_self));
    };
    $self->{'wevents'} = $widget && do {
      require Gtk2::Ex::WidgetEvents;
      Gtk2::Ex::WidgetEvents->new
          ($widget,
           ['pointer-motion-mask',
            'enter-notify-mask',
            'leave-notify-mask']);
    };

    # initial display
    if ($widget && $self->{'widget'}->realized) {
      $self->{'want_query_pointer'} = 1;
      Scalar::Util::weaken (my $weak_self = $self);
      _queue_synccall($self, \$weak_self);
    }
  }

  ### widget_ids: $self->{'widget_ids'}
}

# $self->{'statusbar_ids'} = $self->{'statusbar'} && do {
#   Scalar::Util::weaken (my $weak_self = $self);
#   require Glib::Ex::SignalIds;
#   Glib::Ex::SignalIds->new
#       ($self->{'statusbar'},
#        $self->{'statusbar'}->signal_connect ('destroy',
#                                              \&_do_statusbar_destroy,
#                                              \$weak_self));
# };
# sub _do_statusbar_destroy {
#   my ($statusbar, $ref_weak_self) = @_;
#   ### PointerPosition _do_statusbar_destroy() ...
#   if (my $self = $$ref_weak_self) {
#     undef $self->{'statusbar'};
#   }
# }

# 'enter-notify-event' signal on the widgets
# 'motion-notify-event' signal on the widgets
sub _do_enter_or_motion_notify {
  my ($widget, $event, $ref_weak_self) = @_;
  ### PointerPosition _do_enter_or_motion_notify(): "$widget"

  if (my $self = $$ref_weak_self) {
    # ignore signals on a previously installed widget
    if ($self->{'widget'} && $self->{'widget'} == $widget) {
      $self->{'x'} = $event->x;
      $self->{'y'} = $event->y;
      $self->{'want_query_pointer'} = 0;

      # If someone else has set pointer-motion-hint then it's their
      # responsibility to get_pointer ... presumably.
      # if ($event->can('is_hint') && $event->is_hint) {
      #   ($self->{'x'},$self->{'y'}) = $widget->get_pointer;
      # } else {
      # }

      _queue_synccall($self, $ref_weak_self);
    }
  }
  return Gtk2::EVENT_PROPAGATE;
}

# 'leave-notify-event' signal on one of the widgets
sub _do_leave_notify {
  my ($widget, $event, $ref_weak_self) = @_;
  ### PointerPosition _do_leave_notify(): "$widget"

  if (my $self = $$ref_weak_self) {
    undef $self->{'x'};
    undef $self->{'y'};
    $self->{'want_query_pointer'} = 0;
    _queue_synccall ($self, $ref_weak_self);
  }
  return Gtk2::EVENT_PROPAGATE;
}

sub _queue_synccall {
  my ($self, $ref_weak_self) = @_;
  ### _queue_synccall(): "$ref_weak_self"

  if ($self->{'widget'}) {
    $self->{'sync_call_pending'} ||= do {
      Gtk2::Ex::SyncCall->sync ($self->{'widget'},
                                \&_do_synccall,
                                $ref_weak_self);
      1;
    };
  }
}
sub _do_synccall {
  my ($ref_weak_self) = @_;
  ### _do_synccall() ...

  my $self = $$ref_weak_self || return;
  $self->{'sync_call_pending'} = 0;

  my $message;
  if (my $widget = $self->{'widget'}) {
    if ($self->{'want_query_pointer'}) {
      my ($x,$y) = $widget->get_pointer;
      if (! _widget_xy_in_widget($widget,$x,$y)) {
        undef $x;
        undef $y;
      }
      $self->{'x'} = $x;
      $self->{'y'} = $x;
    }

    if (defined $self->{'x'}) {
      $message = $self->signal_emit ('message-string',
                                     $self->{'widget'},
                                     $self->{'x'}, $self->{'y'});
    }
  }
  $self->set_message ($message);
}

1;
__END__

=for stopwords Math-Image Ryde

=head1 NAME

App::MathImage::Gtk2::Ex::Statusbar::PointerPosition -- widget pointer position message in a statusbar

=for test_synopsis my ($my_widget, $my_statusbar)

=head1 SYNOPSIS

 use App::MathImage::Gtk2::Ex::Statusbar::PointerPosition;
 my $ppos = App::MathImage::Gtk2::Ex::Statusbar::PointerPosition->new
              (widget => $my_widget,
               statusbar => $my_statusbar);

=head1 WIDGET HIERARCHY

C<App::MathImage::Gtk2::Ex::Statusbar::PointerPosition> is a C<Glib::Object>
subclass,

    Glib::Object
      Gtk2::Ex::Statusbar::Message
        App::MathImage::Gtk2::Ex::Statusbar::PointerPosition

=head1 DESCRIPTION

B<Experimental!>

A PointerPosition object displays a message in a C<Gtk2::Statusbar>
following the mouse pointer position in a given widget.

    +--------------------------------------------+
    |                                            |
    |            *                               |
    |             \__mouse pointer               |
    |                                            |
    |                                            |
    +--------------------------------------------+
    | statusbar message about pointer position   |
    +--------------------------------------------+

The basic operation is a C<motion-notify-event> handler on the widget and a
C<message-string> callback to get a string to show.  But the advantage of
PointerPosition is that it also blanks on leave and it defers updates with
the C<Gtk2::Ex::SyncCall> mechanism so as not to do more statusbar updates
than can be actually displayed.

=head1 FUNCTIONS

=over 4

=item C<< $ppos = App::MathImage::Gtk2::Ex::Statusbar::PointerPosition->new (key=>value,...) >>

Create and return a new PointerPosition object.  Optional key/value pairs
set initial properties per C<< Glib::Object->new >>.

    $ppos = App::MathImage::Gtk2::Ex::Statusbar::PointerPosition->new
               (widget => $my_widget,
                statusbar => $my_statusbar);


=back

=head1 PROPERTIES

=over 4

=item C<widget> (C<Gtk2::Widget> object, default C<undef>)

The widget to watch for mouse motion.

In the current code this must be a windowed widget.  It doesn't have to be
realized or visible yet -- a statusbar message will be shown if or when that
happens (and the mouse is in it).

=item C<statusbar> (C<Gtk2::Statusbar> object, default C<undef>)

The statusbar to display a message in.

=back

=head1 SIGNALS

=over 4

=item C<message-string> (parameters: widget, x, y)

Emitted as a callback to the application asking it for a message string to
display for the mouse at x,y within widget.

The widget is always the PointerPosition widget parameter value, but is
included as a parameter since making a message will very often want to get
or check something from the widget.

    $ppos->signal_connect
        (message_string => \&my_message_string);

    sub my_message_string {
      my ($ppos, $widget, $x, $y, $userdata) = @_;
      return "mouse at X=$x Y=$y, in widget coordinates";
    }

If no message should be shown then return C<undef> from the handler.

=back

=head1 BUILDABLE

C<App::MathImage::Gtk2::Ex::Statusbar::PointerPosition> can be built in a
C<Gtk2::Builder> spec the same as any other C<Glib::Object>.  The class name
is "App__MathImage__Gtk2__Ex__Statusbar__PointerPosition" as usual for
Perl-Gtk package name to class name conversion.

The target C<widget> and C<statusbar> properties can be set to objects
created in the builder spec.  For example

  <object class="App__MathImage__Gtk2__Ex__Statusbar__PointerPosition"
          id="pointerposition">
    <property name="widget">my_drawing</property>
    <property name="statusbar">my_statusbar</property>
  </object>

=cut

  # <object class="GtkDrawingArea" id="my_drawing">
  #   ...
  # </object>
  # <object class="GtkStatusbar" id="my_statusbar">
  #   ...
  # </object>


=head1 SEE ALSO

L<Glib::Object>,
L<Gtk2::Statusbar>,
L<Gtk2::Widget>

=head1 HOME PAGE

http://user42.tuxfamily.org/math-image/index.html

=head1 LICENSE

Copyright 2010, 2011, 2012 Kevin Ryde

Math-Image 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.

Math-Image 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
Math-Image.  If not, see L<http://www.gnu.org/licenses/>.

=cut
