#!perl -w use strict; { package Board; my $white = '_'; my $black = '#'; # Construct a new board. sub new { my $proto = shift || die "Expected class"; my $class = ref($proto) || $proto; my $self = [[($white)x5],[($white)x5],[($white)x5], [($white)x5],[($white)x5]]; bless ($self, $class); return $self; } # Returns true if the board is all black. False otherwise. sub Finished { my $self = shift || die "Expected self"; for( @$self ) { for( @$_ ) { return 0 if $white eq $_; } } return 1; } # Returns a display version of the board, suitable for printing. sub Display { my $self = shift || die "Expected self"; my $rowN = 0; my @disp = map {"$_\n"} " 12345", map {++$rowN . join('', @$_)} @$self; return wantarray ? @disp : join '', @disp; } # Toggle the location given, and the locations to the N, E, S, & W sub Toggle { die "Incorrect number of args" unless 3 == @_; my ( $self, $x, $y ) = @_; die "X ($x) out of range\n" if $x > 5 or 1 > $x; die "Y ($y) out of range\n" if $y > 5 or 1 > $y; $self->_ToggleSquare( $x, $y ); $self->_ToggleSquare( $x+1, $y ); $self->_ToggleSquare( $x-1, $y ); $self->_ToggleSquare( $x, $y+1 ); $self->_ToggleSquare( $x, $y-1 ); return undef; } # Toggle the given location. No-op if location is out of range. sub _ToggleSquare { die "Incorrect number of args" unless 3 == @_; my ( $self, $x, $y ) = @_; return undef if $x > 5 or 1 > $x or $y > 5 or 1 > $y; ($x, $y) = map { $_ - 1 } $x, $y; $self->[$x]->[$y] = $white eq $self->[$x]->[$y] ? $black : $white; return undef; } } sub GetMove { print "> "; my $move = <>; # Read from STDIN, or a file. my ($control, $x, $y) = $move =~ m/^\s*([a-zA-Z]+|(\d)[\/,\s-]?(\d))\s*$/; ($x, $y) = GetMove() if not defined $control; # Repeat as necessary die "Game Over\n" if $control && $control =~ m/^[qQeE]/; # quit, exit, etc. return ($x, $y); } sub main { my $board = Board->new(); my @moves = (); while( not $board->Finished() ) { print $board->Display(); my @move = GetMove(); push @moves, \@move; $board->Toggle( @move ); } print "Success! ", scalar( @moves ), " moves.\n"; print join( "\n", map { join '-', @$_ } @moves ), "\n"; return 0; } exit( main() );