view release on metacpan or  search on metacpan

lib/Tcl/pTk/demos/widtrib/npuz.pl  view on Meta::CPAN

	    $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->width;
    $CAMEL_HEIGHT = $CAMEL->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 P...
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)}