#!/Perl/bin/perl

use strict;
use warnings;

# Tk support is enabled if the Tk module is used before POE itself.
use Tk;
use POE;
use POE qw( Component::EasyDBI );

use Config::Auto;
use Data::Dumper qw/Dumper/;
use DBP::GUIComponents::SmallDemoTab;
use DBP::GUIComponents::BigDemoTab;
use Perl6::Say;
use Tk::Animation;
use Tk::HList;
use Tk::PNG;
use SQL::Abstract;
use Tk::Table;

$Data::Dumper::Sortkeys = 1;

# Create the session that will drive the user interface.

POE::Session->create(
	inline_states => {
		_start 					=> \&ui_start,
		ev_count 				=> \&ui_count,
		ev_clear 				=> \&ui_clear,
		custom_loop_initiator	=> \&custom_loop_initiator,
		custom_loop				=> \&custom_loop,
    },
);

# Run the program until it is exited.

$poe_kernel->run();
exit 0;

=head1 METHODEN

=head2 ui_start( ??? )

Create the user interface when the session starts.  This assumes
some familiarity with Tk.  ui_start() illustrates four important
points.

1. Tk events require a main window.  POE creates one for internal
use and exports it as $poe_main_window.  ui_start() uses that as the
basis for its user interface.

2. Widgets we need to work with later, such as the counter display,
must be stored somewhere.  The heap is a convenient place for them.

3. Tk widgets expect callbacks in the form of coderefs.  The
session's postback() method provides coderefs that post events when
called.  The Button created in ui_start() fires an "ev_clear" event
when it is pressed.

4. POE::Kernel methods such as yield(), post(), delay(), signal(),
and select() (among others) work the same as they would without Tk.
This feature makes it possible to write back end sessions that
support multiple GUIs with a single code base.

=cut

sub ui_start {
    my ( $kernel, $session, $heap ) = @_[ KERNEL, SESSION, HEAP ];

    # ------------------------------------------------------------
    # - Initialisierung

    # ------------------------------------------------------
    # -- Test: etwas Inhalt einfügen
    # ...
    # ------------------------------------------------------
    

    # ------------------------------------------------------------
    # - Statusbar
    #   -> für den UI-Counter
    require Tk::StatusBar;
    $heap->{statusbar} = $poe_main_window->StatusBar();
    $heap->{statusbar}->addLabel(
        -relief         => 'flat',
        -text           => "Welcome to the statusbar",
    );
    
    $heap->{statusbar}->addLabel(
        -text           => 'Frame:',
        -width          => '10',
        -anchor         => 'center',
    );
    
    $heap->{statusbar}->addLabel(
        -width          => 20,
        -anchor         => 'center',
        -textvariable   => \$heap->{counter},
        -foreground     => 'blue',
    );
    
    $heap->{statusbar}->addLabel(
        -width          => 10,
        -anchor         => 'center',
        -text           => "Clear",
        -foreground     => 'blue',
        -command        => $session->postback("ev_clear"),
        -event          => '<Button-1>',
    );

    # ------------------------------------------------------------
    # - Test-Zeug
    testzeug( $heap, $poe_main_window );

	# call a recursive looping event
	$kernel->yield('custom_loop_initiator', 1);
	
	# now start another one, with another argument
	$kernel->yield('custom_loop_initiator', 2);

    $kernel->yield("ev_count");
} # /ui_start



=head2 testzeug( $heap, $poe_main_window )

Dient dazu diverses Testzeug auszuführen, z.B: Debugging.
Bei Auslieferung des Programms sollte diese Funktion nichts mehr machen, aber
dennoch enthalten sein damit man später mal schnell was debuggen kann.

=cut

sub testzeug {
    my $heap    = shift;
    my $mw      = shift;
    
    
    
} # /testzeug




=head2 custom_loop_initiator( ... )

=cut

