PTK

[perl5] なーんか勝手に参考にしているやつ

Hello World!

Presented here in this section are XWD->GIF files (non-transparent GIF87 - amenable to all GUI browsers that I know of, and more respectful of my limited disk space :P) of the ex0.pl script taken from UserGuide.pod:

    #!/usr/bin/perl5 -w
    #
    # A trivial one-window example is show below:
    #

    use strict;
    use Tk; 
    my $main = new MainWindow;
    $main->Label(-text => 'Hello, world!')->pack;
    $main->Button(-text => 'Quit',
                  -command => sub{exit}
                  )->pack;
    MainLoop;

So here it is: img/Hello.gif

Please note that in that image (as well as most of the rest on this page) I have not included the window manager border because it's appearence depends on your window manager.
For example under mwm with green borders ex0.pl might look like this: img/Hello_mwm.gif

Whereas under tvtwm with red borders it might look like this: img/Hello_tvtwm.gif

Widget primitives

One of the things that makes the Tk toolkit so useful and easy to use is the large number of configuration options and the reasonableness of all the default values of those options. This is especially valuable in an interpreted language as the programmer is accustomed to quick turn around times. The default values allow for a "quick hack" followed by a more professional re-working later by specifying a few -configuration => options in already working code.

Presented here in this section are XWD->GIF files to display the output of very basic perl/Tk scripts of the following form:

    #!/usr/bin/perl -w
    use strict;
    use Tk;
    my $top = MainWindow->new();
    $top -> Widget() -> pack;
    $MainLoop;

Since I do not know of anyone who has set their web-browser background color to yellow - it was chosen to highlight the widget over the Toplevel that is a part of MainWindow in a few of the following images. In them I used:

    $top -> Widget(-background => 'yellow') -> pack;

Where Widget may be any one of several widget primitives: Button, Radiobutton, Checkbutton, Listbox, Scrollbar, Entry, Text, Canvas, Frame, Toplevel, Scale, Menu, Menubutton

Button

    #!/usr/bin/perl -w
    use strict;
    use Tk;
    my $top = MainWindow->new();
    $top -> Button(-background => 'yellow') -> pack;
    $MainLoop;

Radiobutton

    #!/usr/bin/perl -w
    use strict;
    use Tk;
    my $top = MainWindow->new();
    $top -> Radiobutton() -> pack;
    $MainLoop;

Note that the default is selected: img/Radiobutton.gif

Checkbutton

    #!/usr/bin/perl -w
    use strict;
    use Tk;
    my $top = MainWindow->new();
    $top -> Checkbutton(-background => 'yellow') -> pack;
    $MainLoop;

Note that the default is unselected: img/Checkbutton.gif

Listbox

    #!/usr/bin/perl -w
    use strict;
    use Tk;
    my $top = MainWindow->new();
    $top -> Listbox() -> pack;
    $MainLoop;

Scrollbar

    #!/usr/bin/perl -w
    use strict;
    use Tk;
    my $top = MainWindow->new();
    $top -> Scrollbar() -> pack;
    $MainLoop;

Note that the default is small with a vertical orientation: img/Scrollbar.gif

Entry

    #!/usr/bin/perl -w
    use strict;
    use Tk;
    my $top = MainWindow->new();
    $top -> Entry() -> pack;
    $MainLoop;

Text

    #!/usr/bin/perl -w
    use strict;
    use Tk;
    my $top = MainWindow->new();
    $top -> Entry() -> pack;
    $MainLoop;

Note that the default size is pretty big: img/Text.gif

Canvas

    #!/usr/bin/perl -w
    use strict;
    use Tk;
    my $top = MainWindow->new();
    $top -> Canvas() -> pack;
    $MainLoop;

Frame

    #!/usr/bin/perl -w
    use strict;
    use Tk;
    my $top = MainWindow->new();
    $top -> Frame() -> pack;
    $MainLoop;

Note that the Frame is a container widget and unless it has something to contain or is given non-trivial -height and -width options it is barely visible at all: img/Frame.gif

Toplevel

Toplevels cannot be packed from a MainWindow (since MainWindow "is" a Toplevel).

Scale

    #!/usr/bin/perl -w
    use strict;
    use Tk;
    my $top = MainWindow->new();
    $top -> Scale() -> pack;
    $MainLoop;

Note that the default is that the scale runs from 0 to 100 from top to bottom in a vertical orientation: img/Scale.gif

Menubutton

    #!/usr/bin/perl -w
    use strict;
    use Tk;
    my $top = MainWindow->new();
    $top -> Menubutton() -> pack;
    $MainLoop;

Compounds|Composites

In days gone by you could have visited the Perl/Tk Compound Widget page where there were many cute screen captures (similar to this page only cuter). It was on the web at:

    http://fxfx.com/kgr/compound/

(farewell Perl/Tk compound widget page....)

You might also be interested in the Compound widgets in your own Contrib directory. Here are some recent Contrib documents:

    http://w4.lns.cornell.edu/~pvhp/ptk/Contrib/

FileSelector

At the Perl/Tk compound widget site there was a wonderful page dedicated to an early version of the FileSelector. It used to be at:

    http://fxfx.com/kgr/compound/FileSelector/

Through the generosity of Kevin Greer who maintained that page I have managed to recover the rather nice picture that he made of the early FileSelector:
img/FileSelector.gif

