Initial commit of OpenSPARC T2 design and verification files.
[OpenSPARC-T2-DV] / tools / perl-5.8.0 / lib / site_perl / 5.8.0 / sun4-solaris / Tk / demos / widget_lib / mkPuzzle.pl
CommitLineData
86530b38
AT
1
2
3sub 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
41sub 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
671;