home *** CD-ROM | disk | FTP | other *** search
/ Australian Personal Computer 2004 July / APC0407D2.iso / workshop / apache / files / ActivePerl-5.6.1.638-MSWin32-x86.msi / _fd0e2b437346429736136f65cc1eb105 < prev    next >
Encoding:
Text File  |  2004-04-13  |  2.7 KB  |  68 lines
  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;
  68.