combat.pl

#!/usr/bin/perl
use 5.10.1;
use strict;
use Getopt::Long;
use Pod::Usage;

our $VERSION = 0.1;
our $number = 100;
our $wimpy = 0;
our $man = {};
our $monster = "";
our $surprise = 0;
our $highdex = 0;
our $verbose = 0;
our $help = 0;
our $list = 0;

GetOptions(
  "number=i"      => \$number,  # Number of simulations to run
  "wimpy=f"       => \$wimpy,   # Wimpy mode
  "man=s%"        => \$man,     # Man
  "monster=s"     => \$monster, # Monster
  "surprise+"     => \$surprise,# flag
  "highdex=i"     => \$highdex, # high DEX for initiative bonus
  "verbose+"      => \$verbose, # flag
  "list"          => \$list,    # list the monsters implemented so far & exit
  "version|V"     => sub { VERSION(); exit; },
  'help|?'        => \$help)    or pod2usage(2);

pod2usage(1) if $help;

sub VERSION {
print <<EOF

This is combat.pl version $VERSION.

Help with command-line options should be found by using "combat.pl --help".
Complete documentation including copyright and license should be found by
using "perldoc combat.pl".
EOF
}

package Dice;
sub d20 {  int(rand(20)) + 1; }
sub d12 {  int(rand(12)) + 1; }
sub d10 {  int(rand(10)) + 1; }
sub d8  {  int(rand(8))  + 1; }
sub d6  {  int(rand(6))  + 1; }
sub d4  {  int(rand(4))  + 1; }

sub roll {
  my ($num,$sides) = @_;
  my $result = 0;
  while($num--) {
    $result += $sides->();
  }
  return $result;
}

our $d20 = \&d20;
our $d6 = \&d6;
our $d4 = \&d4;

package Logger;
sub log {
  my $msg = shift;
  if($verbose){
    print $msg;
  }
}

package Formatter;
sub s { # Number-sensitive plural "s" ending
  my $num = shift;
  if($num == 1 || $num =~ m/one/i){
    return "";
  } else {
    return "s";
  }
}

sub plus { # Return "+number" with plus sign if given number is positive
  my $num = shift;
  if($num > 0){
    return "+$num";
  } else {
    return "$num";
  }
}

package Statistics;
sub new {
  my $proto = shift;
  my $class = ref($proto) || $proto;
  my $name = shift;
  my $self  = { NAME=>$name, MIN=>undef, MAX=>undef, TOTAL=>0 };
  bless ($self, $class);
  return $self;
}

sub record {
  my $self = shift;
  my $round = shift;
  $self->{$round}++;
  $self->{TOTAL}++;
  if(!defined($self->{MAX}) || $round > $self->{MAX}) { $self->{MAX} = $round; }
  if(!defined($self->{MIN}) || $round < $self->{MIN}) { $self->{MIN} = $round; }
}

sub element {
  my $self = shift;
  my $x = shift;
  my $count = 0;
  if($self->{TOTAL} == 0) { return 0; }
  if($x > $self->{TOTAL}) { return 0; }
  for my $group ($self->{MIN} ..  $self->{MAX}) {
    $count += $self->{$group};
    if($count >= $x) { return $group; }
  }
  return 0;
}

sub moment {
  my $self = shift;
  my $power = shift;
  my $sum = 0;
  if($self->{TOTAL} == 0) { return 0; }
  if(!defined($power)) { $power = 1; }
  for my $group ($self->{MIN} ..  $self->{MAX}) {
    $sum += ($group**$power) * ($self->{$group});
  }
  return $sum/$self->{TOTAL};
}

sub sd {
  my $self = shift;
  my $mean = $self->moment();
  my $mu2 = $self->moment(2);
  my $n =  $self->{TOTAL};
  if($n <= 1) { return "NaN"; }
  return sqrt(($n/($n - 1)) * ($mu2 - $mean**2));
}

sub min {
  my $self = shift;
  !defined($self->{MIN}) ? "NaN" : $self->{MIN};
}

sub max {
  my $self = shift;
  !defined($self->{MAX}) ? "NaN" : $self->{MAX};
}

sub median {
  my $self = shift;
  my $x;
  if($self->{TOTAL} == 0) { return "NaN"; }
  if($self->{TOTAL} % 2 == 0) {
    $x = $self->{TOTAL} / 2;
    return ($self->element($x) + $self->element($x + 1))/2;
   } else {
    $x = ($self->{TOTAL} + 1) / 2;
    return $self->element($x);
   }
}

package Items;
our @Armor = ("AC 0", "AC 1", "Plate Armor & Shield", "Plate Armor", "Chain Mail & Shield", "Chain Mail", "Leather & Shield", "Leather Armor", "Shield Only", "No Armor or Shield");

package Thing;

our @Abilities = ("STR","INT","WIS","CON","DEX","CHA");

sub new {
  my $proto = shift;
  my $class = ref($proto) || $proto;
  my (%params) = @_;
  my $self  = {
    NAME => $params{"NAME"},
    STR => $params{"STR"},
    INT => $params{"INT"},
    WIS => $params{"WIS"},
    CON => $params{"CON"},
    DEX => $params{"DEX"},
    CHA => $params{"CHA"},
    AC => $params{"AC"},
    XP => $params{"XP"},
    LEVEL => $params{"LEVEL"},
    HD => $params{"HD"},
    MAXHP => $params{"MAXHP"},
    CURHP => $params{"CURHP"},
    RACE => $params{"RACE"},
    ALIGN => $params{"ALIGN"},
    MONEY => $params{"MONEY"},
    ENCUMBRANCE => $params{"ENCUMBRANCE"},
    ITEMS => $params{"ITEMS"},  # This should be an array reference
    SPELLS => $params{"SPELLS"} # Ditto
  };
  bless ($self, $class);
  return $self;
}

