#!/usr/bin/perl

package TkApp;

use base qw(Class::Accessor);

use strict;
use warnings;
use FileHandle;
use Data::Dumper qw/Dumper/;
use Date::Format;
use Tk;
use Tk::Pane;
use Tk::DHList;
use DBI;
use Config::Auto;
use SQL::Abstract;

__PACKAGE__->follow_best_practice();
__PACKAGE__->mk_accessors(qw(mw cfg dbh left right));

our $VERSION = 0.1;

=head1 NAME

TkApp - Demonstration of the export functionality of a canvas. Allows for
different export formats than ps via L<PostScript::Convert>.

=head1 SYNOPSIS

        use strict;
        use warnings;
        
        my $app = TkApp->new();
        $app->run();

=head1 DESCRIPTION

Display segments of two languages side by side and allow alignment of matching
segments. The left side will be called source language (SL), the right side
target language (TL).

The following alignments are allowed:

=over

=item * 1:1 - one segment in the source language corresponds to exactely one
segment in the target language.

=item * 1:n - one segment of the target language corresponds to (one or) more 
than one segment in the target language.

=item * n:1 - n segments in the source language correspond to exactely one 
segment in the target language.

=back

=head1 METHODS

=head2 new()

Ctor. Calls _build_gui and _init().

=cut

sub new {
        my $class = shift;
        my %args = @_;
        
        my $self = bless({}, $class);
        
        $self->_init(\%args);
        $self->_build_gui();
        
        return $self;
} # /new




=head2 _init( \%args )

Read config files, set up database connection etc.

Private method. Don't call it directly, as this will be done by new().

=cut

sub _init {
        my $self = shift;

        # -- MainWindow
        my $mw = Tk::MainWindow->new(
                -width => 1024,
                -height => 640,
        );
        $mw->packPropagate(0);
        $self->set_mw($mw);
        
} # /_init




=head2 _build_gui()

Build GUI. Set up widgets etc. Positioning is done here, too.

Private method. Don't call it directly, as this will be done by new().

=cut

sub _build_gui {
        my $self = shift;
        my $mw = $self->get_mw();

        # define & pack your widgets here
        my $alignment_frame = $mw->Frame()->pack(-fill => 'both', -expand => 1,);
    my $left = $alignment_frame->Scrolled('DHList', 
        -scrollbars          => 'e',
        -cursor              => 'right_ptr',
        -relief              => 'sunken',
        -borderwidth         => '2',
        -width               => '10',  # columns
        -height              => '15',  # lines
        -background          => 'orange',
        -selectmode          => 'extended',
        -viewtype            => 'withdata',
        -databackground      => 'skyblue',
        -numeric_primary_sort   => '0',
        -numeric_secondary_sort => '1',
    )->pack(-side => 'left', -fill => 'both', -expand => 1,);
        $self->set_left($left);
        
        my $middle = $alignment_frame->Scrolled('Canvas',
                -bg => 'yellow',-width => '100', -scrollbars => 'e',
        )->pack(-side => 'left',-fill => 'both');
        
        my $right = $alignment_frame->Scrolled('DHList', 
        -scrollbars          => 'e',
        -cursor              => 'right_ptr',
        -relief              => 'sunken',
        -borderwidth         => '2',
        -width               => '10',  # columns
        -height              => '15',  # lines
        -background          => 'orange',
        -selectmode          => 'extended',
        -viewtype            => 'withdata',
        -databackground      => 'skyblue',
        -numeric_primary_sort   => '0',
        -numeric_secondary_sort => '1',
    )->pack(-side => 'left', -fill => 'both', -expand => 1,);
        $self->set_right($right);

        my $buttons = $mw->Frame()->pack(-side => 'left', -fill => 'x', -expand => 1,);
        $buttons->Button(-text => 'align', -command => sub{ print "TODO...\n"; })->pack();
        
} # /_build_gui




=head2 run()

This actually starts the application, including the gui event loop.
Fills in some data for testing purposes.

=cut

sub run {
        my $self = shift;
        my $mw = $self->get_mw();
        
        # fill gui with samle data
        my @source_segments = (
                {segment_id => 1, segment => 'Einstellungen'},
                {segment_id => 2, segment => 'Peter geht nach Hause.'},
                {segment_id => 3, segment => 'Schalten Sie Ihren Computer aus und das Gehirn ein.'},
        );
        my $left = $self->get_left();
        foreach my $record ( @source_segments ) {
                $left->add($record->{segment_id}, -data => $record->{segment},);
        }

        my @target_segments = (
                {segment_id => 30, segment => 'Settings'},
                {segment_id => 31, segment => 'Peter is going home.'},
                {segment_id => 32, segment => 'Turn off your computer.'},
                {segment_id => 33, segment => 'Then use your brain.'},
        );
        my $right = $self->get_right();
        foreach my $record ( @target_segments ) {
                $right->add($record->{segment_id}, -data => $record->{segment},);
        }
        
        $mw->MainLoop();
} # /run




=head1 SEE ALSO

L<Tk::Canvas>, L<Tk::DHList>.

=cut

1;

use strict;
use warnings;
use FindBin qw/$Bin/;

my $app = TkApp->new();
$app->run();