Commit | Line | Data |
---|---|---|
86530b38 AT |
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; |