1 |
=head1 NAME |
2 |
|
3 |
Jeweler |
4 |
|
5 |
=head1 DESCRIPTION |
6 |
|
7 |
The Jeweler skill helper module. |
8 |
|
9 |
=cut |
10 |
|
11 |
package Jeweler; |
12 |
|
13 |
=over 4 |
14 |
|
15 |
=item @RESISTS |
16 |
|
17 |
List of all resistancies that can occur on rings and amulets. |
18 |
|
19 |
=cut |
20 |
|
21 |
my @RESISTS = ( |
22 |
cf::ATNR_PHYSICAL, |
23 |
cf::ATNR_MAGIC, |
24 |
cf::ATNR_FIRE, |
25 |
cf::ATNR_ELECTRICITY, |
26 |
cf::ATNR_COLD, |
27 |
cf::ATNR_CONFUSION, |
28 |
|
29 |
cf::ATNR_ACID, |
30 |
cf::ATNR_DRAIN, |
31 |
cf::ATNR_GHOSTHIT, |
32 |
cf::ATNR_POISON, |
33 |
cf::ATNR_SLOW, |
34 |
cf::ATNR_PARALYZE, |
35 |
|
36 |
cf::ATNR_TURN_UNDEAD, |
37 |
cf::ATNR_FEAR, |
38 |
cf::ATNR_DEPLETE, |
39 |
cf::ATNR_DEATH, |
40 |
cf::ATNR_HOLYWORD, |
41 |
cf::ATNR_LIFE_STEALING, |
42 |
|
43 |
cf::ATNR_BLIND, |
44 |
cf::ATNR_DISEASE, |
45 |
); |
46 |
|
47 |
=item @EFFECT_RESISTS |
48 |
|
49 |
List of all effect resistancies that occur on rings and amulets. |
50 |
The difference is made because effect resistancies are less effective at lower levels. |
51 |
|
52 |
=cut |
53 |
|
54 |
my @EFFECT_RESISTS = ( |
55 |
cf::ATNR_CONFUSION, |
56 |
cf::ATNR_DRAIN, |
57 |
cf::ATNR_POISON, |
58 |
cf::ATNR_SLOW, |
59 |
cf::ATNR_PARALYZE, |
60 |
cf::ATNR_TURN_UNDEAD, |
61 |
cf::ATNR_FEAR, |
62 |
cf::ATNR_DEPLETE, |
63 |
cf::ATNR_DEATH, |
64 |
cf::ATNR_BLIND, |
65 |
cf::ATNR_DISEASE, |
66 |
); |
67 |
|
68 |
my %RESMAP = ( |
69 |
cf::ATNR_PHYSICAL => "PHYSICAL", |
70 |
cf::ATNR_MAGIC => "MAGIC", |
71 |
cf::ATNR_FIRE => "FIRE", |
72 |
cf::ATNR_ELECTRICITY => "ELECTRICITY", |
73 |
cf::ATNR_COLD => "COLD", |
74 |
cf::ATNR_CONFUSION => "CONFUSION", |
75 |
cf::ATNR_ACID => "ACID", |
76 |
|
77 |
cf::ATNR_DRAIN => "DRAIN", |
78 |
cf::ATNR_GHOSTHIT => "GHOSTHIT", |
79 |
cf::ATNR_POISON => "POISON", |
80 |
cf::ATNR_SLOW => "SLOW", |
81 |
cf::ATNR_PARALYZE => "PARALYZE", |
82 |
cf::ATNR_TURN_UNDEAD => "TURN_UNDEAD", |
83 |
|
84 |
cf::ATNR_FEAR => "FEAR", |
85 |
cf::ATNR_DEPLETE => "DEPLETE", |
86 |
cf::ATNR_DEATH => "DEATH", |
87 |
cf::ATNR_HOLYWORD => "HOLYWORD", |
88 |
cf::ATNR_LIFE_STEALING => "LIFE_STEALING", |
89 |
cf::ATNR_BLIND => "BLIND", |
90 |
cf::ATNR_DISEASE => "DISEASE", |
91 |
); |
92 |
|
93 |
=back |
94 |
|
95 |
=cut |
96 |
|
97 |
package Jeweler::CauldronHandler; |
98 |
|
99 |
=head2 CauldronHandler |
100 |
|
101 |
The Jeweler::CauldronHandler package, that helps you with handling the |
102 |
cauldron stuff. Can also be used for other skills. |
103 |
|
104 |
=cut |
105 |
|
106 |
sub new { |
107 |
my ($class, %arg) = @_; |
108 |
|
109 |
my $self = bless { |
110 |
%arg, |
111 |
}, $class; |
112 |
|
113 |
$self; |
114 |
} |
115 |
|
116 |
=over 4 |
117 |
|
118 |
=item find_cauldron ($arch_name, @map_stack) |
119 |
|
120 |
This finds the cauldron with C<$arch_name> on the C<@map_stack> and initalises the CauldronHandler. |
121 |
It takes the topmost cauldron that is found. Returns undef if no cauldron was found. |
122 |
Returns the cauldron object if it was found. |
123 |
|
124 |
=cut |
125 |
|
126 |
sub find_cauldron { |
127 |
my ($self, $arch_name, @map_stack) = @_; |
128 |
|
129 |
my @c = |
130 |
grep { |
131 |
$_->flag (cf::FLAG_IS_CAULDRON) |
132 |
and $_->archetype->name eq $arch_name |
133 |
} @map_stack; |
134 |
|
135 |
$self->{cauldron} = $c[0]; |
136 |
} |
137 |
|
138 |
=item grep_by_type (@types) |
139 |
|
140 |
Finds all objects in the cauldron that have the type of one of C<@types>. |
141 |
|
142 |
=cut |
143 |
|
144 |
sub grep_by_type { |
145 |
my ($self, @types) = @_; |
146 |
|
147 |
return () unless $self->{cauldron}; |
148 |
|
149 |
my @res = grep { |
150 |
my $ob = $_; |
151 |
(grep { $ob->type == $_ } @types) > 0 |
152 |
} $self->{cauldron}->inv; |
153 |
|
154 |
return @res |
155 |
} |
156 |
|
157 |
=item extract_jeweler_ingredients |
158 |
|
159 |
Extracts the ingredients that matter for the Jeweler skill |
160 |
and returns a Jeweler::Ingredients object. |
161 |
|
162 |
=cut |
163 |
|
164 |
sub extract_jeweler_ingredients { |
165 |
my ($self) = @_; |
166 |
|
167 |
return () unless $self->{cauldron}; |
168 |
|
169 |
my $ingreds = {}; |
170 |
|
171 |
my %type_to_key = ( |
172 |
cf::RING => 'rings', |
173 |
cf::AMULET => 'ammys', |
174 |
cf::INORGANIC => 'mets_and_mins', |
175 |
cf::GEM => 'gems', |
176 |
cf::POTION => 'potions', |
177 |
cf::SCROLL => 'scrolls', |
178 |
); |
179 |
|
180 |
for ($self->{cauldron}->inv) { |
181 |
|
182 |
if (my $k = $type_to_key{$_->type}) { |
183 |
push @{$ingreds->{$k}}, $_; |
184 |
|
185 |
} else { |
186 |
Jeweler::Util::remove ($_); |
187 |
} |
188 |
} |
189 |
|
190 |
return Jeweler::Ingredients->new (ingredients => $ingreds, cauldron_helper => $self) |
191 |
} |
192 |
|
193 |
=item put ($object) |
194 |
|
195 |
Just puts the C<$object> into the cauldron. |
196 |
|
197 |
=cut |
198 |
|
199 |
sub put { |
200 |
my ($self, $obj) = @_; |
201 |
|
202 |
return undef unless $self->{cauldron}; |
203 |
|
204 |
$obj->insert_ob_in_ob ($self->{cauldron}); |
205 |
} |
206 |
|
207 |
=back |
208 |
|
209 |
=cut |
210 |
|
211 |
package Jeweler::Ingredients; |
212 |
|
213 |
=head2 Ingredients |
214 |
|
215 |
This class handles the ingredients. |
216 |
|
217 |
=over 4 |
218 |
|
219 |
=item new (ingredients => $ingred_hash) |
220 |
|
221 |
This is called from the CauldronHandler that gives you the ingredients. |
222 |
|
223 |
=cut |
224 |
|
225 |
sub new { |
226 |
my ($class, %arg) = @_; |
227 |
|
228 |
my $self = bless { |
229 |
%arg, |
230 |
}, $class; |
231 |
|
232 |
$self; |
233 |
} |
234 |
|
235 |
=item value ($group, $archname) |
236 |
|
237 |
Returns the value of the ingredients in C<$group> with the archetypename C<$archname>. |
238 |
|
239 |
=cut |
240 |
|
241 |
sub value { |
242 |
my ($self, $group, $archname) = @_; |
243 |
|
244 |
my @objs = grep { |
245 |
$_->archetype->name eq $archname |
246 |
} @{$self->{ingredients}->{$group} || []}; |
247 |
|
248 |
my $sum = 0; |
249 |
for (@objs) { |
250 |
$sum += $_->nrof * $_->value; |
251 |
} |
252 |
|
253 |
return $sum; |
254 |
} |
255 |
|
256 |
=item remove ($group, $archname) |
257 |
|
258 |
Removes the ingredients in C<$group> with archname C<$archname>. |
259 |
|
260 |
=cut |
261 |
|
262 |
sub remove { |
263 |
my ($self, $group, $archname) = @_; |
264 |
|
265 |
my $ingred = $self->{ingredients}; |
266 |
|
267 |
my @out; |
268 |
|
269 |
for (@{$ingred->{$group}}) { |
270 |
if ($_->archetype->name eq $archname) { |
271 |
Jeweler::Util::remove ($_); |
272 |
} else { |
273 |
push @out, $_; |
274 |
} |
275 |
} |
276 |
|
277 |
@{$ingred->{$grp}} = @out; |
278 |
} |
279 |
|
280 |
=back |
281 |
|
282 |
=cut |
283 |
|
284 |
package Jeweler::Util; |
285 |
|
286 |
=head2 Util |
287 |
|
288 |
Some utility functions for the Jeweler skill. |
289 |
|
290 |
=over 4 |
291 |
|
292 |
=item remove ($object) |
293 |
|
294 |
Removes the C<$object> and it's inventory recursivley from the game. |
295 |
|
296 |
=cut |
297 |
|
298 |
sub remove { |
299 |
my ($obj) = @_; |
300 |
|
301 |
remove ($_) for ($obj->inv); |
302 |
$obj->remove; |
303 |
$obj->free; |
304 |
} |
305 |
|
306 |
=back |
307 |
|
308 |
=back |
309 |
|
310 |
1 |