sub as_string {
  my $self = shift;
  Logger::log(sprintf("%s [MV %d\", AC %d, HD %s, hp %d/%d]\n",
    $self->{NAME},
    $self->{MV},
    $self->AC(),
    $self->HD_as_string(),
    $self->{CURHP},
    $self->{MAXHP}));
}

# HD could be its own object with these methods:
# HD.as_string(), HD.dice(), HD.bonus()
sub HD_as_string {
  my $self = shift;
  my ($ndice,$plusses) = ($self->{HD}->[0], $self->{HD}->[1]);
  if($ndice == 1/2) { $ndice = "1/2"; }
  return $plusses ? $ndice . Formatter::plus($plusses) : $ndice;
}

sub HD_dice {
  my $self = shift;
  return $self->{HD}->[0];
}
sub HD_bonus {
  my $self = shift;
  return $self->{HD}->[1];
}

sub AC {
  my $self = shift;
  return $self->{AC};
}

sub surprised {
  my $self = shift;
  if (@_) { $self->{SURPRISED} = shift }
  Logger::log($self->{NAME} . " is surprised for " . $self->{SURPRISED} .
    " round" . Formatter::s($self->{SURPRISED}) . ".\n");
  return $self->{SURPRISED};
}

sub disarmed {
  my $self = shift;
  if (@_) { $self->{DISARMED} = shift }
  Logger::log($self->{NAME} . " drops his weapon!\n");
  return $self->{DISARMED};
}

sub check_initiative {
  my $self = shift;
  # The commented out code gives a +1 bonus for high DEX
  if( $self->{HIGHDEX} && $self->{DEX} >= $self->{HIGHDEX} ){
    Logger::log($self->{NAME} . "'s high DEX (" . $self->{DEX} .
      ") gives him a +1 to initiative.\n");
    $self->{INITIATIVE} = Dice::d6() + 1;
  } else {
    $self->{INITIATIVE} = Dice::d6();
  }
  Logger::log($self->{NAME} . " throws " . $self->{INITIATIVE} . " initiative.\n");
  return $self->{INITIATIVE};
}

sub check_surprise {
  my $self = shift;
  my $roll = Dice::d6();
  if($roll == 1 || $roll == 2) {
    if($main::surprise) {
      $self->surprised($roll); # 1 or 2 rounds of surprise
    } else {
      $self->surprised(1); # only ever 1 surprise round
    }
    $self->check_drop();
  }
}

sub check_drop {
  my $self = shift;
  if( Dice::d4() == 1 ){
    return $self->disarmed(1);
  }
}

sub is_dead {
  my $self = shift;
  if( $self->{CURHP} <= 0 ){
    return 1;
  } else {
    return 0;
  }
}

sub flees { # Check if Thing will flee. Perform calculation here.
  my $self = shift;
  return 0; # fight-to-the-death by default.
  # Right now, this is only used to implement Diku-/LP- MUD-style "wimpy"
  # mode in the "Man" class. But could be overridden in the monster class or
  # future CM classes to implement morale checks and routs...although I will
  # probably implement check_morale later and override that to implement a
  # "wimpy" mode option.
}
sub fled { # Thing has fled (past tense): No calculation performed here.
  my $self = shift;
  return 0; # fight-to-the-death by default.
}

# Calculate chance to hit target
sub to_hit {
  my $self = shift;
  my $ac = shift;
  # N.B. Right now, this method's argument is AC because this is LBB ACS.
  # In the future, we might want to change this to the target's object.
  # For example, if we implement CM's CT, we need to know type of attacker
  # and defender, e.g., Heavy Foot versus Medium Horse. AC doesn't make sense
  # here. But if we implement CM's Man-to-Man table, we need to know attacker's
  # weapon type and defender's armor class, which we can always get from the
  # objects, e.g., $self->{WT}, $target->AC().
  die "Called pure virtual method: Thing::to_hit.";
  # This is a pure virtual method. Must be overriden by subclasses.
}

# Roll for HP
sub roll_hp {
  my $self = shift;
  my $HP;
  my ($ndice,$plusses) = ($self->{HD}->[0],$self->{HD}->[1]);
  # Take account of half n(umber of)dice
  if($ndice == 1/2) {
    $HP = int((Dice::d6() + 1)/2) + $plusses;
  } else {
    $HP = Dice::roll($ndice,$Dice::d6) + $plusses;
  }
  # Take account of negative "plusses" bringing the result to zero (or less)
  if($HP <= 0) { $HP = 1; }
  return $HP;
}

# Roll for damage
sub calc_damage {
  my $self = shift;
  my $damage = Dice::d6();
  Logger::log($self->{NAME} . " throws " . $damage . " hp of damage.\n");
  return $damage;
}

sub on_hit {
  # Event Handler
  # called after successfully hitting victim
  my $self = shift;
  my $victim = shift;
  # subclasses should override this method if they have special attacks, e.g.,
  # $self->paralyze($victim); # for ghouls
}

sub on_damage {
  # Event Handler
  # called when damage is to be applied
  my $self = shift;
  my $damage = shift;
  $self->{CURHP} -= $damage;
  Logger::log($self->{NAME} . " sustains " . $damage . " hp of damage" .
    " and has " . $self->{CURHP} . " hp remaining.\n");
}

sub on_dead {
  my $self = shift;
  Logger::log($self->{NAME} . " is slain.\n");
}

package Man;
@Man::ISA = ("Thing");

