#!/usr/local/bin/perl -w
# Tk-example.pl -- Zeigt **einige** Widgets des Tk-Moduls.

use strict;
use Tk;                  # Tk-Modul aus dem CPAN

# Einige globale Variablen
my ($mw, $btn1, $btn2, $btn3, $c1, $c2, $r1, $r2);
my ($fbutton, $fcheck, $fradio, $fentry);
my ($c1_value, $c2_value, $hello, $r_common);
my ($entry, $label, $lvar, $lab1, $lab2);
my ($flist, $scrl);

# ---------- Erzeuge das Hauptfenster
$mw   = MainWindow->new();

# ---------- Erzeuge einen Frame mit einigen Buttons
$fbutton = $mw->Frame(-relief => 'ridge', -borderwidth => '1m');
$btn1 = $fbutton->Button(-text    => 'Exit!',
                         -command => sub { exit 0; });
$btn2 = $fbutton->Button(-text    => 'Do It!',
                         -command => [\&the_handler,
                                      "button", "arg1"]);
$btn3 = $fbutton->Button(-text    => 'I am disabled',
                         -state   => "disabled",
                         -command => [\&the__handler, 
                                      "button", "arg2"]);
$btn1->pack(-side => 'left');
$btn2->pack(-side => 'left');
$btn3->pack(-side => 'left');
$fbutton->pack();

# ---------- Erzeuge einen Frame mit zwei Checkbuttons
$fcheck = $mw->Frame(-relief => 'sunken', -borderwidth => '1m');
$c1   = $fcheck->Checkbutton(-text    => 'Yes/No',
                             -command => [\&the_handler,
                                          "check", "arg3"],
                             -state   => "normal",
                             -onvalue => "I am ready",
                             -offvalue => "I ain't ready",
                             -variable => \$c1_value);
$hello = "Hi!";
$c2   = $fcheck->Checkbutton(-textvariable => \$hello,
                             -onvalue => "ACK",
                             -offvalue => "NAK",
                             -variable => \$c2_value);
$c1->pack(-side => 'right', -padx => '1c');
$c2->pack(-side => 'right', -padx => '1c');
$fcheck->pack();

# ---------- Erzeuge einen Frame mit zwei Radiobuttons
$fradio = $mw->Frame(-relief => 'ridge', -borderwidth => '1m');
$r1     = $fradio->Radiobutton(-text => "Ack", -anchor => "w",
                               -variable => \$r_common,
                               -value => "ACK");
$r2     = $fradio->Radiobutton(-text => "Nack", -anchor => "w",
                               -variable => \$r_common,
                               -value => "NAK",
                               -command => [\&the_handler,
                                            "radiobutton",
                                            "no ack"]);
$r1->pack(-side => 'left', -padx => '1c');
$r2->pack(-side => 'right');
$fradio->pack();

# ---------- Erzeuge einen Frame mit einem Label und einem Entry
$fentry = $mw->Frame(-relief => 'ridge', -borderwidth => '1m');
$lvar   = "Prompt: ";
$label  = $fentry->Label(-text => "$lvar")
    ->pack(-side => 'left', -padx => '0.5c');
$entry  = $fentry->Entry(-textvariable => \$lvar)
    ->pack(-side => 'left', -padx => '0.5c');
$lab1   = $fentry->Label(-text => "You entered: ")
    ->pack(-side => 'top', -pady => '0.1c');
$lab2   = $fentry->Label(-textvariable => \$lvar)
    ->pack(-side => 'left', -padx => '0.5c');

$entry->bind('<Return>', [ \&the_handler, "entry", "RET" ]);
$entry->bind('<F1>',     [ \&the_handler, "entry", "F1"  ]);
$fentry->pack();

# ---------- Erzeuge eine scrollbare Listbox
$flist = $mw->Frame(-relief => 'ridge', -borderwidth => '1m');
$flist->Label(-text => 'Choose one of these:')
    ->pack(-side => 'left');
$scrl  = $flist->ScrlListbox(-label => 'Selection',
                             -selectmode => 'single',
                             -height => 3,
                             -exportselection => 0)
    ->pack(-side => 'left');
$scrl->insert("end", "first");
$scrl->insert("end", "second");
$scrl->insert("end", "third");
$scrl->insert("end", "fourth");
$scrl->insert("end", "fifth");
$flist->Button(-text => "Read It!",
          -command => sub { print $scrl->Getselected(), "\n"; })
    ->pack();
$flist->pack();

# ---------- Haupt-Event-Schleife
MainLoop;

# ---------- Hilfsfunktion
sub the_handler {
    my ($what, @arglist) = @_;
    my $elem = "";
    print "handler: [$what] list = (";
    foreach $elem (@arglist) {
        print "$elem ";
    }
    print ")\n";
}