The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
# Copyright 2008, 2009, 2010, 2011 Kevin Ryde

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

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;
  }
  move ($event->x, $event->y);
  done();
  $edit_elem->write;
  return Gtk2::EVENT_PROPAGATE;
}

sub draw {
  my ($want, $region) = @_;
  if (DEBUG >= 2) { print "  draw drawn=$drawn want=$want\n"; }
  if ($drawn != $want) {
    $edit_elem->draw ($graph, $region);
    $drawn = $want;
  }
}

sub move {
  my ($x, $y) = @_;
  if (! $active) { return; }
  if (DEBUG) { print "AnnDrag move $x, $y\n"; }

  my $t = $graph->x_to_date ($x);
  my $price = $graph->y_to_value ($y);
  my $scale_y = $graph->scale_y_proc;

  if (DEBUG) {
    print "  $t, $price  was ",$edit_elem->t,",",$edit_elem->price," (",
      $graph->scale_y ($edit_elem->price),")\n";
  }

  # redraw only if changed
  if ($edit_elem->t != $t
      || $scale_y->($edit_elem->price) != $scale_y->($price)) {
    if (DEBUG >= 2) { print "  redraw\n"; }
    draw (0);
    $edit_elem->t ($t);
    $edit_elem->price ($price);
    draw (1);
  } else {
    if (DEBUG >= 2) { print "  no pixel position change\n"; }
    # but store floating point price always
    $edit_elem->price ($price);
  }
}

sub _do_key_snooper {
  my ($widget, $event) = @_;

  # ignore key releases
  $event->type eq 'key-press' or return Gtk2::EVENT_PROPAGATE;

  # needing an actual self Gtk2::Object
  #   require Gtk2::Ex::BindingBits;
  #   Gtk2::Ex::BindingBits::activate_event
  #   if (App::Chart::Gtk2::GUI::bindings_activate_event ('App__Chart__Gtk2__AnnDrag_keys',
  #                                                $event, $self)) {
  #     return Gtk2::EVENT_STOP; # since handled
  #   }

  my $keyval = $event->keyval;
  my $modifiers = $event->state;
  $modifiers = $modifiers & Gtk2::Accelerator->get_default_mod_mask;
  my $key = lc (Gtk2::Gdk->keyval_name ($keyval));
  if (DEBUG) { print "keypress $key\n"; }

  if ($key eq 'escape') {
    abort ();

  } elsif ($key eq 'a') {
    toggle_alert ();

  } elsif ($key eq 'space') {
    swap_ends ();

  } elsif ($key eq 'd') {
    delete_elem ();

  } elsif ($key eq 'h') {
    toggle_horizontal ();

  } else {
    # some key not for us
    return Gtk2::EVENT_PROPAGATE;
  }

  # any of the handled keys
  return Gtk2::EVENT_STOP;
}

sub toggle_alert {
  goto &_do_toggle_alert;
}
sub _do_toggle_alert {
  my ($self) = @_;
  if ($edit_elem->isa('App::Chart::Annotation::Line')) {
    if ($edit_elem->{'id'}) {
      $graph->error_bell;
      return;
    }
    draw (0);
    $edit_elem = App::Chart::Annotation::Alert->new
      (symbol => $edit_elem->{'symbol'},
       price  => $edit_elem->{'price1'},
       above  => 1);

  } else {
    draw (0);
    $edit_elem->{'above'} = ($edit_elem->{'above'} ? 0 : 1);
  }
  draw (1);
}

sub toggle_horizontal {
  goto &_do_toggle_horizontal;
}
sub _do_toggle_horizontal {
  my ($self) = @_;
  draw (0);
  $edit_elem->{'horizontal'} = ($edit_elem->{'horizontal'} ? 0 : 1);
  draw (1);
}

sub swap_ends {
  goto &_do_swap_ends;
}
sub _do_swap_ends {
  if (DEBUG) { print "swap_ends\n"; }
  draw (0);
  $edit_elem->swap_ends;
  draw (1);
  Gtk2::Ex::WidgetBits::warp_pointer ($graph,
                                      $graph->scale_x ($edit_elem->t),
                                      $graph->scale_y ($edit_elem->price));
}

# return a line from notes, or undef
# the line ends are swapped if necessary to make t2,p2 the point near x,y
#
sub find {
  my ($x, $y) = @_;
  if (DEBUG) { print "find\n"; }

  my $series = $graph->get('series_list')->[0] || return undef;
  my $scale_x = $graph->scale_x_proc;
  my $scale_y = $graph->scale_y_proc;

  # distance in millimetres from tdate/price to X,Y
  my $tp_distance = sub {
    my ($t, $p) = @_;
    return Gtk2::Ex::WidgetBits::xy_distance_mm
      ($graph, $x,$y, $scale_x->($t), $scale_y->($p));
  };

  my $min_elem;
  my $min_dist;
  my $minproc = sub {
    my ($elem, $t, $p) = @_;
    my $dist = $tp_distance->($t, $p);
    if (DEBUG) { print "  $elem dist $dist\n"; }
    if ($dist > 5) {
      return;  # no more than 5 millimetres
    }
    if (! defined $min_dist || $dist < $min_dist) {
      $min_dist = $dist;
      $min_elem = $elem;
    }
  };

  require App::Chart::Annotation;
  foreach my $elem (@{$series->AnnLines_arrayref}) {
    $minproc->($elem, $elem->t, $elem->price);
    $elem = $elem->clone ($elem);
    $elem->swap_ends;
    $minproc->($elem, $elem->t, $elem->price);
  }
  {
    my $t = App::Chart::Gtk2::Graph::Plugin::Alerts::draw_t ($graph);
    foreach my $elem (@{$series->Alerts_arrayref}) {
      $minproc->($elem, $t, $elem->price);
    }
  }

  if (DEBUG) { print "  result ",$min_elem||'undef',
                 " dist ",$min_dist||'undef',"\n"; }
  return $min_elem;
}

1;
__END__

# =head1 NAME
# 
# App::Chart::Gtk2::AnnDrag -- annotation line or alert dragging
# 
# =head1 SEE ALSO
# 
# L<App::Chart::Gtk2::Graph>
# 
# =cut