#!/usr/bin/perl
=header
	Program :	WinSize Module
	Authors :	Harald Piske and Glenn Linderman
	Written :	2001-04-20
	Purpose :	provide dynamic resizing for Win32::GUI

	History :	Modified by on 

2002-02-01 gl		Added support for multiple windows.
                    Fixed > vs >= for selection of controls to move.
                    Clean up all warnings, for use strict.
                    Added version number.
                    Converted from local to my variables, and avoided
                    using @_, and $_ except in for loops.
2002-02-02 gl		Commented out debugging messages
                    Removed redefinition warnings
2002-02-04 hp		WinSize return value is registry key

=cut

package WinSize;

BEGIN
{
	$WinSize::VERSION = "1.13"; # ==> ALSO update version in pod below!
	use Exporter;
	use vars qw(@ISA @EXPORT);
	@ISA = qw(Exporter);
	@EXPORT = qw(WinSize);
}
use strict;
use Win32::GUI;
use Win32::TieRegistry;
return 1;

=usage
WinSize ($Main, %options);  # Version 1.13
		-takes a snapshot of your window
		-looks up the registry for the last size and implements it
		-returns the registry handle of the subkey used
		-notes size changes and repositions / resizes controls
		-notes the current size in the registry upon window termination
options:
-regkey => 'name'
	defaults to your window caption ($main->Text).
	The window pos is stored under
	HKEY_CURRENT_USER\Software\<your -regkey parameter>
	in the Value "WindowRect_<windowname> as a comma separated string
        of four numbers.
	You can give a subkey with e.g. -regkey => 'yourname\\yourprogram';
	in fact, you are strongly encouraged to do so in order to avoid
	name pollution of the HCU\Software branch.
control => anchor
	specify for each control how it should behave when the window resizes.
	anchor is a string consisting of:
	L	left	left and right margins follow right window margin (move)
	R	right	right margin follows right window margin (size)
	T	top	top and bottom margins follow bottom window margin (move)
	B	bottom	bottom margin follows bottom window margin (size)
	each letter can be followed by a number indicating a factor by which
	to move the margin. Integers between 2 and 100 are percentages of the
	relevant client area dimension. Positive decimal values are taken to
	be the factor. 0 determines the factor according to the current
	position of the respective edge.

Winsize automatically moves all objects to the right of the right side of
any control moved or resized, as well as all objects below the bottom margin.
Therefore, the order of the anchor definitions is relevant to the outcome.

Example: imagine a treeview on the left and a textfield on the right
myTree => R30B, myText => RB
The treeview changes width by 30% of the amount of width change of the
window. The textfield moves along accordingly. Then, the textfield
changes width, because the right side is to follow 100% of the window.
Both fields shrink and grow with the vertical extent of the window.
Contrary to that,
myTree => R30B, myText => LB
would move the textfield with the right edge of the window, without
changing it's size.

=cut

