[OpenSPARC-T2-DV] / tools / perl-5.8.0 / lib / site_perl / 5.8.0 / sun4-solaris / Tk / demos / widtrib / npuz.pl

# 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.

#!/usr/local/bin/perl -w
#
# puz - demonstrate the Grid geometry manager by implementing an n-puzzle.
#
# Stephen O. Lidie, Lehigh University Computing Center, lusol@Lehigh.EDU
# 96/08/11.
#
# 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.

require 5.002;
use Tk;
use Tk::Dialog;
use strict;
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 $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;

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 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.

    if (Exists $PF) {
	my $image;
	foreach (@PUZ) {
	    $image = $_->cget(-image);
	    $image = $SPACE_IMAGE if not defined $image;
	    $image->delete;
	}
	$PF->destroy;
    }

    $PF = $MW->Frame->grid;	# create the puzzle frame grid 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[$_] = [$_, 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 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');

    # Create the menubar.

    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->separator;
    $mbf->command(-label => 'Quit', -command => [$MW => 'bell']);

    my $mbp = $mf->Menubutton(-text => 'Prefs', -relief => 'raised');
    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    => $_,
			    -variable => \$PIECES,
			    -value    => $_,
			    -command  => \&create_puz,
			    );
    }

    my $mbq = $mf->Menubutton(-text => 'Help', -relief => 'raised');
    my $about = $MW->Dialog(-text => <<"END"
npuz Version 1.0\n
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.
END
    );
    $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');

} # 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) = @_;

    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) {$_->configure(-command => \&beep)}
    }

} # end move_piece

