File Coverage

blib/lib/Gtk2/Ex/QuadButton/Scroll.pm

Criterion	Covered	Total	%
statement	10	12	83.3
branch			n/a
condition			n/a
subroutine	4	4	100.0
pod			n/a
total	14	16	87.5

# Copyright 2010, 2011 Kevin Ryde

# This file is part of Gtk2-Ex-QuadButton.
#
# Gtk2-Ex-QuadButton 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-QuadButton 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-QuadButton.  If not, see .

package Gtk2::Ex::QuadButton::Scroll;
use 5.008;
use strict;
use warnings;
use Gtk2 1.220;
use Gtk2::Ex::AdjustmentBits 40;  # new v.40

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

our $VERSION = 1;

use Gtk2::Ex::QuadButton;
use Glib::Object::Subclass
  'Gtk2::Ex::QuadButton',
  signals => { clicked => \&_do_clicked,
             },
  properties => [ Glib::ParamSpec->object
                  ('hadjustment',
                   (do {
                     my $str = 'Horizontal adjustment';
                     # translation if available
                     eval { require Locale::Messages;
                            Locale::Messages::dgettext('gtk20-properties',$str)
                            } || $str }),
                   'Blurb.',
                   'Gtk2::Adjustment',
                   Glib::G_PARAM_READWRITE),

                  Glib::ParamSpec->object
                  ('vadjustment',
                   (do {
                     my $str = 'Vertical adjustment';
                     # translation if available
                     eval { require Locale::Messages;
                            Locale::Messages::dgettext('gtk20-properties',$str)
                            } || $str }),
                   'Blurb.',
                   'Gtk2::Adjustment',
                   Glib::G_PARAM_READWRITE),

                  Glib::ParamSpec->boolean
                  ('hinverted',
                   'Horizontal inverted',
                   'Whether to invert horizontal movement, so left increases and right decreases.',
                   0, # default no
                   Glib::G_PARAM_READWRITE),

                  Glib::ParamSpec->boolean
                  ('vinverted',
                   'Vertical inverted',
                   'Whether to invert vertical movement, so up increases and down decreases.',
                   0, # default no
                   Glib::G_PARAM_READWRITE),
                ];

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

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

sub _do_clicked {
  my ($self, $scroll_type) = @_;
  _scroll_vh_type ($self->{'hadjustment'}, $self->{'vadjustment'},
                  $scroll_type,
                  $self->{'hinverted'}, $self->{'vinverted'});

}

my %dir_to_argnum = (left  => 0,
                     right => 0,
                     up    => 1,
                     down  => 1);
my %dir_to_neg = (left  => 1,
                  right => 0,
                  up    => 1,
                  down  => 0);

# anything for GtkScrollType page-forward etc or jump ?
#
sub _scroll_vh_type {
  my ($hadj, $vadj, $scroll_type, $hinv, $vinv) = @_;

  if ($scroll_type =~ /(page|step)-(up|down|left|right)/) {
    my $argnum = $dir_to_argnum{$2};
    my $adj = $_[$argnum];
    my $amount_method = "${1}_increment";
    my $add = $adj->$amount_method;
    if ($dir_to_neg{$2} ^ !!$_[3+$argnum]) {
      $add = -$add;
    }
    Gtk2::Ex::AdjustmentBits::scroll_value ($adj, $add);
  }
}

1;
__END__