#!/usr/bin/perl
use Gtk2::TestHelper tests => 10;

# $Id$

my $window = Gtk2::Window->new;
my $hpaned = Gtk2::HPaned->new;
my $vpaned = Gtk2::VPaned->new;

my $hframe = Gtk2::Frame->new;
my $vframe1 = Gtk2::Frame->new;
my $vframe2 = Gtk2::Frame->new;

$hframe->modify_bg ('normal', Gtk2::Gdk::Color->parse ('red'));
$vframe1->modify_bg ('normal', Gtk2::Gdk::Color->parse ('green'));
$vframe2->modify_bg ('normal', Gtk2::Gdk::Color->parse ('blue'));

$window->add ($hpaned);

$hpaned->add ($hframe);
$hpaned->pack2 ($vpaned, TRUE, FALSE);

$vpaned->add1 ($vframe1);
$vpaned->add2 ($vframe2);

$vpaned->remove ($vframe1);
$vpaned->remove ($vframe2);

$vpaned->pack1 ($vframe1, TRUE, FALSE);
$vpaned->pack2 ($vframe2, FALSE, FALSE);

is ($vpaned->child1, $vframe1);
is ($vpaned->child2, $vframe2);
is ($vpaned->get_child1, $vframe1);
is ($vpaned->get_child2, $vframe2);

$vpaned->set_position (23);
is ($vpaned->get_position, 23);

ok (defined $hpaned->child1_resize);
ok (defined $hpaned->child2_resize);
ok (defined $vpaned->child1_shrink);
ok (defined $vpaned->child2_shrink);

$hpaned->child1_resize (23);
$hpaned->child2_resize (42);
$vpaned->child1_shrink (23);
$vpaned->child2_shrink (42);

$hpaned->compute_position (23, 10, 10);

SKIP: {
  skip 'new 2.20 stuff', 1
    unless Gtk2->CHECK_VERSION(2, 20, 0);

  my $window = Gtk2::Window->new;
  my $paned = Gtk2::HPaned->new;
  $window->add ($paned);
  $paned->realize;
  isa_ok ($paned->get_handle_window, 'Gtk2::Gdk::Window');
}

__END__

# The following 50 tests are disabled because they proved unreliable.

print "hpaned 1 -> ".$hpaned->child1_resize."\n";
print "hpaned 2 -> ".$hpaned->child2_resize."\n";
print "vpaned 1 -> ".$vpaned->child1_resize."\n";
print "vpaned 2 -> ".$vpaned->child2_resize."\n";

$window->show_all;
$window->show_now;

$hframe->set_size_request (50,50);
$vframe1->set_size_request (50,50);
$vframe2->set_size_request (50,50);

my $pad;
if (Gtk2->CHECK_VERSION (2, 2, 0)) {
	$pad = $hpaned->style_get ('handle-size');
} else {
	# crap.  we didn't have a way to query style property information
	# until 2.2, so we can't implement gtk_wigdet_style_get () here.
	# we have to improvise.
	$pad = $window->allocation->height
	     - $vframe1->allocation->height
	     - $vframe2->allocation->height;
}
print "handle-size $pad\n";

my @windowprops = (
	[ FALSE,  TRUE,   TRUE, FALSE,  300, 400 ],
	[ FALSE,  TRUE,   TRUE, FALSE,  400, 300 ],
	[ FALSE, FALSE,  FALSE, FALSE,  100, 100 ],
	[ FALSE, FALSE,  FALSE, FALSE,  300, 400 ],
	[ FALSE, FALSE,  FALSE, FALSE,  400, 300 ],
	[  TRUE, FALSE,  FALSE,  TRUE,  100, 100 ],
	[  TRUE, FALSE,  FALSE,  TRUE,  300, 400 ],
	[  TRUE, FALSE,  FALSE,  TRUE,  400, 300 ],
	[  TRUE, FALSE,  FALSE,  TRUE,  100, 100 ],
);
my @framesizes = (
	[   4,   8+$pad,    4,   4,    4,   4 ],
	[  50, 400+$pad,  250, 350,  250,  50 ],
	[  50, 300+$pad,  350, 250,  350,  50 ],
	[  50, 100+$pad,   50,  50,   50,  50 ],
	[ 150, 400+$pad,  150, 200,  150, 200 ],
	[ 200, 300+$pad,  200, 150,  200, 150 ],
	[  50, 100+$pad,   50,  50,   50,  50 ],
	[ 250, 400+$pad,   50,  50,   50, 350 ],
	[ 350, 300+$pad,   50,  50,   50, 250 ],
	[  50, 100+$pad,   50,  50,   50,  50 ],
);
# use Data::Dumper;

my $i = 0;

$window->signal_connect (size_allocate => sub {
	my ($w, $h);
	my $this;

	$this = shift @framesizes;

	if ($i++) {
		# don't validate the first wave -- the window probably
		# hasn't had time to get properly sized.
		($w, $h) = sizeof ($hframe);
		is ($w, $this->[0]);
		is ($h, $this->[1]);
		my @foo = ($w, $h);

		($w, $h) = sizeof ($vframe1);
		is ($w, $this->[2]);
		is ($h, $this->[3]);
		push @foo, $w, $h;

		($w, $h) = sizeof ($vframe2);
		is ($w, $this->[4]);
		is ($h, $this->[5]);
		push @foo, $w, $h;
		print join(" ", "[", @foo, "]\n");
	}

	$this = shift @windowprops;
	if ($this) {
		$hpaned->child1_resize ($this->[0]);
		$hpaned->child2_resize ($this->[1]);
		$vpaned->child1_resize ($this->[2]);
		$vpaned->child2_resize ($this->[3]);
		$window->resize ($this->[4] + $pad, $this->[5] + $pad);
		1;
	} else {
		Gtk2->main_quit;
	}
});


Gtk2->main;

sub sizeof {
	my $allocation = shift->allocation;
	return ($allocation->width, $allocation->height);
}

__END__

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