From c635cf5996f9ec6439b8eaee284681014451583d Mon Sep 17 00:00:00 2001 From: doy Date: Fri, 24 Apr 2009 23:28:38 -0500 Subject: get rid of the 'ghostlike' abstract base, and have other ghostlike games just inherit from ghost directly --- lib/Bot/Games.pm | 1 - lib/Bot/Games/Game/Ghost.pm | 149 +++++++++++++++++++++++++++++++++++++++ lib/Bot/Games/Game/Ghostlike.pm | 141 ------------------------------------ lib/Bot/Games/Game/Spook.pm | 2 +- lib/Bot/Games/Game/Superghost.pm | 2 +- lib/Bot/Games/Game/Xghost.pm | 2 +- 6 files changed, 152 insertions(+), 145 deletions(-) create mode 100644 lib/Bot/Games/Game/Ghost.pm delete mode 100644 lib/Bot/Games/Game/Ghostlike.pm diff --git a/lib/Bot/Games.pm b/lib/Bot/Games.pm index 83516bb..599927b 100644 --- a/lib/Bot/Games.pm +++ b/lib/Bot/Games.pm @@ -3,7 +3,6 @@ package Bot::Games; use Bot::Games::OO; use Module::Pluggable search_path => 'Bot::Games::Game', - except => ['Bot::Games::Game::Ghostlike'], sub_name => 'games'; extends 'Bot::BasicBot'; diff --git a/lib/Bot/Games/Game/Ghost.pm b/lib/Bot/Games/Game/Ghost.pm new file mode 100644 index 0000000..093b013 --- /dev/null +++ b/lib/Bot/Games/Game/Ghost.pm @@ -0,0 +1,149 @@ +#!/usr/bin/perl +package Bot::Games::Game::Ghost; +use Bot::Games::OO; +use Games::Word::Wordlist; +extends 'Bot::Games::Game'; + +has '+help' => ( + default => "ghost help", +); + +has current_player => ( + is => 'rw', + isa => 'Str', + predicate => 'has_current_player', + command => 1, +); + +has players_fixed => ( + is => 'rw', + isa => 'Bool', + default => 0, + command => 1, +); + +has state => ( + is => 'rw', + isa => 'Str', + default => '', + command => 1, +); + +has challenger => ( + is => 'rw', + isa => 'Str', + predicate => 'has_challenger', + command => 1, +); +command 'has_challenger'; + +has wordlist => ( + is => 'ro', + isa => 'Games::Word::Wordlist', + default => sub { Games::Word::Wordlist->new('/usr/share/dict/words') }, + handles => { + valid_word => 'is_word', + }, +); + +around state => sub { + my $orig = shift; + my $self = shift; + return $self->$orig unless @_; + my ($state) = @_; + $state = uc $state; + return $self->$orig($state); +}; + +augment turn => sub { + my $self = shift; + my ($player, $state) = @_; + + if ($self->current_player_index == 0 + && !$self->players_fixed + && !grep { $player eq $_ } $self->players) { + $self->add_player($player); + $self->current_player($player); + } + + return "It's " . $self->current_player . "'s turn!" + if $player ne $self->current_player; + return "You must respond to " . $self->challenger . "'s challenge!" + if $self->has_challenger; + return "$state isn't a valid move!" + unless $self->valid_move($state); + + $self->current_player($self->next_player); + return $self->state($state); +}; + +command challenge => sub { + my $self = shift; + my ($word, $args) = @_; + my $player = $args->{player}; + return "It's " . $self->current_player . "'s turn!" + if $player ne $self->current_player; + my $prev = $self->previous_player; + my $challenger = $self->has_challenger ? $self->challenger : $player; + if ($word) { + if (!$self->valid_word_from_state($word)) { + return "$word is not valid for state " . $self->state . "!"; + } + elsif ($self->valid_word($word)) { + $self->is_over(1); + return "$word is a word! $challenger wins!"; + } + else { + $self->is_over(1); + return "$word is not a word. $challenger loses!"; + } + } + else { + $self->challenger($player); + $self->current_player($prev); + return "$player is challenging $prev!"; + } +}; + +command previous_player => sub { + my $self = shift; + return unless $self->has_current_player; + return $self->players->[$self->current_player_index - 1]; +}; + +command next_player => sub { + my $self = shift; + return unless $self->has_current_player; + return $self->players->[($self->current_player_index + 1) % $self->num_players]; +}; + +command valid_move => sub { + my $self = shift; + my ($move) = @_; + return uc(substr($move, 0, -1)) eq $self->state; +}; + +command valid_word_from_state => sub { + my $self = shift; + my ($word) = @_; + return uc($word) eq $self->state; +}; + +command give_up => sub { + my $self = shift; + $self->is_over(1); + return "Game over!"; +}; + +sub current_player_index { + my $self = shift; + for (0..($self->num_players - 1)) { + return $_ if $self->current_player eq $self->players->[$_]; + } + return 0; +} + +__PACKAGE__->meta->make_immutable; +no Bot::Games::OO; + +1; diff --git a/lib/Bot/Games/Game/Ghostlike.pm b/lib/Bot/Games/Game/Ghostlike.pm deleted file mode 100644 index fc6229a..0000000 --- a/lib/Bot/Games/Game/Ghostlike.pm +++ /dev/null @@ -1,141 +0,0 @@ -#!/usr/bin/perl -package Bot::Games::Game::Ghostlike; -use Bot::Games::OO; -use Games::Word::Wordlist; -extends 'Bot::Games::Game'; - -has current_player => ( - is => 'rw', - isa => 'Str', - predicate => 'has_current_player', - command => 1, -); - -has players_fixed => ( - is => 'rw', - isa => 'Bool', - default => 0, - command => 1, -); - -has state => ( - is => 'rw', - isa => 'Str', - default => '', - command => 1, -); - -has challenger => ( - is => 'rw', - isa => 'Str', - predicate => 'has_challenger', - command => 1, -); -command 'has_challenger'; - -has wordlist => ( - is => 'ro', - isa => 'Games::Word::Wordlist', - default => sub { Games::Word::Wordlist->new('/usr/share/dict/words') }, - handles => { - valid_word => 'is_word', - }, -); - -around state => sub { - my $orig = shift; - my $self = shift; - return $self->$orig unless @_; - my ($state) = @_; - $state = uc $state; - return $self->$orig($state); -}; - -augment turn => sub { - my $self = shift; - my ($player, $state) = @_; - - if ($self->current_player_index == 0 - && !$self->players_fixed - && !grep { $player eq $_ } $self->players) { - $self->add_player($player); - $self->current_player($player); - } - - return "It's " . $self->current_player . "'s turn!" - if $player ne $self->current_player; - return "You must respond to " . $self->challenger . "'s challenge!" - if $self->has_challenger; - return "$state isn't a valid move!" - unless $self->valid_move($state); - - $self->current_player($self->next_player); - return $self->state($state); -}; - -command challenge => sub { - my $self = shift; - my ($word, $args) = @_; - my $player = $args->{player}; - return "It's " . $self->current_player . "'s turn!" - if $player ne $self->current_player; - my $prev = $self->previous_player; - my $challenger = $self->has_challenger ? $self->challenger : $player; - if ($word) { - if (!$self->valid_word_from_state($word)) { - return "$word is not valid for state " . $self->state . "!"; - } - elsif ($self->valid_word($word)) { - $self->is_over(1); - return "$word is a word! $challenger wins!"; - } - else { - $self->is_over(1); - return "$word is not a word. $challenger loses!"; - } - } - else { - $self->challenger($player); - $self->current_player($prev); - return "$player is challenging $prev!"; - } -}; - -command previous_player => sub { - my $self = shift; - return unless $self->has_current_player; - return $self->players->[$self->current_player_index - 1]; -}; - -command next_player => sub { - my $self = shift; - return unless $self->has_current_player; - return $self->players->[($self->current_player_index + 1) % $self->num_players]; -}; - -command valid_move => sub { 1 }; - -command valid_word_from_state => sub { - my $self = shift; - my ($word) = @_; - return uc($word) eq $self->state; -}; - -command give_up => sub { - my $self = shift; - $self->is_over(1); - return "Game over!"; -}; - -sub current_player_index { - my $self = shift; - for (0..($self->num_players - 1)) { - return $_ if $self->current_player eq $self->players->[$_]; - } - return 0; -} - -__PACKAGE__->meta->make_immutable; -no Bot::Games::OO; - -1; diff --git a/lib/Bot/Games/Game/Spook.pm b/lib/Bot/Games/Game/Spook.pm index 5780953..609bc06 100644 --- a/lib/Bot/Games/Game/Spook.pm +++ b/lib/Bot/Games/Game/Spook.pm @@ -2,7 +2,7 @@ package Bot::Games::Game::Spook; use Bot::Games::OO; use Games::Word qw/is_subpermutation/; -extends 'Bot::Games::Game::Ghostlike'; +extends 'Bot::Games::Game::Ghost'; has '+help' => ( default => "spook help", diff --git a/lib/Bot/Games/Game/Superghost.pm b/lib/Bot/Games/Game/Superghost.pm index df297ee..0784698 100644 --- a/lib/Bot/Games/Game/Superghost.pm +++ b/lib/Bot/Games/Game/Superghost.pm @@ -1,7 +1,7 @@ #!/usr/bin/perl package Bot::Games::Game::Superghost; use Bot::Games::OO; -extends 'Bot::Games::Game::Ghostlike'; +extends 'Bot::Games::Game::Ghost'; has '+help' => ( default => "superghost help", diff --git a/lib/Bot/Games/Game/Xghost.pm b/lib/Bot/Games/Game/Xghost.pm index 0c44cff..20dc19a 100644 --- a/lib/Bot/Games/Game/Xghost.pm +++ b/lib/Bot/Games/Game/Xghost.pm @@ -2,7 +2,7 @@ package Bot::Games::Game::Xghost; use Bot::Games::OO; use Games::Word qw/is_substring/; -extends 'Bot::Games::Game::Ghostlike'; +extends 'Bot::Games::Game::Ghost'; has '+help' => ( default => "xghost help", -- cgit v1.2.3-54-g00ecf