our %MenAttacking = (
#       Level
# AC    1-3  4-6  7-9  10-12  13-15   16&+
  2 =>  [17,  15,  12,   10,     8,     5],
  3 =>  [16,  14,  11,    9,     7,     4],
  4 =>  [15,  13,  10,    8,     6,     3],
  5 =>  [14,  12,   9,    7,     5,     2],
  6 =>  [13,  11,   8,    6,     4,     1],
  7 =>  [12,  10,   7,    5,     3,     1],
  8 =>  [11,   9,   6,    4,     2,     1],
  9 =>  [10,   8,   5,    3,     1,     1]
);

sub to_hit {
  my $self = shift;
  my $ac = shift;
  my $group = int(($self->{LEVEL} - 1)/$self->{STEP});
  return $MenAttacking{$ac}->[$group];
}

# wimpy mode
# TODO: You can only flee on your move.  You must have initiative.
# You can't be dead, paralyzed or surprised, but you can be disarmed.

sub flees {
  my $self = shift;
  my $wimpy = $self->{WIMPY};
  if($wimpy == 0) { return 0; } # wimpy mode is off
  # Can't flee if you can't move (dur to death, paralysis or surprise
  if($self->{PARALYZED} || $self->{SURPRISED} || $self->is_dead()) {
    return 0;
  }
  if(int($wimpy) == $wimpy) {   # wimpy is an integer
    if($self->{CURHP} <= $wimpy){
      $self->{FLED} = 1;
      return 1;
    } else { return 0; }
  }
  # wimpy is a fraction of max hp
  elsif($self->{CURHP} <= int($wimpy * $self->{MAXHP})) {
    $self->{FLED} = 1;
    return 1;
  } else { return 0; }
}

sub fled {
  my $self = shift;
  return $self->{FLED};
}

sub wimpy {
  my $self = shift;
  my $wimpy = shift;
  $self->{WIMPY} = $wimpy;
  if($wimpy) {
    Logger::log($self->{NAME} . "'s wimpy mode turned on and set to " .
      $wimpy ."\n");
  } else {
    #Logger::log($self->{NAME} . "'s wimpy mode turned off\n");
  }
  return $wimpy;
}

sub highdex {
  my $self = shift;
  my $highdex = shift;
  $self->{HIGHDEX} = $highdex;
  if($highdex) {
    Logger::log($self->{NAME} . "'s highdex mode turned on and set to " .
      $highdex ."\n");
  } else {
    #Logger::log($self->{NAME} . "'s highdex mode turned off\n");
  }
  return $highdex;
}


package FightingMan;
@FightingMan::ISA = ("Man");

our @XP = (0, 0, 2000, 4000, 8000, 16_000, 32_000, 64_000, 120_000, 240_000, 360_000);
our @Title = ("Normal Man", "Veteran", "Warrior", "Swordsman", "Hero", "Swashbuckler", "Myrmidon", "Champion", "Superhero", "Lord", "Lord, 10th Level");
our @HD = ( [1,0], [1,1], [2,0], [3,0], [4,0], [5,1], [6,0], [7,1], [8,2], [9,3], [10,1]);

sub new {
  my $proto = shift;
  my $class = ref($proto) || $proto;
  my($self) = $class->SUPER::new(@_);
  $self->{"STEP"} = 3;
  bless ($self,$class);
  return $self;
}

sub rand {
  my $self = shift;

# Use these defaults if they're not defined.
# If they're defined, don't modify them...
  if(!defined($self->{LEVEL})){ $self->{LEVEL} = 1; }
  if(!defined($self->{AC})){ $self->{AC} = 6; }
  if(!defined($self->{MV})){ $self->{MV} = 12; }

# Set these appropriately by level...
  $self->{HD} = $HD[$self->{LEVEL}];
  $self->{XP} = $XP[$self->{LEVEL}];
  $self->{NAME} = $Title[$self->{LEVEL}];

# Randomize these...
  $self->{MAXHP} =
    $self->{CURHP} =
      $self->roll_hp();
# Roll 3d6 in order for ability scores
  foreach my $ability (@Abilities) {
    $self->{$ability} = Dice::roll(3,$Dice::d6);
  }

# Reset these...
  $self->{SURPRISED} = 0;
  $self->{DISARMED} = 0;
  $self->{PARALYZED} = 0;
  $self->{INITIATIVE} = 0;
  $self->{FLED} = 0;
}

# Saving throws...These are class/level/type specific, more so than Men
# Attacking table where you can use the same table and just regroup it
# 1-3,1-4,1-5 based on class. Therefore, I'm going to implement SVs at this
# level of the code.

# Saving throw for all wands, including polymorph and paralization
# See MM/10.
sub save_versus_paralization {
  my $self = shift;
  my $condition = shift;
  my $row = int(($self->{LEVEL} - 1)/3);
  my @saving_throw = (13,11,9,7,5);
  my $saving_throw = $row > 4 ? 5 : $saving_throw[$row];
  my $throw = Dice::d20();
  Logger::log($self->{NAME} . " requires a roll of at least " . $saving_throw .
    " to save versus " . $condition . ", and throws " . $throw . "\n");
  return ($throw >= $saving_throw);
}

package MagicUser;
@MagicUser::ISA = ("Man");
sub new {
  my $proto = shift;
  my $class = ref($proto) || $proto;
  my($self) = $class->SUPER::new(@_);
  $self->{"STEP"} = 5;
  bless ($self,$class);
  return $self;
}

package Cleric;
@Cleric::ISA = ("Man");
sub new {
  my $proto = shift;
  my $class = ref($proto) || $proto;
  my($self) = $class->SUPER::new(@_);
  $self->{"STEP"} = 4;
  bless ($self,$class);
  return $self;
}

package Monster;
@Monster::ISA = ("Thing");

