| NetHack-Item documentation | Contained in the NetHack-Item distribution. |
NetHack::Inventory - the player's inventory
version 0.13
use NetHack::ItemPool;
my $pool = NetHack::ItemPool->new;
$pool->new_item("x - 3 food rations");
$pool->inventory->get('x'); # NetHack::Item<3 food rations>
$pool->new_item("M - a unicorn horn");
# updates (not replaces!) the horn already in M
$pool->new_item("M - a blessed unicorn horn");
# replaces the horn in M because it's a different item
$pool->new_item("M - a scroll of taming");
| NetHack-Item documentation | Contained in the NetHack-Item distribution. |
package NetHack::Inventory; BEGIN { $NetHack::Inventory::VERSION = '0.13'; } use Moose; with 'NetHack::ItemPool::Role::HasPool'; use NetHack::Inventory::Equipment; use constant equipment_class => 'NetHack::Inventory::Equipment'; has inventory => ( traits => ['Hash'], is => 'ro', isa => 'HashRef[NetHack::Item]', default => sub { {} }, handles => { get => 'get', set => 'set', remove => 'delete', items => 'values', slots => 'keys', has_items => 'count', }, ); has equipment => ( is => 'ro', isa => 'NetHack::Inventory::Equipment', lazy => 1, handles => qr/^(?!update|remove|(has_)?pool|slots)\w/, default => sub { my $self = shift; $self->equipment_class->new( pool => $self->pool, ) }, ); has weight => ( is => 'ro', isa => 'Int', lazy => 1, builder => '_calculate_weight', clearer => 'invalidate_weight', ); has '+pool' => ( required => 1, ); sub _extract_slot { my ($slot, $item); if (@_ == 2) { ($slot, $item) = @_; $item->slot($slot); } else { $item = shift; $slot = $item->slot; confess "No slot was passed to set, and the item ($item) didn't have a value for its slot attribute." if !defined($slot); } return $slot => $item; } around set => sub { my $orig = shift; my $self = shift; my ($slot, $item) = _extract_slot(@_); # gold pieces don't belong in inventory return if $item->has_identity && $item->identity eq 'gold piece'; $self->$orig($slot => $item); }; sub update { my $self = shift; my $args = ref($_[0]) eq 'HASH' ? shift : {}; my ($slot, $item) = _extract_slot(@_); # gold pieces don't belong in inventory return if $item->has_identity && $item->identity eq 'gold piece'; if (my $old = $self->get($slot)) { if ($item->is_evolution_of($old)) { my $old_quantity = $old->quantity; $old->incorporate_stats_from($item); $old->slot($slot); $old->quantity($old_quantity + $item->quantity) if $args->{add} && $old->stackable; $self->equipment->update($old); $self->invalidate_weight; } else { warn "Displacing [" . $old->raw . "] in slot $slot with " . "[" . $item->raw . "]."; $self->set($slot => $item); } return $old; } $self->set($slot => $item); return $item; } sub add { shift->update({add => 1}, @_) } after 'set' => sub { my $self = shift; my $args = ref($_[0]) eq 'HASH' ? shift : {}; my (undef, $item) = _extract_slot(@_); $self->equipment->update($item); $self->invalidate_weight; }; before remove => sub { my $self = shift; my $item = $self->get(shift); $self->equipment->remove($item); }; sub exact_weight { my $self = shift; my $weight = 0; for my $item ($self->items) { return undef if !defined($item->weight); $weight += $item->weight; } return $weight; } sub _calculate_weight { my $self = shift; my ($total_min, $total_max) = (0, 0); for my $item ($self->items) { my ($min, $max) = (sort $item->spoiler_values('weight'))[0, -1]; $total_min += $min * $item->quantity; $total_max += $max * $item->quantity; } return int(($total_max + $total_min) / 2); } sub decrease_quantity { my $self = shift; my $slot = shift; my $by = shift || 1; my $item = $self->get($slot); if (!$item) { warn "Inventory->decrease_quantity called on an empty slot '$slot'"; return 0; } my $orig_quantity = $item->quantity; if ($by >= $orig_quantity) { $self->remove($slot); return 0; } $item->quantity($orig_quantity - $by); return $item->quantity; } __PACKAGE__->meta->make_immutable; no Moose; 1; __END__