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;