our %MonstersAttacking = (
#        HD Up to
# AC       1  1+1  2-3  3-4  4-6  6-8  9-10  11&+
  2 =>   [17,  16,  15,  13,  12,  11,    9,   7],
  3 =>   [16,  15,  14,  12,  11,  10,    8,   6],
  4 =>   [15,  14,  13,  11,  10,   9,    7,   5],
  5 =>   [14,  13,  12,  10,   9,   8,    6,   4],
  6 =>   [13,  12,  11,   9,   8,   7,    5,   3],
  7 =>   [12,  11,  10,   8,   7,   6,    4,   2],
  8 =>   [11,  10,   9,   7,   6,   5,    3,   1],
  9 =>   [10,   9,   8,   6,   5,   4,    2,   0]
);

sub to_hit {
  my $self = shift;
  my $ac = shift || 9;
  my ($dice, $plusses) = ($self->{HD}->[0], $self->{HD}->[1]);
  my $group;
  if($dice == 1/2)                   { $group = 0; }
  elsif($dice == 1 && $plusses <= 0) { $group = 0; }
  elsif($dice == 1 && $plusses  > 0) { $group = 1; }
  elsif($dice == 2)                  { $group = 2; }
  elsif($dice == 3 && $plusses <= 0) { $group = 2; }
  elsif($dice == 3 && $plusses  > 0) { $group = 3; }
  elsif($dice == 4 && $plusses <= 0) { $group = 3; }
  elsif($dice == 4 && $plusses  > 0) { $group = 4; }
  elsif($dice == 5)                  { $group = 4; }
  elsif($dice == 6 && $plusses <= 0) { $group = 4; }
  elsif($dice == 6 && $plusses  > 0) { $group = 5; }
  elsif($dice == 7)                  { $group = 5; }
  elsif($dice == 8)                  { $group = 5; }
  elsif($dice == 9)                  { $group = 6; }
  elsif($dice == 10)                 { $group = 6; }
  else                               { $group = 7; } # $dice >= 11
  return $MonstersAttacking{$ac}->[$group];
}

sub rand {
  my $self = shift;
  $self->{MAXHP} =
    $self->{CURHP} =
      $self->roll_hp();

  if(!defined($self->{AC})){ $self->{AC} = 6; }
  if(!defined($self->{MV})){ $self->{MV} = 9; }

# Reset these...
  $self->{SURPRISED} = 0;
  $self->{DISARMED} = 0;
  $self->{PARALYZED} = 0;
  $self->{INITIATIVE} = 0;
  $self->{FLED} = 0;
}

package Ghoul;
@Ghoul::ISA = ("Monster");

sub new {
  my $proto = shift;
  my $class = ref($proto) || $proto;
  my($self) = $class->SUPER::new(
    HD=>[2,0],MV=>9,AC=>6,NAME=>"Ghoul",
    @_);
  bless ($self,$class);
  return $self;
}

sub on_hit {
  # Event Handler
  # called after successfully hitting victim
  my $self = shift;
  my $victim = shift;
  $self->paralyze($victim);
}

sub paralyze {
  # When a ghoul successfully hits a victim,
  # the victim must save versus paralization
  # or he's paralyzed for 2d4 turns
  my $self = shift;
  my $victim = shift;
  # Elves are immune from paralization
  if($victim->{RACE} eq "ELF") { return; }
  if(!$victim->save_versus_paralization("paralysis")) {
    my $duration = Dice::roll(2,$Dice::d4);
    Logger::log("Fails! " . $victim->{NAME} . " is paralysed for " .
      $duration . " rounds.\n");
    if($victim->{PARALYZED} <= $duration) { # if the victim is already paralyzed
      $victim->{PARALYZED} = $duration;     # for longer, do nothing
    }
  }
}

package Ogre;
@Ogre::ISA = ("Monster");

sub new {
  my $proto = shift;
  my $class = ref($proto) || $proto;
  my($self) = $class->SUPER::new(
    NAME=>"Ogre",AC=>5,MV=>9,HD=>[4,1],
    @_);
  bless ($self,$class);
  return $self;
}

# Ogres cause 3-8 (1d6+2) damage per hit
sub calc_damage {
  my $self = shift;
  my $damage = Dice::d6() + 2;
  Logger::log($self->{NAME} . " throws " . $damage . " hp of damage.\n");
  return $damage;
}

package MonsterFactory;

our @Monsters = qw(Skeleton Zombie Goblin Orc Hobgoblin Ghoul Gnoll Ogre);

sub CreateMonster {
  my $self = shift;
  my $type = shift;
  if($type eq "") {
    $type = $Monsters[Dice::d8() - 1];
    printf "Monster not specified. Randomizing... $type.\n";
  }
  for ($type) {
    when (/Skeleton/i) { return Monster->new(NAME=>"Skeleton",
      AC=>7,MV=>6,HD=>[1/2,0]); } # TODO: never ck morale
    when (/Zombie/i) { return Monster->new(NAME=>"Zombie",
      AC=>8,MV=>6,HD=>[1,0]); } # TODO: never ck morale
    when (/Hobgoblin/i) { return Monster->new(NAME=>"Hobgoblin",
      AC=>5,MV=>9,HD=>[1,1]); } # TODO: +1 morale
    # TODO: Orcs and Goblins suffer -1 penalties to attack/morale in daylight
    when (/Goblin/i) { return Monster->new(NAME=>"Goblin",
      AC=>6,MV=>6,HD=>[1,-1]); }
    when (/Orc/i) { return Monster->new(NAME=>"Orc",
      AC=>6,MV=>9,HD=>[1,0]); }
    when (/Ghoul/i) { return Ghoul->new(); }
    when (/Gnoll/i) { return Monster->new(NAME=>"Gnoll",
      AC=>5,MV=>9,HD=>[2,0]); } # TODO: +2 morale
    when (/Ogre/i) { return Ogre->new(); }
    default { die "Couldn't create monster '$type'\n"; }
    }
}