sub custom_loop_initiator {
	my $session 	= $_[SESSION];
	my $kernel		= $_[KERNEL];
	my $id 			= $_[ARG0];
	
	say "init with $id";
	
	$kernel->yield('custom_loop', $id);
} # /custom_loop_initiator




=head2 custom_loop( ... )

=cut

sub custom_loop {
	my $kernel = $_[KERNEL];
	my $id = $_[ARG0];
	
	say "custom loop with id=$id";
	
	$kernel->delay('custom_loop_initiator' => 2, $id);
} # /custom_loop




=head2 ui_count( ??? )

Handle the "ev_count" event by increasing a counter and displaying
its new value.

=cut

sub ui_count {
    $_[HEAP]->{counter}++;
    $_[KERNEL]->yield("ev_count");
} # /ui_count




=head2 ui_clear

Handle the "ev_clear" event by clearing and redisplaying the
counter.

=cut

sub ui_clear {
    $_[HEAP]->{counter} = 0;
} # /ui_clear




=head1 QUELLEN

http://poe.perl.org/?POE_Cookbook/Tk_Interfaces

This sample program creates a very simple Tk counter.  Its interface
consists of three widgets: A rapidly increasing counter, and a
button to reset that counter.

#!/Perl/bin/perl

use strict;
use warnings;

# Tk support is enabled if the Tk module is used before POE itself.
use Tk;
use POE;

use Data::Dumper qw/Dumper/;

$Data::Dumper::Sortkeys = 1;

# Create the session that will drive the user interface.

POE::Session->create(
	inline_states => {
		_start 					=> \&ui_start,
		ev_count 				=> \&ui_count,
		ev_clear 				=> \&ui_clear,
		custom_loop_initiator	=> \&custom_loop_initiator,
		custom_loop				=> \&custom_loop,
    },
);

# Run the program until it is exited.

$poe_kernel->run();
exit 0;

=head1 METHODEN

=head2 ui_start( ??? )

Create the user interface when the session starts.  This assumes
some familiarity with Tk.  ui_start() illustrates four important
points.

1. Tk events require a main window.  POE creates one for internal
use and exports it as $poe_main_window.  ui_start() uses that as the
basis for its user interface.

2. Widgets we need to work with later, such as the counter display,
must be stored somewhere.  The heap is a convenient place for them.

3. Tk widgets expect callbacks in the form of coderefs.  The
session's postback() method provides coderefs that post events when
called.  The Button created in ui_start() fires an "ev_clear" event
when it is pressed.

4. POE::Kernel methods such as yield(), post(), delay(), signal(),
and select() (among others) work the same as they would without Tk.
This feature makes it possible to write back end sessions that
support multiple GUIs with a single code base.

=cut

sub ui_start {
    my ( $kernel, $session, $heap ) = @_[ KERNEL, SESSION, HEAP ];

    # ------------------------------------------------------------
    # - Initialisierung

    # ------------------------------------------------------
    # -- Test: etwas Inhalt einfügen
    # ...
    # ------------------------------------------------------
	# t=toplevel
    $heap->{t}->{1} = MySpecialComponent->new($poe_main_window, 10001);
	$heap->{t}->{2} = MySpecialComponent->new($poe_main_window, 20001);

    # ------------------------------------------------------------
    # - Statusbar
    #   -> für den UI-Counter
    require Tk::StatusBar;
    $heap->{statusbar} = $poe_main_window->StatusBar();
    $heap->{statusbar}->addLabel(
        -relief         => 'flat',
        -text           => "Welcome to the statusbar",
    );
    
    $heap->{statusbar}->addLabel(
        -text           => 'Frame:',
        -width          => '10',
        -anchor         => 'center',
    );
    
    $heap->{statusbar}->addLabel(
        -width          => 20,
        -anchor         => 'center',
        -textvariable   => \$heap->{counter},
        -foreground     => 'blue',
    );
    
    $heap->{statusbar}->addLabel(
        -width          => 10,
        -anchor         => 'center',
        -text           => "Clear",
        -foreground     => 'blue',
        -command        => $session->postback("ev_clear"),
        -event          => '<Button-1>',
    );

    # ------------------------------------------------------------
    # - Test-Zeug
    testzeug( $heap, $poe_main_window );

	# call a recursive looping event
	$kernel->yield('custom_loop_initiator', 1);
	
	# now start another one, with another argument
	$kernel->yield('custom_loop_initiator', 2);

    $kernel->yield("ev_count");
} # /ui_start