sub new_puz {

    srand time;
    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++) {
	$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 puzzle pieces

sub xy {my($n) = @_; ($n % $SIDE, int $n / $SIDE)} # ordinal to X/Y
Commit	Line	Data
86530b38 AT	1	# A N-puzzle implemented via the Grid geometry manager.
	2	#
	3	# This program is described in the Perl/Tk column from Volume 1, Issue 4 of
	4	# The Perl Journal (http://tpj.com/tpj), and is included in the Perl/Tk
	5	# distribution with permission. It has been modified slightly to conform
	6	# to the widget demo standard.
	7
	8	#!/usr/local/bin/perl -w
	9	#
	10	# puz - demonstrate the Grid geometry manager by implementing an n-puzzle.
	11	#
	12	# Stephen O. Lidie, Lehigh University Computing Center, lusol@Lehigh.EDU
	13	# 96/08/11.
	14	#
	15	# Copyright (C) 1996 - 1998 Stephen O. Lidie. All rights reserved.
	16	#
	17	# This program is free software; you can redistribute it and/or modify it under
	18	# the same terms as Perl itself.
	19
	20	require 5.002;
	21	use Tk;
	22	use Tk::Dialog;
	23	use strict;
	24	use subs qw(beep create_puz create_ui puz_fini move_piece new_puz randomly xy);
	25
	26	my $CAMEL; # Perl/Tk Xcamel.gif Photo image
	27	my $CAMEL_HEIGHT; # Xcamel height
	28	my $CAMEL_WIDTH; # Xcamel width
	29	my (@LEVELS) = (9, 16, 36, 64); # possible puzzle piece counts
	30	my $MW = MainWindow->new; # program's main window
	31	my @ORDER; # random puzzle piece ordinals
	32	my $PIECES = $LEVELS[1]; # total puzzle piece count
	33	my $OLD_PIECES = -1; # previous puzzle piece count
	34	my $PF; # puzzle Frame
	35	my @PUZ; # puzzle piece information
	36	my $SIDE; # pieces per side of puzzle
	37	my $SPACE; # shortcut to puzzle space piece
	38	my $SPACE_IMAGE; # space piece image
	39
	40	create_ui;
	41	create_puz;
	42
	43	sub beep {$MW->bell}
	44
	45	sub create_puz {
	46
	47	return if $PIECES == $OLD_PIECES;
	48
	49	# Create all the puzzle pieces - buttons with images - and arrange them
	50	# in a rectangular grid. @PUZ is a list of button widget references which
	51	# represent the puzzle pieces.
	52	#
	53	# The actual ordering is controlled by @ORDER, a list of list of two:
	54	#
	55	# $ORDER[$i]->[0] = puzzle piece ordinal
	56	# $ORDER[$i]->[1] = random number used to shuffle the puzzle ordinals
	57	#
	58	# If the puzzle frame $PF exists, we've been here before, which means that
	59	# all images and widgets associated with the previous puzzle need
	60	# destroying, plugging a potential memory leak. It's important to note
	61	# that an image must be explicity deleted - it doesn't magically go away
	62	# if a widget, which just happens to use it, is destroyed. So, loop
	63	# through all the puzzle pieces and delete their images, then destroy the
	64	# puzzle's master frame $PF, destroying all child widgets. Now, this
65	# scheme isn't particulary efficient, but it is simple; ideally, we'd like
66	# to create these images only once and reuse them as required.
67
68	if (Exists $PF) {
69	my $image;
70	foreach (@PUZ) {
71	$image = $_->cget(-image);
72	$image = $SPACE_IMAGE if not defined $image;
73	$image->delete;
74	}
75	$PF->destroy;
76	}
77
78	$PF = $MW->Frame->grid; # create the puzzle frame grid master
79	$OLD_PIECES = $PIECES;
80	$#PUZ = $#ORDER = $PIECES - 1;
81	$SIDE = sqrt $PIECES;
82
83	my($i, $o, $c, $r, $w, $h, $x, $y, $but, $gif);
84
85	foreach (0..$#ORDER) {$ORDER[$_] = [$_, undef]}
86
87	for($i = 0; $i <= $#PUZ; $i++) {
88	$o = $ORDER[$i]->[0];
89	($c, $r) = xy $o; # puzzle ordinal to column/row
90	$w = $CAMEL_WIDTH / $SIDE;
91	$h = $CAMEL_HEIGHT / $SIDE;
92	$x = $c * $w; # x/column pixel offset
93	$y = $r * $h; # y/row pixel offset
94	$gif = $PF->Photo; # new, empty, GIF image
95	$gif->copy($CAMEL, -from => $x, $y, $x+$w, $y+$h);
96	$but = $PF->Button(-image => $gif,
97	-relief => 'flat',
98	-borderwidth => 0,
99	-command => \&beep,
100	-highlightthickness => 0,
101	);
102	$PUZ[$o] = $but;
103	($c, $r) = xy $i;
104	$but->grid(-column => $c, -row => $r, -sticky => 'nsew');
105	if ($o == 0) {
106	$SPACE_IMAGE = $gif;
107	$SPACE = $but;
108	}
109	} # forend all puzzle pieces
110
111	} # end create_puz
112
113	sub create_ui {
114
115	# Create a color Photo image of the Xcamel puzzle.
116
117	$CAMEL = $MW->Photo(-file => "$WIDTRIB/lib/npuz/Xcamel.npuz");
118	$CAMEL_WIDTH = $CAMEL->image('width');
119	$CAMEL_HEIGHT = $CAMEL->image('height');
120
121	# Create the menubar.
122
123	my $mf = $MW->Frame(-bg => 'blue')->grid(-sticky => 'ew');
124	$mf->gridColumnconfigure(1, -weight => 1);
125
126	my $mbf = $mf->Menubutton(-text => 'File', -relief => 'raised');
127	$mbf->command(-label => 'New Puzzle', -command => \&new_puz);
128	$mbf->separator;
129	$mbf->command(-label => 'Quit', -command => [$MW => 'bell']);
130
131	my $mbp = $mf->Menubutton(-text => 'Prefs', -relief => 'raised');
132	my $pieces = 'Pieces';
133	$mbp->cascade(-label => $pieces);
134	my $mbpm = $mbp->cget(-menu);
135	my $mbpmp = $mbpm->Menu;
136	$mbp->entryconfigure($pieces, -menu => $mbpmp);
137	foreach (@LEVELS) {
138	$mbpmp->radiobutton(-label => $_,
139	-variable => \$PIECES,
140	-value => $_,
141	-command => \&create_puz,
142	);
143	}
144
145	my $mbq = $mf->Menubutton(-text => 'Help', -relief => 'raised');
146	my $about = $MW->Dialog(-text => <<"END"
147	npuz Version 1.0\n
148	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.
149	END
150	);
151	$about->configure(-wraplength => '6i');
152	$mbq->command(-label => 'About', -command => [$about => 'Show']);
153
154	$mbf->grid(-row => 0, -column => 0, -sticky => 'w');
155	$mbp->grid(-row => 0, -column => 1, -sticky => 'w');
156	$mbq->grid(-row => 0, -column => 2, -sticky => 'e');
157
158	} # end create_ui
159
160	sub puz_fini {
161
162	# Return true iff all puzzle pieces are in order.
163
164	my($i, $c, $r, %info);
165	for($i = 0; $i <= $#PUZ; $i++) {
166	($c, $r) = xy $i;
167	%info = $PUZ[$i]->gridInfo;
168	return 0 if $c != $info{-column} or $r != $info{-row};
169	}
170	return 1;
171
172	} # end puz_fini
173
174	sub move_piece {
175
176	my($piece) = @_;
177
178	my(%info, $c, $r, $sc, $sr);
179	%info = $piece->gridInfo; ($c, $r) = @info{-column,-row};
180	%info = $SPACE->gridInfo; ($sc, $sr) = @info{-column,-row};
181	if ( ($sr == $r and ($sc == $c-1 or $sc == $c+1)) or
182	($sc == $c and ($sr == $r-1 or $sr == $r+1)) ) {
183	$SPACE->grid(-column => $c, -row => $r);
184	$piece->grid(-column => $sc, -row => $sr);
185	}
186	if (puz_fini) {
187	my $color = ($SPACE->configure(-activebackground))[3];
188	$SPACE->configure(-image => $SPACE_IMAGE,
189	-activebackground => $color,
190	-background => $color,
191	-relief => 'flat',
192	);
193	foreach (@PUZ) {$_->configure(-command => \&beep)}
194	}
195
196	} # end move_piece
197
198	sub new_puz {
199
200	srand time;
201	foreach (0..$#ORDER) {$ORDER[$_]->[1] = rand $#ORDER}
202	my @order = sort randomly @ORDER;
203	#@order = @ORDER; # here's how I solve the puzzle (;
204	my($i, $o, $c, $r, $but);
205
206	for($i = 0; $i <= $#PUZ; $i++) {
207	$o = $order[$i]->[0];
208	$but = $PUZ[$o];
209	if ($o == 0) {
210	$but->configure(-background => 'red',
211	-relief => 'sunken',
212	-image => undef,
213	-activebackground => 'red',
214	);
215	} else {
216	$but->configure(-command => [\&move_piece, $but]);
217	}
218	($c, $r) = xy $i;
219	$but->grid(-column => $c, -row => $r, -sticky => 'nsew');
220	}
221
222	} # end new_puz
223
224	sub randomly {$a->[1] <=> $b->[1]} # randomize order of puzzle pieces
225
226	sub xy {my($n) = @_; ($n % $SIDE, int $n / $SIDE)} # ordinal to X/Y