 2008/10/01
|
Last update 1999/02/20
TPJ: Issue_04_Tk
- grid
- images
- menu1
- menu1.gif
- menu2
- menu2.gif
- mvtar
- npuz
- npuz.gif
- pack
- pack.gif
- patchy
- prob1
- prob1.gif
- prob2
- prob2.gif
- prob3
- prop
- simp
- simp.gif
- simple_puz
- More Samples on Tk
Download grid
|
#!/usr/local/bin/perl -w
|
|
#
|
|
# Create two columns of data: left-adjusted text labels and right-adj\
|
|
usted
|
|
# numbers. Each row consists of two labels managed by the grider, whi\
|
|
ch are
|
|
# "stuck" to opposite sides of their respective column. The grider fi\
|
|
lls
|
|
# unused space in the east-west direction so that all rows are the sam\
|
|
e length
|
|
# (that of the widest row).
|
|
use English;
|
|
use Tk;
|
|
use strict;
|
|
my $MW = MainWindow->new;
|
|
my @text = ('This is a long label', 'Then a short',
|
|
'Frogs lacking lipophores are blue');
|
|
my($i, $w) = (0, undef);
|
|
foreach (@text) {
|
|
$w = $MW->Label(-text => $ARG);
|
|
$w->grid(-row => $i, -column => 0, -sticky => 'w');
|
|
$w = $MW->Label(-text => $i . '0' x $i);
|
|
$w->grid(-row => $i, -column => 1, -sticky => 'e');
|
|
$i++;
|
|
}
|
|
|
|
MainLoop;
|
Download images
Download menu1
|
#!/usr/local/bin/perl -w
|
|
#
|
|
# menu1 - first attempt at gridding a menubar.
|
|
require 5.002;
|
|
use Tk;
|
|
use strict;
|
|
my $MW = MainWindow->new;
|
|
my $mf = $MW->Frame->grid;
|
|
my $PF = $MW->Frame(-width => 300)->grid;
|
|
|
|
my $mbf = $mf->Menubutton(-text => 'File', -relief => 'raise\
|
|
d');
|
|
my $mbp = $mf->Menubutton(-text => 'Prefs', -relief => 'raise\
|
|
d');
|
|
my $mbq = $mf->Menubutton(-text => 'Help', -relief => 'raise\
|
|
d');
|
|
|
|
$mbf->grid(-row => 0, -column => 0, -sticky => 'w');
|
|
$mbp->grid(-row => 0, -column => 1, -sticky => 'w');
|
|
$mbq->grid(-row => 0, -column => 2, -sticky => 'e');
|
|
|
|
MainLoop;
|

Download menu2
|
#!/usr/local/bin/perl -w
|
|
#
|
|
# menu2 - stick the menubar frame east-west and give column 1 all unus\
|
|
ed space.
|
|
require 5.002;
|
|
use Tk;
|
|
use strict;
|
|
my $MW = MainWindow->new;
|
|
my $mf = $MW->Frame->grid(-sticky => 'ew');
|
|
my $PF = $MW->Frame(-width => 300)->grid;
|
|
$mf->gridColumnconfigure(1, -weight => 1);
|
|
my $mbf = $mf->Menubutton(-text => 'File', -relief => 'raise\
|
|
d');
|
|
my $mbp = $mf->Menubutton(-text => 'Prefs', -relief => 'raise\
|
|
d');
|
|
my $mbq = $mf->Menubutton(-text => 'Help', -relief => 'raise\
|
|
d');
|
|
$mbf->grid(-row => 0, -column => 0);
|
|
$mbp->grid(-row => 0, -column => 1, -sticky => 'w');
|
|
$mbq->grid(-row => 0, -column => 2);
|
|
MainLoop;
|

Download mvtar
|
#!/bin/sh
|
|
cd /home/bug
|
|
echo tarring ...
|
|
tar -cf grid.tar grid
|
|
rm -fr grid.tar.gz
|
|
echo zipping ...
|
|
gzip grid.tar
|
|
hostname; ls -al grid.tar.gz
|
|
rcp grid.tar.gz dillon:/home/bug/grid.tar.gz-from-dandy
|
|
rsh dillon 'hostname; ls -al grid.tar.gz-from-dandy'
|
Download npuz
|
#!/usr/local/bin/perl -w
|
|
#
|
|
# puz - demonstrate the Grid geometry manager by implementing an n-puz\
|
|
zle.
|
|
#
|
|
# Stephen O. Lidie, Lehigh University Computing Center, lusol@Lehigh.E\
|
|
DU
|
|
# 96/08/11.
|
|
#
|
|
# Copyright (C) 1996 - 1996 Stephen O. Lidie. All rights reserved.
|
|
#
|
|
# This program is free software; you can redistribute it and/or modify\
|
|
it under
|
|
# the same terms as Perl itself.
|
|
require 5.002;
|
|
use English;
|
|
use Tk;
|
|
use Tk::Dialog;
|
|
use strict;
|
|
use subs qw(beep create_puz create_ui puz_fini move_piece new_puz rand\
|
|
omly xy);
|
|
|
|
my $CAMEL; # Perl/Tk Xcamel.gif Photo image
|
|
my $CAMEL_HEIGHT; # Xcamel height
|
|
my $CAMEL_WIDTH; # Xcamel width
|
|
my(@LEVELS) = (9, 16, 36, 64); # possible puzzle piece counts
|
|
my $MW = MainWindow->new; # Perl/Tk main window
|
|
my @ORDER; # random puzzle piece ordinals
|
|
my $PIECES = $LEVELS[1]; # total puzzle piece count
|
|
my $OLD_PIECES = -1; # previous puzzle piece count
|
|
my $PF; # puzzle Frame
|
|
my @PUZ; # puzzle piece information
|
|
my $SIDE; # pieces per side of puzzle
|
|
my $SPACE; # shortcut to puzzle space piece
|
|
my $SPACE_IMAGE; # space piece image
|
|
|
|
create_ui;
|
|
create_puz;
|
|
MainLoop;
|
|
|
|
sub beep {$MW->bell}
|
|
|
|
sub create_puz {
|
|
|
|
return if $PIECES == $OLD_PIECES;
|
|
|
|
# Create all the puzzle pieces - buttons with images - and arrange\
|
|
them
|
|
# in a rectangular grid. @PUZ is a list of button widget referenc\
|
|
es which
|
|
# represent the puzzle pieces.
|
|
#
|
|
# The actual ordering is controlled by @ORDER, a list of list of t\
|
|
wo:
|
|
#
|
|
# $ORDER[$i]->[0] = puzzle piece ordinal
|
|
# $ORDER[$i]->[1] = random number used to shuffle the puzzle or\
|
|
dinals
|
|
#
|
|
# If the puzzle frame $PF exists, we've been here before, which me\
|
|
ans that
|
|
# all images and widgets associated with the previous puzzle need
|
|
# destroying, plugging a potential memory leak. It's important to\
|
|
note
|
|
# that an image must be explicity deleted - it doesn't magically g\
|
|
o away
|
|
# if a widget, which just happens to use it, is destroyed. So, lo\
|
|
op
|
|
# through all the puzzle pieces and delete their images, then dest\
|
|
roy the
|
|
# puzzle's master frame $PF, destroying all child widgets. Now, t\
|
|
his
|
|
# scheme isn't particulary efficient, but it is simple; ideally, w\
|
|
e'd like
|
|
# to create these images only once and reuse them as required.
|
|
if (Exists $PF) {
|
|
my $image;
|
|
foreach (@PUZ) {
|
|
$image = $ARG->cget(-image);
|
|
$image = $SPACE_IMAGE if not defined $image;
|
|
$image->delete;
|
|
}
|
|
$PF->destroy;
|
|
}
|
|
$PF = $MW->Frame->grid; # create the puzzle frame gri\
|
|
d master
|
|
$OLD_PIECES = $PIECES;
|
|
$#PUZ = $#ORDER = $PIECES - 1;
|
|
$SIDE = sqrt $PIECES;
|
|
|
|
my($i, $o, $c, $r, $w, $h, $x, $y, $but, $gif);
|
|
|
|
foreach (0..$#ORDER) {$ORDER[$ARG] = [$ARG, undef]}
|
|
|
|
for($i = 0; $i <= $#PUZ; $i++) {
|
|
$o = $ORDER[$i]->[0];
|
|
($c, $r) = xy $o; # puzzle ordinal to column/row
|
|
$w = $CAMEL_WIDTH / $SIDE;
|
|
$h = $CAMEL_HEIGHT / $SIDE;
|
|
$x = $c * $w; # x/column pixel offset
|
|
$y = $r * $h; # y/row pixel offset
|
|
$gif = $PF->Photo; # new, empty, GIF image
|
|
$gif->copy($CAMEL, -from => $x, $y, $x+$w, $y+$h);
|
|
$but = $PF->Button(-image => $gif,
|
|
-relief => 'flat',
|
|
-borderwidth => 0,
|
|
-command => \&beep,
|
|
-highlightthickness => 0,
|
|
);
|
|
$PUZ[$o] = $but;
|
|
($c, $r) = xy $i;
|
|
$but->grid(-column => $c, -row => $r, -sticky => '\
|
|
nsew');
|
|
if ($o == 0) {
|
|
$SPACE_IMAGE = $gif;
|
|
$SPACE = $but;
|
|
}
|
|
} # forend all puzzle pieces
|
|
|
|
} # end create_puz
|
|
|
|
sub create_ui {
|
|
|
|
# Create a color icon and a Photo image of the Xcamel puzzle.
|
|
|
|
$MW->after(0 => sub {
|
|
$MW->Icon(-image => $MW->Photo(-file => 'images/Xc\
|
|
amel.icon'))}
|
|
);
|
|
$CAMEL = $MW->Photo(-file => 'images/Xcamel.npuz');
|
|
$CAMEL_WIDTH = $CAMEL->image('width');
|
|
$CAMEL_HEIGHT = $CAMEL->image('height');
|
|
# Create the menubar.
|
|
my $mf = $MW->Frame(-bg => 'blue')->grid(-sticky => 'e\
|
|
w');
|
|
$mf->gridColumnconfigure(1, -weight => 1);
|
|
|
|
my $mbf = $mf->Menubutton(-text => 'File', -relief => 'ra\
|
|
ised');
|
|
$mbf->command(-label => 'New Puzzle', -command => \&new_p\
|
|
uz);
|
|
$mbf->separator;
|
|
$mbf->command(-label => 'Quit', -command => \&exit);
|
|
my $mbp = $mf->Menubutton(-text => 'Prefs', -relief => 'r\
|
|
aised');
|
|
my $pieces = 'Pieces';
|
|
$mbp->cascade(-label => $pieces);
|
|
my $mbpm = $mbp->cget(-menu);
|
|
my $mbpmp = $mbpm->Menu;
|
|
$mbp->entryconfigure($pieces, -menu => $mbpmp);
|
|
foreach (@LEVELS) {
|
|
$mbpmp->radiobutton(-label => $ARG,
|
|
-variable => \$PIECES,
|
|
-value => $ARG,
|
|
-command => \&create_puz,
|
|
);
|
|
}
|
|
my $mbq = $mf->Menubutton(-text => 'Help', -relief => 'ra\
|
|
ised');
|
|
my $about = $MW->Dialog(-text => <<"END"
|
|
npuz Version 1.0\n
|
|
Select \"File/New Puzzle\", then click around the red \"space\" to rea\
|
|
rrange the pieces and solve the puzzle!
|
|
END
|
|
);
|
|
$mbq->command(-label => 'About', -command => [$about =>\
|
|
; 'Show']);
|
|
$mbf->grid(-row => 0, -column => 0, -sticky => 'w');
|
|
$mbp->grid(-row => 0, -column => 1, -sticky => 'w');
|
|
$mbq->grid(-row => 0, -column => 2, -sticky => 'e');
|
|
} # end create_ui
|
|
sub puz_fini {
|
|
# Return true iff all puzzle pieces are in order.
|
|
my($i, $c, $r, %info);
|
|
for($i = 0; $i <= $#PUZ; $i++) {
|
|
($c, $r) = xy $i;
|
|
%info = $PUZ[$i]->gridInfo;
|
|
return 0 if $c != $info{-column} or $r != $info{-row};
|
|
}
|
|
return 1;
|
|
} # end puz_fini
|
|
sub move_piece {
|
|
my($piece) = @ARG;
|
|
my(%info, $c, $r, $sc, $sr);
|
|
%info = $piece->gridInfo; ($c, $r) = @info{-column,-row};
|
|
%info = $SPACE->gridInfo; ($sc, $sr) = @info{-column,-row};
|
|
if ( ($sr == $r and ($sc == $c-1 or $sc == $c+1)) or
|
|
($sc == $c and ($sr == $r-1 or $sr == $r+1)) ) {
|
|
$SPACE->grid(-column => $c, -row => $r);
|
|
$piece->grid(-column => $sc, -row => $sr);
|
|
}
|
|
if (puz_fini) {
|
|
my $color = ($SPACE->configure(-activebackground))[3];
|
|
$SPACE->configure(-image => $SPACE_IMAGE,
|
|
-activebackground => $color,
|
|
-background => $color,
|
|
-relief => 'flat',
|
|
);
|
|
foreach (@PUZ) {$ARG->configure(-command => \&beep)}
|
|
}
|
|
} # end move_piece
|
|
sub new_puz {
|
|
srand time;
|
|
foreach (0..$#ORDER) {$ORDER[$ARG]->[1] = rand $#ORDER}
|
|
my @order = sort randomly @ORDER;
|
|
#@order = @ORDER; # here's how I solve the puzzle (;
|
|
my($i, $o, $c, $r, $but);
|
|
for($i = 0; $i <= $#PUZ; $i++) {
|
|
$o = $order[$i]->[0];
|
|
$but = $PUZ[$o];
|
|
if ($o == 0) {
|
|
$but->configure(-background => 'red',
|
|
-relief => 'sunken',
|
|
-image => undef,
|
|
-activebackground => 'red',
|
|
);
|
|
} else {
|
|
$but->configure(-command => [\&move_piece, $but]);
|
|
}
|
|
($c, $r) = xy $i;
|
|
$but->grid(-column => $c, -row => $r, -sticky => '\
|
|
nsew');
|
|
}
|
|
} # end new_puz
|
|
sub randomly {$a->[1] <=> $b->[1]} # randomize order of pu\
|
|
zzle pieces
|
|
sub xy {my($n) = @ARG; ($n % $SIDE, int $n / $SIDE)} # ordinal to X/Y
|

Download pack
|
#!/usr/local/bin/perl -w
|
|
#
|
|
# Create two columns of data: left-adjusted text labels and right-adj\
|
|
usted
|
|
# numbers. Each row consists of a frame with two labels packed on opp\
|
|
osite
|
|
# sides. The packer fills unused space in the X-dimension so that all\
|
|
frames
|
|
# are the same length (that of the widest frame).
|
|
|
|
use English;
|
|
use Tk;
|
|
use strict;
|
|
|
|
my $MW = MainWindow->new;
|
|
my @text = ('This is a long label', 'Then a short',
|
|
'Frogs lacking lipophores are blue');
|
|
|
|
my($i, $w, $f) = (0, undef, undef);
|
|
foreach (@text) {
|
|
$f = $MW->Frame->pack(-fill => 'x');
|
|
$w = $f->Label(-text => $ARG);
|
|
$w->pack(-side => 'left');
|
|
$w = $f->Label(-text => $i . '0' x $i);
|
|
$w->pack(-side => 'right');
|
|
$i++;
|
|
}
|
|
|
|
MainLoop;
|

Download patchy
|
*** tpj4.orig Sun Nov 10 18:51:24 1996
|
|
--- tpj4 Sun Nov 10 18:57:37 1996
|
|
***************
|
|
*** 18,24 ****
|
|
This means that in order to calculate the final look of an
|
|
application, geometry information propagates outwards from the
|
|
innermost masters to the MainWindow. We'll see why and how to defea\
|
|
t
|
|
! this behaviour later.
|
|
|
|
Before any widget can appear on the display it must be managed by a
|
|
geometry manager. There can actually be multiple geometry managers
|
|
--- 18,24 ----
|
|
This means that in order to calculate the final look of an
|
|
application, geometry information propagates outwards from the
|
|
innermost masters to the MainWindow. We'll see why and how to defea\
|
|
t
|
|
! this behavior later.
|
|
|
|
Before any widget can appear on the display it must be managed by a
|
|
geometry manager. There can actually be multiple geometry managers
|
|
***************
|
|
*** 87,94 ****
|
|
(insert prob1.gif here)
|
|
! Suprisingly, the names are *not* left justified, but appear to be
|
|
! centered, and the numbers, which we thought might be left justifed,
|
|
seem to be right justified!
|
|
Something must be amiss. To figure out what's going on, try applying
|
|
--- 87,94 ----
|
|
|
|
(insert prob1.gif here)
|
|
|
|
! Surprisingly, the names are *not* left justified, but appear to be
|
|
! centered, and the numbers, which we thought might be left justified,
|
|
seem to be right justified!
|
|
|
|
Something must be amiss. To figure out what's going on, try applying
|
|
***************
|
|
*** 254,260 ****
|
|
to a 4x4 square, you can choose N, the length of a side, from the se\
|
|
t
|
|
(3, 4, 6, 8). To make the puzzle solution more difficult, the
|
|
numbered squares have been replaced with real puzzle images from the
|
|
! offical Perl/Tk icon, which we all know as *Camelus bactrianus*.
|
|
|
|
(insert npuz.gif here)
|
|
|
|
--- 254,260 ----
|
|
to a 4x4 square, you can choose N, the length of a side, from the se\
|
|
t
|
|
(3, 4, 6, 8). To make the puzzle solution more difficult, the
|
|
numbered squares have been replaced with real puzzle images from the
|
|
! official Perl/Tk icon, which we all know as *Camelus bactrianus*.
|
|
|
|
(insert npuz.gif here)
|
|
|
|
***************
|
|
*** 306,318 ****
|
|
subroutine *xy* does, and then grid it. The @ORDER list in effect
|
|
shuffles the pieces so the game doesn't start already solved.
|
|
(Perhaps @ORDER isn't an appropriate variable name, since the end
|
|
! result is to increase the games's entrophy, or add disorder to it.)
|
|
Running *simp* creates this display:
|
|
(insert simp.gif here)
|
|
! The -sticky => 'nsew' attribute is analagous to the packer's -fil\
|
|
l => 'both',
|
|
and ensures that all buttons completely fill their allocated space.
|
|
Notice that grid column zero is wider than the other columns. This \
|
|
is
|
|
because the grider assigns the column a width equal to that of the
|
|
--- 306,318 ----
|
|
subroutine *xy* does, and then grid it. The @ORDER list in effect
|
|
shuffles the pieces so the game doesn't start already solved.
|
|
(Perhaps @ORDER isn't an appropriate variable name, since the end
|
|
! result is to increase the game's entropy, or add disorder to it.)
|
|
Running *simp* creates this display:
|
|
(insert simp.gif here)
|
|
! The -sticky => 'nsew' attribute is analogous to the packer's -fil\
|
|
l => 'both',
|
|
and ensures that all buttons completely fill their allocated space.
|
|
Notice that grid column zero is wider than the other columns. This \
|
|
is
|
|
because the grider assigns the column a width equal to that of the
|
|
***************
|
|
*** 326,332 ****
|
|
numbers with a portion of the image.
|
|
. Keep track of every button widget and its grid position so\
|
|
we
|
|
know when it's adjacent to the space piece.
|
|
! . Devise a button callback to actually regrid a piece when i\
|
|
ts
|
|
eligible to move.
|
|
Since we view the puzzle pieces as a list, the variable @PUZ will
|
|
--- 326,332 ----
|
|
numbers with a portion of the image.
|
|
. Keep track of every button widget and its grid position so\
|
|
we
|
|
know when it's adjacent to the space piece.
|
|
! . Devise a button callback to actually re-grid a piece when \
|
|
its
|
|
eligible to move.
|
|
Since we view the puzzle pieces as a list, the variable @PUZ will
|
|
***************
|
|
*** 378,384 ****
|
|
sub-region using the *copy()* method, which copies from the source
|
|
image $CAMEL to the new image $gif. *
|
|
! After updating @PUZ with the new button, the piece is grided and a
|
|
callback to *move_piece()* is created, passing a reference to the
|
|
button.
|
|
--- 378,384 ----
|
|
sub-region using the *copy()* method, which copies from the source
|
|
image $CAMEL to the new image $gif. *
|
|
! After updating @PUZ with the new button, the piece is gridded and a
|
|
callback to *move_piece()* is created, passing a reference to the
|
|
button.
|
|
***************
|
|
*** 385,392 ****
|
|
* footnote (
|
|
It's important to note that when you are finished with an image it
|
|
! must be explicity deleted - it doesn't magically go away if a widget\
|
|
,
|
|
! which just happens to use it, is destroyed. (After all, serveral
|
|
widgets might be sharing the same image.) To prevent a memory leak
|
|
when a new game is started and all previous buttons are deleted, we
|
|
first delete all their images:
|
|
--- 385,392 ----
|
|
* footnote (
|
|
|
|
It's important to note that when you are finished with an image it
|
|
! must be explicitly deleted - it doesn't magically go away if a widge\
|
|
t,
|
|
! which just happens to use it, is destroyed. (After all, several
|
|
widgets might be sharing the same image.) To prevent a memory leak
|
|
when a new game is started and all previous buttons are deleted, we
|
|
first delete all their images:
|
|
***************
|
|
*** 455,461 ****
|
|
The frame $PF represents the puzzle frame, and artificially fixes th\
|
|
e
|
|
width of the application's display to 300 pixels. I did this so
|
|
there's unused space for the menubuttons to move about in to help
|
|
! illustrate gridder mechanics. The goal in this example is to grid t\
|
|
he
|
|
File and Prefs menubuttons side by side west, the Help menubutton
|
|
east, with unused space in the center of the frame. Instead, this i\
|
|
s
|
|
the result:
|
|
--- 455,461 ----
|
|
The frame $PF represents the puzzle frame, and artificially fixes th\
|
|
e
|
|
width of the application's display to 300 pixels. I did this so
|
|
there's unused space for the menubuttons to move about in to help
|
|
! illustrate grider mechanics. The goal in this example is to grid th\
|
|
e
|
|
File and Prefs menubuttons side by side west, the Help menubutton
|
|
east, with unused space in the center of the frame. Instead, this i\
|
|
s
|
|
the result:
|
|
***************
|
|
*** 486,497 ****
|
|
columns are weightless, the Prefs column gets 100% of the unallocate\
|
|
d
|
|
space. It's important that Prefs be west sticky, but the other two
|
|
columns don't need to be sticky at all, since they get no unused
|
|
! space. Although the current version of grid acccepts floating point
|
|
weight values, the next one will not, so always use integers.
|
|
Sometimes it's desirable to disable the outward propagation of
|
|
geometry configuration information. For instance, suppose you want \
|
|
to
|
|
! manage a frame of a particlular size, and within the frame pack/grid
|
|
other widgets. This example grids a frame with an embedded button b\
|
|
ut
|
|
prevents the grider from shrink-wrapping the frame around the button\
|
|
:
|
|
--- 486,497 ----
|
|
columns are weightless, the Prefs column gets 100% of the unallocate\
|
|
d
|
|
space. It's important that Prefs be west sticky, but the other two
|
|
columns don't need to be sticky at all, since they get no unused
|
|
! space. Although the current version of grid accepts floating point
|
|
weight values, the next one will not, so always use integers.
|
|
|
|
Sometimes it's desirable to disable the outward propagation of
|
|
geometry configuration information. For instance, suppose you want \
|
|
to
|
|
! manage a frame of a particular size, and within the frame pack/grid
|
|
other widgets. This example grids a frame with an embedded button b\
|
|
ut
|
|
prevents the grider from shrink-wrapping the frame around the button\
|
|
:
|
|
|
Download prob1
|
#!/usr/local/bin/perl -w
|
|
use Tk;
|
|
use strict;
|
|
|
|
my $MW = MainWindow->new;
|
|
my $f1 = $MW->Frame->pack;
|
|
my $f2 = $MW->Frame->pack;
|
|
|
|
$f1->Label(-text => 'This is a very long label', -width => 30\
|
|
)
|
|
->pack(-side => 'left', -anchor => 'w');
|
|
$f1->Label(-text => 123)->pack(-side => 'left');
|
|
|
|
$f2->Label(-text => 'A short one', -width => 30\
|
|
)
|
|
->pack(-side => 'left', -anchor => 'w');
|
|
$f2->Label(-text => 456)->pack(-side => 'left');
|
|
|
|
$MW->Button(-text => 'Quit', -command => ['destroy', $MW])
|
|
->pack(-side => 'bottom');
|
|
MainLoop;
|

Download prob2
|
#!/usr/local/bin/perl -w
|
|
use Tk;
|
|
use strict;
|
|
|
|
my $MW = MainWindow->new;
|
|
$MW->configure(-bg => 'white');
|
|
$MW->optionAdd('*font' => 'fixed');
|
|
my $f1 = $MW->Frame->pack;
|
|
my $f2 = $MW->Frame->pack;
|
|
|
|
$f1->Label(-text => 'This is a very long label', -width => 30\
|
|
, -bg => 'gray')
|
|
->pack(-side => 'left', -anchor => 'w');
|
|
$f1->Label(-text => 1234567890, -bg => 'yellow')->pack(-si\
|
|
de => 'left');
|
|
|
|
$f2->Label(-text => 'A short one', -width => 30\
|
|
, -bg => 'gray')
|
|
->pack(-side => 'left', -anchor => 'w');
|
|
$f2->Label(-text => 456, -bg => 'yellow')->pack(-side =>\
|
|
; 'left');
|
|
|
|
$MW->Button(-text => 'Quit', -command => ['destroy', $MW])-&g\
|
|
t;pack;
|
|
|
|
MainLoop;
|

Download prob3
|
#!/usr/local/bin/perl -w
|
|
use Tk;
|
|
use strict;
|
|
|
|
my $MW = MainWindow->new;
|
|
$MW->configure(-bg => 'white');
|
|
$MW->optionAdd('*font' => 'fixed');
|
|
my $f1 = $MW->Frame->pack;
|
|
my $f2 = $MW->Frame->pack(-fill ,'x');
|
|
|
|
$f1->Label(-text => 'This is a very long label', -width => 30\
|
|
, -bg => 'gray',
|
|
-anchor => 'w')->pack(-side => 'left');
|
|
$f1->Label(-text => 1234567890, -bg => 'yellow')->pack(-si\
|
|
de => 'right');
|
|
|
|
$f2->Label(-text => 'A short one', -width => 30\
|
|
, -bg => 'gray',
|
|
-anchor => 'w')->pack(-side => 'left');
|
|
$f2->Label(-text => 456, -bg => 'yellow')->pack(-side =>\
|
|
; 'right');
|
|
|
|
$MW->Button(-text => 'Quit', -command => ['destroy', $MW])-&g\
|
|
t;pack;
|
|
|
|
MainLoop;
|
Download prop
|
#!/usr/local/bin/perl -w
|
|
#
|
|
# Remove the *gridPropagate()* statement to shrink-wrap the display.
|
|
use Tk;
|
|
use strict;
|
|
|
|
my $MW = MainWindow->new;
|
|
my $f = $MW->Frame(-width => 200, -height => 100)->grid;
|
|
$f->gridPropagate(0);
|
|
|
|
$f->Button(-text => 'To shrink or not to shrink', -command =>\
|
|
\&exit)->grid;
|
|
|
|
MainLoop;
|
Download simp
|
#!/usr/local/bin/perl -w
|
|
#
|
|
# simp (simple_puz) - randomly grid 15 buttons and a space in a 4x4 re\
|
|
ctangle.
|
|
require 5.002;
|
|
use English;
|
|
use Tk;
|
|
use strict;
|
|
use subs qw(create_puz xy);
|
|
my $MW = MainWindow->new;
|
|
my $PIECES = 16;
|
|
my $SIDE = sqrt $PIECES;
|
|
my @ORDER = (3, 1, 6, 2, 5, 7, 15, 13, 0, 4, 11, 8, 9, 14, 10, 12);
|
|
create_puz;
|
|
MainLoop;
|
|
|
|
sub create_puz {
|
|
|
|
my($i, $text, $num, $but, $c, $r);
|
|
for($i = 0; $i <= $PIECES-1; $i++) {
|
|
$num = $ORDER[$i];
|
|
$text = ($num == 0) ? 'Space' : $num;
|
|
$but = $MW->Button(-text => $text, -command => [$MW =\
|
|
> 'bell']);
|
|
($c, $r) = xy $i;
|
|
$but->grid(-column => $c, -row => $r, -sticky => '\
|
|
nsew');
|
|
} # forend all puzzle pieces
|
|
} # end create_puz
|
|
sub xy {my($n) = @ARG; ($n % $SIDE, int $n / $SIDE)} # ordinal to X/Y
|

| Issue_04_Tk21. simple_puz
|
Download simple_puz
|
#!/usr/local/bin/perl -w
|
|
#
|
|
# simp (simple_puz) - randomly grid 15 buttons and a space in a 4x4 re\
|
|
ctangle.
|
|
require 5.002;
|
|
use English;
|
|
use Tk;
|
|
use strict;
|
|
use subs qw(create_puz xy);
|
|
my $MW = MainWindow->new;
|
|
my $PIECES = 16;
|
|
my $SIDE = sqrt $PIECES;
|
|
my @ORDER = (3, 1, 6, 2, 5, 7, 15, 13, 0, 4, 11, 8, 9, 14, 10, 12);
|
|
create_puz;
|
|
MainLoop;
|
|
|
|
sub create_puz {
|
|
|
|
my($i, $text, $num, $but, $c, $r);
|
|
for($i = 0; $i <= $PIECES-1; $i++) {
|
|
$num = $ORDER[$i];
|
|
$text = ($num == 0) ? 'Space' : $num;
|
|
$but = $MW->Button(-text => $text, -command => [$MW =\
|
|
> 'bell']);
|
|
($c, $r) = xy $i;
|
|
$but->grid(-column => $c, -row => $r, -sticky => '\
|
|
nsew');
|
|
} # forend all puzzle pieces
|
|
} # end create_puz
|
|
sub xy {my($n) = @ARG; ($n % $SIDE, int $n / $SIDE)} # ordinal to X/Y
|
| Issue_04_Tk22. More Samples on Tk
|

Last update 1999/02/20 
All Rights Reserved - (C) 1997 - 2008 by The Labs.Com |