view release on metacpan or  search on metacpan

lib/Games/Nintendo/Mario.pm  view on Meta::CPAN

#pod Nintendo's long-running Mario franchise of games.  Each Mario object keeps
#pod track of the plumber's current state and can be damaged or given powerups to
#pod change his state.
#pod
#pod =cut

use Carp qw(cluck);

sub _names  { qw[Mario Luigi] }
sub _states { qw[normal] }
sub _items  { () }
sub _other_defaults { () }

sub _goto_hash   {
  { damage => 'dead' }
}

sub _goto {
  my $self = shift;
  my ($state, $item) = @_;
  my $goto = $self->_goto_hash;

  return unless exists $goto->{$item};
  return $goto->{$item} unless ref $goto->{$item} eq 'HASH';
  return $goto->{$item}{_else} unless $goto->{$item}{$state};
  return $goto->{$item}{$state};
}

#pod =method new
#pod
#pod   my $hero = Games::Nintendo::Mario->new(name => 'Luigi');
#pod
#pod The constructor for Mario objects takes two named parameters, C<name> and
#pod C<state>.  C<name> must be either "Mario" or "Luigi" and C<state> must be
#pod "normal"
#pod
#pod If left undefined, C<name> and C<state> will default to "Mario" and "normal"
#pod respectively.
#pod
#pod =cut

sub new {
  my $class = shift;
  my %args  = (name => 'Mario', state => 'normal', @_);

  unless (grep { $_ eq $args{name} } $class->_names) {
    cluck "bad name for plumber";
    return;
  }
  unless (grep { $_ eq $args{state} } $class->_states) {
    cluck "bad starting state for plumber";
    return;
  }

  my $plumber = {
    state => $args{state},
    name  => $args{name},
    $class->_other_defaults
  };

  bless $plumber => $class;
}

#pod =method powerup
#pod
#pod   $hero->powerup('hammer'); # this won't work
#pod
#pod As the base Games::Nintendo::Mario class represents Mario from the original
#pod Mario Bros., there is no valid way to call this method.  Subclasses
#pod representing Mario in other games may allow various powerup names to be passed.
#pod
#pod =cut

sub powerup {
  my $plumber = shift;
  my $item    = shift;

  if ($plumber->state eq 'dead') {
    cluck "$plumber->{name} can't power up when dead";
    return $plumber;
  }

  unless (grep { $_ eq $item } $plumber->_items) {
    cluck "$plumber->{name} can't power up with that!";
    return $plumber;
  }

  my $goto = $plumber->_goto($plumber->state,$item);

  $plumber->{state} = $goto if $goto;

  return $plumber;
}

#pod =method damage
#pod
#pod   $hero->damage;
#pod
#pod This method causes the object to react as if Mario has been attacked or
#pod damaged.  In the base Games::Nintendo::Mario class, this will always result in
#pod his death.
#pod
#pod =cut

sub damage {
  my $plumber = shift;

  my $goto = $plumber->_goto($plumber->state,'damage');

  $plumber->{state} = $goto if $goto;

  return $plumber;
}

#pod =method state
#pod
#pod   print $hero->state;
#pod
#pod This method accesses the name of Mario's current state.
#pod
#pod =cut