-
Notifications
You must be signed in to change notification settings - Fork 4
Expand file tree
/
Copy pathItemPool.pm
More file actions
135 lines (103 loc) · 2.78 KB
/
ItemPool.pm
File metadata and controls
135 lines (103 loc) · 2.78 KB
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
package NetHack::ItemPool;
use Moose;
use NetHack::Item;
use NetHack::Inventory;
use NetHack::ItemPool::Trackers;
use constant item_class => 'NetHack::Item';
use constant inventory_class => 'NetHack::Inventory';
use constant trackers_class => 'NetHack::ItemPool::Trackers';
has fruit_name => (
is => 'ro',
isa => 'Str',
default => 'slime mold',
);
has fruit_plural => (
is => 'ro',
isa => 'Str',
default => 'slime molds',
);
has allow_other_fruit_names => (
is => 'ro',
isa => 'Bool',
);
has artifacts => (
is => 'ro',
isa => 'HashRef',
default => sub { {} },
);
has inventory => (
is => 'ro',
isa => 'NetHack::Inventory',
lazy => 1,
default => sub {
my $self = shift;
$self->inventory_class->new(
pool => $self,
)
},
);
has trackers => (
is => 'ro',
isa => 'NetHack::ItemPool::Trackers',
lazy => 1,
default => sub {
my $self = shift;
$self->trackers_class->new(
pool => $self,
)
},
handles => [qw/tracker_for possible_appearances_of/],
);
sub _create_item {
my $self = shift;
unshift @_, 'raw' if @_ == 1;
return $self->item_class->new(@_, pool => $self);
}
sub new_item {
my $self = shift;
my $item = $self->_create_item(@_);
if ($item->is_artifact) {
if (my $existing_arti = $self->get_artifact($item->artifact)) {
$existing_arti->incorporate_stats_from($item);
$item = $existing_arti;
}
else {
$self->incorporate_artifact($item);
}
}
if ($item->has_appearance && (my $tracker = $self->tracker_for($item))) {
$item->_set_tracker($tracker);
}
return $item;
}
sub get_artifact {
my $self = shift;
my $name = shift;
return $self->artifacts->{$name};
}
sub incorporate_artifact {
my $self = shift;
my $item = shift;
return if $self->artifacts->{ $item->artifact };
$self->artifacts->{ $item->artifact } = $item;
}
__PACKAGE__->meta->make_immutable;
no Moose;
1;
__END__
=head1 NAME
NetHack::ItemPool - represents a universe of NetHack items
=head1 SYNOPSIS
use NetHack::ItemPool;
my $pool = NetHack::ItemPool->new;
my $excalibur = $pool->new_item("the +3 Excalibur (weapon in hand)");
is($pool->inventory->weapon, $excalibur);
=head1 DESCRIPTION
Objects of this class represent a universe of NetHack items. For example, each
instance of this class gets exactly one Magicbane, because each NetHack game
gets exactly one Magicbane.
An ItemPool also manages inventory (L<NetHack::Inventory>) and
equipment (L<NetHack::Inventory::Equipment>) for you.
More documentation to come. For now, the best resource is this module's test
suite.
=cut