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