=head2 testzeug( $heap, $poe_main_window )

Dient dazu diverses Testzeug auszuführen, z.B: Debugging.
Bei Auslieferung des Programms sollte diese Funktion nichts mehr machen, aber
dennoch enthalten sein damit man später mal schnell was debuggen kann.

=cut

sub testzeug {
    my $heap    = shift;
    my $mw      = shift;
    
    
    
} # /testzeug




=head2 custom_loop_initiator( ... )

Get the value of the label,
increment it by 1 and call
the custom_loop event to
update the label.

=cut

sub custom_loop_initiator {
	my $kernel		= $_[KERNEL];
	my $heap		= $_[HEAP];
	my $id 			= $_[ARG0];
	
	my $no = $heap->{t}->{$id}->no();
	
	# invoke the call
	$kernel->yield('custom_loop', $id, ++$no);
	
	# Calculate next object to be updated.
	my $next_id = ($id == 1 ? 2 : 1);
	
	# do some looping
	$kernel->delay('custom_loop_initiator' => 1, $next_id);
} # /custom_loop_initiator




=head2 custom_loop( ... )

=cut

sub custom_loop {
	my $kernel 	= $_[KERNEL];
	my $heap	= $_[HEAP];
	my $id 		= $_[ARG0];
	my $new_no	= $_[ARG1];
	
	$heap->{t}->{$id}->no($new_no);
	
	
} # /custom_loop




=head2 ui_count( ??? )

Handle the "ev_count" event by increasing a counter and displaying
its new value.

=cut

sub ui_count {
    $_[HEAP]->{counter}++;
    $_[KERNEL]->yield("ev_count");
} # /ui_count




=head2 ui_clear

Handle the "ev_clear" event by clearing and redisplaying the
counter.

=cut

sub ui_clear {
    $_[HEAP]->{counter} = 0;
} # /ui_clear




=head1 QUELLEN

http://poe.perl.org/?POE_Cookbook/Tk_Interfaces

This sample program creates a very simple Tk counter.  Its interface
consists of three widgets: A rapidly increasing counter, and a
button to reset that counter.

=cut




package MySpecialComponent;

use strict;
use warnings;

=head1 MySpecialComponent

Absolutely useless GUI component. Puts a Label in a toplevel, that will be
created on a given (other) toplevel. Used to demonstarte a problem I have
with POE.



=head1 METHODS

=head2 new( $toplevel, $initial_number )

ctor.

=cut

sub new {
	my $class	= shift;
	my $top		= shift or die("Missing toplevel arg.");
	my $no		= shift or die("Missing a number.");
	
	my $self = bless({}, $class);
	
	$self->{'__TOPLEVEL'} = $top->Toplevel(-title => 'T'.$no);
	$self->{'__LABEL'} = $self->{'__TOPLEVEL'}->Label(-text => $no, -width => 40,)->pack();
	
	return $self;
} # /new




=head2 no( $no? )

Getter / setter for the number of this widget.
If $no is given, the label will be set to $no. If it's omitted, only the
current value of the label is returned.
Always returns the current value of the label.

=cut

sub no {
	my $self	= shift;
	my $new_no	= shift; # may be undef
	
	# setter
	if( defined $new_no ) {
		$self->{'__LABEL'}->configure('-text' => $new_no);
		return $new_no;
	}
	
	# getter
	return $self->{'__LABEL'}->cget('-text');
} # /no


1; # /MySpecialComponent