File Coverage

blib/lib/Gtk2/Ex/GdkBits.pm

Criterion	Covered	Total	%
statement	16	18	88.8
branch			n/a
condition			n/a
subroutine	6	6	100.0
pod			n/a
total	22	24	91.6

# Copyright 2007, 2008, 2009, 2010, 2011, 2012 Kevin Ryde

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

package Gtk2::Ex::GdkBits;
use 5.008;
use strict;
use warnings;
use Carp;
use List::Util 'min';
use Gtk2;

use Exporter;
our @ISA = ('Exporter');
our @EXPORT_OK = qw(draw_rectangle_corners
                    window_get_root_position
                    window_clear_region);
our $VERSION = 48;


# The loop here is similar to what gtk_widget_translate_coordinates() does
# chasing up through window ancestors.
#
sub window_get_root_position {
  my ($window) = @_;
  my $x = 0;
  my $y = 0;
  while ($window->get_window_type ne 'root') {
    my ($parent_x, $parent_y) = $window->get_position;
    $x += $parent_x;
    $y += $parent_y;
    $window = $window->get_parent
      || croak 'Gtk2::Ex::GdkBits::window_get_root_position(): oops, didn\'t reach root window';
  }
  return ($x, $y);
}

sub window_clear_region {
  my ($win, $region) = @_;
  foreach my $rect ($region->get_rectangles) {
    $win->clear_area ($rect->values);
  }
}

sub draw_rectangle_corners {
  my ($drawable, $gc, $filled, $x1,$y1, $x2,$y2) = @_;
  #### draw rect: "$x1,$y1 - $x2,$y2"
  $drawable->draw_rectangle ($gc, $filled,
                             min ($x1, $x2),
                             min ($y1, $y2),
                             abs ($x1 - $x2) + ($filled ? 1 : 0),
                             abs ($y1 - $y2) + ($filled ? 1 : 0));
}

# Not yet documented, might move elsewhere ...
# Or maybe better $rect->intersect not undef ...
sub rect_contains_rect {
  my ($rect, $part) = @_;
  return $rect->x <= $part->x
    && $rect->y <= $part->y
    && $rect->x + $rect->width  >= $part->x + $part->width
    && $rect->y + $rect->height >= $part->y + $part->height;
}

1;
__END__