Commits

Anonymous committed a68168c

Convert CRLF newlines to LF newlines.

Comments (0)

Files changed (68)

-General questions?  Type '?' for help.
-
-Darkness got you down?  Try wielding a light source in either of your
-hands.  Type 'w', select either 'L.Hand' or 'R.Hand', then select a
-light source.  If you put the light source in your right hand, you
-might be able to swing it at your opponent while in battle.
-
-Accidentally typed something while the screen was redrawing, and it
-looks all wrong now?  Type 'control-l' to refresh the display.
+General questions?  Type '?' for help.
+
+Darkness got you down?  Try wielding a light source in either of your
+hands.  Type 'w', select either 'L.Hand' or 'R.Hand', then select a
+light source.  If you put the light source in your right hand, you
+might be able to swing it at your opponent while in battle.
+
+Accidentally typed something while the screen was redrawing, and it
+looks all wrong now?  Type 'control-l' to refresh the display.
-package Actor;
-@ISA = qw( Physical );
-
-# Copyright (c)2000-2013, Chris Pressey, Cat's Eye Technologies.
-# All rights reserved.
-# Distributed under a BSD-style license; see the file LICENSE for more info.
-
-use Carp;
-
-# our $AUTOLOAD;  # it's a package global
-
-%stat =
-(
-  'strength'     => 1,
-  'constitution' => 1,
-  'dexterity'    => 1,
-  'intelligence' => 1,
-  'spirit'       => 1,
-  'charisma'     => 1,
-);
-$sorder =
-[
-  'strength',
-  'constitution',
-  'dexterity',
-  'intelligence',
-  'spirit',
-  'charisma',
-];
-my %fields =
-(
-  %Physical::fields,
-  'hair_type'      => '',
-  'hair_color'     => 'unremarkable',
-  'eye_type'       => '',
-  'eye_color'      => 'unremarkable',
-  'skin_type'      => '',
-  'skin_color'     => 'unremarkable',
-  'character_bio'  => undef,
-
-  'race'           => 'Unique',
-  'carcass'        => 1,
-
-  'lit'            => 0,  # value *derived* from holding light source
-  'incapacitated'  => 0,  # value *derived* from operating stats
-
-  'using_talent'   => undef,  # when like [13, $talent, $target], means slow talent is being used
-
-  'blind'          => 0,
-  'deaf'           => 0,
-  'dumb'           => 0,
-  'confused'       => 0,
-  'paralyzed'      => 0,
-  'placid'         => 0,
-  'blurry'         => 0,
-
-  'nightvision'    => 0,
-
-  'sleeping'       => 0,
-  
-  'totalhits'      => 0,
-  'blockedhits'    => 0,
-  'totalswings'    => 0,
-  'damagingswings' => 0,
-
-  'party'          => undef,
-  'encounter'      => undef,
-
-  'combat'         => 'Attack',  # some creatures will Flee or Bargain instead
-  'noncombat'      => 'Wander',
-  'body_aim'       => 'dumb_biped',
-
-  'max'            => { %stat },
-  'op'             => { %stat },
-
-  'experience'       => 0,
-  'spent_experience' => 0,
-  'standing'         => {},
-
-  'belongings'     => [],
-  'talents'        => [],
-
-  'target'         => undef,
-
-  'head'           => undef,
-  'neck'           => undef,
-  'shoulders'      => undef,
-  'arms'           => undef,
-  'rwrist'         => undef,
-  'lwrist'         => undef,
-  'hands'          => undef,
-  'rfinger'        => undef,
-  'lfinger'        => undef,
-  'rhand'          => undef,
-  'lhand'          => undef,
-  'torso'          => undef,
-  'waist'          => undef,
-  'legs'           => undef,
-  'rankle'         => undef,
-  'lankle'         => undef,
-  'feet'           => undef,
-
-  'domhand'        => 'rhand',
-  'ambidextrous'   => 0,       # 1 means can control the above
-  'on_move'        => '',
-);
-
-sub new
-{
-  my $class = shift;
-  my %params = @_;
-  my $self =
-  {
-    '_permitted' => \%fields,
-    %fields,
-    'standing'       => {},
-    'belongings'     => [],
-    'talents'        => [],
-    'max'            => { %stat },
-    'op'             => { %stat },
-    %params
-  };
-  bless $self, $class;
-  $self->heal_all;
-  $self->recalc_lit;
-  return $self;
-}
-
-require Character;
-
-# called after constructor to ensure proper sexualization,
-# wielding items (even magicked ones,) etc.
-sub prep
-{
-  my $self = shift;
-
-  # adjust character for gender bonuses
-
-  $self->sexualize;
-
-  # clone out individual attacks array
-
-  my $y; my @e = ();
-  foreach $y (@{$self->{melee_attacks}})
-  {
-    my $q = $y->clone;
-    $q->{force} = $y->{force}->copy;
-    push @e, $q;
-  }
-  $self->{melee_attacks} = [ @e ] if $#e > -1;
-
-  #@e = ();
-  #foreach $y (@{$self->{projectile_attacks}})
-  #{
-  #  push @e, $y->clone;
-  #}
-  #$self->{projectile_attacks} = [ @e ] if $#e > -1;
-
-  # swap contents of lhand and rhand if nonweapon is in dominant hand
-
-  my $d = $self->{domhand};
-  if ($d eq 'ambi')
-  {
-    $self->{ambidextrous} = 1;
-    $d = $self->{domhand} = 'rhand';
-  }
-  $nd = 'rhand' if $d eq 'lhand';
-  $nd = 'lhand' if $d eq 'rhand';
-
-  if (defined $self->{$d})
-  {
-    if (defined $self->{$nd})
-    {
-      if ($self->{$d}{melee_attacks}[0]{force}->max <
-          $self->{$nd}{melee_attacks}[0]{force}->max)
-      {
-        my $t = $self->{$d};
-        $self->{$d} = $self->{$nd};
-        $self->{$nd} = $t;
-      }
-    }
-  } else
-  {
-    if (defined $self->{$nd})
-    {
-      $self->{$d} = $self->{$nd};
-      $self->{$nd} = undef;
-    }
-  }
-
-  # activate worn magic items (girdles of strength and so on)
-
-  my $i;
-  foreach $i (keys %{$wtable})
-  {
-    if (defined $self->{$wtable->{$i}[0]})
-    {
-      # ::msg($self->{$wtable->{$i}[0]}{name});
-      $self->{$wtable->{$i}[0]} = $self->{$wtable->{$i}[0]}->clone;
-      ::script $self->{$wtable->{$i}[0]}{on_wear}, $self->{$wtable->{$i}[0]}, $self, 1;
-    }
-  }
-
-  # instance any belongings which are not yet Items (i.e. Distributions)
-
-  my @q = ();
-  foreach $i (@{$self->{belongings}})
-  {
-    if (ref($i) eq 'Distribution')
-    {
-      while (ref($i) eq 'Distribution')
-      {
-        $i = $i->pick;
-      }
-      push @q, $i->clone if defined $i;
-    } else
-    {
-      push @q, $i->clone if defined $i;
-    }
-  }
-  $self->{belongings} = [ @q ];
-
-  # clone out talents
-
-  @q = ();
-  foreach $i (@{$self->{talents}})
-  {
-    if (ref($i) eq 'Distribution')
-    {
-      while (ref($i) eq 'Distribution')
-      {
-        $i = $i->pick;
-      }
-      push @q, $i->clone if defined $i;
-    } else
-    {
-      push @q, $i->clone if defined $i;
-    }
-  }
-  $self->{talents} = [ @q ];
-
-  # anything else appropriate to newly created creatures
-
-  $self->heal_all;
-
-  return;
-}
-
-sub heal_all
-{
-  my $self = shift; my $k;
-  foreach $k (keys %{$self->{max}})
-  {
-    $self->{op}{$k} = $self->{max}{$k};
-  }
-}
-
-sub adjust
-{
-  my $self = shift;
-  my $stat = shift;
-  my $delta = shift;
-  my $causer = shift || carp "Need cause";
-  if (defined $delta and $delta != 0)
-  {
-    if ($self->{op}{$stat} + $delta <= 0 and $self->{op}{$stat} > 0)
-    {
-      $self->{op}{$stat} = 0;
-      $self->seen($self, "<self> is incapacitated by the loss of all of <his> $stat!") if not $self->{incapacitated};
-      $self->{incapacitated} = 1;
-      $self->review('character');
-    } elsif ($self->{op}{$stat} + $delta <= 0 and $self->{op}{$stat} == 0)
-    {
-      $self->death($causer);
-    } else
-    {
-      $self->{op}{$stat} += $delta;
-      # $self->{op}{$stat} = 0
-      #   if $stat ne 'constitution' and $self->{op}{$stat} < 0;
-      $self->review('character');
-    }
-  }
-}
-
-# given Item or Talent, returns boolean indicating whether
-# this actor possesses it; in case of count of Items, the
-# actor must possess at least that many
-# given Adj, return first item which implies that Adj
-sub has
-{
-  my $self = shift;
-  my $thing = shift;
-
-  if (ref($thing) eq 'Item')
-  {
-    my $x;
-    foreach $x (@{$self->{belongings}})
-    {
-      if ($thing->combinable($x) and $x->{count} >= $thing->{count})
-      {
-        return $x;
-      }
-    }
-  }
-  elsif (ref($thing) eq 'Adj')
-  {
-    my $x;
-    foreach $x (@{$self->{belongings}})
-    {
-      if ($x->is($thing))
-      {
-        return $x;
-      }
-    }
-  }
-  elsif (ref($thing) eq 'Talent' or not ref($thing))
-  {
-    my $x;
-    my $n = $thing;
-    $n = $thing->{name} if ref($thing);
-    foreach $x (@{$self->{talents}})
-    {
-      return $x if $n eq $x->{name};
-    }
-  }
-  return 0;
-}
-
-sub learn
-{
-  my $self = shift;
-  my $talent = shift;
-  my $prof = shift;
-  carp "Need proficiency level" if not defined $prof;
-
-  my $t = undef;
-
-  if (ref($talent) eq 'Talent')
-  {
-    if ($t = $self->has($talent))
-    {
-      $t->{prof} += $prof;
-      if ($t->{prof} <= 0)
-      {
-        $t->{prof} = 0;
-        my $i = 0;
-        for($i = 0; $i <= $#{$self->{talents}}; $i++)
-        {
-          last if not defined $self->{talents}[$i];
-          if ($self->{talents}[$i]{prof} <= 0)
-          {
-            my $j;
-            # print "deleting $self->{talents}[$i]{name}"; sleep 2;
-            for($j = $i+1; $j <= $#{$self->{talents}}; $j++)
-            {
-              $self->{talents}[$j-1] = $self->{talents}[$j];
-            }
-            $#{$self->{talents}}--;
-            $i--;
-          }
-        }
-      }
-    } else
-    {
-      if ($#{$self->{talents}} == -1)
-      {
-        $self->{talents} = [];
-      }
-      $t = $talent->clone;
-      $t->{owner} = $self;
-      $t->{prof} = $prof;
-      push @{$self->{talents}}, $t;
-    }
-    $self->review('talents');
-  }
-  return $t;
-}
-
-sub take
-{
-  my $self = shift;
-  my $item = shift;
-  if (ref($item) eq 'Item')
-  {
-    my $x;
-    foreach $x (@{$self->{belongings}})
-    {
-      if ($item->combinable($x))
-      {
-        $x->{count} += $item->{count};
-        $self->review('inventory');
-        return;
-      }
-    }
-    push @{$self->{belongings}}, $item;
-    $item->{x} = -1;
-    $item->{y} = -1;
-    $item->{location} = $self;
-  } else { carp "Need item I think!" }
-  $self->review('inventory');
-}
-
-sub pickup
-{
-  my $self = shift;
-  my $thing = $self->{location}{map}[$self->{x}][$self->{y}][0];
-  if (ref($thing) ne 'Item')
-  {
-    $self->seen($thing, "<self> finds nothing on <other>.");
-    return 0;
-  }
-  shift @{$self->{location}{map}[$self->{x}][$self->{y}]};
-  if ($thing->{count} > 1)
-  {
-    $self->seen($thing, "<self> picks up <# other>.");
-  } else
-  {
-    $self->seen($thing, "<self> picks up <a other>.");
-  }
-  if (::script $thing->{on_pickup}, $thing, $self)
-  {
-    $self->take($thing);
-  }
-  return 1;
-}
-
-sub relieve
-{
-  my $self = shift;
-  my $thing = shift;
-  my $j = 0;
-  while ($j <= $#{$self->{belongings}})
-  {
-    if ($thing eq $self->{belongings}[$j])
-    {
-      my $k = $j;
-      for($k = $j; $k < $#{$self->{belongings}}; $k++)
-      {
-        $self->{belongings}[$k] = $self->{belongings}[$k+1];
-      }
-      $#{$self->{belongings}}--;
-      last;
-    }
-    $j++;
-  }
-  $self->review('inventory');
-}
-
-sub drop
-{
-  my $self = shift;
-  my $thing = shift;
-  $thing->{x} = $self->{x};
-  $thing->{y} = $self->{y};
-  $thing->{location} = $self->{location};
-  unshift @{$self->{location}{map}[$self->{x}][$self->{y}]}, $thing;
-}
-
-$wtable = 
-{
-  'Head'      => ['head',      'head'],
-  'Neck'      => ['neck',      'neck'],
-  'Shoulders' => ['shoulders', 'shoulders'],
-  'Arms'      => ['arms',      'arms'],
-  'R.Wrist'   => ['rwrist',    'bracelet'],
-  'L.Wrist'   => ['lwrist',    'bracelet'],
-  'Hands'     => ['hands',     'hands'],
-  'R.Finger'  => ['rfinger',   'ring'],
-  'L.Finger'  => ['lfinger',   'ring'],
-  'R.Hand'    => ['rhand',     'hand'],
-  'L.Hand'    => ['lhand',     'hand'],
-  'Torso'     => ['torso',     'torso'],
-  'Waist'     => ['waist',     'waist'],
-  'Legs'      => ['legs',      'legs'],
-  'R.Ankle'   => ['rankle',    'bracelet'],
-  'L.Ankle'   => ['lankle',    'bracelet'],
-  'Feet'      => ['feet',      'feet'],
-};
-
-$worder = 
-[
-  'Head',
-  'Neck',
-  'Shoulders',
-  'Arms',
-  'R.Wrist',
-  'L.Wrist',
-  'Hands',
-  'R.Finger',
-  'L.Finger',
-  'R.Hand',
-  'L.Hand',
-  'Torso',
-  'Waist',
-  'Legs',
-  'R.Ankle',
-  'L.Ankle',
-  'Feet',
-];
-
-sub recalc_lit
-{
-  my $self = shift;
-  my $j; my $l = 0;
-  for($j = 0; $j <= $#{$worder}; $j++)
-  {
-    my $method = $wtable->{$worder->[$j]}->[0];
-    my $r = $self->{$method};
-    if (defined $r) { $l = 1 if $r->{lightsource}; }
-  }
-  $self->{lit} = $l || $self->{nightvision};
-}
-
-# returns false if action could not be accomplished
-sub put_on
-{
-  my $self = shift;
-  my $item = shift;
-  my $method = shift;
-  my $init_equip = shift || 0;
-  my $old;
-
-  if ($item->{count} > 1)
-  {
-    $old = $item;
-    $item = $item->clone;
-    $old->{count}--;
-    $item->{count} = 1;
-  } else
-  {
-    $self->relieve($item);
-  }
-
-  my $k;
-  foreach $k (keys %{$item->{worn_on}{$method}})
-  {
-    if (defined $self->{$k})
-    {
-      if ($init_equip)
-      {
-        $self->take($item);
-        return 1;
-      } else
-      {
-        $self->seen($self->{$k}, "<self> will have to remove <other> first.");
-        return 0;
-      }
-    }
-    $self->{$k} = $item;
-    $self->{attached}{$k} = $method;
-  }
-
-  $self->recalc_lit;
-  if (exists $item->{on_wear})
-  {
-    ::script $item->{on_wear}, $item, $self, 1;
-  }
-  $item->{x} = -1;
-  $item->{y} = -1;
-  $item->{location} = $self;
-  $item->identify;
-
-  return 1;
-}
-
-# returns item taken off
-sub take_off
-{
-  my $self = shift;
-  my $method = shift;
-  my $force = shift || 0;
-  $method = $self->{attached}{$method} if defined $self->{attached}{$method};
-  my $item = $self->{$method};
-  if (not ($item->{curse} and not $force))
-  {
-    my $k;
-    foreach $k (keys %{$item->{worn_on}{$method}})
-    {
-      $self->{$k} = undef;
-      $self->{attached}{$k} = undef;
-    }
-    $self->{$method} = undef;
-    if (not $item->{body})
-    {
-      $self->take($item);
-    }
-    $self->recalc_lit;
-    if (exists $item->{on_wear})
-    {
-      ::script $item->{on_wear}, $item, $self, -1;
-    }
-  }
-  return $item;
-}
-
-sub wield
-{
-  my $self = shift;
-  my $key; my @w;
-  if ($::pref{wield} eq 'body')
-  {
-    foreach $key (@{$worder})
-    {
-      my $method = $wtable->{$key}[0];
-      push @w, $key if (not defined $self->{$method}
-                        or $::pref{bodymenu} eq 'full');
-    }
-    if ($#w == -1)
-    {
-      $self->seen($self, "<self> can equip no more items.");
-      return 0;
-    } else
-    {
-      my $q = Menu->new(
-                         'label' => [ @w ],
-                       )->pick;
-      if ($q eq 'Cancel')
-      {
-        return 0;
-      }
-      if (defined $self->{$wtable->{$q}->[0]})
-      {
-        my $verb = "take off";
-        $verb = "put away" if $q eq 'L.Hand' or $q eq 'R.Hand';
-        $self->seen($self->{$wtable->{$q}->[0]}, "<self> will have to $verb <other> first.");
-        return 0;
-      }
-      my $i = $self->choose_item($wtable->{$q}->[0]);
-      if (not defined $i)
-      {
-        return 0;
-      } else
-      {
-        if ($i)
-        {
-          if ($self->put_on($i, $wtable->{$q}->[0]))
-          {
-            $i->identify;
-            if ($wtable->{$q}->[0] eq 'lhand' or $wtable->{$q}->[0] eq 'rhand')
-            {
-              $self->seen($i, "<self> readies <other>.");
-            } else
-            {
-              $self->seen($i, "<self> puts on <other>.");
-            }
-          }
-        } else
-        {
-          $self->seen($self, "<self> has nothing appropriate to equip there.");
-          return 0;
-        }
-      }
-    }
-  } elsif ($::pref{wield} eq 'item')
-  {
-    my $i = $self->choose_item();
-    if (not defined $i)
-    {
-      return 0;
-    } else
-    {
-      if ($i)
-      {
-        foreach $key (@{$worder})
-        {
-          my $method = $wtable->{$key}[0];
-          push @w, $key if (not defined $self->{$method} and
-                                defined $i->{worn_on}{$method});
-        }
-        if ($#w == -1)
-        {
-          $self->seen("<self> has nowhere to equip that.");
-          return 0;
-        } else
-        {
-          my $q = Menu->new( 'indent' => 1,
-                             'label' => [ @w ],
-                           )->pick;
-          if ($q eq 'Cancel')
-          {
-            return 0;
-          }
-          $i->identify;
-          $self->put_on($i, $wtable->{$q}->[0]);  # should always return 0
-        }
-      } else
-      {
-        $self->seen($self, "<self> has nothing to equip.");
-        return 0;
-      }
-    }
-  }
-  return 1;
-}
-
-sub unwield
-{
-  my $self = shift;
-  my $key; my @w;
-  foreach $key (@{$worder})
-  {
-    my $method = $wtable->{$key}[0];
-    push @w, $key if defined $self->{$method};
-  }
-  if ($#w == -1)
-  {
-    $self->seen($self, "<self> has nothing equipped.");
-    return 0;
-  } else
-  {
-    my $q = Menu->new(
-                       'label' => [ @w ],
-                     )->pick;
-    my $t;
-    if ($q eq 'Cancel')
-    {
-      return 0;
-    }
-    $t = $self->take_off($wtable->{$q}->[0]);
-    if ($t->{curse})
-    {
-      $self->seen($t, "<self> cannot seem to let go of <other>!");
-    } else
-    {
-      if ($wtable->{$q}->[0] eq 'lhand' or $wtable->{$q}->[0] eq 'rhand')
-      {
-        $self->seen($t, "<self> puts <other> away.");
-      } else
-      {
-        $self->seen($t, "<self> takes off <other>.");
-      }
-    }
-  }
-  return 1;
-}
-
-require Combat;
-
-sub hostile
-{
-  my $self = shift;
-  my $n = { %{$self} };
-  bless $n, ref $self;
-  $n->{hostile} = 1;
-  return $n;
-}
-
-sub reward
-{
-  my $self = shift;
-  my $k; my $r = 0;
-  foreach $k (keys %stat)
-  {
-    $r += $self->{max}{$k};
-  }
-  foreach $k (@{$self->{talents}})
-  {
-    $r += 50; # $k->reward;
-  }
-  # also factor in: experience, talents, and so forth
-  $r += $self->{experience};
-  return $r;
-}
-
-1;
+package Actor;
+@ISA = qw( Physical );
+
+# Copyright (c)2000-2013, Chris Pressey, Cat's Eye Technologies.
+# All rights reserved.
+# Distributed under a BSD-style license; see the file LICENSE for more info.
+
+use Carp;
+
+# our $AUTOLOAD;  # it's a package global
+
+%stat =
+(
+  'strength'     => 1,
+  'constitution' => 1,
+  'dexterity'    => 1,
+  'intelligence' => 1,
+  'spirit'       => 1,
+  'charisma'     => 1,
+);
+$sorder =
+[
+  'strength',
+  'constitution',
+  'dexterity',
+  'intelligence',
+  'spirit',
+  'charisma',
+];
+my %fields =
+(
+  %Physical::fields,
+  'hair_type'      => '',
+  'hair_color'     => 'unremarkable',
+  'eye_type'       => '',
+  'eye_color'      => 'unremarkable',
+  'skin_type'      => '',
+  'skin_color'     => 'unremarkable',
+  'character_bio'  => undef,
+
+  'race'           => 'Unique',
+  'carcass'        => 1,
+
+  'lit'            => 0,  # value *derived* from holding light source
+  'incapacitated'  => 0,  # value *derived* from operating stats
+
+  'using_talent'   => undef,  # when like [13, $talent, $target], means slow talent is being used
+
+  'blind'          => 0,
+  'deaf'           => 0,
+  'dumb'           => 0,
+  'confused'       => 0,
+  'paralyzed'      => 0,
+  'placid'         => 0,
+  'blurry'         => 0,
+
+  'nightvision'    => 0,
+
+  'sleeping'       => 0,
+  
+  'totalhits'      => 0,
+  'blockedhits'    => 0,
+  'totalswings'    => 0,
+  'damagingswings' => 0,
+
+  'party'          => undef,
+  'encounter'      => undef,
+
+  'combat'         => 'Attack',  # some creatures will Flee or Bargain instead
+  'noncombat'      => 'Wander',
+  'body_aim'       => 'dumb_biped',
+
+  'max'            => { %stat },
+  'op'             => { %stat },
+
+  'experience'       => 0,
+  'spent_experience' => 0,
+  'standing'         => {},
+
+  'belongings'     => [],
+  'talents'        => [],
+
+  'target'         => undef,
+
+  'head'           => undef,
+  'neck'           => undef,
+  'shoulders'      => undef,
+  'arms'           => undef,
+  'rwrist'         => undef,
+  'lwrist'         => undef,
+  'hands'          => undef,
+  'rfinger'        => undef,
+  'lfinger'        => undef,
+  'rhand'          => undef,
+  'lhand'          => undef,
+  'torso'          => undef,
+  'waist'          => undef,
+  'legs'           => undef,
+  'rankle'         => undef,
+  'lankle'         => undef,
+  'feet'           => undef,
+
+  'domhand'        => 'rhand',
+  'ambidextrous'   => 0,       # 1 means can control the above
+  'on_move'        => '',
+);
+
+sub new
+{
+  my $class = shift;
+  my %params = @_;
+  my $self =
+  {
+    '_permitted' => \%fields,
+    %fields,
+    'standing'       => {},
+    'belongings'     => [],
+    'talents'        => [],
+    'max'            => { %stat },
+    'op'             => { %stat },
+    %params
+  };
+  bless $self, $class;
+  $self->heal_all;
+  $self->recalc_lit;
+  return $self;
+}
+
+require Character;
+
+# called after constructor to ensure proper sexualization,
+# wielding items (even magicked ones,) etc.
+sub prep
+{
+  my $self = shift;
+
+  # adjust character for gender bonuses
+
+  $self->sexualize;
+
+  # clone out individual attacks array
+
+  my $y; my @e = ();
+  foreach $y (@{$self->{melee_attacks}})
+  {
+    my $q = $y->clone;
+    $q->{force} = $y->{force}->copy;
+    push @e, $q;
+  }
+  $self->{melee_attacks} = [ @e ] if $#e > -1;
+
+  #@e = ();
+  #foreach $y (@{$self->{projectile_attacks}})
+  #{
+  #  push @e, $y->clone;
+  #}
+  #$self->{projectile_attacks} = [ @e ] if $#e > -1;
+
+  # swap contents of lhand and rhand if nonweapon is in dominant hand
+
+  my $d = $self->{domhand};
+  if ($d eq 'ambi')
+  {
+    $self->{ambidextrous} = 1;
+    $d = $self->{domhand} = 'rhand';
+  }
+  $nd = 'rhand' if $d eq 'lhand';
+  $nd = 'lhand' if $d eq 'rhand';
+
+  if (defined $self->{$d})
+  {
+    if (defined $self->{$nd})
+    {
+      if ($self->{$d}{melee_attacks}[0]{force}->max <
+          $self->{$nd}{melee_attacks}[0]{force}->max)
+      {
+        my $t = $self->{$d};
+        $self->{$d} = $self->{$nd};
+        $self->{$nd} = $t;
+      }
+    }
+  } else
+  {
+    if (defined $self->{$nd})
+    {
+      $self->{$d} = $self->{$nd};
+      $self->{$nd} = undef;
+    }
+  }
+
+  # activate worn magic items (girdles of strength and so on)
+
+  my $i;
+  foreach $i (keys %{$wtable})
+  {
+    if (defined $self->{$wtable->{$i}[0]})
+    {
+      # ::msg($self->{$wtable->{$i}[0]}{name});
+      $self->{$wtable->{$i}[0]} = $self->{$wtable->{$i}[0]}->clone;
+      ::script $self->{$wtable->{$i}[0]}{on_wear}, $self->{$wtable->{$i}[0]}, $self, 1;
+    }
+  }
+
+  # instance any belongings which are not yet Items (i.e. Distributions)
+
+  my @q = ();
+  foreach $i (@{$self->{belongings}})
+  {
+    if (ref($i) eq 'Distribution')
+    {
+      while (ref($i) eq 'Distribution')
+      {
+        $i = $i->pick;
+      }
+      push @q, $i->clone if defined $i;
+    } else
+    {
+      push @q, $i->clone if defined $i;
+    }
+  }
+  $self->{belongings} = [ @q ];
+
+  # clone out talents
+
+  @q = ();
+  foreach $i (@{$self->{talents}})
+  {
+    if (ref($i) eq 'Distribution')
+    {
+      while (ref($i) eq 'Distribution')
+      {
+        $i = $i->pick;
+      }
+      push @q, $i->clone if defined $i;
+    } else
+    {
+      push @q, $i->clone if defined $i;
+    }
+  }
+  $self->{talents} = [ @q ];
+
+  # anything else appropriate to newly created creatures
+
+  $self->heal_all;
+
+  return;
+}
+
+sub heal_all
+{
+  my $self = shift; my $k;
+  foreach $k (keys %{$self->{max}})
+  {
+    $self->{op}{$k} = $self->{max}{$k};
+  }
+}
+
+sub adjust
+{
+  my $self = shift;
+  my $stat = shift;
+  my $delta = shift;
+  my $causer = shift || carp "Need cause";
+  if (defined $delta and $delta != 0)
+  {
+    if ($self->{op}{$stat} + $delta <= 0 and $self->{op}{$stat} > 0)
+    {
+      $self->{op}{$stat} = 0;
+      $self->seen($self, "<self> is incapacitated by the loss of all of <his> $stat!") if not $self->{incapacitated};
+      $self->{incapacitated} = 1;
+      $self->review('character');
+    } elsif ($self->{op}{$stat} + $delta <= 0 and $self->{op}{$stat} == 0)
+    {
+      $self->death($causer);
+    } else
+    {
+      $self->{op}{$stat} += $delta;
+      # $self->{op}{$stat} = 0
+      #   if $stat ne 'constitution' and $self->{op}{$stat} < 0;
+      $self->review('character');
+    }
+  }
+}
+
+# given Item or Talent, returns boolean indicating whether
+# this actor possesses it; in case of count of Items, the
+# actor must possess at least that many
+# given Adj, return first item which implies that Adj
+sub has
+{
+  my $self = shift;
+  my $thing = shift;
+
+  if (ref($thing) eq 'Item')
+  {
+    my $x;
+    foreach $x (@{$self->{belongings}})
+    {
+      if ($thing->combinable($x) and $x->{count} >= $thing->{count})
+      {
+        return $x;
+      }
+    }
+  }
+  elsif (ref($thing) eq 'Adj')
+  {
+    my $x;
+    foreach $x (@{$self->{belongings}})
+    {
+      if ($x->is($thing))
+      {
+        return $x;
+      }
+    }
+  }
+  elsif (ref($thing) eq 'Talent' or not ref($thing))
+  {
+    my $x;
+    my $n = $thing;
+    $n = $thing->{name} if ref($thing);
+    foreach $x (@{$self->{talents}})
+    {
+      return $x if $n eq $x->{name};
+    }
+  }
+  return 0;
+}
+
+sub learn
+{
+  my $self = shift;
+  my $talent = shift;
+  my $prof = shift;
+  carp "Need proficiency level" if not defined $prof;
+
+  my $t = undef;
+
+  if (ref($talent) eq 'Talent')
+  {
+    if ($t = $self->has($talent))
+    {
+      $t->{prof} += $prof;
+      if ($t->{prof} <= 0)
+      {
+        $t->{prof} = 0;
+        my $i = 0;
+        for($i = 0; $i <= $#{$self->{talents}}; $i++)
+        {
+          last if not defined $self->{talents}[$i];
+          if ($self->{talents}[$i]{prof} <= 0)
+          {
+            my $j;
+            # print "deleting $self->{talents}[$i]{name}"; sleep 2;
+            for($j = $i+1; $j <= $#{$self->{talents}}; $j++)
+            {
+              $self->{talents}[$j-1] = $self->{talents}[$j];
+            }
+            $#{$self->{talents}}--;
+            $i--;
+          }
+        }
+      }
+    } else
+    {
+      if ($#{$self->{talents}} == -1)
+      {
+        $self->{talents} = [];
+      }
+      $t = $talent->clone;
+      $t->{owner} = $self;
+      $t->{prof} = $prof;
+      push @{$self->{talents}}, $t;
+    }
+    $self->review('talents');
+  }
+  return $t;
+}
+
+sub take
+{
+  my $self = shift;
+  my $item = shift;
+  if (ref($item) eq 'Item')
+  {
+    my $x;
+    foreach $x (@{$self->{belongings}})
+    {
+      if ($item->combinable($x))
+      {
+        $x->{count} += $item->{count};
+        $self->review('inventory');
+        return;
+      }
+    }
+    push @{$self->{belongings}}, $item;
+    $item->{x} = -1;
+    $item->{y} = -1;
+    $item->{location} = $self;
+  } else { carp "Need item I think!" }
+  $self->review('inventory');
+}
+
+sub pickup
+{
+  my $self = shift;
+  my $thing = $self->{location}{map}[$self->{x}][$self->{y}][0];
+  if (ref($thing) ne 'Item')
+  {
+    $self->seen($thing, "<self> finds nothing on <other>.");
+    return 0;
+  }
+  shift @{$self->{location}{map}[$self->{x}][$self->{y}]};
+  if ($thing->{count} > 1)
+  {
+    $self->seen($thing, "<self> picks up <# other>.");
+  } else
+  {
+    $self->seen($thing, "<self> picks up <a other>.");
+  }
+  if (::script $thing->{on_pickup}, $thing, $self)
+  {
+    $self->take($thing);
+  }
+  return 1;
+}
+
+sub relieve
+{
+  my $self = shift;
+  my $thing = shift;
+  my $j = 0;
+  while ($j <= $#{$self->{belongings}})
+  {
+    if ($thing eq $self->{belongings}[$j])
+    {
+      my $k = $j;
+      for($k = $j; $k < $#{$self->{belongings}}; $k++)
+      {
+        $self->{belongings}[$k] = $self->{belongings}[$k+1];
+      }
+      $#{$self->{belongings}}--;
+      last;
+    }
+    $j++;
+  }
+  $self->review('inventory');
+}
+
+sub drop
+{
+  my $self = shift;
+  my $thing = shift;
+  $thing->{x} = $self->{x};
+  $thing->{y} = $self->{y};
+  $thing->{location} = $self->{location};
+  unshift @{$self->{location}{map}[$self->{x}][$self->{y}]}, $thing;
+}
+
+$wtable = 
+{
+  'Head'      => ['head',      'head'],
+  'Neck'      => ['neck',      'neck'],
+  'Shoulders' => ['shoulders', 'shoulders'],
+  'Arms'      => ['arms',      'arms'],
+  'R.Wrist'   => ['rwrist',    'bracelet'],
+  'L.Wrist'   => ['lwrist',    'bracelet'],
+  'Hands'     => ['hands',     'hands'],
+  'R.Finger'  => ['rfinger',   'ring'],
+  'L.Finger'  => ['lfinger',   'ring'],
+  'R.Hand'    => ['rhand',     'hand'],
+  'L.Hand'    => ['lhand',     'hand'],
+  'Torso'     => ['torso',     'torso'],
+  'Waist'     => ['waist',     'waist'],
+  'Legs'      => ['legs',      'legs'],
+  'R.Ankle'   => ['rankle',    'bracelet'],
+  'L.Ankle'   => ['lankle',    'bracelet'],
+  'Feet'      => ['feet',      'feet'],
+};
+
+$worder = 
+[
+  'Head',
+  'Neck',
+  'Shoulders',
+  'Arms',
+  'R.Wrist',
+  'L.Wrist',
+  'Hands',
+  'R.Finger',
+  'L.Finger',
+  'R.Hand',
+  'L.Hand',
+  'Torso',
+  'Waist',
+  'Legs',
+  'R.Ankle',
+  'L.Ankle',
+  'Feet',
+];
+
+sub recalc_lit
+{
+  my $self = shift;
+  my $j; my $l = 0;
+  for($j = 0; $j <= $#{$worder}; $j++)
+  {
+    my $method = $wtable->{$worder->[$j]}->[0];
+    my $r = $self->{$method};
+    if (defined $r) { $l = 1 if $r->{lightsource}; }
+  }
+  $self->{lit} = $l || $self->{nightvision};
+}
+
+# returns false if action could not be accomplished
+sub put_on
+{
+  my $self = shift;
+  my $item = shift;
+  my $method = shift;
+  my $init_equip = shift || 0;
+  my $old;
+
+  if ($item->{count} > 1)
+  {
+    $old = $item;
+    $item = $item->clone;
+    $old->{count}--;
+    $item->{count} = 1;
+  } else
+  {
+    $self->relieve($item);
+  }
+
+  my $k;
+  foreach $k (keys %{$item->{worn_on}{$method}})
+  {
+    if (defined $self->{$k})
+    {
+      if ($init_equip)
+      {
+        $self->take($item);
+        return 1;
+      } else
+      {
+        $self->seen($self->{$k}, "<self> will have to remove <other> first.");
+        return 0;
+      }
+    }
+    $self->{$k} = $item;
+    $self->{attached}{$k} = $method;
+  }
+
+  $self->recalc_lit;
+  if (exists $item->{on_wear})
+  {
+    ::script $item->{on_wear}, $item, $self, 1;
+  }
+  $item->{x} = -1;
+  $item->{y} = -1;
+  $item->{location} = $self;
+  $item->identify;
+
+  return 1;
+}
+
+# returns item taken off
+sub take_off
+{
+  my $self = shift;
+  my $method = shift;
+  my $force = shift || 0;
+  $method = $self->{attached}{$method} if defined $self->{attached}{$method};
+  my $item = $self->{$method};
+  if (not ($item->{curse} and not $force))
+  {
+    my $k;
+    foreach $k (keys %{$item->{worn_on}{$method}})
+    {
+      $self->{$k} = undef;
+      $self->{attached}{$k} = undef;
+    }
+    $self->{$method} = undef;
+    if (not $item->{body})
+    {
+      $self->take($item);
+    }
+    $self->recalc_lit;
+    if (exists $item->{on_wear})
+    {
+      ::script $item->{on_wear}, $item, $self, -1;
+    }
+  }
+  return $item;
+}
+
+sub wield
+{
+  my $self = shift;
+  my $key; my @w;
+  if ($::pref{wield} eq 'body')
+  {
+    foreach $key (@{$worder})
+    {
+      my $method = $wtable->{$key}[0];
+      push @w, $key if (not defined $self->{$method}
+                        or $::pref{bodymenu} eq 'full');
+    }
+    if ($#w == -1)
+    {
+      $self->seen($self, "<self> can equip no more items.");
+      return 0;
+    } else
+    {
+      my $q = Menu->new(
+                         'label' => [ @w ],
+                       )->pick;
+      if ($q eq 'Cancel')
+      {
+        return 0;
+      }
+      if (defined $self->{$wtable->{$q}->[0]})
+      {
+        my $verb = "take off";
+        $verb = "put away" if $q eq 'L.Hand' or $q eq 'R.Hand';
+        $self->seen($self->{$wtable->{$q}->[0]}, "<self> will have to $verb <other> first.");
+        return 0;
+      }
+      my $i = $self->choose_item($wtable->{$q}->[0]);
+      if (not defined $i)
+      {
+        return 0;
+      } else
+      {
+        if ($i)
+        {
+          if ($self->put_on($i, $wtable->{$q}->[0]))
+          {
+            $i->identify;
+            if ($wtable->{$q}->[0] eq 'lhand' or $wtable->{$q}->[0] eq 'rhand')
+            {
+              $self->seen($i, "<self> readies <other>.");
+            } else
+            {
+              $self->seen($i, "<self> puts on <other>.");
+            }
+          }
+        } else
+        {
+          $self->seen($self, "<self> has nothing appropriate to equip there.");
+          return 0;
+        }
+      }
+    }
+  } elsif ($::pref{wield} eq 'item')
+  {
+    my $i = $self->choose_item();
+    if (not defined $i)
+    {
+      return 0;
+    } else
+    {
+      if ($i)
+      {
+        foreach $key (@{$worder})
+        {
+          my $method = $wtable->{$key}[0];
+          push @w, $key if (not defined $self->{$method} and
+                                defined $i->{worn_on}{$method});
+        }
+        if ($#w == -1)
+        {
+          $self->seen("<self> has nowhere to equip that.");
+          return 0;
+        } else
+        {
+          my $q = Menu->new( 'indent' => 1,
+                             'label' => [ @w ],
+                           )->pick;
+          if ($q eq 'Cancel')
+          {
+            return 0;
+          }
+          $i->identify;
+          $self->put_on($i, $wtable->{$q}->[0]);  # should always return 0
+        }
+      } else
+      {
+        $self->seen($self, "<self> has nothing to equip.");
+        return 0;
+      }
+    }
+  }
+  return 1;
+}
+
+sub unwield
+{
+  my $self = shift;
+  my $key; my @w;
+  foreach $key (@{$worder})
+  {
+    my $method = $wtable->{$key}[0];
+    push @w, $key if defined $self->{$method};
+  }
+  if ($#w == -1)
+  {
+    $self->seen($self, "<self> has nothing equipped.");
+    return 0;
+  } else
+  {
+    my $q = Menu->new(
+                       'label' => [ @w ],
+                     )->pick;
+    my $t;
+    if ($q eq 'Cancel')
+    {
+      return 0;
+    }
+    $t = $self->take_off($wtable->{$q}->[0]);
+    if ($t->{curse})
+    {
+      $self->seen($t, "<self> cannot seem to let go of <other>!");
+    } else
+    {
+      if ($wtable->{$q}->[0] eq 'lhand' or $wtable->{$q}->[0] eq 'rhand')
+      {
+        $self->seen($t, "<self> puts <other> away.");
+      } else
+      {
+        $self->seen($t, "<self> takes off <other>.");
+      }
+    }
+  }
+  return 1;
+}
+
+require Combat;
+
+sub hostile
+{
+  my $self = shift;
+  my $n = { %{$self} };
+  bless $n, ref $self;
+  $n->{hostile} = 1;
+  return $n;
+}
+
+sub reward
+{
+  my $self = shift;
+  my $k; my $r = 0;
+  foreach $k (keys %stat)
+  {
+    $r += $self->{max}{$k};
+  }
+  foreach $k (@{$self->{talents}})
+  {
+    $r += 50; # $k->reward;
+  }
+  # also factor in: experience, talents, and so forth
+  $r += $self->{experience};
+  return $r;
+}
+
+1;
-package Adj;
-@ISA = qw( Saveable );
-
-# Copyright (c)2000-2013, Chris Pressey, Cat's Eye Technologies.
-# All rights reserved.
-# Distributed under a BSD-style license; see the file LICENSE for more info.
-
-use Carp;
-
-my %fields =
-(
-  'name'     => '',
-  'implies'  => [],
-);
-
-sub new
-{
-  my $class = shift;
-  my $name = shift;
-  my $self =
-  {
-    '_permitted' => \%fields,
-    %fields,
-    'name' => $name,
-    'implies'  => [],
-  };
-  bless $self, $class;
-}
-
-sub implies
-{
-  my $self = shift;
-  my $other = shift;
-  carp "$other should be ref, $self, $self->{name}" if not ref $other;
-  # my $f = 0;
-  # grep { $f = 1 if $_ eq $other } @{$self->{implies}};
-  # if (not $f)
-  # {
-  $self->{implies} = [] if not defined $self->{implies};
-  $other->{implies} = [] if not defined $other->{implies};
-  $self->{implies} = [ @{$self->{implies}}, $other, @{$other->{implies}} ];
-  # }
-  return $self;
-}
-
-sub is
-{
-  my $self = shift;
-  my $other = shift;
-  grep { return 1 if $_ eq $other } @{$self->{implies}};
-  return 0;
-}
-
-sub equal_adjectival
-{
-  my $self = shift;
-  my $other = shift;
-  grep { return 0 if not $other->is($_) } @{$self->{implies}};
-  return 1;
-}
-
-sub composition
-{
-  my $self = shift;
-  my $f; my $s = '';
-  foreach $f (@{$self->{implies}})
-  {
-    $s .= $f->{name} . ', ';
-  }
-  return $s;
-}
-
-### ADJECTIVALS
-
-$earth = Adj->new('earth');
-
-$metal = Adj->new('metal')->implies($earth);
-$platinum = Adj->new('platinum')->implies($metal);
-$gold  = Adj->new('gold')->implies($metal);
-$silver  = Adj->new('silver')->implies($metal);
-$copper  = Adj->new('copper')->implies($metal);
-$iron  = Adj->new('iron')->implies($metal);
-$bronze  = Adj->new('bronze')->implies($metal);
-$meteoric_iron  = Adj->new('meteoric-iron')->implies($iron);
-$steel  = Adj->new('steel')->implies($iron);
-$lead  = Adj->new('lead')->implies($metal);
-$tin  = Adj->new('tin')->implies($metal);
-
-$stone = Adj->new('stone')->implies($earth);
-$gem   = Adj->new('gem')->implies($stone);
-$opal  = Adj->new('opal')->implies($gem);
-
-$limestone = Adj->new('limestone')->implies($stone);
-$granite = Adj->new('granite')->implies($stone);
-$marble = Adj->new('marble')->implies($stone);
-
-$mud = Adj->new('mud')->implies($earth);
-$clay = Adj->new('clay')->implies($earth);
-
-$gas = Adj->new('gas');
-$air = Adj->new('air')->implies($gas);
-
-$water = Adj->new('water');
-
-$heat = Adj->new('heat');
-$fire = Adj->new('fire')->implies($heat);
-
-$steam = Adj->new('steam')->implies($heat)->implies($air)->implies($water);
-
-$cold = Adj->new('cold');
-$ice  = Adj->new('ice')->implies($cold)->implies($water);
-
-$acid = Adj->new('acid');
-$electricity = Adj->new('electricity');
-
-$plant = Adj->new('plant');
-$garlic = Adj->new('garlic')->implies($plant);
-$mint = Adj->new('mint')->implies($plant);
-$holly = Adj->new('holly')->implies($plant);
-$wood = Adj->new('wood')->implies($plant);
-
-$flesh = Adj->new('flesh');
-$leather = Adj->new('leather')->implies($flesh);
-
-$bone  = Adj->new('bone');
-$wax   = Adj->new('wax');
-$jelly = Adj->new('jelly');
-$silk  = Adj->new('silk');
-$canvas= Adj->new('canvas');
-$fur   = Adj->new('fur');
-
-$kinetic = Adj->new('kinetic');
-$crushing = Adj->new('crushing')->implies($kinetic);
-$cutting  = Adj->new('cutting')->implies($kinetic);
-$piercing = Adj->new('piercing')->implies($kinetic);
-
-$explosion = Adj->new('explosion');
-
-$magic = Adj->new('magic');
-$curse = Adj->new('curse');
-$blessing = Adj->new('blessing');  # to do: much more complex in the future, I swear
-
-$written = Adj->new('written');
-$edible  = Adj->new('edible');
-$liquid  = Adj->new('liquid');
-
-$weapon = Adj->new('weapon');
-$bolt = Adj->new('bolt')->implies($weapon);
-$arrow = Adj->new('arrow')->implies($weapon);
-$round = Adj->new('round')->implies($weapon);
-$knife = Adj->new('knife')->implies($weapon);  # includes daggers
-$club = Adj->new('club')->implies($weapon);
-$card = Adj->new('card')->implies($weapon);
-$axe = Adj->new('axe')->implies($weapon);
-
-$bow = Adj->new('bow')->implies($weapon);
-$crossbow = Adj->new('crossbow')->implies($weapon);
-
-$hammer = Adj->new('hammer')->implies($weapon);  # includes maces
-$sword = Adj->new('sword')->implies($weapon);
-$flail = Adj->new('flail')->implies($weapon);
-$two_handed = Adj->new('two-handed')->implies($weapon);
-
-$flute    = Adj->new('flute');
-$reed     = Adj->new('reed');
-$horn     = Adj->new('horn');
-$harp     = Adj->new('harp');
-$keyboard = Adj->new('keyboard');
-$lute     = Adj->new('lute');
-$viol     = Adj->new('viol');
-$drum     = Adj->new('drum');
-
-$wall     = Adj->new('wall');
-$obstacle = Adj->new('obstacle');
-
-$ethereal = Adj->new('ethereal');
-$aquatic  = Adj->new('aquatic');
-$airborne = Adj->new('airborne');
-
-1;
+package Adj;
+@ISA = qw( Saveable );
+
+# Copyright (c)2000-2013, Chris Pressey, Cat's Eye Technologies.
+# All rights reserved.
+# Distributed under a BSD-style license; see the file LICENSE for more info.
+
+use Carp;
+
+my %fields =
+(
+  'name'     => '',
+  'implies'  => [],
+);
+
+sub new
+{
+  my $class = shift;
+  my $name = shift;
+  my $self =
+  {
+    '_permitted' => \%fields,
+    %fields,
+    'name' => $name,
+    'implies'  => [],
+  };
+  bless $self, $class;
+}
+
+sub implies
+{
+  my $self = shift;
+  my $other = shift;
+  carp "$other should be ref, $self, $self->{name}" if not ref $other;
+  # my $f = 0;
+  # grep { $f = 1 if $_ eq $other } @{$self->{implies}};
+  # if (not $f)
+  # {
+  $self->{implies} = [] if not defined $self->{implies};
+  $other->{implies} = [] if not defined $other->{implies};
+  $self->{implies} = [ @{$self->{implies}}, $other, @{$other->{implies}} ];
+  # }
+  return $self;
+}
+
+sub is
+{
+  my $self = shift;
+  my $other = shift;
+  grep { return 1 if $_ eq $other } @{$self->{implies}};
+  return 0;
+}
+
+sub equal_adjectival
+{
+  my $self = shift;
+  my $other = shift;
+  grep { return 0 if not $other->is($_) } @{$self->{implies}};
+  return 1;
+}
+
+sub composition
+{
+  my $self = shift;
+  my $f; my $s = '';
+  foreach $f (@{$self->{implies}})
+  {
+    $s .= $f->{name} . ', ';
+  }
+  return $s;
+}
+
+### ADJECTIVALS
+
+$earth = Adj->new('earth');
+
+$metal = Adj->new('metal')->implies($earth);
+$platinum = Adj->new('platinum')->implies($metal);
+$gold  = Adj->new('gold')->implies($metal);
+$silver  = Adj->new('silver')->implies($metal);
+$copper  = Adj->new('copper')->implies($metal);
+$iron  = Adj->new('iron')->implies($metal);
+$bronze  = Adj->new('bronze')->implies($metal);
+$meteoric_iron  = Adj->new('meteoric-iron')->implies($iron);
+$steel  = Adj->new('steel')->implies($iron);
+$lead  = Adj->new('lead')->implies($metal);
+$tin  = Adj->new('tin')->implies($metal);
+
+$stone = Adj->new('stone')->implies($earth);
+$gem   = Adj->new('gem')->implies($stone);
+$opal  = Adj->new('opal')->implies($gem);
+
+$limestone = Adj->new('limestone')->implies($stone);
+$granite = Adj->new('granite')->implies($stone);
+$marble = Adj->new('marble')->implies($stone);
+
+$mud = Adj->new('mud')->implies($earth);
+$clay = Adj->new('clay')->implies($earth);
+
+$gas = Adj->new('gas');
+$air = Adj->new('air')->implies($gas);
+
+$water = Adj->new('water');
+
+$heat = Adj->new('heat');
+$fire = Adj->new('fire')->implies($heat);
+
+$steam = Adj->new('steam')->implies($heat)->implies($air)->implies($water);
+
+$cold = Adj->new('cold');
+$ice  = Adj->new('ice')->implies($cold)->implies($water);
+
+$acid = Adj->new('acid');
+$electricity = Adj->new('electricity');
+
+$plant = Adj->new('plant');
+$garlic = Adj->new('garlic')->implies($plant);
+$mint = Adj->new('mint')->implies($plant);
+$holly = Adj->new('holly')->implies($plant);
+$wood = Adj->new('wood')->implies($plant);
+
+$flesh = Adj->new('flesh');
+$leather = Adj->new('leather')->implies($flesh);
+
+$bone  = Adj->new('bone');
+$wax   = Adj->new('wax');
+$jelly = Adj->new('jelly');
+$silk  = Adj->new('silk');
+$canvas= Adj->new('canvas');
+$fur   = Adj->new('fur');
+
+$kinetic = Adj->new('kinetic');
+$crushing = Adj->new('crushing')->implies($kinetic);
+$cutting  = Adj->new('cutting')->implies($kinetic);
+$piercing = Adj->new('piercing')->implies($kinetic);
+
+$explosion = Adj->new('explosion');
+
+$magic = Adj->new('magic');
+$curse = Adj->new('curse');
+$blessing = Adj->new('blessing');  # to do: much more complex in the future, I swear
+
+$written = Adj->new('written');
+$edible  = Adj->new('edible');
+$liquid  = Adj->new('liquid');
+
+$weapon = Adj->new('weapon');
+$bolt = Adj->new('bolt')->implies($weapon);
+$arrow = Adj->new('arrow')->implies($weapon);
+$round = Adj->new('round')->implies($weapon);
+$knife = Adj->new('knife')->implies($weapon);  # includes daggers
+$club = Adj->new('club')->implies($weapon);
+$card = Adj->new('card')->implies($weapon);
+$axe = Adj->new('axe')->implies($weapon);
+
+$bow = Adj->new('bow')->implies($weapon);
+$crossbow = Adj->new('crossbow')->implies($weapon);
+
+$hammer = Adj->new('hammer')->implies($weapon);  # includes maces
+$sword = Adj->new('sword')->implies($weapon);
+$flail = Adj->new('flail')->implies($weapon);
+$two_handed = Adj->new('two-handed')->implies($weapon);
+
+$flute    = Adj->new('flute');
+$reed     = Adj->new('reed');
+$horn     = Adj->new('horn');
+$harp     = Adj->new('harp');
+$keyboard = Adj->new('keyboard');
+$lute     = Adj->new('lute');
+$viol     = Adj->new('viol');
+$drum     = Adj->new('drum');
+
+$wall     = Adj->new('wall');
+$obstacle = Adj->new('obstacle');
+
+$ethereal = Adj->new('ethereal');
+$aquatic  = Adj->new('aquatic');
+$airborne = Adj->new('airborne');
+
+1;
-package Attack;
-@ISA = qw( Cloneable Saveable );
-
-# Attack objects - multiple claws, teeth etc - in CARPE DIEM
-
-# Copyright (c)2000-2013, Chris Pressey, Cat's Eye Technologies.
-# All rights reserved.
-# Distributed under a BSD-style license; see the file LICENSE for more info.
-
-use Carp;
-
-# our $AUTOLOAD;  # it's a package global
-
-my %fields =
-(
-  'attemptverb'   => 'attacks',
-  'successverb'   => 'hits',
-  'force'         => undef,
-  'accuracy'      => 0,
-  'followup'      => 0,  # only applicable if preceding attack suceeded
-  'autofollow'    => 0,  # >0 means automatically applicable if all n preceding attacks succeeded
-  'on_strike'     => '',
-);
-
-sub new
-{
-  my $class = shift;
-  my %params = @_;
-  my $self =
-  {
-    '_permitted' => \%fields,
-    %fields,
-    %params,
-  };
-  bless $self, $class;
-  return $self;
-}
-
-sub weapon
-{
-  my $class = shift;
-  my $ac = shift;
-  my $d = shift;
-  my @a = @_;
-  my $self =
-  {
-    '_permitted' => \%fields,
-    %fields,
-    'attemptverb'   => 'swings at',
-    'successverb'   => 'strikes',
-    'force'      => Force->new($d, @a),
-    'accuracy'   => $ac,
-  };
-  bless $self, $class;
-  return $self;
-}
-
-sub equal
-{
-  my $self = shift;
-  my $other = shift;
-
-  return $self->{attemptverb} eq $other->{attemptverb} and
-         $self->{successverb} eq $other->{successverb} and
-         $self->{accuracy} == $other->{accuracy} and
-         $self->{followup} == $other->{followup} and
-         $self->{autofollow} == $other->{autofollow} and
-         $self->{on_strike} == $other->{on_strike} and
-         $self->{force}->equal($other->{force});
-}
-
-1;
+package Attack;
+@ISA = qw( Cloneable Saveable );
+
+# Attack objects - multiple claws, teeth etc - in CARPE DIEM
+
+# Copyright (c)2000-2013, Chris Pressey, Cat's Eye Technologies.
+# All rights reserved.
+# Distributed under a BSD-style license; see the file LICENSE for more info.
+
+use Carp;
+
+# our $AUTOLOAD;  # it's a package global
+
+my %fields =
+(
+  'attemptverb'   => 'attacks',
+  'successverb'   => 'hits',
+  'force'         => undef,
+  'accuracy'      => 0,
+  'followup'      => 0,  # only applicable if preceding attack suceeded
+  'autofollow'    => 0,  # >0 means automatically applicable if all n preceding attacks succeeded
+  'on_strike'     => '',
+);
+
+sub new
+{
+  my $class = shift;
+  my %params = @_;
+  my $self =
+  {
+    '_permitted' => \%fields,
+    %fields,
+    %params,
+  };
+  bless $self, $class;
+  return $self;
+}
+
+sub weapon
+{
+  my $class = shift;
+  my $ac = shift;
+  my $d = shift;
+  my @a = @_;
+  my $self =
+  {
+    '_permitted' => \%fields,
+    %fields,
+    'attemptverb'   => 'swings at',
+    'successverb'   => 'strikes',
+    'force'      => Force->new($d, @a),
+    'accuracy'   => $ac,
+  };
+  bless $self, $class;
+  return $self;
+}
+
+sub equal
+{
+  my $self = shift;
+  my $other = shift;
+
+  return $self->{attemptverb} eq $other->{attemptverb} and
+         $self->{successverb} eq $other->{successverb} and
+         $self->{accuracy} == $other->{accuracy} and
+         $self->{followup} == $other->{followup} and
+         $self->{autofollow} == $other->{autofollow} and
+         $self->{on_strike} == $other->{on_strike} and
+         $self->{force}->equal($other->{force});
+}
+
+1;
-# Copyright (c)2000-2013, Chris Pressey, Cat's Eye Technologies.
-# All rights reserved.
-# Distributed under a BSD-style license; see the file LICENSE for more info.
-
-sub sexualize  # this should be implemented on the race object? ***
-{
-  my $self = shift;
-  if ($self->{sex} eq 'Male' and $self->{race} ne 'Ursati')
-  {
-    $self->{max}{strength}++;
-  }
-  elsif ($self->{sex} eq 'Female' and $self->{race} ne 'Ursati')
-  {
-    $self->{max}{dexterity}++;
-  }
-  elsif ($self->{sex} eq 'Female' and $self->{race} eq 'Ursati')
-  {
-    $self->{max}{strength}++;
-    $self->{max}{constitution}--;
-  }
-  $self->{name} = lcfirst($self->{sex}) . ' ' . $self->{name} unless $self->{proper};
-  return $self;
-}
-
-sub roll # a high-level constructor
-{
-  my $class = shift;
-  my %params = @_;
-  my $self; my $race = undef; my $sex = 'Cancel';
-  ::color('grey','black');
-  ::clrscr();
-  ::color('lime','black');
-  ::draw_box(1,1,$::pref{map_width},$::pref{map_height});
-  ::color('white','black');
-  ::draw_box($::pref{map_width}+1,1,$::setup{screen_width},$::pref{map_height});
-
-  my @rnam; my @rlor;
-  my $i;
-  for($i = 0; $i <= $#{$::pc_races}; $i++)
-  {
-    push @rnam, $::pc_races->[$i]{race};
-    push @rlor, $::pc_races->[$i]{lore};
-  }
-  while((not defined $race) or ($sex eq 'Cancel'))
-  {
-    $race = Menu->new( 'cancel' => undef, 'display_help' => 1,
-                       'value' => [@{$::pc_races}],
-                       'label' => [@rnam],
-                       'lore'  => [@rlor],
-                     )->pick;
-    if (defined $race and ref($race->{sex}) eq 'Distribution')
-    {
-      $sex = Menu->new('indent'=>1,'label' => ['Male','Female'], 'display_help' => 1,
-                       'lore'=>['Males generally have slightly greater raw strength than females.',
-                                'Females generally have slightly greater dexterity than males.'])->pick;
-    }
-    $sex = $race->{sex} if ref($race->{sex}) ne 'Distribution';
-  }
-
-roll_it:
-  $self = $race->clone;
-  $self->{sex} = $sex;
-  $self->sexualize;
-  $self->{color} = $self->{skin_color};
-
-  $self->heal_all;
-  $self->{proper} = 1;
-  $self->{body_aim} = 'smart_biped';
-  $self->view('character');
-
-  ::gen_bio($self);
-
-  ::color('grey','black');
-  ::gotoxy(4,21); ::display(::fit($self->{hair_type} . ' ' . $self->{hair_color} . " hair", 40) . '          ');
-  ::gotoxy(4,22); ::display(::fit($self->{eye_type}  . ' ' . $self->{eye_color}  . " eyes", 40) . '          ');
-  ::gotoxy(4,23); ::display(::fit($self->{skin_type} . ' ' . $self->{skin_color} . " skin", 40) . '          ');
-
-  ::gotoxy(4,20);
-  ::display("right-handed  ") if $self->{domhand} eq 'rhand'; 
-  ::display("left-handed   ") if $self->{domhand} eq 'lhand'; 
-  ::display("ambidextrous  ") if $self->{domhand} eq 'ambi'; 
-
-  ::gotoxy(4,3);
-  ::color('grey','black');
-  ::display("'R' to re-roll character stats or 'Enter' to accept.");
-  my $key = ::getkey;
-  if ($key eq 'r' or $key eq 'R') { goto roll_it; }
-  ::gotoxy(4,3);
-  ::display("                                                    ");
-
-  ::gotoxy(4,3);
-  ::display("Enter the name of this character: ");
-  $self->{name} = ::readstring(15)
-        || ($self->{sex} eq 'Male' ? $::male_name{$self->{race}}[::d(1,$#{$::male_name{$self->{race}}}+1)-1]
-                                   : $::female_name{$self->{race}}[::d(1,$#{$::female_name{$self->{race}}}+1)-1])
-        || $self->{race};
-
-  my $d = $self->{domhand};
-  if ($d eq 'ambi')
-  {
-    $self->{ambidextrous} = 1;
-    $d = $self->{domhand} = 'rhand';
-  }
-
-  return $self;
-}
-
-# returns: ref to Item
-# or undef if action cancelled
-# or 0 if no applicable items
-sub choose_item
-{
-  my $self = shift;
-  my @type = @_;
-
-  my $x; my @r; my @ru; my $j = 0; my $map = {};
-  my @r2; my @ru2;
-  while ($j <= $#{$self->{belongings}})
-  {
-    $x = $self->{belongings}[$j++];
-    my $inc = 0;
-    if ($#type == -1)
-    {
-      $inc = 1;
-    } else
-    {
-      my $t;
-      foreach $t (@type)
-      {
-        if ((ref($t) eq 'Adj' and $x->is($t))
-             or exists $x->{worn_on}{$t}
-             or ($t eq 'sell!' and defined $x->{value})
-             or ($t eq 'buy!'  and defined $x->{value}))
-        {
-          $inc = 1;