package PanedFrameH;

use strict;
use Tk;
use Tk qw(Ev $XS_VERSION);

sub new {
    my ($parent, $width, $height, $ratio) = @_;
    
    my $f = $parent->Frame(-width=>$width, -height=>$height);
    
    my $pane1 = $f->Frame(-background=>'white')
	->place(-relx=>0,
		-rely=>0.5,
		-anchor=>'w',
		-relwidth=>$ratio,
		-relheight=>1.0);
    my $pane2 = $f->Frame(-background=>'black')
	->place(-relx=>1.0,
		-rely=>0.5,
		-anchor=>'e',
		-relwidth=>1.0 - $ratio,
		-relheight=>1.0);
    my $sash = $f->Frame(-width=>4,
			 -borderwidth=>2,
			 -relief=>'sunken')
	->place(-relx=>$ratio,
		-rely=>0.5,
		-relheight=>1.0,
		-anchor=>'c',);
    my $grip = $f->Frame(-width=>10,
		      -height=>10,
		      -borderwidth=>2,
		      -relief=>'raised')
	->place(-relx=>$ratio, -rely=>0.95, -anchor=>'c');

    my $panedframe = {
	"frame" => $f,
	"pane1" => $pane1,
	"pane2" => $pane2,
	"grip" => $grip,
	"sash" => $sash,
	"frac" => $ratio
    };

    $grip->bind('<ButtonPress-1>', [\&PanedWindowGrab]);
    $grip->bind('<ButtonRelease-1>', [\&PanedWindowUnrab, $panedframe]);
    $grip->bind('<B1-Motion>', [\&PanedWindowDrag, $panedframe, Ev('x'), Ev('y')]);

    bless $panedframe, 'PanedFrameH';
    
    return $panedframe;
}

sub PanedWindowGrab {
    my $w = shift;

    $w->configure(-relief=>'sunken');
}

sub PanedWindowUnrab {
    my $w = shift;
    my $parent = shift;

    $parent->{'pane1'}->place(-relwidth=>$parent->{'frac'});

    $parent->{'pane2'}->place(-relwidth=>1.0 - $parent->{'frac'});
    
    $w->configure(-relief=>'raised');
}

sub PanedWindowDrag {
    my $w = shift;
    my $parent = shift;
    my $x = shift;
    my $y = shift;
    
    $w->configure(-relief=>'sunken');
    
    my $px = $parent->{'frame'}->winfo('rootx');
    my $nx = $w->winfo('rootx');

    my $width = $parent->{'frame'}->winfo('width');
    my $frac = ($nx - $px + $x) / $width;
    if ($frac < 0.05) {
	$frac = 0.05;
    }
    if ($frac > 0.95) {
	$frac = 0.95;
    }
    $parent->{'frac'} = $frac;

    $parent->{'sash'}->place(-relx=>$frac);
    $parent->{'grip'}->place(-relx=>$frac);
}

return 1;