1#!/usr/bin/env perl
2
3use English;
4use Tk;
5require Tk::demos::LabEnLabRad;
6use strict;
7
8my $MW = MainWindow->new;
9
10# Create and pack the expandable LabeledEntryLabeledRadiobutton widget.  Then
11# globally configure the advertised Frame, Label and Radiobutton widgets.
12# Lastly, specifically configure the radiobutton widget labeled 'RL3', a tiny
13# widget inside the advertised composite LabeledRadiobutton widget, the
14# entry widget in the advertised composite LabeledEntry widget, and then
15# create some key bindings.
16
17my $entry_var = 'Frogs lacking lipophores are blue.';
18my $radio_var = '';
19my $cw = $MW->LabeledEntryLabeledRadiobutton(
20    'Name'          => 'frog',
21    -entry_label    => 'Entry Label',
22    -entry_variable => \$entry_var,
23    -radio_label    => 'Radio Label',
24    -radio_variable => \$radio_var,
25    -radiobuttons   => [qw(RL1 RL2 RL3 RL4 RL5)],
26);
27$cw->pack(-expand => 1, -fill => 'both');
28
29print "Check out composite widget hierarchy ...\n";
30$cw->Walk(sub {print "  subwidget=", shift->PathName, "\n";});
31
32$cw->Walk(
33    sub {
34        my($w, $class) = @_;
35        $w->configure(-relief => 'ridge', -bd => 5) if $class eq $w->class;
36    }, 'Frame',
37);
38$cw->Walk(
39    sub {
40        my($w, $class) = @_;
41        $w->configure(-relief => 'flat', -bg => 'azure') if $class eq $w->class;
42    }, 'Label',
43);
44$cw->Walk(
45    sub {
46        my($w, $class) = @_;
47        $w->configure(-selectcolor => 'red', -indicatoron => 0, -bg => 'green')
48            if $class eq $w->class;
49    }, 'Radiobutton',
50);
51
52my $r = $cw->Subwidget('labeled_radiobutton')->Subwidget('RL3');
53$r->configure(-bg => 'pink', -command =>
54    sub {print "radiobutton 'RL3' selected!\n";}
55);
56
57$cw->bind('<Return>' => \&process_return );
58
59$cw->Subwidget('labeled_entry')->configure(-bg => 'orange');
60
61# Create and pack a button that demonstrates how to reconfigure the entire
62# composite widget by invoking the `configure' method on the composite
63# widget rather than on specific subwidgets, or classes of widgets.
64
65my $b;
66$b = $MW->Button(-text => 'Reconfigure subwidgets', -command =>
67    sub {
68        $cw->configure(
69            -background         => 'cyan',
70            -foreground         => 'blue',
71            -borderwidth        => 0,
72            -relief             => 'ridge',
73            -highlightthickness => 0,
74            -indicatoron        => 1
75        );
76        $b->packForget;
77    }
78);
79$b->pack(-side => 'top', -expand => 1, -fill => 'both');
80
81# Create and pack the Quit button.
82
83my $q = $MW->Button(-text => 'Quit', -command => sub{exit});
84$q->pack(-side => 'top', -expand => 1, -fill => 'both');
85
86MainLoop;
87
88sub process_return {
89
90    my($objref) = @_;
91
92    print "In entry callback, objref=$objref, \$entry_var=\'$entry_var\'.\n";
93
94} # end process_return
95