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 / bitmaps.pl
CommitLineData
86530b38
AT
1# bitmaps.pl
2
3use subs qw/bitmaps_row/;
4use vars qw/$TOP/;
5
6sub bitmaps {
7
8 # Create a top-level window that displays all of Tk's built-in bitmaps.
9
10 my($demo) = @_;
11 $TOP = $MW->WidgetDemo(
12 -name => $demo,
13 -text => 'This window displays all of Tk\'s built-in bitmaps, along with the names you can use for them in Perl scripts.',
14 -title => 'Bitmap Demonstration',
15 -iconname => 'bitmaps',
16 );
17
18 my $frame = $TOP->Frame;
19 $frame->pack(qw/-side top -expand yes -fill both/);
20 bitmaps_row $frame, qw/error gray12 gray25 gray50 gray75 hourglass/;
21 bitmaps_row $frame, qw/info questhead question Tk transparent warning/;
22
23} # end bitmaps
24
25sub bitmaps_row {
26
27 # The procedure below creates a new row of bitmaps in a window.
28
29 my($w, @names) = @_;
30
31 my $row = $w->Frame->pack(qw/-side top -fill both/);
32
33 foreach my $bitmap_name (@names) {
34 my $bit = $row->Frame;
35 $bit->pack(qw/-side left -fill both -pady .25c -padx .25c/);
36 my $label = $bit->Label(-text => $bitmap_name, -width => 9);
37 $label->pack(qw/-side bottom/);
38 my $bitmap = $bit->Label('-bitmap' => $bitmap_name);
39 $bitmap->pack(qw/-side bottom/);
40 }
41
42} # end bitmaps_row
43
441;