package Othello; use strict; # # public methods: # # my $game = new Othello($skill); # $game->place_piece($color,$x,$y) || warn "Bad Thing!"; # $game->print_board; # $game->skill($skill); # my skill = $game->skill; # my $winner = $game->winner; # my $free = $game->free; # my $turn = $game->turn; # my @opps = $game->get_opportunities($color); # my ($black, $white) = $game->scores; # my $black_score = $game->scores("B"); # # data structures: # # These data structures are private to the module. # Don't mess with them - use the provided methods instead. # # board is a reference to a 2xarray, with values of 0|B|W for the pieces # turn is the turn number, 0 at init, 1 on first move # won tells if/who won the game, values 0|B|W # score_w, score_b are the numbers of white and black pieces on the board # skill is the skill level 1-5 # free is how many squares are free # # x/y_max/min are private variables telling the dimensions of the board # valid_colors is a private hash with the B|W colors # my $_x_min = 1; my $_x_max = 8; my $_y_min = 1; my $_y_max = 8; my %_valid_colors = ('B' => 1, 'W' => 1,); my %_fields = ( 'board' => undef, 'turn' => undef, 'won' => undef, 'score_w' => undef, 'score_b' => undef, 'skill' => undef, 'free' => undef, ); # # Public methods are here # sub new { # # Usage: my $game = new Othello($skill); # # Creates a new game object and initializes the board. Also sets # the skill level to the one specified, or to 1 if none is given. # my ($class,$skill) = @_; my $self = {%_fields}; bless $self, ref($class) || $class; $self->_init_game; $self->skill($skill); $self; } sub skill { # # Usage: my skill = $game->skill; # $game->skill($skill); # # Allows you to set the skill level of the game, # or get the current skill level if no args are given. # my $self = shift; if (@_) { my $skill = shift || 1; $skill = int($skill); $skill = 1 if ($skill < 1); $skill = 5 if ($skill > 5); return $self->{'skill'} = $skill; } return $self->{'skill'}; } sub print_board { # # Usage: $game->print_board; # # prints out an ascii rendition of the board # my $self = shift; my ($x,$y); print " 1 2 3 4 5 6 7 8 \n"; for $y ($_y_min..$_y_max) { print " +---+---+---+---+---+---+---+---+\n"; print "$y | "; for $x ($_x_min..$_x_max) { my $piece = $self->_square($x,$y); if ($piece) { print (($piece eq "W")?"O":"."); } else { print " "; } print " | "; } print "\n"; } print " +---+---+---+---+---+---+---+---+\n"; } sub place_piece { # # Usage: $game->place_piece($color,$x,$y) || warn "Bad Thing!"; # # Allows you to place a piece of the given color at the goven # coordinates. Returns true on success, false on failure. # my $self = shift; my $color = shift || return 0; my ($x,$y) = @_; return 0 unless (_valid_color($color)); return 0 unless ($self->_check_move($color,$x,$y)); # put the piece on the board and flip pieces accordingly $self->_square($x,$y,$color); $self->_flip_pieces($color,$x,$y); # set and check scores and winning stuff $self->{'turn'}++; ($self->{'score_b'},$self->{'score_w'}) = $self->score; $self->{'won'} = $self->_get_winner unless $self->{'free'}; foreach $color (keys %_valid_colors) { $self->{'won'} = $self->_get_winner unless $self->get_opportunities($color); } return 1; } sub winner { # # Usage: my $winner = $game->winner; # # Returns the color (B|W) of the winner. Returns 0 if no winner yet. # Return is undefined for a tie, but it will usually be Black. my $self = shift; if ($self->{'won'}) { return $self->{'won'}; } else { return 0; } } sub free { # # Usage: my $free = $game->free; # # Returns the number of spaces unoccupied by pieces. # my $self = shift; return $self->{'free'}; } sub turn { # Usage: my $turn = $game->turn; # # Returns the number of the turn the game is on. # my $self = shift; return $self->{'turn'}; } sub get_opportunities { # # Usage: my @opps = $game->get_opportunities($color); # # Returns a list of opportunities for the color given in the form # (XY, XY, XY, ...) Returns an empty list if there are none. # my $self = shift; my $color = shift || return 0; my ($x,$y); my @opportunities = (); for $x ($_x_min..$_x_max) { for $y ($_y_min..$_y_max) { next if $self->_square($x,$y); push (@opportunities,"$x$y") if $self->_opportunity($color,$x,$y); } } return @opportunities; } sub score { # # Usage: my ($black, $white) = $game->scores; # my $black_score = $game->scores("B"); # # Returns an array with the scores of the colors (alphabetical). # Returns the score of the specifiec color if argument given. # my $self = shift; my $player = shift; my %scores = (); my ($x,$y,$color); my $free = 0; # count the pieces for $x ($_x_min..$_x_max) { for $y ($_y_min..$_y_max) { $color = $self->_square($x,$y); if ($color) { $scores{$color}++; } else { $free++; } } } # return the scores $self->{'free'} = $free; if ($player) { return $scores{$player}; } else { return map {$scores{$_}} (sort keys %_valid_colors); } } sub dump_game { # # Usage: my $dump = $game->dump_game; # # Returns a string that stores the state of a game. May be # encoded and used as a parameter to a CGI script, or passed # back through the load_game method to restore a game. my $self = shift; my $game; return $game; } sub load_game ($) { # # Usage: my $game = Othello::load_game($dump); # # Creates a new game object in a state determined by the string # passed into the method. Compatible with dump_game. # my $dump = shift; my $skill; my $game = new Othello($skill); return $game; } sub encode (\$) { my $game_ref = shift; } sub decode (\$) { my $game_ref = shift; } # # Private methods after here # sub _init_game { my $self = shift; $self->{'score_w'} = 2; $self->{'score_b'} = 2; $self->{'turn'} = 0; $self->{'won'} = 0; $self->{'skill'} = 1; $self->{'free'} = (8*8)-4; $self->_square(4,4,"B"); $self->_square(4,5,"W"); $self->_square(5,4,"W"); $self->_square(5,5,"B"); } sub _check_move { # tells if move is legal or not my $self = shift; my $color = shift || return 0; my ($x, $y) = @_; if ( (_valid_square($x,$y) ) && (! $self->_square($x,$y) ) && (_valid_color($color) ) ) { return $self->_opportunity($color,$x,$y); } else { return 0; } } sub _square { # returns the occupant of the square, 0 if none my $self = shift; my $x = shift || return 0; my $y = shift || return 0; my $value = shift; return 0 unless (_valid_square($x,$y)); if (defined $value) { $self->{'board'}[$x][$y] = $value; } return $self->{'board'}[$x][$y]; } sub _get_winner { # gets the winner of a game my $self = shift; my $score = 0; my ($winner,$color); for $color (keys %_valid_colors) { my $color_score = $self->score($color); if ($self->score($color) > $score) { $winner = $color; $score = $color_score; } } return $winner; } sub _opportunity { # tells if there is an opportunity for a color at a space my $self = shift; my $color = shift || return 0; my ($x,$y) = @_; my ($i,$j); return 0 unless (_valid_color($color)); # look in all directions for a line to flip, # return true if we find one for $i (-1..1) { for $j (-1..1) { # don't bother checking our square next unless ($i || $j); # skip if the square isn't occupied by an opposing piece my $new_x = $x + $i; my $new_y = $y + $j; my $neighbor = ($self->_square($new_x,$new_y)); next if ((!$neighbor) || ($neighbor eq $color)); # if it's an opponent's piece, follow the line # until we find one of our pieces $new_x += $i; $new_y += $j; while ( _valid_square($new_x,$new_y) ) { $neighbor = ($self->_square($new_x,$new_y)); last unless ($neighbor); return 1 if ($neighbor eq $color); $new_x += $i; $new_y += $j; } } } return 0; } sub _valid_square ($$) { # tells if the x,y given is on the board my ($x,$y) = @_; if ( $x>=$_x_min && $x<=$_x_max && $y>=$_y_min && $y<=$_y_max ) { return 1; } else { return 0; } } sub _valid_color ($) { # tells if the color given is valid my $color = shift || return 0; return $_valid_colors{$color}; } sub _flip_pieces { my $self = shift; my $color = shift || return 0; my ($x,$y) = @_; my ($i,$j); return 0 unless (_valid_color($color)); # look in all directions for a line to flip for $i (-1..1) { for $j (-1..1) { # don't bother checking our square next unless ($i || $j); # skip if the square isn't occupied by an opposing piece my $flip_x = my $look_x = $x + $i; my $flip_y = my $look_y = $y + $j; my $neighbor = ($self->_square($look_x,$look_y)); next if ((!$neighbor) || ($neighbor eq $color)); # look outward for a bounding piece of our color my $foundit = 0; $look_x += $i; $look_y += $j; while ( _valid_square($look_x,$look_y) ) { $neighbor = ($self->_square($look_x,$look_y)); last unless $neighbor; $foundit = 1 if ($neighbor eq $color); $look_x += $i; $look_y += $j; } # if there's a bounding piece, flip the row if ($foundit) { $neighbor = ($self->_square($flip_x,$flip_y)); while ( ( _valid_square($flip_x,$flip_y) ) && ( $neighbor ) && ( $neighbor ne $color ) ) { $self->_square($flip_x,$flip_y,$color); $flip_x += $i; $flip_y += $j; $neighbor = ($self->_square($flip_x,$flip_y)); } } } } return 1; } 1;