view release on metacpan or  search on metacpan

lib/App/Chart/Gtk2/AnnDrag.pm  view on Meta::CPAN

package App::Chart::Gtk2::AnnDrag;
use 5.008;
use strict;
use warnings;
use Gtk2 1.220;

use Gtk2::Ex::WidgetBits;
use App::Chart::Gtk2::Graph::Plugin::Alerts;

Gtk2->CHECK_VERSION(2,12,0)
  or die "Need Gtk 2.12 or higher";  # for ->error_bell

use constant DEBUG => 0;

use Glib::Object::Subclass
  'Gtk2::Object',
  signals => { abort => { param_types   => [],
                          return_type   => undef,
                          flags         => ['run-last','action'],
                          class_closure => \&_do_abort,
                        },
               toggle_alert => { param_types   => [],
                                 return_type   => undef,
                                 flags         => ['run-last','action'],
                                 class_closure => \&_do_toggle_alert,
                               },
               swap_ends => { param_types   => [],
                              return_type   => undef,
                              flags         => ['run-last','action'],
                              class_closure => \&_do_swap_ends,
                            },
               delete_element => { param_types   => [],
                                   return_type   => undef,
                                   flags         => ['run-last','action'],
                                   class_closure => \&_do_delete_element,
                                 },
               toggle_horizontal => { param_types   => [],
                                      return_type   => undef,
                                      flags         => ['run-last','action'],
                                      class_closure => \&_do_toggle_horizontal,
                                    },
             };

# priority level "gtk" treating this as widget level default, for overriding
# by application or user RC
Gtk2::Rc->parse_string (<<'HERE');
binding "App__Chart__Gtk2__AnnDrag_keys" {
  bind "Escape"         { "abort" () }
  bind "a"              { "toggle-alert" () }
  bind "space"          { "swap-ends" () }
  bind "d"              { "delete-element" () }
  bind "h"              { "toggle-horizontal" () }
}
class "App__Chart__Gtk2__AnnDrag" binding:gtk "App__Chart__Gtk2__AnnDrag_keys"
HERE


my $active = 0;
my $graph;
my $cursor;
my $drawn = 0;
my $wevents;
my $snooper;

my $orig_elem;  # from database, or undef for new line
my $edit_elem;

use constant::defer init => sub {
  $graph->signal_connect (motion_notify_event => \&_do_motion_notify_event);
  $graph->signal_connect (button_release_event=> \&_do_button_release_event);

  require Gtk2::Ex::WidgetCursor;
  $cursor = Gtk2::Ex::WidgetCursor->new (widget => $graph,
                                         cursor => 'left_ptr');

  require Gtk2::Ex::WidgetEvents;
  $wevents = Gtk2::Ex::WidgetEvents->new ($graph, ['key-press-mask',
                                                   'button-motion-mask',
                                                   'button-release-mask']);
  require Gtk2::Ex::KeySnooper;
  $snooper = Gtk2::Ex::KeySnooper->new;
  return; # nothing to memoize
};

# start dragging in $graph of object nearest $event
sub start {
  ($graph, my $event) = @_;  # global $graph
  if ($active) { return; }

  init ();
  my $x = $event->x;
  my $y = $event->y;
  $orig_elem = find ($x, $y);
  if ($orig_elem) {
    $edit_elem = $orig_elem->clone;
    $drawn = 1;
  } else {
    $edit_elem = App::Chart::Annotation::Line->new_for_graph ($graph, $x, $y);
    $drawn = 0;
    draw(1);
  }

  $active = 1;
  $cursor->active (1);
  $snooper->install (\&_do_key_snooper);
}

sub _stop {
  $active = 0;
  $cursor->active (0);
  $snooper->remove;
}

sub done {
  if (! $active) { return; }
  if (DEBUG) { print "done\n"; }
  _stop ();
  draw (1);
}

sub abort {
  goto &_do_abort;
}
sub _do_abort {
  my ($self) = @_;
  if (! $active) { return; }
  _stop ();
  draw (0);
  $edit_elem = $orig_elem;
  if ($edit_elem) {
    draw(1);
  }
}

sub delete_elem {
  goto &_do_delete_element;
}
sub _do_delete_element {
  my ($self) = @_;
  if (! $active) { return; }
  _stop();
  draw (0);
  if ($orig_elem) {
    $orig_elem->delete;
  }
}

sub _do_expose_event {
  my ($graph, $event) = @_;
  $drawn = 0;
  draw (1, $event->region);
  return Gtk2::EVENT_PROPAGATE;
}

sub _do_motion_notify_event {
  my ($graph, $event) = @_;
  my $x = $event->x;
  my $y = $event->y;
  if ($event->is_hint) {
    ($x, $y) = $event->window->get_pointer;
  }
  move ($x, $y);
  return Gtk2::EVENT_PROPAGATE;
}

sub _do_button_release_event {
  my ($graph, $event) = @_;
  if (! $active) { # button release after Esc or D keyboard stop
    return Gtk2::EVENT_PROPAGATE;
  }