Dial

    #!/usr/bin/perl -w
    use strict;
    use Tk;
    use Tk::Dial;
    my $top = MainWindow->new();
    $top -> Dial() -> pack;
    $MainLoop;

<- up to 100 (default).

3D effect with Frames

Strictly speaking this is not really a compound or composite widget - but it does combine several widget primitives into a perl/Tk script. A question arose recently (December95|January96) about how to get 3D effects with perl/Tk widgets. The answer "use the -borderwidth => some number argument" (posted by a couple of folks) when incorporated into the original test script:

    #!/usr/bin/perl -w

    use Tk;

    $mw = MainWindow->new();

    $f = $mw->Frame( -relief => 'raised', -borderwidth => 2);
    $f->pack( -side => 'top', -fill => 'both',
           -padx => "0.4c", -pady => "0.4c");

    $ff = $f->Frame( -relief => 'raised', -borderwidth => 2);
    $ff->pack( -side => 'top', -fill => 'both',
           -padx => "0.4c", -pady => "0.4c");

    $fff = $ff->Frame( -relief => 'raised', -borderwidth => 2);
    $fff->pack( -side => 'top', -fill => 'both',
            -padx => "0.4c", -pady => "0.4c");
    $fff->Label( -text => 'Raised frames')->pack();

    $g = $mw->Frame( -relief => 'sunken', -borderwidth => 2);
    $g->pack( -side => 'top', -fill => 'both', -expand => 1,
          -padx => "0.4c", -pady => "0.4c");

    $gg = $g->Frame( -relief => 'sunken', -borderwidth => 2);
    $gg->pack( -side => 'top', -fill => 'both', -expand => 1,
       -padx => "0.4c", -pady => "0.4c");

    $ggg = $gg->Frame( -relief => 'sunken', -borderwidth => 2);
    $ggg->pack( -side => 'top', -fill => 'both', -expand => 1,
        -padx => "0.4c", -pady => "0.4c");
    $ggg->Label( -text => 'Sunken frames')->pack();

    MainLoop();

makes for a rather pretty effect:
img/3d.frame.gif

Tk bitmaps (builtin)

This was taken directly from the bitmap display script widget_lib/bitmaps.pl that is ordinarily run as part of the widget demo:
img/Tk_bm.gif

Bitmap

Here is but a small segment of the code in icon.pl that gives a nice Checkbutton selected|de-selected affect through the use of the Bitmap perl/Tk function:

    #!/usr/bin/perl -w
    # from icon.pl
    sub icon_mini {
        my $w = new MainWindow;

        $w->Bitmap('flagup',
            -file => "$tk_library/demos/images/flagup",
            -maskfile => "$tk_library/demos/images/flagup",
        );
        $w->Bitmap('flagdown',
            -file => "$tk_library/demos/images/flagdown",
            -maskfile => "$tk_library/demos/images/flagdown",
        );

        my $w_frame_b1 = $w->Checkbutton(
            -image            => 'flagdown',
            -selectimage      => 'flagup',
            -indicatoron      => 0,
        );
        $w_frame_b1->pack();
    } # end icon
    use Tk;
    icon_mini();
    MainLoop;

Here it is unselected: img/mail_demo_flagdown.gif

and selected: img/mail_demo_flagup.gif

Pixmaps

The perl/Tk Pixmap() function can be used to achieve an effect similar to the

wm iconbitmap @file

in Tcl/Tk. Consider it's use in iconwin:

    #!/usr/bin/perl -w
    BEGIN { unshift(@INC,'blib') }
    use Tk;
    $top = MainWindow->new();
    $top->iconify;
    $top->Icon(
         '-image' => $top->Pixmap(
                          '-file' => "Tk/demos/images/ned.xpm")
               );
    $top->after(3000, [ 'Icon', $top, '-background' => 'green' ]);
    $top->iconify;
    MainLoop();

The icon generated by this script might appear under mwm as: img/pixicon_mwm.gif

under twm as: img/pixicon_twm.gif

and under tvtwm as: img/pixicon_tvtwm.gif

Photos

The perl/Tk Photo() function achieves an effect similar to the Bitmap() function discussed previously. Namely, it returns a file descriptor to be used in a later -image configuration option to a widget.

As an example consider the Label widget that uses the 'imggif' descriptor in the following:

    #!/usr/bin/perl -w
    use strict;
    use Tk;
    my $main = new MainWindow;
    $main -> Photo('imggif', 
             -file => "$Tk::tk_library/demos/images/earthris.gif");
    my $c = $main->Label('-image' => 'imggif')->pack;
    $main->Button(-text => 'exit',
                  -command => sub{destroy $main}
                  )->pack(-anchor => 'e');
    MainLoop;

Tk::JPEG

The JPEG.pm module for Tk was written by Nick Ing-Simmons to incorporate the IJG code. It too returns a file handle to be used in a later -image configuration option to a widget.

Here our Label widget now uses the $jpgimg descriptor in the following:

    #!/usr/bin/perl -w
    use strict;
    use Tk;
    require Tk::JPEG;
    my $main = new MainWindow;
    my $jpgimg = $main -> Photo('-format' => 'jpeg'.
                                 -file => "testimg.jpg");
    my $c = $main->Label('-image' => $jpgimg)->pack;
    MainLoop;

(This particular image is in GIF format to reach the widest possible graphic browser audience):
img/jpeg_testimg.gif