#!/usr/bin/perl -w
srand;
$a1 = 1;
$a2 = 2;
$a3 = 3;
$b1 = 4;
$b2 = 5;
$b3 = 6;
$c1 = 7;
$c2 = 8;
$c3 = "";
$win = 0;
print "\n" x 100;
draw();
print "Your goal is to match this pattern.\n";
print "You may move any square that is next to the blank spot.\n";
print "Press enter when ready. ";
$pause = <STDIN>;
randomize();
{
%squares = ("a1", $a1, "a2", $a2, "a3", $a3, "b1", $b1, "b2", $b2, "b3
+", $b3, "c1", $c1, "c2", $c2, "c3", $c3);
draw();
win();
(exit) if ($win eq 1);
{
  $bad_move = 0;
  print "Which square will you move? ";
  chomp ($response = <STDIN>);
  $move = $squares{$response};
  check_move();
  (redo) if ($bad_move eq 1);
}
fill_blank();
#$squares{$response} = "";
make_blank();
redo;
}

#checks to make sure a proper piece is selected
sub check_move() {
  foreach $i (keys %squares) {
    if ($squares{$i} eq "") {
      if ($response eq 'a1') {
        if ($i ne 'a2' && $i ne 'b1') {
          ($bad_move = 1);
        }
      } elsif ($response eq 'a2') {
        if ($i ne 'a1' && $i ne 'a3' && $i ne 'b2') {
          ($bad_move = 1);
        }
      } elsif ($response eq 'a3') {
        if ($i ne 'a2' && $i ne 'b3') {
          ($bad_move = 1);
        }
      } elsif ($response eq 'b1') {
        if ($i ne 'b2' && $i ne 'a1' && $i ne 'c1') {
          ($bad_move = 1);
        }
      } elsif ($response eq 'b2') {
        if ($i ne 'b1' && $i ne 'b3' && $i ne 'a2' && $i ne 'c2') {
          ($bad_move = 1);
        }
      } elsif ($response eq 'b3') {
        if ($i ne 'b2' && $i ne 'a3' && $i ne 'c3') {
          ($bad_move = 1);
        }
      } elsif ($response eq 'c1') {
        if ($i ne 'c2' && $i ne 'b1') {
          ($bad_move = 1);
        }
      } elsif ($response eq 'c2') {
        if ($i ne 'c1' && $i ne 'c3' && $i ne 'b2') {
          ($bad_move = 1);
        }
      } elsif ($response eq 'c3') {
        if ($i ne 'c2' && $i ne 'b3') {
          ($bad_move = 1);
        }
      }
    }
  }
}
# makes the moved piece blank
sub make_blank() {
  $i = $response;
  ($a1 = "") if ($i eq 'a1');
  ($a2 = "") if ($i eq 'a2');
  ($a3 = "") if ($i eq 'a3');
  ($b1 = "") if ($i eq 'b1');
  ($b2 = "") if ($i eq 'b2');
  ($b3 = "") if ($i eq 'b3');
  ($c1 = "") if ($i eq 'c1');
  ($c2 = "") if ($i eq 'c2');
  ($c3 = "") if ($i eq 'c3');
}

#  randomizes order of pieces for initial game play
sub randomize() {
  $b2 = "";
  @numbers = qw(1 2 3 4 5 6 7 8);

  $new = rand($#numbers);
  $a1 = $numbers[$new];
  splice(@numbers, $new, 1);

  $new = rand($#numbers);
  $a2 = $numbers[$new];
  splice(@numbers, $new, 1);

  $new = rand($#numbers);
  $a3 = $numbers[$new];
  splice(@numbers, $new, 1);

  $new = rand($#numbers);
  $b1 = $numbers[$new];
  splice(@numbers, $new, 1);

  $new = rand($#numbers);
  $b3 = $numbers[$new];
  splice(@numbers, $new, 1);

  $new = rand($#numbers);
  $c1 = $numbers[$new];
  splice(@numbers, $new, 1);

  $new = rand($#numbers);
  $c2 = $numbers[$new];
  splice(@numbers, $new, 1);

  $new = rand($#numbers);
  $c3 = $numbers[$new];
  splice(@numbers, $new, 1);

}

# sets number to blank position
sub fill_blank() {
  foreach $i (keys %squares) {
    if ($squares{$i} eq "") {
      ($a1 = $move) if ($i eq 'a1');
      ($a2 = $move) if ($i eq 'a2');
      ($a3 = $move) if ($i eq 'a3');
      ($b1 = $move) if ($i eq 'b1');
      ($b2 = $move) if ($i eq 'b2');
      ($b3 = $move) if ($i eq 'b3');
      ($c1 = $move) if ($i eq 'c1');
      ($c2 = $move) if ($i eq 'c2');
      ($c3 = $move) if ($i eq 'c3');

#      #delete $squares{$i};
#      $squares{$i} = $move;
#      print $move;
    }
  }
}

# checks for winning sequence
sub win() {
  if ($a1 eq 1 && $a2 eq 2 && $a3 eq 3 && $b1 eq 4 && $b2 eq 5 && $b3 
+eq 6 && $c1 eq 7 && $c2 eq 8) {
    print "YOU WIN!\n";
    $win = 1;
  }
}
# draws board
sub draw() {
  print "\n" x 100;
  printf "                                    1   2   3\n";
  printf "                                  -------------\n";
  printf "                                a | %1s | %1s | %1s |\n", $a
+1, $a2, $a3;
  printf "                                  -------------\n";
  printf "                                b | %1s | %1s | %1s |\n", $b
+1, $b2, $b3;
  printf "                                  -------------\n";
  printf "                                c | %1s | %1s | %1s |\n", $c
+1, $c2, $c3;
  printf "                                  -------------\n";
  print "\n" x13;
}
[download]

edit by thelenm: added code tags

---

---

Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!

Titles consisting of a single word are discouraged, and in most cases are disallowed outright.

Read Where should I post X? if you're not absolutely sure you're posting in the right place.

Please read these before you post! —

• How do I compose an effective node title?
• How do I post a question effectively?
• Markup in the Monastery

Posts may use any of the Perl Monks Approved HTML tags:

a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr

You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)

	For:		Use:
	&		&
	<		&lt;
	>		&gt;
	[		&#91;
	]		&#93;

Link using PerlMonks shortcuts! What shortcuts can I use for linking?

See Writeup Formatting Tips and other pages linked from there for more info.