#!/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. =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, L. =cut 1; use strict; use warnings; use FindBin qw/$Bin/; my $app = TkApp->new(); $app->run();