sub ListMonsters {
  my $self = shift;
  print "The available monsters are ", join(", ", @Monsters), "\n";
}

package ManFactory;

sub CreateMan {
  my $self = shift;
  my $params = shift;
  my ($LEVEL, $AC);
  $LEVEL = $$params{LEVEL};
  $AC = $$params{AC};
  if(!defined($LEVEL)) {
    # This gives 15% chance to levels 1-2; 10% chance to levels 3-9
    # $LEVEL = ((Dice::d20() - 1) % 9) + 1;
    # This gives level 1 prob 1/6 & levels 2-6 with prob (7-level)/18
    $LEVEL = abs(Dice::roll(2,$Dice::d6) - 7) + 1;
    printf "No level for Fighting Man specified. Randomizing... $LEVEL.\n";
  }
  if(!defined($AC)) {
    $AC = Dice::d8() + 1;
    printf "No AC for Fighting Man specified. Randomizing... $AC.\n";
  }
  return FightingMan->new(LEVEL=>$LEVEL,AC=>$AC);
}

package TurnSequence;
sub new {
  my $proto = shift;
  my $class = ref($proto) || $proto;
  my ($sidea,$sideb) = @_;
  my $self = {QUEUE=>[[$sidea,$sideb],[$sideb,$sidea]]};
  # TODO: SimultaneousMovementSystem should override this constructor,
  # make a deep copy of $sideb called $sidebcopy, and do this...
  #   my $self = {QUEUE=>[[$sidea,$sideb],[$sidebcopy,$sidea]]};
  # That way, any changes to $sideb on $sidea's turn will not affect
  # how $sideb performs on it's turn.
  bless($self,$class);
  return $self;
}

sub resolve {
  my $self = shift;
  until($self->is_done()) {
      $self->begin_turn();
    # A full turn sequence might go through the following phases:
    # $self->fire_missiles();
    # $self->cast_spells();
    # Turning on wimpy mode allows the man to flee on his move() if he's low on hp
      $self->move();
    # For now we're primarily interested in melee()
      $self->melee()
        unless $self->attacker()->fled();
      $self->end_turn();
  }
}

sub attacker {
  my $self = shift;
  return $self->{SIDEA};
}

sub defender {
  my $self = shift;
  return $self->{SIDEB};
}

sub begin_turn {
  my $self = shift;
  my $next = shift @{$self->{QUEUE}};
  if(defined($next)) {
    ($self->{SIDEA}, $self->{SIDEB}) = ($next->[0],$next->[1]);
  } else { die "Bad turn!\n"; }
}

sub is_done {
  my $self = shift;
  return scalar @{$self->{QUEUE}} == 0;
}

sub move {
  my $self = shift;
  if($self->attacker()->flees()) {
    Logger::log($self->attacker()->{NAME} . " flees.\n");
  }
}

sub melee {
  my $self = shift;

  if($self->attacker()->{INITIATIVE} != 0) {
    if($self->defender()->{PARALYZED}) {
      # Paralysed victims are automatically hit each round.
      Logger::log($self->attacker()->{NAME} . " attacks paralyzed " . $self->defender()->{NAME} .
        " on initiative ". $self->attacker()->{INITIATIVE} ." and hits automatically.\n");
      $self->apply_damage();
    } else {
      my ($to_hit, $throw) = ($self->attacker()->to_hit($self->defender()->AC()), Dice::d20());
      Logger::log($self->attacker()->{NAME} . " attacks " . $self->defender()->{NAME} .
        " on initiative " . $self->attacker()->{INITIATIVE} . ", requiring at least " .
        $to_hit . " to hit and throws " . $throw . "\n");
      if($self->defender()->{SURPRISED}){
        $throw += 4;
        Logger::log($self->defender()->{NAME} . " is surprised, adjusting attack throw by +4 to " . $throw. "\n");
      }
      # TODO: Monster makes up to HD attacks versus men up to 1 HD
      # and Monster applies HD bonus to one attack
      #if($self->attacker()->isa("Monster") && $self->attacker()->HD_bonus()){
      #  $throw += $self->attacker()->HD_bonus();
      #  Logger::log($self->attacker()->{NAME} . " adds it's HD bonus, adjusting attack throw by " . Formatter::plus($self->attacker()->HD_bonus()) . " to " . $throw. "\n");
      #}
      if($throw >= $to_hit){
        Logger::log($self->defender()->{NAME} . " is hit.\n");
        $self->apply_damage();
      }
    }
  }
}

sub apply_damage {
  my $self = shift;
  my $damage =
    $self->attacker()->calc_damage();
  $self->defender()->on_damage($damage);
  $self->attacker()->on_hit($self->defender());
  if($self->defender()->is_dead()) {
    $self->defender()->on_dead();
  }
}

sub end_turn {
  my $self = shift;
  die "Pure virtual method 'TurnSequence::end_turn()' called\n";
}

package MoveCountermoveSystem;
@MoveCountermoveSystem::ISA = ("TurnSequence");

sub end_turn {
  my $self = shift;

  # Check that defender still has a turn
  return if($self->is_done());

  # In the following cases, the defender doesn't get his turn
  # because of some new condition: death, paralysis, fled, etc.
  if($self->defender()->is_dead() ||
    $self->defender()->{PARALYZED} ||
    $self->attacker()->fled()) {
    shift @{$self->{QUEUE}};
  }
}

package SimultaneousMovementSystem;
@SimultaneousMovementSystem::ISA = ("TurnSequence");

