=head1 NAME

Win32::GUI::Window::Object -- Win32::GUI::Window-as-object

=head1 DESCRIPTION

Win32::GUI is object-based rather than truly object 
oriented, at least when it comes to event handlers. This 
means events aren't called as methods on an object, they are 
simply procedure calls. (This is maybe a legacy design from 
early versions of VB which worked something like that.)

Win32::GUI::Window::Object provides true object semantics 
for events. 

You subclass Win32::GUI::Window::Object and provide event 
handler methods for the window and it's controls, and then 
the methods are called on the object when the events fire.

This also provides an object identity to the events, i.e. 
you can create many windows of the same type.


=head2 Interface

There is no public interface to this class.



=head1 SYNOPSIS

	#!/usr/local/bin/perl -w

	use strict;
	use Data::Dumper;
	use Win32::GUI;
	use lib ("../lib");
	use Win32::GUI::Window::Object;



	for (1..3) {
		my $id = int(rand(100));
		my $win = DemoWindow->winCreate($id);
		$win->Show();
		}

	Win32::GUI::Dialog();





	package DemoWindow;

	#Inherit from the new Window-as-object class
	use base qw(Win32::GUI::Window::Object);



	#A demo property to give it some identity
	use Class::MethodMaker get_set => [ "no" ];



	#Class method to create/build a window of this class. It
	#could eventually be a window built by TGL.
	#
	#This could be in the new() method as well, calling the
	#SUPER::new() to create the object, then setting the no()
	#property.
	#
	sub winCreate { my $pkg = shift;
		my ($no) = @_;

		my $self = $pkg->new(
		      -left   => 100 + int(rand(400)),
		      -top    => 50 + int(rand(200)),
		      -width  => 300,
		      -height => 100,
		      -name   => "winMain",
		      -text   => "Window $no",
		      );

		$self->no($no);		#Set the demo property

		my $btnHelloWorld = $self->AddButton(
				-name => "btnHelloWorld",
				-text => "Hello world!",
				-left => 10,
				-top => 10,
				-height => 20,
				-width => 100,
				);

		return($self);
		}



	#Event handlers are ordinary methods, with $self as
	#the first parameter as usual. This gives context to the
	#event, making it possible to have many instances of the
	#same window class.

	sub winMain_Terminate { my $self = shift;
		print "winMain_Terminate from DemoWindow with no (" . $self->no . ")\n";
		return(-1);
		}



	sub btnHelloWorld_Click { my $self = shift;
		my $no = $self->no();
		print "btnHelloWorld_Click in DemoWindow no == $no\n";
		$self->Text("Window $no - " . int(rand(100)) );

		return(1);
		}

=cut





use strict;





package Win32::GUI::Window::Object;
use base "Win32::GUI::Window";





=head1 PROPERTIES

=head2 _nameObject

The unique name identifier for this object.

=cut
use Class::MethodMaker get_set => [ "_nameObject" ];





=head1 CLASS PROPERTIES

=head2 _raEvent

Array ref with event names known by the object.

If you have any event handlers declared in your window 
package when the window is created, there will be real event 
handler subs created that links to your class.

This has to be a class property to be useful since it's used 
in the new() method. Add to it if you need other event 
handlers created for the window.

=cut
my $raEvent = [ qw(
Activate
BeginTrack
ButtonClick
Change
Changing
Click
Collapse
Collapsing
ColumnClick
DblClick
Deactivate
DividerDblClick
DropFiles
EndTrack
Expand
Expanding
GotFocus
HeightChange
ItemCheck
ItemClick
ItemDblClick
KeyDown
KeyPress
KeyUp
LostFocus
Maximize
Minimize
MouseDown
MouseEvent
MouseMove
MouseUp
NeedText
NodeClick
Release
Resize
RightClick
Terminate
Timer
Track
)];
sub _raEvent { my $pkg = shift;
	$raEvent = $_[0] if(@_);
	return($raEvent);
	}





=head1 METHODS

=head2 new()

Create new Win32::GUI::Window::Object object.

=cut
sub new { my $pkg = shift;
	
	my $nameObject = $pkg->_newName();
	
	my $self = $pkg->SUPER::new( $pkg->_aLocalizeName($nameObject, @_) );
	$self->_nameObject($nameObject);

	$self->_createAddMethods();		#Every the time, there may be some new ones created between compile time and run time
	$self->_createEventHandlers();

	return($self);
	}





=head2 _createEventHandlers()

Create event handlers for all methods that look like event
handlers in the class' package.

=cut
sub _createEventHandlers { my $self = shift; my $pkg = ref($self);

	#An event handler method ends in _ and an event name (extracted from the Win32::GUI source)
	my $rexIsHandler = "_(" . join("|", @{$pkg->_raEvent()}) . ')$';

	my %hST = eval "\%${pkg}::";
	my @aHandler = grep { /$rexIsHandler/ }  keys %hST;

	#Stick the new event handler subs in the main symbol table. 
	#Their code calls this object's event handler method via a closure of $self
	no strict 'refs';
	for my $handler (@aHandler) {
		my $nameHandlerGlobal = $self->_nameObject . $handler;
		*{"::$nameHandlerGlobal"} = sub { $self->$handler(@_) };		#$self is a closure
		}

	return(1);
	}





=head2 _createAddMethods()

Create AddXXX methods for all controls that are present in
the Win32::GUI::Windows class' package.

The new AddXXX methods re-writes the -name of the controls-
to-be-created so it conforms to the calling Window object's
_nameObject().

=cut
sub _createAddMethods { my $pkg = shift;

	my @aMethod = grep { /^(Add\u\w\w*)/ }  keys %Win32::GUI::Window::;

	#Stick the new Add methods handlers in this symbol table
	no strict 'refs';
	for my $method (@aMethod) {
		defined(*{$method}) and next;		#Don't re-defined the method, just add any new ones since last run
		*{$method} =
				sub {
					my $self = shift;
					my $m = "SUPER::$method";
					$self->$m( $self->_aLocalizeName($self->_nameObject, @_) );
					};
		}

	return(1);
	}





=head1 CLASS METHODS

=head2 _aLocalizeName($id, @aParam)

Localize -name options in @aParam and return a new list of
options. Use the $id as unique token for this.

=cut
sub _aLocalizeName { my $pkg = shift;
	my $id = shift;

	my $modifier = undef;
	my @aRet = map {
		my $ret = $_;
		if(defined($modifier)) {
			$ret = "$modifier$_";
			$modifier = undef;
			}
		else {
			$modifier = $id if(($_ || "") eq "-name");
			}
		$ret;
		} @_;

	return(@aRet);
	}





=head2 _newName()

Return new unique name for a object.

=cut
my $gIdObject = 0;
sub _newName { my $pkg = shift;
	$gIdObject++;
	return("wgwo${gIdObject}_");
	}





=head2 __aEventFromSource($source)

Return array with event names found in $source. Feed it with
the contents of GUI_Events.cpp.

Dev utility, hence the __ name.

=cut
sub __aEventFromSource { my $pkg = shift;
	my ($source) = @_;

	my @aEventCall = ($source =~ /strcat\(Name, "_(\w+)"\);/gs);
	my @aEventCmp = ($source =~ /strcmp\(name, "(\w+)"\) == 0/gs);

	return(@aEventCall, @aEventCmp);
	}





1;





#EOF