sub Resize
{
        my ($name, $win, $obj, $main, @winsize, $base, $temp);
	$win = $WinSize::WinSize{$name = shift}  or  return 1;
	$main = $$win{-window};
	$obj = $$win{-controls};
	@winsize = @{$$win{-winsize}};
	$winsize[0] -= $$main{-width};
	$winsize[1] -= $$main{-height};
#print "$winsize[0] x $winsize[1]\n";
	for (@{$$win{-anchors}})
	{
		my ($control, $side, $fac) = @{$_};
#print "$control(", join (',', @{$$obj{$control}}), ") $side $fac ->";
		$base = $$obj{$control}->[$side] - int ($fac * $winsize[$side & 1]);
		$base -= $$main{$control}->{$side == 2 ? -left : -top}
			- $$obj{$control}->[$side & 1]  if $side > 1;
		$side = qw(-left -top -width -height)[$side];
#print " $side = $base\n";
		$$main{$control}->{$side} = $base;
	}
	$temp = $$win{-resize};
	return defined &$temp ? &$temp : 1;
}
sub GetRect
{
	my ($name, $win, $reg, @rect, $temp);
	$win = $WinSize::WinSize{$name = shift} or return;
	if ($reg = $$win{-regkey})
	{
#print "GetRect: name: $name  reg: $reg\n";
	    $temp = $reg->{"\\WindowRect_" . $name};
	    if ( $temp )
	    {
			@rect = split ',', $temp;
#print "GetRect: $name  @rect\n";
			if ( shift )
			{ 
				return @rect;
			}
			if ( $#rect == 3 )
			{
				$$win{-window}->Move (@rect[0,1]);
				$$win{-window}->Resize ($rect[2] - $rect[0], $rect[3] - $rect[1]);
			}
# The below produces "use of initialized value" warning, the above doesn't.
#			$$win{-window}->Change
#			(
#				-pos => [@rect[0,1]],
#				-size => [$rect[2] - $rect[0], $rect[3] - $rect[1]],
#			) if $#rect == 3;
		}
	}
	return;
}
sub SaveRect
{
	my ($name, $win, $reg, $temp);
	$win = $WinSize::WinSize{$name = shift}  or  return;
	if ($reg = $$win{-regkey})
	{
#print "SaveRect: name: $name  reg: $reg\n";
		$temp = join ',', $$win{-window}->GetWindowRect();
#print "SaveRect: $temp\n";
		$reg->{"\\WindowRect_" . $name} = $temp;
	}
	return;
}
sub Terminate
{
	my ($name, $win, $temp);
	$win = $WinSize::WinSize{$name = shift}  or  return -1;
#print "name: $name\n";
	& SaveRect ($name);
	$temp = $$win{-terminate};
	return defined &$temp ? &$temp : -1;
}
sub WinSize
{
	my $main = shift;
	my ($name, $control, $perc, $reg, $side, $fac, $temp);
	my (@winsize, %obj, %win, @anc, @anchor_temp);
	$name = $main->{-name};
	@winsize = ($main->{-width}, $main->{-height});
	for (grep !/^-/, keys %{$main})
	{
		next  unless $control = $main->{$_};
#print "poss. control: $_\n";
		next  unless $side = $control->{-width};
		next  unless $control->{-type} > 10;
#print "actual control: $_\n";
		$obj{$_} = [$control->{-left}, $control->{-top},
			$side, $control->{-height}];
	}
	while ($control = shift)
	{
		if (lc $control eq -regkey)
		{
			$reg = shift;
			next;
		}
		die "invalid control $control"  unless $obj{$control};
		$temp = uc shift;
		$temp =~ s/\s//g;
		while (($side, $fac, $perc) = $temp =~ /([LTRB])(\d+(%?)|[01]?\.\d*|\d*)/)
		{
			$temp = $';
			$side = index 'LTRB', $side;
			$fac = 1  if $fac eq '';
			$fac /= 100  if $perc || $fac > 1;
			$fac ||= $obj{$control}->[$side] / $winsize[$side & 1];
			push @anc, [$control, $side, $fac];
			$side &= 1;
			for (keys %obj)
			{
				next if $_ eq $control;
				if ($side)
				{
					next  if $obj{$_}->[1] < $obj{$control}->[1];
					next  if $obj{$_}->[0] >= $obj{$control}->[0] + $obj{$control}->[2];
					next  if $obj{$_}->[0] + $obj{$_}->[2] < $obj{$control}->[0];
				}else{
					next  if $obj{$_}->[0] < $obj{$control}->[0];
					next  if $obj{$_}->[1] >= $obj{$control}->[1] + $obj{$control}->[3];
					next  if $obj{$_}->[1] + $obj{$_}->[3] < $obj{$control}->[1];
				}
				push @anc, [$_, $side, $fac];
			}
		}
		die "invalid anchor for $control"  if $temp ne '';
	}
	%win = ();
	for (0..$#anc)
	{
		@anchor_temp = @{$anc[$_]};
		$win{$anchor_temp[0] . $anchor_temp[1]} = $_;
	}
	@anchor_temp = ();
	for (sort {$a <=> $b} values %win)
	{
		push @anchor_temp, $anc[$_];
	}
	$reg ||= $name;
	$reg = "Perl Win32-GUI\\$reg"  if $reg !~ /\\/;;
	$reg = $Registry->{"CUser\\Software\\$reg\\"} = {};
	%win =
	(
		-window  => $main,
		-winsize => [@winsize],
		-controls=> \%obj,
		-anchors => [@anchor_temp],
		-regkey  => $reg,
	);
	$WinSize::WinSize{$name} = \%win;
	eval qq
	(
		\$win{-resize} = \\&main::$name\_Resize;
		sub $name\_Resize {Resize ('$name')}
# The following undef is commented out because it seems to make the code
# go away, not just the name, even though a reference was taken above.
# So instead of eliminating the name to turn off the redefine warning,
# we turn off the warning instead.  Some thing below for _Terminate.
#		undef &main::$name\_Resize;
		no warnings 'redefine';
		*main::$name\_Resize = \\&$name\_Resize;
		use warnings 'redefine';

		\$win{-terminate} = \\&main::$name\_Terminate;
		sub $name\_Terminate {Terminate ('$name')}

#		undef &main::$name\_Terminate;
		no warnings 'redefine';
		*main::$name\_Terminate = \\&$name\_Terminate;
		use warnings 'redefine';
	);
	& GetRect ($name);
	return $reg;
}