view release on metacpan or  search on metacpan

devel/run.pl  view on Meta::CPAN

my $table = Gtk2::Table->new (2, 2, 0);
$hbox->pack_start ($table, 0,0,0);

my $area = Gtk2::DrawingArea->new;
$area->set_size_request (200, 200);
$table->attach ($area, 0,1, 0,1,
                ['expand','shrink','fill'],['expand','shrink','fill'], 0,0);
$area->set_flags ('can-focus');
$area->grab_focus;
$area->add_events (['button-press-mask',
                    'button-motion-mask',
                    'button-release-mask']);
# $area->signal_connect (motion_notify_event => sub {
#                          print "$progname: motion_notify\n";
#                          return Gtk2::EVENT_PROPAGATE;
#                        });

my $vadj = Gtk2::Adjustment->new (100, 0, 300, 1, 10, 100);
$vadj->signal_connect
  (notify => sub {
     my ($vadj, $pspec) = @_;
     my $pname = $pspec->get_name;
     print "$progname: vadj notify \"$pname\", value now ",$vadj->value,"\n";
   });
$vadj->signal_connect
  (value_changed => sub {
     my ($vadj, $pspec) = @_;
     print "$progname: vadj value-changed, value now ",$vadj->value,"\n";
   });
my $vscroll = Gtk2::VScrollBar->new ($vadj);
$table->attach ($vscroll, 1,2, 0,1,
                [],['expand','shrink','fill'], 0,0);

my $hadj = Gtk2::Adjustment->new (100, 0, 300, 1, 10, 100);
my $hscroll = Gtk2::HScrollBar->new ($hadj);
$table->attach ($hscroll, 0,1, 1,2,
                ['expand','shrink','fill'],[], 0,0);

my $dragger;
my $confine = 0;
my $hinverted = 0;
my $vinverted = 0;
my $update_policy = 0;
sub make {
  $dragger = Gtk2::Ex::Dragger->new (widget        => $area,
                                     hadjustment   => $hadj,
                                     vadjustment   => $vadj,
                                     hinverted     => $hinverted,
                                     vinverted     => $vinverted,
                                     update_policy => $update_policy,
                                     confine       => $confine,
                                     cursor        => 'fleur');
  print "$progname ",($confine?"confined ":"unconfined "),
    ($hinverted?"hinv ":"hnorm "),
      ($vinverted?"vinv":"vnorm"),
        "policy $update_policy\n";
}
# make();

sub update {
  if (defined $dragger) {
    make ();
  }
}
{
  my $button = Gtk2::CheckButton->new_with_label ('Confine');
  $vbox->pack_start ($button, 0,0,0);
  $button->signal_connect (toggled => sub {
                             $confine = $button->get_active;
                             update();
                           });
}
{
  my $button = Gtk2::CheckButton->new_with_label ('H Inverted');
  $vbox->pack_start ($button, 0,0,0);
  $button->signal_connect ('notify::active' => sub {
                             $hinverted = $button->get_active;
                             update();
                           });
}
{
  my $button = Gtk2::CheckButton->new_with_label ('V Inverted');
  $vbox->pack_start ($button, 0,0,0);
  $button->signal_connect ('notify::active' => sub {
                             $vinverted = $button->get_active;
                             update();
                           });
}
# {
#   my $combobox = Gtk2::ComboBox->new_text;
#   $vbox->pack_start ($combobox, 0,0,0);
#   foreach my $policy ('default', 'continuous', 'discontinuous', 'delayed') {
#     $combobox->append_text ($policy);
#   }
#   $combobox->set_active (0);
#   $combobox->signal_connect
#     (changed => sub {
#        $update_policy = $combobox->get_active_text;
#        update();
#      });
# }
{
  require Gtk2::Ex::ComboBox::Enum;
  my $combobox = Gtk2::Ex::ComboBox::Enum->new
    (enum_type   => 'Gtk2::Ex::Dragger::UpdatePolicy',
     active_nick => Gtk2::Ex::Dragger->find_property('update-policy')->get_default_value);
  $vbox->pack_start ($combobox, 0,0,0);
  $combobox->signal_connect
    ('notify::active-nick' => sub {
       $update_policy = $combobox->get('active-nick');
       update();
     });
}
{
  my $button = Gtk2::CheckButton->new_with_label ('Hint Mask');
  $vbox->pack_start ($button, 0,0,0);
  $button->signal_connect
    (notify => sub {
       $area->unrealize;
       my $motion_mask = $button->get_active