| 1 | |
| 2 | |
| 3 | sub mkPuzzle { |
| 4 | |
| 5 | # Create a top-level window containing a 15-puzzle game. |
| 6 | |
| 7 | $mkPuzzle->destroy if Exists($mkPuzzle); |
| 8 | $mkPuzzle = $top->Toplevel(); |
| 9 | my $w = $mkPuzzle; |
| 10 | dpos $w; |
| 11 | $w->title('15-Puzzle Demonstration'); |
| 12 | $w->iconname('15-Puzzle'); |
| 13 | |
| 14 | my $w_msg = $w->Message(-font => '-Adobe-times-medium-r-normal--*-180-*-*-*-*-*-*', -aspect => '300', -text => |
| 15 | 'A 15-puzzle appears below as a collection of buttons. Click on any of the pieces next to ' . |
| 16 | 'the space, and that piece will slide over the space. Continue this until the pieces are ' . |
| 17 | 'arranged in numerical order from upper-left to lower-right. Click the "OK" button when ' . |
| 18 | 'you\'ve finished playing.'); |
| 19 | my $w_frame = $w->Frame(-width => 120, -height => 120, -borderwidth => '2', -relief => 'sunken', -background => 'Bisque3'); |
| 20 | my $w_ok = $w->Button(-text => 'OK', -width => 8, -command => ['destroy', $w]); |
| 21 | $w_msg->pack(-side => 'top'); |
| 22 | $w_frame->pack(-side => 'top', -padx => '5', -pady => '5'); |
| 23 | $w_ok->pack(-side => 'bottom'); |
| 24 | |
| 25 | @order = (3, 1, 6, 2, 5, 7, 15, 13, 4, 11, 8, 9, 14, 10, 12); |
| 26 | for ($i=0; $i<15; $i++) { |
| 27 | $num = $order[$i]; |
| 28 | $mkPuzzle::xpos{$num} = ($i%4)*.25; |
| 29 | $mkPuzzle::ypos{$num} = (int($i/4))*.25; |
| 30 | $w_frame_num = $w_frame->Button(-relief => 'raised', -text => $num, -highlightthickness => 0); |
| 31 | $w_frame_num->configure(-command => [sub {&puzzle_switch}, $w_frame_num, $num]); |
| 32 | $w_frame_num->place(-relx => $mkPuzzle::xpos{$num}, -rely => $mkPuzzle::ypos{$num}, -relwidth => .25, |
| 33 | -relheight => .25); |
| 34 | } |
| 35 | $mkPuzzle::xpos{'space'} = .75; |
| 36 | $mkPuzzle::ypos{'space'} = .75; |
| 37 | |
| 38 | } # end mkPuzzle |
| 39 | |
| 40 | |
| 41 | sub puzzle_switch { |
| 42 | |
| 43 | # Procedure invoked by buttons in the puzzle to resize the puzzle entries. |
| 44 | |
| 45 | my($w, $num) = @_; |
| 46 | |
| 47 | if ( (($mkPuzzle::ypos{$num} >= ($mkPuzzle::ypos{'space'} - .01)) && |
| 48 | ($mkPuzzle::ypos{$num} <= ($mkPuzzle::ypos{'space'} + .01)) |
| 49 | && ($mkPuzzle::xpos{$num} >= ($mkPuzzle::xpos{'space'} - .26)) && |
| 50 | ($mkPuzzle::xpos{$num} <= ($mkPuzzle::xpos{'space'} + .26))) |
| 51 | || (($mkPuzzle::xpos{$num} >= ($mkPuzzle::xpos{'space'} - .01)) && |
| 52 | ($mkPuzzle::xpos{$num} <= ($mkPuzzle::xpos{'space'} + .01)) |
| 53 | && ($mkPuzzle::ypos{$num} >= ($mkPuzzle::ypos{'space'} - .26)) && |
| 54 | ($mkPuzzle::ypos{$num} <= ($mkPuzzle::ypos{'space'} + .26))) ) { |
| 55 | my $tmp = $mkPuzzle::xpos{'space'}; |
| 56 | $mkPuzzle::xpos{'space'} = $mkPuzzle::xpos{$num}; |
| 57 | $mkPuzzle::xpos{$num} = $tmp; |
| 58 | $tmp = $mkPuzzle::ypos{'space'}; |
| 59 | $mkPuzzle::ypos{'space'} = $mkPuzzle::ypos{$num}; |
| 60 | $mkPuzzle::ypos{$num} = $tmp; |
| 61 | $w->place(-relx => $mkPuzzle::xpos{$num}, -rely => $mkPuzzle::ypos{$num}); |
| 62 | } |
| 63 | |
| 64 | } # end puzzle_switch |
| 65 | |
| 66 | |
| 67 | 1; |