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 / image2.pl

# image2.pl

use File::Basename;
use subs qw/image2_load_dir image2_load_image/;
use vars qw/$TOP/;

sub image2 {

    # This demonstration script creates a simple collection of widgets
    # that allow you to select and view images in a Tk label.

    my($demo) = @_;
    $TOP = $MW->WidgetDemo(
        -name     => $demo,
        -text     => 'This demonstration allows you to view images using a Tk "photo" image.  First type a directory name in the listbox, then type Return to load the directory into the listbox.  Then double-click on a file name in the listbox to see that image.',
        -title    => 'Image Demonstration #2',
        -iconname => 'image2',
    );

    my $dir_label = $TOP->Label(-text => 'Directory:');
    my $demo_img = Tk->findINC('demos/images');
    my $dir_name = $TOP->Entry(-width => 30, -textvariable => \$demo_img);
    my $frog0 = $TOP->Frame;
    my $frog = $frog0->Frame;
    my $file_label = $frog->Label(-text => 'File:');
    my $f = $frog->Frame;
    my(@pl) = qw/-side top -anchor w/;
    $dir_label->pack(@pl);
    $dir_name->pack(@pl);
    
    # All these "frog" and "toad" frames are just to repackage the listbox
    # and image side by side so they fit within an SVGA screen.

    $frog0->pack;
    $frog->pack(qw/-side left/);
    my $toad = $frog0->Frame;
    $toad->pack(qw/-side right/);
    $file_label->pack(@pl);
    $f->pack(@pl);

    my $f_list = $f->Listbox(-width => 20, -height => 10);
    $dir_name->bind('<Return>' => [\&image2_load_dir, $f_list, \$demo_img]);
    my $f_scroll = $f->Scrollbar(-command => [$f_list => 'yview']);
    $f_list->configure(-yscrollcommand => [$f_scroll => 'set']);
    @pl = qw/-side left -fill y -expand 1/;
    $f_list->pack(@pl);
    $f_scroll->pack(@pl);
    $f_list->insert(0, qw(earth.gif earthris.gif mickey.gif teapot.ppm));

    my $image2a = $TOP->Photo;
    $f_list->bind('<Double-1>' => [\&image2_load_image, $image2a, \$demo_img]);
    my $image_label = $toad->Label(-text => 'Image:');
    my $image = $toad->Label(-image => $image2a);
    @pl = qw/-side top -anchor w/;
    $image_label->pack(@pl);
    $image->pack(@pl);

} # end image2

sub image2_load_dir {

    # This procedure reloads the directory listbox from the directory
    # named in the demo's entry.
    #
    # Arguments:
    # e       -                 Reference to entry widget.
    # l       -                 Reference to listbox widget.
    # dir_name -                 Directory name reference.

    my($e, $l, $dir_name) = @_;

    $l->delete(0, 'end');
    my $i;
    local *DIR;
    opendir DIR, $$dir_name;
    foreach $i (sort readdir DIR) {
       $l->insert('end', $i);
    }
    closedir DIR;

} # end image2_load_dir

sub image2_load_image {

    # Given the name of the toplevel window of the demo and the mouse
    # position, extracts the directory entry under the mouse and loads
    # that file into a photo image for display.
    #
    # Arguments:
    # l       -         Reference to listbox widget.
    # i       -         Reference to image object.
    # dir_name -         Directory name reference.

    my($l, $i, $dir_name) = @_;

    my $e = $l->XEvent;
    my($x, $y) = ($e->x, $e->y);
    $i->configure(-file => "$$dir_name/" . $l->get("\@$x,$y"));

    # NOTE:  $l->get('active') works just as well.  

} # end image2_load_image

1;