#!/usr/bin/perl -w
###############
# slidingBlock2.cgimp
#    An implementation a sliding block puzzle as a cgi script,
#    using the CGI.pm perl module.
#
#    This version has been adapted to run under mod_perl.
#
#     E F C     
#     D H G       a scrambled position for the 3x3 sliding block puzzle
#       B A
#
#    The basic idea is that the entire puzzle state is passed
#    in the URL on each request.  The position shown above is
#
#       slidingBlock.cgi?puzzlestring=EFCDHG-BA&size=3
#
#    To slide a block, you click on a cell near the hole,
#    and that link takes you to the next state of the puzzle.
#
#    For example, with the puzzle as shown above, 
#    clicking on the "B" character would swap the B and the hole,
#    and thus on the displayed webpage the "B" would be a link
#    giving the puzzle state after that swap, i.e.
#    
#       <a href="slidingBlock.cgi?puzzlestring=EFCDHGB-A&size=3">B</a>
#
#      E F C      After clicking on the "B", 
#      D H G      the displayed page would look like this.
#      B   A
#    
#    
##############
package slidingBlock;   # added package declaration for safety under mod_perl.
use strict;
use CGI;
use CGI::Carp qw( fatalsToBrowser );

our $cgi          = new CGI;
our $color        = "darkred";
our $linkcolor    = "darkred";  # To make the clickable spots more visible,
                               # make $linkcolor something like "red".
our $url          = $cgi->url( -relative=>1, -query=>0 );
our $size         = $cgi->param("size") || 5;
our $puzzlestring = $cgi->param("puzzlestring") || makePuzzleString($size);

if ( $cgi->param("Change Size") ) {
  $size = $cgi->param("sizePopUp");
  $puzzlestring = makePuzzleString($size);
}

if ( $cgi->param("Scramble") ) {
  $size = $cgi->param("sizePopUp");
  $puzzlestring = makeRandomPuzzleString($size);
}

our $puzzle       = makePuzzle($puzzlestring,$size);
our $dashindex    = index($puzzlestring,"-");
our $rowdash      = int($dashindex/$size);
our $coldash      = $dashindex % $size;

printWebPage();
exit;    # -- in mod_perl, this is redefined to "return" to caller.

# --- subroutines --------------------------

# modify string passed by swapping two characters.
sub swapChars {
 my ($string, $n1, $n2) = @_;
 my $char1 = substr( $string, $n1, 1);
 my $char2 = substr( $string, $n2, 1);
 substr( $string, $n1, 1) = $char2;
 substr( $string, $n2, 1) = $char1;
 return $string;
}

# Same as makePuzzleString below, but 
# initialize string in a random sequence.
sub makeRandomPuzzleString{
 my ($size) = @_;
 my $nrandomswaps = 2*$size*$size;  # random pair exchanges.
 my $sizesq = $size*$size;
 my $tmpPuzzle = makePuzzleString($size);
 for (my $i=0; $i<$nrandomswaps; $i++) {
   my $first = int rand $sizesq;
   my $second = $first;
   while ($first == $second) {$second = int rand $sizesq; }
   $tmpPuzzle = swapChars($tmpPuzzle,$first,$second);
 }
 return $tmpPuzzle;
}

# Usage: $puzzleString = makePuzzleString($size);
# Returns "ABCDEFGHIKLMNO-", $size*$size chars.
sub makePuzzleString {
  my ($size) = @_;
  my $char = "A";
  my $ncells = $size * $size;
  my $puzzlestring = "";
  do { 
    $puzzlestring .= $char;
    $char++;
  } while length($puzzlestring) < ($ncells-1);
  $puzzlestring .= "-";
  return $puzzlestring;
}

# Usage: $puzzle = makePuzzle($puzzlestring);
# Returns a 2-dimensional array of chars, 
# filling in $puzzlestring left-to-right and
# top-to-bottom.
sub makePuzzle {
  my ($puzzlestring,$size) = @_;
  my $puzzle;
  # my $b = substring($puzzle,2,1);   ######### UNCOMMENT THIS TO SEE CGI::Carp do its thing.
  my $n=0;
  for (my $y=0; $y<$size; $y++) {
    for (my $x=0; $x< $size; $x++) {
      $puzzle->[$y][$x] = substr($puzzlestring,$n,1);
      $n++;
    }
  }
  return $puzzle;
}

sub swapCharsUrl {
  my ($row1,$col1,$row2,$col2) = @_;
  my $newstring = $puzzlestring;
  $newstring = swapChars($newstring, $col1+$size*$row1, $col2+$size*$row2);
  return "<a href=" . 
            $url . "?puzzlestring=" . $newstring . 
                    "&size=" . $size . 
          ">";         
}

sub tryDashAt {
  my ($row,$col,$dr,$dc) = @_;
  if (  $row+$dr eq $rowdash and $col+$dc eq $coldash ) {
    print swapCharsUrl($row,$col,$row+$dr,$col+$dc);
    print $puzzle->[$row][$col];
    print "</a>";
    return 1;
    }
  else {
    return 0;
  }
}


# print the web page html for the puzzle.
sub printWebPage {
  print $cgi->header;
  print $cgi->start_html(
                         -title => "A Sliding Block Puzzle",
                         -alink => $linkcolor,
                         -link  => $linkcolor,
                         -vlink => $linkcolor,
                        );
  print "
 <br><br>
 <i>A Sliding Block Puzzle</i> - 
 <small>click on one of the letters next to the hole</small>
 <br><br>\n
      ";

  print "<table border=1>\n";
  for (my $row=0; $row<$size; $row++) {
    print "<tr>";
    for (my $col=0; $col<$size; $col++) {
      
      my $char = $puzzle->[$row][$col];
      $char = "&nbsp;" if $char eq "-";

      print "<td bgcolor=lightblue><big><b>";
      if    ( tryDashAt($row,$col, 0, 1 ) ) {}
      elsif ( tryDashAt($row,$col, 0,-1 ) ) {}
      elsif ( tryDashAt($row,$col, 1, 0 ) ) {}
      elsif ( tryDashAt($row,$col,-1, 0 ) ) {}
      else {
        print "<font color=$color>";
        print $char;
        print "</font>";
      }
      print "</b></big></td>";

    }
    print "</tr>\n";
  }
  print "</table>\n";

  # Form pop-up and buttons to resize and scrable.
  print "<hr noshade size=1>";
  print $cgi->start_form;
  print $cgi->popup_menu( -name    => "sizePopUp", 
                          -values  => ["3","4","5"],
                          -default => $size );
  print $cgi->submit("Change Size");
  print $cgi->submit("Scramble");
  print $cgi->end_form;
  
  print $cgi->end_html;
}


=head1 NAME

slidingBlock.cgi implements the classic puzzle as a cgi webpage.

=head1 SYNOPSIS

Just point your web browser at it and let-er rip.

=head1 AUTHOR

 Jim Mahoney (mahoney@marlboro.edu)
 Marlboro College

=head1 SEE ALSO

  perl, CGI.pm

=head1 COPYRIGHT

Copyright (c) 2001 Jim Mahoney

This software may be used and distributed under the same terms as Perl itself.

=cut