sub end_turn {
  my $self = shift;

  # Check that defender still has a turn
  return if($self->is_done());

  # In the following cases, the defender only gets his turn because he attacks simultaneously
  if($self->defender()->is_dead()) {
    Logger::log($self->defender()->{NAME} .
      " has been slain but attacks with simultaneous initiative.\n");
  } elsif($self->defender()->{PARALYZED} && $self->defender()->{INITIATIVE}) {
    # $self->defender() combatant was paralyzed this round but attacks simultaneously
    # TODO: Do we need to $self->defender()->{PARALYZED}++ in this case due to simultaneity???
    Logger::log($self->defender()->{NAME} .
      " is paralysed for " . $self->defender()->{PARALYZED} .
      " rounds but attacks simultaneously this round.\n");
  }
}

sub move {
  my $self = shift;
  # TODO: To simplify things for now, we don't allow a man to flee
  # on simultaneous initiative.
  # Alternatively: You could allow the attacker to disengage by
  # up to 1/2 move, but give defender attack of opportunity.
  # Or: You could allow defender to retreat--full move--but
  # defender gets attack of opportunity at +2 to hit.
}

package Combat;

sub new {
  my $proto = shift;
  my $class = ref($proto) || $proto;
  my ($man,$monster,$number,$highdex,$wimpy) = @_;
  my $self = {};

  # Choose opponents
  $self->{MONSTER} = MonsterFactory->CreateMonster($monster);

  $self->{MAN} = ManFactory->CreateMan($man);
  $self->{MAN}->rand(); # need to do this to set his name as a fxn of cls/lvl
  $self->{MAN}->highdex($highdex);
  $self->{MAN}->wimpy($wimpy);

  # These objects will tally simulation results
  $self->{WIN} = Statistics->new("wins");
  $self->{LOSE} = Statistics->new("loses");
  $self->{DRAW} = Statistics->new("draws");
  $self->{FLEES} = Statistics->new("flees");

  $self->{NUMBER} = $number;

  bless($self,$class);
  return $self;
}

sub check_surprise {
  my $self = shift;
  Logger::log("Surprise is checked...\n");
  Logger::log($self->{MONSTER}->{NAME} . " attempts to surprise " . $self->{MAN}->{NAME} . "\n");
  $self->{MAN}->check_surprise();
  Logger::log($self->{MAN}->{NAME} . " attempts to surprise " . $self->{MONSTER}->{NAME} . "\n");
  $self->{MONSTER}->check_surprise();
}

sub check_distance {
  my $self = shift;
  # TODO: In the future, combatants must close distance to melee
  # But may keep distance to fire missiles or cast spells.
  # There is a difference between underworld distance and wilderness distance. See U&WA.
  # E.g., underworld distance = 4" + d6" = 5"-10"
}

sub check_initiative {
  my $self = shift;

  # Check initiative
  # Combatants who are surprised, disarmed or paralyzed don't have initiative
  # Otherwise, have each combatant roll for initiative
  foreach my $i ($self->{MONSTER}, $self->{MAN}) {
    if($i->{SURPRISED}){
      Logger::log($i->{NAME} . " is surprised and has no initiative.\n");
      $i->{INITIATIVE} = 0;
    } elsif($i->{SURPRISED} == 0 && $i->{DISARMED} == 1) {
      Logger::log($i->{NAME} . " is disarmed and cannot attack, instead spending the round re-arming.\n");
      $i->{INITIATIVE} = 0;
    } elsif($i->{PARALYZED}) {
      Logger::log($i->{NAME} . " is paralyzed and cannot attack.\n");
      $i->{INITIATIVE} = 0;
    } else {
      $i->check_initiative();
    }
  }

  # Put combatants in order of initiative, highest to lowest
  if($self->{MAN}->{INITIATIVE} > $self->{MONSTER}->{INITIATIVE}){
    return MoveCountermoveSystem->new($self->{MAN}, $self->{MONSTER});
  } elsif ($self->{MAN}->{INITIATIVE} < $self->{MONSTER}->{INITIATIVE}){
    return MoveCountermoveSystem->new($self->{MONSTER}, $self->{MAN});
  } else { # initiative is equal
    return SimultaneousMovementSystem->new($self->{MONSTER}, $self->{MAN});
  }
}

sub round {
  my $self = shift;
  my $round = shift;
  Logger::log("\n--- ROUND NUMBER $round ---\n");

  # Check initiative
  Logger::log("Initiative is checked...\n");
  my $turn_sequence =
    $self->check_initiative();

  # Resolve attacks
  Logger::log("Attacks are resolved...\n");
  $turn_sequence->resolve();

  # End of round cleanup
  $self->post_exchange_of_blows();
}

sub post_exchange_of_blows {
  my $self = shift;
  # Basically, these are state transitions for surprised and disarmed combatants
  foreach my $i ($self->{MONSTER}, $self->{MAN}) {
    if($i->{SURPRISED} == 0 && $i->{DISARMED} == 1) {
      $i->{DISARMED} = 0;
    }
    if($i->{SURPRISED}){
      $i->{SURPRISED}--;
    }
    if($i->{PARALYZED}){
      $i->{PARALYZED}--;
    }
  }
}

sub initialize {
  my $self = shift;

  # Randomize opponents OR reset comatants to max hit points
  $self->{MONSTER}->rand();
  $self->{MAN}->rand();
  Logger::log("\n" . $self->{MONSTER}->{NAME} . " encounters " . $self->{MAN}->{NAME} . "\n");
  $self->{MONSTER}->as_string();
  $self->{MAN}->as_string();
}

