# A N-puzzle implemented via the Grid geometry manager.
# This program is described in the Perl/Tk column from Volume 1, Issue 4 of
# The Perl Journal (http://tpj.com/tpj), and is included in the Perl/Tk
# distribution with permission. It has been modified slightly to conform
# to the widget demo standard.
# puz - demonstrate the Grid geometry manager by implementing an n-puzzle.
# Stephen O. Lidie, Lehigh University Computing Center, lusol@Lehigh.EDU
# Copyright (C) 1996 - 1998 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.
use subs
qw(beep create_puz create_ui puz_fini move_piece new_puz randomly 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; # program's 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 @PUZ; # puzzle piece information
my $SIDE; # pieces per side of puzzle
my $SPACE; # shortcut to puzzle space piece
my $SPACE_IMAGE; # space piece image
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 references which
# represent the puzzle pieces.
# The actual ordering is controlled by @ORDER, a list of list of two:
# $ORDER[$i]->[0] = puzzle piece ordinal
# $ORDER[$i]->[1] = random number used to shuffle the puzzle ordinals
# If the puzzle frame $PF exists, we've been here before, which means 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 go away
# if a widget, which just happens to use it, is destroyed. So, loop
# through all the puzzle pieces and delete their images, then destroy the
# puzzle's master frame $PF, destroying all child widgets. Now, this
# scheme isn't particulary efficient, but it is simple; ideally, we'd like
# to create these images only once and reuse them as required.
$image = $_->cget(-image
);
$image = $SPACE_IMAGE if not defined $image;
$PF = $MW->Frame->grid; # create the puzzle frame grid master
$#PUZ = $#ORDER = $PIECES - 1;
my($i, $o, $c, $r, $w, $h, $x, $y, $but, $gif);
foreach (0..$#ORDER) {$ORDER[$_] = [$_, undef]}
for($i = 0; $i <= $#PUZ; $i++) {
($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,
-highlightthickness
=> 0,
$but->grid(-column
=> $c, -row
=> $r, -sticky
=> 'nsew');
} # forend all puzzle pieces
# Create a color Photo image of the Xcamel puzzle.
$CAMEL = $MW->Photo(-file
=> "$WIDTRIB/lib/npuz/Xcamel.npuz");
$CAMEL_WIDTH = $CAMEL->image('width');
$CAMEL_HEIGHT = $CAMEL->image('height');
my $mf = $MW->Frame(-bg
=> 'blue')->grid(-sticky
=> 'ew');
$mf->gridColumnconfigure(1, -weight
=> 1);
my $mbf = $mf->Menubutton(-text
=> 'File', -relief
=> 'raised');
$mbf->command(-label
=> 'New Puzzle', -command
=> \
&new_puz
);
$mbf->command(-label
=> 'Quit', -command
=> [$MW => 'bell']);
my $mbp = $mf->Menubutton(-text
=> 'Prefs', -relief
=> 'raised');
$mbp->cascade(-label
=> $pieces);
my $mbpm = $mbp->cget(-menu
);
$mbp->entryconfigure($pieces, -menu
=> $mbpmp);
$mbpmp->radiobutton(-label
=> $_,
-command
=> \
&create_puz
,
my $mbq = $mf->Menubutton(-text
=> 'Help', -relief
=> 'raised');
my $about = $MW->Dialog(-text
=> <<"END"
Select \"File/New Puzzle\", then click around the red \"space\" to rearrange the pieces and solve the puzzle!\n\nThis program is described in the Perl/Tk column from Volume 1, Issue 4 of The Perl Journal (http://tpj.com/tpj), and is included in the Perl/Tk distribution with permission.
$about->configure(-wraplength
=> '6i');
$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');
# Return true iff all puzzle pieces are in order.
for($i = 0; $i <= $#PUZ; $i++) {
%info = $PUZ[$i]->gridInfo;
return 0 if $c != $info{-column
} or $r != $info{-row
};
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);
my $color = ($SPACE->configure(-activebackground
))[3];
$SPACE->configure(-image
=> $SPACE_IMAGE,
-activebackground
=> $color,
foreach (@PUZ) {$_->configure(-command
=> \
&beep
)}
foreach (0..$#ORDER) {$ORDER[$_]->[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++) {
$but->configure(-background
=> 'red',
-activebackground
=> 'red',
$but->configure(-command
=> [\
&move_piece
, $but]);
$but->grid(-column
=> $c, -row
=> $r, -sticky
=> 'nsew');
sub randomly
{$a->[1] <=> $b->[1]} # randomize order of puzzle pieces
sub xy
{my($n) = @_; ($n % $SIDE, int $n / $SIDE)} # ordinal to X/Y