The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl -w

# Copyright 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 <http://www.gnu.org/licenses/>.

use 5.008;
use strict;
use warnings;
use Test::More;

use lib 't';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings() }

require Gtk2::Ex::WidgetBits;

require Gtk2;
Gtk2->disable_setlocale;  # leave LC_NUMERIC alone for version nums
Gtk2->init_check
  or plan skip_all => 'due to Gtk2->init_check() unsuccessful';
MyTestHelpers::glib_gtk_versions();

plan tests => 23;

{
  my $want_version = 48;
  is ($Gtk2::Ex::WidgetBits::VERSION, $want_version, 'VERSION variable');
  is (Gtk2::Ex::WidgetBits->VERSION,  $want_version, 'VERSION class method');
  ok (eval { Gtk2::Ex::WidgetBits->VERSION($want_version); 1 },
      "VERSION class check $want_version");
  my $check_version = $want_version + 1000;
  ok (! eval { Gtk2::Ex::WidgetBits->VERSION($check_version); 1 },
      "VERSION class check $check_version");
}


#-----------------------------------------------------------------------------
# get_root_position()
#
{
  # use 'popup' to stop any window manager moving
  my $toplevel = Gtk2::Window->new('popup');
  $toplevel->set_size_request (100, 100);
  is_deeply ([ Gtk2::Ex::WidgetBits::get_root_position ($toplevel) ],
             [], 'get_root_position() on unrealized');

  $toplevel->show_all;
  MyTestHelpers::wait_for_event ($toplevel, 'map-event');
  {
    my @top_xy = Gtk2::Ex::WidgetBits::get_root_position ($toplevel);
    diag ("toplevel at $top_xy[0], $top_xy[1]");
    is (scalar @top_xy, 2, 'get_root_position() on realized, num retvals');
  }

  my $layout = Gtk2::Layout->new;
  $layout->set_size_request (50, 50);
  $layout->show;
  $toplevel->add ($layout);
  MyTestHelpers::wait_for_event ($layout, 'size-allocate');
  { my ($x, $y) = $layout->window->get_position;
    diag ("layout win relative position $x,$y");
  }
  {
    my @top_xy = Gtk2::Ex::WidgetBits::get_root_position ($toplevel);
    diag ("toplevel at $top_xy[0], $top_xy[1]");
    my @layout_xy = Gtk2::Ex::WidgetBits::get_root_position ($layout);
    diag ("layout   at $layout_xy[0], $layout_xy[1]");
    is (scalar @layout_xy, 2,
        'get_root_position() on contained layout, num retvals');
    is_deeply (\@layout_xy, \@top_xy,
               'get_root_position() contained layout, same as toplevel');
  }

  my $label = Gtk2::Label->new ('x');
  $layout->put ($label, 20, 30);
  $toplevel->show_all;
  MyTestHelpers::main_iterations();
  {
    my @top_xy = Gtk2::Ex::WidgetBits::get_root_position ($toplevel);
    diag ("toplevel at $top_xy[0], $top_xy[1]");
    my @label_xy = Gtk2::Ex::WidgetBits::get_root_position ($label);
    diag ("label   at $label_xy[0], $label_xy[1]");
    is (scalar @label_xy, 2,
        'get_root_position() on label in layout, num retvals');
    is_deeply ([ Gtk2::Ex::WidgetBits::get_root_position ($label) ],
               [ $top_xy[0] + 20, $top_xy[1] + 30 ],
               'get_root_position() on label in layout, at toplevel+offset');
  }

  $toplevel->destroy;
}

#-----------------------------------------------------------------------------
# warp_pointer()
#
SKIP: {
  Gtk2::Gdk::Display->can('warp_pointer')
      or skip 'no display->warp_pointer(), per Gtk before 2.8', 3;

  my $toplevel = Gtk2::Window->new('toplevel');
  ok (! eval { Gtk2::Ex::WidgetBits::warp_pointer ($toplevel, 10, 20); 1 });
  like ($@, qr/Cannot warp on unrealized/);

  $toplevel->show_all;

  MyTestHelpers::wait_for_event ($toplevel, 'map-event');
  my @old = $toplevel->get_pointer;
  Gtk2::Ex::WidgetBits::warp_pointer ($toplevel, @old);
  my @new = $toplevel->get_pointer;
  is_deeply (\@new, \@old, 'warp_pointer() not moved');

  $toplevel->destroy;
}

#-----------------------------------------------------------------------------
# pixel_size_mm()

SKIP: {
  my $label = Gtk2::Label->new ('foo');
  $label->can('get_screen')
    or skip 'due to no get_screen()', 1;
  is_deeply ([Gtk2::Ex::WidgetBits::pixel_size_mm($label, 10,10, 20,20)],
             [],
             'pixel_size_mm() no values when not on a screen');
}
{
  my $toplevel = Gtk2::Window->new('toplevel');
  my ($width_mm, $height_mm) = Gtk2::Ex::WidgetBits::pixel_size_mm ($toplevel);
  cmp_ok ($width_mm, '>=', 0, 'pixel_size_mm() width_mm');
  cmp_ok ($height_mm, '>=', 0, 'pixel_size_mm() height_mm');
  $toplevel->destroy;
}

#-----------------------------------------------------------------------------
# pixel_aspect_ratio()

SKIP: {
  my $label = Gtk2::Label->new ('foo');
  $label->can('get_screen')
    or skip 'due to no get_screen()', 1;
  is (Gtk2::Ex::WidgetBits::pixel_aspect_ratio($label, 10,10, 20,20),
      undef,
      'pixel_aspect_ratio() undef when not on a screen');
}

#-----------------------------------------------------------------------------
# xy_distance_mm()
#

SKIP: {
  my $label = Gtk2::Label->new ('foo');
  $label->can('get_screen')
    or skip 'due to no get_screen()', 1;
  is (Gtk2::Ex::WidgetBits::xy_distance_mm($label, 10,10, 20,20),
      undef,
      'xy_distance_mm() undef when not on a screen');
}
{
  my $toplevel = Gtk2::Window->new('toplevel');
  is (Gtk2::Ex::WidgetBits::xy_distance_mm ($toplevel, 0,0, 0,0),
      0,
      'xy_distance_mm() zero');
  is (Gtk2::Ex::WidgetBits::xy_distance_mm ($toplevel, 10,10, 10,10),
      0,
      'xy_distance_mm() zero at 10');

  cmp_ok (Gtk2::Ex::WidgetBits::xy_distance_mm ($toplevel, 20,20, 10,0),
          '>', 0,
          'xy_distance_mm() non-zero 20,20 to 10,0');

  cmp_ok (Gtk2::Ex::WidgetBits::xy_distance_mm ($toplevel, 20,20, 20,50),
          '>', 0,
          'xy_distance_mm() non-zero 20,20 to 20,50');

  cmp_ok (Gtk2::Ex::WidgetBits::xy_distance_mm ($toplevel, 20,20, 50,20),
          '>', 0,
          'xy_distance_mm() non-zero 20,20 to 50,20');

  $toplevel->destroy;
}

exit 0;