sub record {
  my $self = shift;
  my $round = shift;

  Logger::log("\n=== RESULT ===\n");
  if($self->{MONSTER}->is_dead() && $self->{MAN}->is_dead()){
    Logger::log($self->{MAN}->{NAME} . " and " . $self->{MONSTER}->{NAME} .
      " have slain each other in " . $round . " round" . Formatter::s($round) .
      ".\n");
    $self->{DRAW}->record($round);
  } elsif ($self->{MONSTER}->is_dead()) {
    Logger::log($self->{MAN}->{NAME} . " has slain " . $self->{MONSTER}->{NAME} .
      " in " . $round . " round" . Formatter::s($round) . ".\n");
    $self->{WIN}->record($round);
  } elsif($self->{MAN}->is_dead()) {
    Logger::log($self->{MONSTER}->{NAME} . " has slain " . $self->{MAN}->{NAME} .
      " in " . $round . " round" . Formatter::s($round) . ".\n");
    $self->{LOSE}->record($round);
  } elsif($self->{MAN}->fled()) {
    Logger::log($self->{MAN}->{NAME} . " fled after " .
      $round . " round" . Formatter::s($round) . ".\n");
    $self->{FLEES}->record($round);
  }
}

sub encounter {
  my $self = shift;
  my $encounter = shift;
  my $round = 0; # reset clock

  Logger::log("\n~~~ ENCOUNTER $encounter ~~~\n");
  $self->initialize();

  $self->check_surprise();
  $self->check_distance();

  # Loop until someone dies or routs
  until($self->{MONSTER}->is_dead() ||
    $self->{MAN}->is_dead() || $self->{MAN}->fled()){
    $self->round(++$round);
  }

  $self->record($round);
}

sub simulate {
  my $self = shift;
  print "\n" . $self->{MONSTER}->{NAME} . " encounters " . $self->{MAN}->{NAME} . "\n";
  for my $n (1..$self->{NUMBER}){
    $self->encounter($n);
  }
}

# Display the final results in plain text
# You could have as_html(), as_csv(), or save() as well
sub as_string_old {
  my $self = shift;
  print "\n*** FINAL TALLY ***\n";
  my @results = ($self->{WIN},$self->{LOSE},$self->{DRAW});
  if($self->{MAN}->{WIMPY}) { push(@results, $self->{FLEES}); }
  foreach my $result (@results) {
    print $self->{MAN}->{NAME} .  " " . $result->{NAME} . " " . $result->{TOTAL} .
      " times: " .
      " min " . $result->min() .
      ", med " . $result->median() .
      ", max " . $result->max() .
      ", mean " . sprintf("%5.2f",$result->moment()) .
      #", mu2 " . sprintf("%5.2f",$result->moment(2)) .
      ", sd " . sprintf("%5.2f",$result->sd()) .
      " rounds.\n" ;
  }
}

sub as_string {
  my $self = shift;
  print "\n*** FINAL TALLY ***\n";
  my @results = ($self->{WIN},$self->{LOSE},$self->{DRAW});
  if($self->{MAN}->{WIMPY}) { push(@results, $self->{FLEES}); }

  my $max = 0;

  foreach my $result (@results) {
    print $self->{MAN}->{NAME} .  " " . $result->{NAME} . " " . $result->{TOTAL} .
      " times. Round:" .
      " min " . $result->min() .
      ", med " . $result->median() .
      ", max " . $result->max() .
      ", mean " . sprintf("%5.2f",$result->moment()) .
      #", mu2 " . sprintf("%5.2f",$result->moment(2)) .
      ", sd " . sprintf("%5.2f",$result->sd()) .
      " \n" ;

    $max = ($result->max() > $max) ? $result->max() : $max;
  }

}

##########     M A I N    R O U T I N E     ##########

if($list) { MonsterFactory->ListMonsters(); exit }

my $combat = Combat->new($man,$monster,$number,$highdex,$wimpy);
$combat->simulate();
$combat->as_string();

__END__

=head1 NAME

combat.pl - ODE<amp>D combat simulator

=head1 SYNOPSIS

  combat.pl [options]

Examples:

  combat.pl --man LEVEL=2 --man AC=4 --monster=Ogre

  combat.pl --list

  combat.pl --verbose

  combat.pl --number 10000

=head1 OPTIONS

=over 8

=item B<--man>

Specify options for the Fighting Man. Currently supported options are:

=over 8

=item B<LEVEL=integer>

Level of the Fighting Man. Note that LEVEL must be all uppercase. If no level is specified, one is generated at random, with lower levels weighted more heavily.

=item B<AC=integer>

Armor Class of the Fighting Man. Note that AC must be all uppercase. If no AC is specified, one is generated at random with equal probability from 2 to 9.

=back

=item B<--monster>

Specify the monster to use. If none is specified, choose one at random with equiprobability.

=item B<--list>

Print the list of available monsters and exit.

=item B<--number>

Specify the number of simulations to run. The default is 100.

=item B<--verbose>

Print a blow-by-blow description of each simulated combat. Otherwise, only the final tallies are printed.

=item B<--highdex>

The Fighting Man's dexterity is generated at random using 3d6. If it's equal to or greater than this integer value, he get's a +1 bonus to initiative as per the FAQ in the Strategic Review No 2. By default, no bonus for high dexterity is granted.

=item B<--surprise>

By default, we check surprise by rolling 1d6 for each combatant, and on a 1 or 2, the combatant is surprised for one round. By turning on this option, the combatant will be surprised for one round on a 1 and two rounds on a 2, as per Gary Gygax's 3 LBB house rules.

=item B<--wimpy>

Emulate the wimpy mode from DikuMUD or LPMud. You must specify either a positive integer or a fraction. If you specify an integer value, the Fighting Man will attempt to flee combat when his hit points fall to or below this value. He may not be able to flee if he's helpless (e.g., paralyzed, stunned, surprised) or if he dies before getting his turn to move. If you specify a fraction, the man attempts to flee as soon as his current HPs fall to or below the fraction of his maximum HPs.

By "flee" we mean "disengage" (as opposed to "retreat") as per Philotomy's "Rules for Melee & Movement." See E<lt>http://web.archive.org/web/20101126040841/http://philotomy.com/combat_sequence.htmlE<gt>.

