Games-Worms

 view release on metacpan or  search on metacpan

lib/Games/Worms/Base.pm  view on Meta::CPAN

  return int(rand($Directions));
}

sub can_zombie { 0 }
 # override with sub can_zombie { 1 } in a class that can be zombies

#--------------------------------------------------------------------------

sub try_move {
  my $worm = $_[0];
  return unless $worm->is_alive;
  if($Debug > 2) {
    sleep 1;
  }

  my $current_node = $worm->{'current_node'};

  my(%dir_2_uneaten_seg);
  my $i;
  foreach my $seg ($current_node->segments_away) {
    $dir_2_uneaten_seg{$i++} = $seg;

lib/Games/Worms/Base.pm  view on Meta::CPAN

}

#--------------------------------------------------------------------------

sub new {
  my $c = shift;
  $c = ref($c) || $c;
  my $it = bless { @_ }, $c;

  $it->{'uid'} = $uid++; # per-session unique, if we need it
  $it->{'is_alive'} = 1 unless defined $it->{'is_alive'};
  $it->{'color'} ||= $it->default_color;
  $it->{'segments_eaten'} = 0;
  $it->{'last_segment_eaten'} = 0;
  $it->{'memoize'} = $it->am_memoized;
  $it->{'can_zombie'} = $it->can_zombie;
  $it->{'is_undead'} = 1 unless defined $it->{'is_undead'};
  $it->{'memory'} = {};

  $it->init;

lib/Games/Worms/Base.pm  view on Meta::CPAN

}

sub am_memoized { 1; }
  # to block memoization, override with: sub am_memoized { 0; }

sub segments_eaten {
  my $it = $_[0];
  return $it->{'segments_eaten'};
}

sub is_alive { # regardless of whether undead or not
  my $it = $_[0];
  return $it->{'is_alive'};
}

#sub current_node {
#  my $it = $_[0];
#  return $it->{'current_node'};
#}

sub die {  # kill this worm.
  my $worm = $_[0];
  print " worm $worm dies\n" if $Debug;
  $worm->{'is_alive'} = 0;
  $worm->{'is_undead'} = 0;
}

sub really_die {  # kill this worm DEAD.
  my $worm = $_[0];
  print " worm $worm really dies\n" if $Debug;
  $worm->{'is_alive'} = 0;
  $worm->{'is_undead'} = 0;
}


sub eat_segment {
  my($worm, $segment) = @_[0,1];
  $worm->{'segments_eaten'}++;
  $worm->{'last_segment_eaten'} = $segment;

  if($worm->{'is_undead'}) {

lib/Games/Worms/Board.pm  view on Meta::CPAN

        $board->{'nodes'}[ rand(scalar( @{$board->{'nodes'}} )) ],
      'board' => $board,
      'rules' => $rules,
      'name' => $w . '(' . $n++ . ')',
    );
  }

  $board->worm_status_setup;

  while(1) {
    my @worms = grep {$_->is_alive} @{$board->{'worms'}};
    unless(@worms) { 
      print "All dead.\n" if $Debug;
      last;
    }
    foreach my $worm (@worms) { $worm->try_move }

  } continue {
    $board->{'generations'}++;
    $board->tick;
  }

t/03_pod_cover.t  view on Meta::CPAN

use Test::Pod::Coverage tests=>5;

# This module has a number of private methods whose names do not begin with
# _.  This is kind of unfortunate, but it's too late now to change things,
# so I will just manually omit them.

pod_coverage_ok(
	"Games::Worms::Base",
	{ also_private => [
		qw/^(?:am_memoized|be_not_undead|be_undead|can_zombie|default_color|die|eat_segment|init|initial_move|is_alive|is_undead|new|eally_die|segments_eaten|try_move|really_die)$/
	], },
	"Games::Worms::Base is covered"
);
pod_coverage_ok(
	"Games::Worms::Beeler",
	{ also_private => [qw/^(?:init|which_way)$/ ] },
	"Games::Worms::Beeler is covered"
);
pod_coverage_ok(
	"Games::Worms::Random",