view release on metacpan or  search on metacpan

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

    int($it->{'tri_base'} * $SIN60 * $it->{'aspect'} + .5);

  $it->{'canvas_width'} = 2 * $it->{'inner_border'} +
        ($it->{'cells_wide'} + .5) * $it->{'tri_base'};
  $it->{'canvas_height'} = 2 * $it->{'inner_border'} +
        $it->{'cells_high'} * $it->{'tri_height'};

  $it->init;
  return $it;
}

sub init { return; } 

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

#sub worms { # return worms on this board (whether live or dead)
#  my $board = $_[0];
#  return @{$board->{'worms'}};
#}

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

sub tick { # do system update tasks -- override in derived classes
  return;
}

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

sub run {
  my($board, @Worm_names) = @_;

  $Games::Worms::Color_counter = 0;
  $board->{'generations'} = 0;
  @Worm_names = ('Games::Worms::Random2', 'Games::Worms::Random2',
                 'Games::Worms::Beeler', 'Games::Worms::Beeler',
                ) unless @Worm_names;

  my $n = 0;
  foreach my $w (@Worm_names) {
    my $rules = '';
    if($w =~ s</(.*)><>) {
      $rules = $1;
      $w = 'Games::Worms::Beeler' unless length $w;
    }

    unless(&_try_use($w)) {
      die "Can't use $w : $Use_Error\n";
    }
    $w->new(
      'current_node' =>
        $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;
  }

  $board->end_game;
  return;
}

#--------------------------------------------------------------------------
# Something to do once everything's died -- override in derived class
sub end_game { return; }

#--------------------------------------------------------------------------
# Whatever needs to be done to set up the status for the newly created
#  worms -- override in derived class
sub worm_status_setup { return; }

#--------------------------------------------------------------------------
# Basically a wrapper around "use Modulename"
my %tried = ();
sub _try_use {
  # "Many men have tried..."  "They tried and failed?"  "They tried and died."
  my $module = $_[0];   # ASSUME sane module name!

  return $tried{$module} if exists $tried{$module};  # memoization

  { no strict;
    return($tried{$module} = 1)
     if defined(%{$class . "::VERSION"}) || defined(@{$class . "::ISA"});
    # we never use'd it, but there it is!
  }

  die "illegal module name \"$module\"\n"
    unless $module =~ m/^[-a-zA-Z0-9_:']+$/s;
  print " About to use $module ...\n" if $Debug;
  {
    local $SIG{'__DIE__'} = undef;
    eval "package Nullius; use $module";
  }
  if($@) {
    print "Error using $module \: $@\n" if $Debug > 1;
    $Use_Error = $@;
    return($tried{$module} = 0);
  } else {
    print " OK, $module is used\n" if $Debug;
    $Use_Error = '';
    return($tried{$module} = 1);
  }
}

#--------------------------------------------------------------------------
# Initialize space -- link up nodes and segments