#!/usr/bin/perl
#------------------------------------------------------------------------------
# Pragmas und Module:
#------------------------------------------------------------------------------
use strict;
use warnings;
use Tk;
#------------------------------------------------------------------------------
# Globales Kofigurationshash:
#------------------------------------------------------------------------------
my %Config = ( debug => 1, # Debuginformationen?
version => '0.0.1', # Programmversion
version_datum => '16.01.2004', # Programmdatum
main_window => undef, # Hauptfenster-Widget
ausg_widget => undef, # Ausgabe-Widget
Menu => undef, # Menu-Widget
Menuefont => '{Arial} 8 {normal}', # Schriftart des Menu
Titel => 'Frühstückers CD Oberfläche',
# Fenstertitel
);
#------------------------------------------------------------------------------
# CDdaten (ein AoH):
#------------------------------------------------------------------------------
my @CD = (
{
name => 'Name der ersten CD',
interp => 'Interpret der ersten CD',
ersch => 'Erscheinungsjahr der ersten CD',
anz => 'Anzahl CD\'s',
},
{
name => 'Name der zweiten CD',
interp => 'Interpret der zweiten CD',
ersch => 'Erscheinungsjahr der zweiten CD',
anz => 'Anzahl CD\'s',
},
{
name => 'Name der dritten CD',
interp => 'Interpret der dritten CD',
ersch => 'Erscheinungsjahr der dritten CD',
anz => 'Anzahl CD\'s',
},
{
name => 'Name der vierten CD',
interp => 'Interpret der vierten CD',
ersch => 'Erscheinungsjahr der vierten CD',
anz => 'Anzahl CD\'s',
},
{
name => 'Name der fünften CD',
interp => 'Interpret der fünften CD',
ersch => 'Erscheinungsjahr der fünften CD',
anz => 'Anzahl CD\'s',
},
);
#------------------------------------------------------------------------------
# Prototypen:
#------------------------------------------------------------------------------
sub tk_main ();
sub show_data ($);
sub show_data ($);
sub clear_data ();
sub anzeigen ($);
#------------------------------------------------------------------------------
# Programmablauf:
#------------------------------------------------------------------------------
tk_main();
MainLoop();
exit;
sub tk_main () {
print "tk_main()\n" if $Config{debug};
#--------------------------------------------------------------------------
# Hauptfenster erzeugen und Fenstertitel vergeben:
#--------------------------------------------------------------------------
my $mw = new MainWindow;
$Config{main_window} = $mw;
$mw->title($Config{Titel});
#--------------------------------------------------------------------------
# Menü erzeugen:
#--------------------------------------------------------------------------
# 1. Menu-Bar erstellen:
$Config{Menu} = $mw->Menu(-type => 'menubar',
-font => $Config{Menuefont},
);
# 2. Dem Fensterwidget sagen, dass unsere Menubar sein Menu ist:
$mw->configure(-menu => $Config{Menu});
# 3. Einträge in der Menu-Bar:
$Config{Menu}->cascade(-label => 'Datei',
-underline => 0,
-font => $Config{Menuefont},
);
$Config{Menu}->separator(); # dadurch wird der Rest rechtsbündig
$Config{Menu}->cascade(-label => 'Hilfe',
-underline => 0,
-font => $Config{Menuefont},
);
# 4. Die einzelnen Untermenüs definieren:
# Zunächst das Dateimenü:
my $menu_datei = $Config{Menu}
->Menu(-font => $Config{Menuefont}, # Schriftart des Menüs
-tearoff => 0, # Menü nicht abreißbar
-menuitems => [
[
'command' => 'Speichern',
#-command => \&save,
-command => sub { print "\a" },
-accelerator => 'F2',
-font => $Config{Menuefont},
-underline => 0,
],
[
'command' => 'Speichern unter',
#-command => \&saveas,
-command => sub { print "\a" },
-accelerator => 'F12',
-font => $Config{Menuefont},
-underline => 10,
],
'-',
[
'command' => 'Beenden',
-command => sub { $mw->destroy() },
-font => $Config{Menuefont},
-underline => 0,
-accelerator => 'Esc',
],
],
);
# Dazu gehört auch, der Menubar zu sagen, dass dieses Untermenü zu seinem
# Eintrag "Datei" gehört:
$Config{Menu}->entryconfigure('Datei', -menu => $menu_datei);
# Analog für die anderen Menüs:
# Hilfemenü:
my $menu_hilfe = $Config{Menu}
->Menu(-font => $Config{Menuefont},
-tearoff => 0,
-menuitems => [
[
'command' => "Hilfe",
#-command => \&hilfe,
-command => sub { print "\a" },
-accelerator => 'F1',
-font => $Config{Menuefont},
-underline => 0,
],
'-',
[
'command' => "Über ...",
#-command => \&ueber,
-command => sub { print "\a" },
-font => $Config{Menuefont},
-underline => 0,
],
],
);
$Config{Menu}->entryconfigure('Hilfe', -menu => $menu_hilfe);
#--------------------------------------------------------------------------
# Hauptfeld:
#--------------------------------------------------------------------------
my $txt = $mw->Scrolled("Text",
-scrollbars => 'osoe',
#-background => $bcolor,
#-foreground => $tcolor,
-width => 80,
-height => 15,
-relief => 'flat',
-wrap => 'none',
)
->pack(-side => 'top',
-expand => 1,
-fill => 'both',
);
for my $index (0..$#CD) {
my $btn = $mw->Button(-text => $CD[$index]->{name},
-width => 80,
-relief => 'flat',
-anchor => 'w',
-command => [ \&anzeigen, $index ],
);
$btn->bind('<Enter>' => sub { show_data($index) } );
$btn->bind('<Leave>' => sub { clear_data } );
$txt->windowCreate('end', -window => $btn);
$txt->insert('end', "\n");
}
$txt->configure(-state => 'disabled');
#--------------------------------------------------------------------------
# Ausgabefeld:
#--------------------------------------------------------------------------
my $aus = $mw->Scrolled("Text",
-scrollbars => 'osoe',
-width => 80,
-height => 4,
-relief => 'flat',
-wrap => 'none',
-background => '#FFFFEE',
-foreground => '#FF6600',
-state => 'disabled',
-relief => 'groove',
)
->pack(-side => 'top',
-expand => 1,
-fill => 'both',
);
$Config{ausg_widget} = $aus;
#--------------------------------------------------------------------------
# Bindungen:
#--------------------------------------------------------------------------
$mw->bind('<Escape>', sub { $mw->destroy() } ); # Ctrl-B: Beenden
#$mw->bind('<F1>', \&help ); # F1: Hilfe
#$mw->bind('<F2>', \&save ); # F2: Speichern
#$mw->bind('<F12>', \&saveas ); # F12: Speichern unter
} # sub tk_main;
sub show_data ($) {
print "show_data()\n" if $Config{debug};
my $index = shift;
die "Fehlender Parameter in 'show_data'" unless defined $index;
die "Falscher Parameter '$index' in 'show_data'" unless $index >= 0 and
$index <= $#CD;
my $text = "Name : " . $CD[$index]->{name} . "\n" .
"Interpret : " . $CD[$index]->{interp} . "\n" .
"Erschienen: " . $CD[$index]->{ersch} . "\n" .
"Anzahl CDs: " . $CD[$index]->{anz};
$Config{ausg_widget}->configure(-state => 'normal');
$Config{ausg_widget}->delete('1.0', 'end');
$Config{ausg_widget}->insert('end', $text);
#$Config{ausg_widget}->insert('end', "\n");
$Config{ausg_widget}->configure(-state => 'disabled');
} # sub show_data
sub clear_data () {
print "clear_data()\n" if $Config{debug};
$Config{ausg_widget}->configure(-state => 'normal');
$Config{ausg_widget}->delete('1.0', 'end');
$Config{ausg_widget}->configure(-state => 'disabled');
} # sub clear_data
sub anzeigen ($) {
print "anzeigen()\n" if $Config{debug};
my $index = shift;
die "Fehlender Parameter in 'anzeigen'" unless defined $index;
die "Falscher Parameter '$index' in 'anzeigen'" unless $index >= 0 and
$index <= $#CD;
# ... irgendwas externes mit der CD anstellen
print "ANZEIGEN: ", $CD[$index]->{name}, "\n";
} # sub anzeigen