#!/usr/bin/perl -w
use strict;
use Gtk2::TestHelper tests => 15;

# $Id$

my $window = Gtk2::Window -> new();

#
# Force the window all the way to the screen, so that the realization and
# mapping process completes before we continue.  Otherwise, we have issues
# with X interactions on some servers.
#
$window -> show_now();

my $win = $window -> window();

SKIP: {
  skip("GdkDisplay and GdkScreen are new in 2.2", 2)
    unless Gtk2->CHECK_VERSION (2, 2, 0);

  isa_ok($win -> get_display(), "Gtk2::Gdk::Display");
  isa_ok($win -> get_screen(), "Gtk2::Gdk::Screen");
}

isa_ok($win -> get_visual(), "Gtk2::Gdk::Visual");

my $colormap = Gtk2::Gdk::Colormap -> get_system();

$win -> set_colormap($colormap);
is($win -> get_colormap(), $colormap);

like($win -> get_depth(), qr/^\d+$/);

my ($w, $h) = $win -> get_size();
like($w, qr/^\d+$/);
like($h, qr/^\d+$/);

isa_ok($win -> get_clip_region(), "Gtk2::Gdk::Region");
isa_ok($win -> get_visible_region(), "Gtk2::Gdk::Region");

my $black = Gtk2::Gdk::Color -> new(0, 0, 0);

my $values = {
  foreground => $black,
  background => $black,
  function => "copy",
  fill => "tiled",
  subwindow_mode => "clip-by-children",
  ts_x_origin => 0,
  ts_y_origin => 0,
  clip_x_origin => 0,
  clip_y_origin => 0,
  graphics_exposures => 1,
  line_width => 5,
  line_style => "solid",
  cap_style => "butt",
  join_style => "round"
};

my $gc = Gtk2::Gdk::GC -> new_with_values($window -> window(), $values);
my $layout = $window -> create_pango_layout("Bla!");

$win -> draw_point($gc, 10, 10);
$win -> draw_points($gc);  # no points
$win -> draw_points($gc, 10, 10, 11, 11, 12, 12, 13, 13);
$win -> draw_line($gc, 5, 5, 10, 10);
$win -> draw_lines($gc);  # no lines
$win -> draw_lines($gc, 5, 5, 10, 10, 15, 15, 20, 20);
$win -> draw_segments($gc);
$win -> draw_segments($gc, 1, 2, 3, 4, 10, 11, 12, 13);
$win -> draw_rectangle($gc, 1, 0, 0, 10, 10);
$win -> draw_arc($gc, 1, 5, 5, 10, 10, 23, 42);
$win -> draw_polygon($gc, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 5, 6, 6);
$win -> draw_layout_line($gc, 10, 10, $layout -> get_line(0));
$win -> draw_layout($gc, 10, 10, $layout);
$win -> draw_layout_line_with_colors($gc, 10, 10, $layout -> get_line(0), $black, $black);
$win -> draw_layout_line_with_colors($gc, 10, 10, $layout -> get_line(0), $black, undef);
$win -> draw_layout_with_colors($gc, 10, 10, $layout, $black, $black);
$win -> draw_layout_with_colors($gc, 10, 10, $layout, undef,  $black);
$win -> draw_drawable($gc, $win, 5, 5, 5, 5, 10, 10);

SKIP: {
  my $image = $win -> get_image(5, 5, 10, 10);
  skip("get_image returned undef, skipping draw_image", 2)
    unless (defined($image));

  isa_ok($image, "Gtk2::Gdk::Image");
  $win -> draw_image($gc, $image, 0, 0, 0, 0, 50, 50);

  require Scalar::Util;
  Scalar::Util::weaken ($image);
  is ($image, undef, 'get_image() resulting image destroyed when unreferenced');
}

SKIP: {
  skip("draw_pixbuf is new in 2.2", 0)
    unless Gtk2->CHECK_VERSION (2, 2, 0);

  $win -> draw_pixbuf($gc, Gtk2::Gdk::Pixbuf -> new("rgb", 0, 8, 10, 10), 0, 0, 0, 0, -1, -1, "none", 5, 5);

  #test with no gc
  $win -> draw_pixbuf(undef, Gtk2::Gdk::Pixbuf -> new("rgb", 0, 8, 10, 10), 0, 0, 0, 0, -1, -1, "none", 5, 5);
}

SKIP: {
  skip("copy_to_image is new in 2.4", 2)
    unless Gtk2->CHECK_VERSION (2, 4, 0);

  my $image = $win -> copy_to_image(undef, 0, 0, 0, 0, 50, 50);
  skip ("copy_to_image returned undef", 2)
    unless (defined($image));

  isa_ok($image, "Gtk2::Gdk::Image",
	'copy_to_image() creating an image');

  require Scalar::Util;
  Scalar::Util::weaken ($image);
  is ($image, undef,
      'copy_to_image() creating an image - destroyed when unreferenced');
}

SKIP: {
  skip("copy_to_image is new in 2.4", 1)
    unless Gtk2->CHECK_VERSION (2, 4, 0);
  my $existing_image = $win -> get_image(5, 5, 10, 10);
  skip("get_image returned undef, skipping draw_image", 2)
    unless (defined($existing_image));

  my $image = $win -> copy_to_image($existing_image, 0, 0, 0, 0, 50, 50);

  skip ("copy_to_image returned undef", 1)
    unless (defined($image));

  isa_ok($image, "Gtk2::Gdk::Image",
	 'copy_to_image() to a given target image');

  require Scalar::Util;
  Scalar::Util::weaken ($image);
  Scalar::Util::weaken ($existing_image);
  is ($image, undef,
      'copy_to_image() to a given target image - destroyed when unreferenced');
}

__END__

Copyright (C) 2003-2010 by the gtk2-perl team (see the file AUTHORS for the
full list).  See LICENSE for more information.