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::Units;

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 => 37;

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

my $label = Gtk2::Label->new;

#-----------------------------------------------------------------------------
# em()

{
  my $em = Gtk2::Ex::Units::em($label);
  ok ($em > 0);
  ok ($em < 1000);
}

#-----------------------------------------------------------------------------
# digit_width()

{
  my $digit_width = Gtk2::Ex::Units::digit_width($label);
  ok ($digit_width > 0);
  ok ($digit_width < 1000);
}

#-----------------------------------------------------------------------------
# ex()

{
  my $ex = Gtk2::Ex::Units::ex($label);
  ok ($ex > 0);
  ok ($ex < 1000);
}

#-----------------------------------------------------------------------------
# line_height()

{
  my $line_height = Gtk2::Ex::Units::line_height($label);
  ok ($line_height > 0);
  ok ($line_height < 1000);
}


#-----------------------------------------------------------------------------

{
  my $target = $label;
  my $char_width = Gtk2::Ex::Units::char_width($target);
  my $em = Gtk2::Ex::Units::em($target);
  my $digit_width = Gtk2::Ex::Units::digit_width($target);
  my $ex = Gtk2::Ex::Units::ex($target);
  my ($screen_width, $screen_height);
  if ($label->can('get_screen')) {
    my $screen = $label->get_screen;
    $screen_width = $screen->get_width;
    $screen_height = $screen->get_height;
  } else {
    $screen_width = Gtk2::Gdk->screen_width;
    $screen_height = Gtk2::Gdk->screen_height;
  }
  diag "em=$em, ex=$ex, char=$char_width, digit=$digit_width";

  foreach my $elem (
                    # no unit
                    [ \&Gtk2::Ex::Units::width, '123', 123 ],
                    [ \&Gtk2::Ex::Units::height, '456', 456 ],

                    # pixel
                    [ \&Gtk2::Ex::Units::width, '123 pixel', 123 ],
                    [ \&Gtk2::Ex::Units::height, '456 pixels', 456 ],

                    # char
                    [ \&Gtk2::Ex::Units::width, '0 char', 0 ],
                    [ \&Gtk2::Ex::Units::width, '6 char', 6*$char_width ],
                    [ \&Gtk2::Ex::Units::width, '7 chars', 7*$char_width ],

                    # em
                    [ \&Gtk2::Ex::Units::width, '0 em', 0 ],
                    [ \&Gtk2::Ex::Units::width, '6 em', 6*$em ],
                    [ \&Gtk2::Ex::Units::width, '7 ems', 7*$em ],
                    # no em for height as yet
                    # [ \&Gtk2::Ex::Units::height, '0 em', 0 ],
                    # [ \&Gtk2::Ex::Units::height, '1 em' ],

                    # digit
                    [ \&Gtk2::Ex::Units::width, '0 digits', 0 ],
                    [ \&Gtk2::Ex::Units::width, '1 digit', $digit_width ],

                    # ex
                    [ \&Gtk2::Ex::Units::height, '6 ex', 6*$ex ],
                    [ \&Gtk2::Ex::Units::height, '8 exes', 8*$ex ],

                    # line
                    [ \&Gtk2::Ex::Units::height, '0 lines', 0 ],

                    # screen
                    [ \&Gtk2::Ex::Units::width, '1 screen', $screen_width ],
                    [ \&Gtk2::Ex::Units::width, '2 screens', 2*$screen_width ],
                    [ \&Gtk2::Ex::Units::height, '1 screen', $screen_height ],
                    [ \&Gtk2::Ex::Units::height, '2 screens', 2*$screen_height],

                    # mm
                    [ \&Gtk2::Ex::Units::width, '0 mm', 0 ],
                    [ \&Gtk2::Ex::Units::height, '0 mm', 0 ],

                    # inch
                    [ \&Gtk2::Ex::Units::width, '0 inch', 0 ],
                    [ \&Gtk2::Ex::Units::height, '0 inches', 0 ],

                    # cm -- not implemented, as yet
                    # [ \&Gtk2::Ex::Units::width, '0 cm', 0 ],
                    # [ \&Gtk2::Ex::Units::height, '0 cm', 0 ],

                   ) {
    my ($func, $str, $want) = @$elem;

    if (defined $want) {
      is (&$func($target,$str), $want,
          "str: $str")
    } else {
      like (&$func($target,$str), qr/^[0-9.]+$/,
            "str: $str");
    }
  }

}


# is (Gtk2::Ex::Units::height ($target, '6 lines'), 6 * $line);
# is (Gtk2::Ex::Units::height ($target, '6 line'),  6 * $line);

my $frame = Gtk2::Frame->new;
$frame->add ($label);

{

  is (Gtk2::Ex::Units::width ($frame, '123'),        123);
  is (Gtk2::Ex::Units::height ($frame, '456'),        456);

  # is (Gtk2::Ex::Units::height ($frame, '6 lines'), 6 * $line);
}

exit 0;