Initial commit of OpenSPARC T2 design and verification files.
[OpenSPARC-T2-DV] / tools / perl-5.8.0 / lib / site_perl / 5.8.0 / sun4-solaris / Tk / demos / widget_lib / mkCheck.pl
CommitLineData
86530b38
AT
1
2
3sub mkCheck {
4
5 # Create a top-level window that displays a bunch of check buttons.
6
7 $mkCheck->destroy if Exists($mkCheck);
8 $mkCheck = $top->Toplevel();
9 my $w = $mkCheck;
10 dpos $w;
11 $w->title('Checkbutton demonstration');
12 $w->iconname('Checkbuttons');
13 my $w_msg = $w->Message(-font => '-Adobe-times-medium-r-normal--*-180-*-*-*-*-*-*', -aspect => '300', -text => 'Three ' .
14 'checkbuttons are displayed below. If you click on a button, it will toggle the button\'s ' .
15 'selection state and set a Perl variable to a value indicating the state of the checkbutton. ' .
16 'Click the "See Variables" button to see the current values of the variables. Click the "OK" ' .
17 'button when you\'ve seen enough.');
18 my $w_frame = $w->Frame(-borderwidth => '10');
19 my $w_frame2 = $w->Frame();
20
21 my(@pl) = (-side => 'top', -fill => 'both');
22 $w_msg->pack(@pl);
23 $w_frame->pack(@pl, -expand => 'yes');
24 $w_frame2->pack(@pl);
25
26 $wipers = 0 if not defined $wipers;
27 $brakes = 0 if not defined $brakes;
28 $sober = 0 if not defined $sober;
29 my $w_frame_b1 = $w_frame->Checkbutton(-text => 'Wipers OK', -variable => \$wipers, -relief => 'flat');
30 my $w_frame_b2 = $w_frame->Checkbutton(-text => 'Brakes OK', -variable => \$brakes, -relief => 'flat');
31 my $w_frame_b3 = $w_frame->Checkbutton(-text => 'Driver Sober', -variable => \$sober, -relief => 'flat');
32 @pl = (-side => 'top', -pady => '2', -expand => 'yes', -anchor => 'w');
33 $w_frame_b1->pack(@pl);
34 $w_frame_b2->pack(@pl);
35 $w_frame_b3->pack(@pl);
36
37 my $w_frame2_ok = $w_frame2->Button(-text => 'OK', -width => 12, -command => ['destroy', $w]);
38 my $w_frame2_vars = $w_frame2->Button(-text => 'See Variables', -width => 12,
39 -command => [\&showVars, $w, 'wipers', 'brakes', 'sober']);
40 @pl = (-side => 'left', -expand => 'yes');
41 $w_frame2_ok->pack(@pl);
42 $w_frame2_vars->pack(@pl);
43
44} # end mkcheck
45
46
471;