home *** CD-ROM | disk | FTP | other *** search
/ Netrunner 2004 October / NETRUNNER0410.ISO / regular / ActivePerl-5.8.4.810-MSWin32-x86.msi / _791641b0c1588080e4c3df9f9ec1f217 < prev    next >
Encoding:
Text File  |  2004-06-01  |  2.7 KB  |  87 lines
  1. # puzzle.pl
  2.  
  3. use subs qw/puzzle_switch/;
  4. use vars qw/$TOP/;
  5.  
  6. sub puzzle {
  7.  
  8.     # Create a top-level window containing a 15-puzzle game.
  9.  
  10.     my($demo) = @_;
  11.     $TOP = $MW->WidgetDemo(
  12.         -name     => $demo,
  13.         -text     => 'A 15-puzzle appears below as a collection of buttons.  Click on any of the pieces next to the space, and that piece will slide over the space.  Continue this until the pieces are arranged in numerical order from upper-left to lower-right.',
  14.         -title    => '15-Puzzle Demonstration',
  15.         -iconname => 'puzzle',
  16.     );
  17.  
  18.     # Special trick: select a darker color for the space by creating a
  19.     # scrollbar widget and using its trough color.
  20.  
  21.     my $s = $TOP->Scrollbar;
  22.     my $frame = $TOP->Frame(
  23.         -width       => 120,
  24.         -height      => 120,
  25.         -borderwidth => '2',
  26.         -relief      => 'sunken',
  27.         -background  => $s->cget(-troughcolor),
  28.     );
  29.     $frame->pack(qw/-side top -padx 1c -pady 1c/);
  30.     $s->destroy;
  31.  
  32.     my(@order) = (3, 1, 6, 2, 5, 7, 15, 13, 4, 11, 8, 9, 14, 10, 12);
  33.     my %xpos = ();
  34.     my %ypos = ();
  35.  
  36.     my($i, $num, $frame_num);
  37.     for ($i=0; $i<15; $i++) {
  38.     $num = $order[$i];
  39.     $xpos{$num} = ($i%4) * 0.25;
  40.     $ypos{$num} = (int($i/4)) * 0.25;
  41.     $frame_num = $frame->Button(
  42.             -relief             => 'raised',
  43.             -text               => $num,
  44.             -highlightthickness => 0,
  45.         );
  46.     $frame_num->configure(
  47.             -command => [\&puzzle_switch, $frame_num, $num, \%xpos, \%ypos],
  48.         );
  49.     $frame_num->place(
  50.             -relx      => $xpos{$num},
  51.             -rely      => $ypos{$num},
  52.             -relwidth  => 0.25,
  53.         -relheight => 0.25,
  54.         );
  55.     } # forend all puzzle numbers
  56.     $xpos{'space'} = 0.75;
  57.     $ypos{'space'} = 0.75;
  58.  
  59. } # end puzzle
  60.  
  61. sub puzzle_switch {
  62.  
  63.     # Procedure invoked by buttons in the puzzle to resize the puzzle entries.
  64.  
  65.     my($w, $num, $xpos, $ypos) = @_;
  66.  
  67.     if (    (($ypos->{$num} >= ($ypos->{'space'} - 0.01)) &&
  68.          ($ypos->{$num} <= ($ypos->{'space'} + 0.01))
  69.          &&  ($xpos->{$num} >= ($xpos->{'space'} - 0.26)) &&
  70.          ($xpos->{$num} <= ($xpos->{'space'} + 0.26)))
  71.      || (($xpos->{$num} >= ($xpos->{'space'} - 0.01)) &&
  72.          ($xpos->{$num} <= ($xpos->{'space'} + 0.01))
  73.      &&  ($ypos->{$num} >= ($ypos->{'space'} - 0.26)) &&
  74.          ($ypos->{$num} <= ($ypos->{'space'} + 0.26))) ) {
  75.     my $tmp = $xpos->{'space'};
  76.     $xpos->{'space'} = $xpos->{$num};
  77.     $xpos->{$num} = $tmp;
  78.     $tmp = $ypos->{'space'};
  79.     $ypos->{'space'} =  $ypos->{$num};
  80.     $ypos->{$num} = $tmp;
  81.     $w->place(-relx => $xpos->{$num}, -rely => $ypos->{$num});
  82.     }
  83.  
  84. } # end puzzle_switch
  85.  
  86. 1;
  87.