#!/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('' => sub { show_data($index) } ); $btn->bind('' => 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('', sub { $mw->destroy() } ); # Ctrl-B: Beenden #$mw->bind('', \&help ); # F1: Hilfe #$mw->bind('', \&save ); # F2: Speichern #$mw->bind('', \&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