=item B<--version>

Print the version of the script and exit.

=item B<--help>

Print a brief help message and exit.

=back

=head1 DESCRIPTION

B<combat.pl> will simulate combat between the specificied combatants using the ODE<amp>D combat rules.

=head1 TO DO

Plenty. There are a few TODOs scattered throughout the source code. Here are some more:

=over 8

=item * B<--system> command-line-switch. Specify rule system, e.g., Whitebox, "Supplement I", EPT, etc.

=item * B<--sample integer>. Print out a random sample of the encounters. E.g., run a million encounters but print out 10 of them, selected randomly.

=item * For each design decision made in this program, cite rule book and page number and include quote.

=item * I took the 25% chance to drop one's weapon upon surprise quite literally: Unlike Ways, I don't require the suprised combatant to be hit by his attacker before I roll for the chance to drop (at least that's what the output of Ways program seems to do--I could be wrong). This could be implemented as an option. It doesn't seem to effect the outcomes much.

=item * Attacker with Hit Dice + Bonus versus Normal Men gets Dice attacks with Bonus going to one attack (MM/5). Problem deciding who is a "normal man".

=item * Fighting Conditions. E.g., goblin gets -1 to attacks and morale when fighting in Full Daylight MM/7, as do Orcs MM/8.

=item * Support for unarmed opponents (like Ghouls).

=item * Check distance at beginning of encounter. Distance depends on Wilderness or Underground. Combatants must spend initial rounds closing in to melee range. In this case, MV becomes an important stat. And so do ENCUMBRANCE and AC insofar as they may effect MV. Conditions (PARALYZED, STUNNED, ...) will temporarily effect MV as well. May also need to know how big of an area/arena the combat takes place in.

=item * Missile fire/ranged attacks.

=item * Spells.

=item * Many-to-many combat rather than just one-to-one.

=item * Morale checks for NPCs once we get many-to-many combats.

=item * Optional Low DEX penalty. N.B. Already implemented: high DEX gives +1 bonus to initiative (Srv #2, FAQ/?).

=item * Regeneration. Trolls and vampires regenerate 3 hp/round starting 3rd round after being hit.

=item * Immunities. Vampires and Spectres immune to attacks except silver/magic.

=item * Weaknesses. Vampires only killed by sunlight/immersed in running water/wooden stake through heart.

=item * Not dead at 0 hp exception: Vampires assume gaseous form at 0 hp.

=item * Type or amount of treasure... After winning a combat we should calculate the payoff, MONEY and XP. We should calculate the expected payoff of each combat.

=item * Option to roll combatants HP etc each encounter or use static values.

=item * Optional EPT critical hit system, EPT/32 Sec. 731.  Nat 20 does "double damage," rolls gain where 19-20 deal "instant death." No "fumble" rule until AD&D(?)

=item * Implement different output devices:

  # print plain text to standard output
  $combat->as_string() or $combat->as_string(STDOUT)

  # save results to database using given DBI handle
  $combat->as_string($mysql)

  # output HTML to TCP/HTTP socket
  $combat->as_string($cgi)

Probably need multiple dispatch for this. Easier than using "Visitor" design pattern.

=item * Only Fighting Man is implemented. No Magic User or Cleric yet.

=item * Only Save Versus Paralysis is implemented (due to Ghoul). Implement others.

=item * Human race assumed. Implement others. E.g., elves not effected by Ghoul paralysis.

=back

=head1 BUGS

Lots. Maybe. This is an early release.

=head1 NOTES

=over 8

=item * This program could just as well have been written more naturally in a "Discrete Event Simulation" language, like Simula (GNU Cim), which supports a clock, random-number-generation, an events list (in a priority queue), an ending-condition, and tracking statistics, as well as object-orientation (classes, objects, single-inheritance, virtual-methods). It also could have been written in Perl6, which has better support for object-orientation as well as multiple-dispatch and other neat features. Common Lisp or Clojure were also considered. I am considering NetLogo for many-to-many combats, since it excels at multi-agent, complex systems modeling in a 2D grid. But ultimately, I used Perl5 because I could bash out the code the fastest.

=item * There is a UML class diagram to show the relations between the classes here. The source is in Visio. A JPEG version is available at E<lt>http://www.flickr.com/photos/79364035@N04/8402807365/E<gt>

=item * "Template" design pattern for main Combat class. Subclasses could then implement optional rules or variant rules or house rules.

=item * "Strategy" design pattern to model turn sequence. Similar to "Template" but finer granularity. Did this because ODE<amp>D allows for both move-countermove and simultaneous turn sequences.

=item * "Factory" design pattern to build men and monsters intended, but not quite there yet. Need to refactor each factory class into one abstract factory class.

=back

=head1 AUTHOR

Elisha "Aher" Abuyah

=head1 HISTORY

This program began as an attempt to replicate the results presented by the author "waysoftheearth" in the discussion thread "A Veteran's Odds" on the Original DE<amp>D Discussion board at E<lt>http://odd74.proboards.com/index.cgi?board=study&action=display&thread=7562E<gt>.

=head1 COPYRIGHT

Copyright 2012 Elisha "Aher" Abuyah

=head1 LICENSE

This program is free software; you may redistribute it and/or modify it under the same terms as Perl itself.

=head1 DISCLAIMERS

This program is distributed in the hope that it will be useful, but without any warranty; without even the implied warranty of merchantability or fitness for a particular purpose.

=head1 AVAILABILITY

The current version is available at Aher's pastebin at E<lt>http://pastebin.com/u/aherE<gt>. A UML class diagram is available at E<lt>http://www.flickr.com/photos/79364035@N04/8402807365/E<gt>.

=head1 DATE

02-Sep-2012

=cut