| … | |
… | |
| 7 | The Jeweler skill helper module. |
7 | The Jeweler skill helper module. |
| 8 | |
8 | |
| 9 | =cut |
9 | =cut |
| 10 | |
10 | |
| 11 | package Jeweler; |
11 | package Jeweler; |
|
|
12 | use strict; |
|
|
13 | use YAML; |
| 12 | |
14 | |
| 13 | =over 4 |
15 | =over 4 |
| 14 | |
16 | |
| 15 | =item @RESISTS |
17 | =item @RESISTS |
| 16 | |
18 | |
| 17 | List of all resistancies that can occur on rings and amulets. |
19 | List of all resistancies that can occur on rings and amulets. |
| 18 | |
20 | |
| 19 | =cut |
21 | =cut |
| 20 | |
22 | |
|
|
23 | our $CFG; |
|
|
24 | |
|
|
25 | sub read_config { |
|
|
26 | my ($filename) = @_; |
|
|
27 | |
|
|
28 | unless (-e $filename) { |
|
|
29 | warn "$filename doesn't exists! no config for jeweler skill loaded!\n"; |
|
|
30 | $CFG = {}; |
|
|
31 | return |
|
|
32 | } |
|
|
33 | |
|
|
34 | $CFG = YAML::LoadFile $filename; |
|
|
35 | } |
|
|
36 | |
|
|
37 | sub getcfg { |
|
|
38 | my ($sect, $key) = @_; |
|
|
39 | my $cfg = $CFG->{$sect}->{$key} |
|
|
40 | or die "Couldn't find $sect/$key in configuration!"; |
|
|
41 | |
|
|
42 | $cfg |
|
|
43 | } |
|
|
44 | |
|
|
45 | # makes a template arch (for example to get the value) |
|
|
46 | sub get_arch { |
|
|
47 | my ($outarch) = @_; |
|
|
48 | unless ($CFG->{arch}->{$outarch}) { |
|
|
49 | $CFG->{arch}->{$outarch} = cf::object::new $outarch; |
|
|
50 | |
|
|
51 | unless ($CFG->{arch}->{$outarch}) { |
|
|
52 | warn "ERROR: Couldn't make $outarch in conversion for $outarch!"; |
|
|
53 | return; |
|
|
54 | } |
|
|
55 | } |
|
|
56 | $CFG->{arch}->{$outarch} |
|
|
57 | } |
|
|
58 | |
| 21 | my @RESISTS = ( |
59 | our @RESISTS = ( |
| 22 | cf::ATNR_PHYSICAL, |
60 | cf::ATNR_PHYSICAL, |
| 23 | cf::ATNR_MAGIC, |
61 | cf::ATNR_MAGIC, |
| 24 | cf::ATNR_FIRE, |
62 | cf::ATNR_FIRE, |
| 25 | cf::ATNR_ELECTRICITY, |
63 | cf::ATNR_ELECTRICITY, |
| 26 | cf::ATNR_COLD, |
64 | cf::ATNR_COLD, |
| … | |
… | |
| 47 | =item @EFFECT_RESISTS |
85 | =item @EFFECT_RESISTS |
| 48 | |
86 | |
| 49 | List of all effect resistancies that occur on rings and amulets. |
87 | 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. |
88 | The difference is made because effect resistancies are less effective at lower levels. |
| 51 | |
89 | |
| 52 | =cut |
90 | =back |
| 53 | |
91 | |
|
|
92 | =cut |
|
|
93 | |
| 54 | my @EFFECT_RESISTS = ( |
94 | our @EFFECT_RESISTS = ( |
| 55 | cf::ATNR_CONFUSION, |
95 | cf::ATNR_CONFUSION, |
| 56 | cf::ATNR_DRAIN, |
96 | cf::ATNR_DRAIN, |
| 57 | cf::ATNR_POISON, |
97 | cf::ATNR_POISON, |
| 58 | cf::ATNR_SLOW, |
98 | cf::ATNR_SLOW, |
| 59 | cf::ATNR_PARALYZE, |
99 | cf::ATNR_PARALYZE, |
| … | |
… | |
| 63 | cf::ATNR_DEATH, |
103 | cf::ATNR_DEATH, |
| 64 | cf::ATNR_BLIND, |
104 | cf::ATNR_BLIND, |
| 65 | cf::ATNR_DISEASE, |
105 | cf::ATNR_DISEASE, |
| 66 | ); |
106 | ); |
| 67 | |
107 | |
| 68 | my %RESMAP = ( |
108 | our %RESMAP = ( |
| 69 | cf::ATNR_PHYSICAL => "PHYSICAL", |
109 | cf::ATNR_PHYSICAL => "PHYSICAL", |
| 70 | cf::ATNR_MAGIC => "MAGIC", |
110 | cf::ATNR_MAGIC => "MAGIC", |
| 71 | cf::ATNR_FIRE => "FIRE", |
111 | cf::ATNR_FIRE => "FIRE", |
| 72 | cf::ATNR_ELECTRICITY => "ELECTRICITY", |
112 | cf::ATNR_ELECTRICITY => "ELECTRICITY", |
| 73 | cf::ATNR_COLD => "COLD", |
113 | cf::ATNR_COLD => "COLD", |
| … | |
… | |
| 88 | cf::ATNR_LIFE_STEALING => "LIFE_STEALING", |
128 | cf::ATNR_LIFE_STEALING => "LIFE_STEALING", |
| 89 | cf::ATNR_BLIND => "BLIND", |
129 | cf::ATNR_BLIND => "BLIND", |
| 90 | cf::ATNR_DISEASE => "DISEASE", |
130 | cf::ATNR_DISEASE => "DISEASE", |
| 91 | ); |
131 | ); |
| 92 | |
132 | |
| 93 | =back |
133 | our %LVL_DIFF_CHANCES = ( |
|
|
134 | +5 => 100, |
|
|
135 | +4 => 95, |
|
|
136 | +3 => 85, |
|
|
137 | +2 => 75, |
|
|
138 | +1 => 65, |
|
|
139 | 0 => 50, |
|
|
140 | -1 => 45, |
|
|
141 | -2 => 35, |
|
|
142 | -3 => 25, |
|
|
143 | -4 => 10, |
|
|
144 | -5 => 0 |
|
|
145 | ); |
| 94 | |
146 | |
| 95 | =cut |
147 | our %LVL_DIFF_MSG = ( |
|
|
148 | -5 => '%s is way above your skill', |
|
|
149 | -4 => 'The chance to make %s is very low', |
|
|
150 | -3 => 'You hava a slight chance to make %s', |
|
|
151 | -2 => 'There is a low chance you finish %s', |
|
|
152 | -1 => 'You could make %s with a chance of nearly 50:50', |
|
|
153 | 0 => 'The chances to fininsh %s is 50:50', |
|
|
154 | 1 => 'To make %s your chance is slightly above 50:50', |
|
|
155 | 2 => 'You could make with a good chance %s if you concentrate a lot', |
|
|
156 | 3 => 'The chance you finish %s with some efford is high', |
|
|
157 | 4 => 'You are nearly confident to finish %s', |
|
|
158 | 5 => 'There is no chance you could fail to make %s', |
|
|
159 | ); |
|
|
160 | |
|
|
161 | sub level_diff_to_str { |
|
|
162 | my ($delta) = @_; |
|
|
163 | $delta = -5 if $delta < -5; |
|
|
164 | $delta = 5 if $delta > 5; |
|
|
165 | return $LVL_DIFF_MSG{$delta} |
|
|
166 | } |
|
|
167 | |
|
|
168 | sub level_diff_to_chance_perc { |
|
|
169 | my ($delta) = @_; |
|
|
170 | $delta = -5 if $delta < -5; |
|
|
171 | $delta = 5 if $delta > 5; |
|
|
172 | return $LVL_DIFF_CHANCES{$delta} |
|
|
173 | } |
|
|
174 | |
|
|
175 | sub analyze { |
|
|
176 | my ($sk, $chdl, $pl) = @_; |
|
|
177 | |
|
|
178 | for ($chdl->grep_by_type (cf::RING, cf::AMULET)) { |
|
|
179 | my $sklvl = cf::exp_to_level ($sk->stats->exp); |
|
|
180 | my $ringlvl = Jeweler::Object->new (object => $_)->power_to_level; |
|
|
181 | |
|
|
182 | if ($pl->get_flag (cf::FLAG_WIZ)) { |
|
|
183 | $pl->message ("The " . $_->name . " is at level $ringlvl chance for you: " . level_diff_to_chance_perc ($sklvl - $ringlvl)); |
|
|
184 | } else { |
|
|
185 | my $tmpl = level_diff_to_str ($sklvl - $ringlvl); |
|
|
186 | my $msg = sprintf $tmpl, $_->name; |
|
|
187 | $pl->message ($msg); |
|
|
188 | } |
|
|
189 | } |
|
|
190 | } |
|
|
191 | |
|
|
192 | # this function converts metals/minerals into a raw ring (of adornment) |
|
|
193 | sub simple_converter { |
|
|
194 | my ($pl, $ingred, $chdl, $conv) = @_; |
|
|
195 | |
|
|
196 | $conv = lc $conv; |
|
|
197 | my $cnvs = $CFG->{conversions}; |
|
|
198 | |
|
|
199 | return unless $cnvs->{$conv}; |
|
|
200 | |
|
|
201 | my %ingred_groups; |
|
|
202 | |
|
|
203 | my @conv_cfg = @{$cnvs->{$conv}}; |
|
|
204 | my $outarch = $conv; |
|
|
205 | my ($ingr_grp, $outarchvalfact, $srcarchname, $xp_gain) = @conv_cfg; |
|
|
206 | |
|
|
207 | unless (@conv_cfg <= 4) { |
|
|
208 | warn "ERROR: Conversion for '$outarch' has only " . (@conv_cfg) . " arguments!"; |
|
|
209 | return; |
|
|
210 | } |
|
|
211 | |
|
|
212 | unless ($xp_gain > 0) { |
|
|
213 | warn "WARNING: xp gain isn't > 0 in convesion '$outarch'\n"; |
|
|
214 | return; |
|
|
215 | } |
|
|
216 | |
|
|
217 | unless ($outarchvalfact) { |
|
|
218 | warn "ERROR: source-arch-value-multiplier == 0 in convesion '$outarch'\n"; |
|
|
219 | return; |
|
|
220 | } |
|
|
221 | |
|
|
222 | unless ($outarchvalfact >= 1) { |
|
|
223 | warn "WARNING: source-arch-value-multiplier < 1 in convesion '$outarch', results in more valuable output!\n"; |
|
|
224 | } |
|
|
225 | |
|
|
226 | my $archvalsum = $ingred->value ($cnvs->{$outarch}->[0], $cnvs->{$outarch}->[2]); |
|
|
227 | $ingred->remove ($cnvs->{$outarch}->[0], $cnvs->{$outarch}->[2]); |
|
|
228 | |
|
|
229 | my $outarchval = Jeweler::get_arch ($outarch)->value; |
|
|
230 | |
|
|
231 | my $nrof = int ($archvalsum / (($outarchval || 1000) * $outarchvalfact)); |
|
|
232 | if ($nrof) { |
|
|
233 | # XXX: yes, i know what i'm doing here, i don't set nrof, but it didn't work somehow (pls. chek sometimes) |
|
|
234 | $chdl->put (cf::object::new $outarch) for 1..$nrof; |
|
|
235 | |
|
|
236 | my $xp_sum = ($xp_gain * $nrof); |
|
|
237 | |
|
|
238 | if ($xp_sum) { |
|
|
239 | $pl->ob->message ("You got $xp_sum xp by making $nrof ${outarch}s"); |
|
|
240 | $pl->ob->change_exp ($xp_sum, "jeweler", cf::SK_EXP_ADD_SKILL); |
|
|
241 | } |
|
|
242 | } |
|
|
243 | } |
|
|
244 | |
| 96 | |
245 | |
| 97 | package Jeweler::CauldronHandler; |
246 | package Jeweler::CauldronHandler; |
|
|
247 | use strict; |
| 98 | |
248 | |
| 99 | =head2 CauldronHandler |
249 | =head2 CauldronHandler |
| 100 | |
250 | |
| 101 | The Jeweler::CauldronHandler package, that helps you with handling the |
251 | The Jeweler::CauldronHandler package, that helps you with handling the |
| 102 | cauldron stuff. Can also be used for other skills. |
252 | cauldron stuff. Can also be used for other skills. |
| … | |
… | |
| 207 | =back |
357 | =back |
| 208 | |
358 | |
| 209 | =cut |
359 | =cut |
| 210 | |
360 | |
| 211 | package Jeweler::Ingredients; |
361 | package Jeweler::Ingredients; |
|
|
362 | use Storable qw/dclone/; |
|
|
363 | use strict; |
| 212 | |
364 | |
| 213 | =head2 Ingredients |
365 | =head2 Ingredients |
| 214 | |
366 | |
| 215 | This class handles the ingredients. |
367 | This class handles the ingredients. |
| 216 | |
368 | |
| … | |
… | |
| 254 | } |
406 | } |
| 255 | |
407 | |
| 256 | =item remove ($group, $archname) |
408 | =item remove ($group, $archname) |
| 257 | |
409 | |
| 258 | Removes the ingredients in C<$group> with archname C<$archname>. |
410 | Removes the ingredients in C<$group> with archname C<$archname>. |
|
|
411 | It removes all in C<$group> if archname is undef. |
| 259 | |
412 | |
| 260 | =cut |
413 | =cut |
| 261 | |
414 | |
| 262 | sub remove { |
415 | sub remove { |
| 263 | my ($self, $group, $archname) = @_; |
416 | my ($self, $group, $archname) = @_; |
| … | |
… | |
| 265 | my $ingred = $self->{ingredients}; |
418 | my $ingred = $self->{ingredients}; |
| 266 | |
419 | |
| 267 | my @out; |
420 | my @out; |
| 268 | |
421 | |
| 269 | for (@{$ingred->{$group}}) { |
422 | for (@{$ingred->{$group}}) { |
|
|
423 | if (defined $archname) { |
| 270 | if ($_->archetype->name eq $archname) { |
424 | if ($_->archetype->name eq $archname) { |
|
|
425 | Jeweler::Util::remove ($_); |
|
|
426 | } else { |
|
|
427 | push @out, $_; |
|
|
428 | } |
|
|
429 | } else { |
| 271 | Jeweler::Util::remove ($_); |
430 | Jeweler::Util::remove ($_); |
|
|
431 | } |
|
|
432 | } |
|
|
433 | |
|
|
434 | @{$ingred->{$group}} = @out; |
|
|
435 | } |
|
|
436 | |
|
|
437 | sub get_plan { |
|
|
438 | my ($self) = @_; |
|
|
439 | |
|
|
440 | my $ingred = $self->{ingredients}; |
|
|
441 | |
|
|
442 | for my $grp (keys %$ingred) { |
|
|
443 | for my $pot (@{$ingred->{$grp}}) { |
|
|
444 | for my $plan (keys %{$Jeweler::CFG->{plans}}) { |
|
|
445 | my $plg = $Jeweler::CFG->{plans}->{$plan}; |
|
|
446 | my @plga = (); |
|
|
447 | unless (ref $plg eq 'ARRAY') { |
|
|
448 | push @plga, $plg; |
|
|
449 | } else { |
|
|
450 | @plga = @$plg; |
|
|
451 | } |
|
|
452 | next unless @plga > 0; |
|
|
453 | if (Jeweler::Util::grep_for_match ($pot, @plga)) { |
|
|
454 | warn "MATCHED: $plan: @plga\n"; |
|
|
455 | return $plan; |
|
|
456 | } |
|
|
457 | } |
|
|
458 | } |
|
|
459 | } |
|
|
460 | } |
|
|
461 | |
|
|
462 | sub get_ring { |
|
|
463 | my ($self) = @_; |
|
|
464 | return ( |
|
|
465 | @{$self->{ingredients}->{ammys} || []}, |
|
|
466 | @{$self->{ingredients}->{rings} || []} |
|
|
467 | ); |
|
|
468 | } |
|
|
469 | |
|
|
470 | sub improve_ring_by_plan { |
|
|
471 | my ($self, $plan, $ring) = @_; |
|
|
472 | |
|
|
473 | $ring = dclone ($ring); |
|
|
474 | |
|
|
475 | my $ingred = $self->{ingredients}; |
|
|
476 | my $impr = {}; |
|
|
477 | |
|
|
478 | if ($plan =~ m/^stat_(\S+)$/) { |
|
|
479 | my $statname = $1; |
|
|
480 | my $plingred = Jeweler::getcfg (plans => $plan) |
|
|
481 | or die "ingredients for plan '$plan' not defined!"; |
|
|
482 | |
|
|
483 | my $cnt = 0; |
|
|
484 | for my $pot (@{$ingred->{potions}}) { |
|
|
485 | if (Jeweler::Util::grep_for_match ($pot, @$plingred)) { |
|
|
486 | $cnt += $pot->nrof; |
|
|
487 | } |
|
|
488 | } |
|
|
489 | warn "Found $cnt potions for plan $plan\n"; |
|
|
490 | |
|
|
491 | my $did_impr = 0; |
|
|
492 | for my $x (reverse 1..10) { |
|
|
493 | my $y = Jeweler::Object::fx ($x, 'stat_potions'); |
|
|
494 | warn "TEST: fx($x): $y->[0] <= $cnt \n"; |
|
|
495 | warn "FE: " . ($y->[0] == $cnt) . "\n"; |
|
|
496 | if ($cnt >= $y->[0]) { |
|
|
497 | $ring->{hash}->{stat}->{$statname} += $x; |
|
|
498 | $did_impr = 1; |
|
|
499 | warn "Found stat increase of $statname +$x\n"; |
|
|
500 | last; |
|
|
501 | } |
|
|
502 | } |
|
|
503 | |
|
|
504 | # we want at least this improvement if we have a plan... |
|
|
505 | $ring->{hash}->{stat}->{$statname} += 1 unless $did_impr; |
|
|
506 | |
|
|
507 | } elsif ($plan =~ m/^spec_(\S+)$/) { |
|
|
508 | } elsif ($plan =~ m/^resist_(\S+)$/) { |
|
|
509 | } |
|
|
510 | |
|
|
511 | return $ring; |
|
|
512 | } |
|
|
513 | |
|
|
514 | sub do_grep { |
|
|
515 | my ($self, $cb, @grepar) = @_; |
|
|
516 | |
|
|
517 | my $ingred = $self->{ingredients}; |
|
|
518 | |
|
|
519 | |
|
|
520 | for my $cat (keys %$ingred) { |
|
|
521 | my @rem; |
|
|
522 | for my $ing (@{$ingred->{$cat}}) { |
|
|
523 | if (Jeweler::Util::grep_for_match ($ing, @grepar)) { |
|
|
524 | unless ($cb->($ing)) { |
|
|
525 | push @rem, $ing; |
|
|
526 | } |
|
|
527 | } else { |
|
|
528 | push @rem, $ing; |
|
|
529 | } |
|
|
530 | } |
|
|
531 | @{$ingred->{$cat}} = @rem; |
|
|
532 | } |
|
|
533 | } |
|
|
534 | |
|
|
535 | sub check_costs { |
|
|
536 | my ($self, $costs, $do_remove) = @_; |
|
|
537 | |
|
|
538 | my $costs = dclone ($costs); |
|
|
539 | |
|
|
540 | for my $key (keys %$costs) { |
|
|
541 | my @grepar; |
|
|
542 | if ($key =~ m/^stat_(\S+)$/) { |
|
|
543 | @grepar = @{Jeweler::getcfg (plans => $key) || []}; |
| 272 | } else { |
544 | } else { |
| 273 | push @out, $_; |
545 | @grepar = (undef, undef, $key); |
|
|
546 | } |
|
|
547 | |
|
|
548 | if ($do_remove) { |
|
|
549 | my $rem = $costs->{$key}; |
|
|
550 | $self->do_grep (sub { if ($rem) { $rem = Jeweler::Util::remove ($_[0], $rem); } 1 }, @grepar); |
|
|
551 | if ($rem > 0) { |
|
|
552 | warn "JEWELER BUG: removed ingredients $rem > 0 after removing!"; |
| 274 | } |
553 | } |
|
|
554 | } else { |
|
|
555 | my $nr; |
|
|
556 | $self->do_grep (sub { warn "CNT!\n"; $nr += $_[0]->nrof; 0 }, @grepar); |
|
|
557 | $costs->{$key} -= $nr; |
|
|
558 | } |
| 275 | } |
559 | } |
| 276 | |
560 | |
| 277 | @{$ingred->{$grp}} = @out; |
561 | return $costs; |
| 278 | } |
562 | } |
| 279 | |
563 | |
| 280 | =back |
564 | =back |
| 281 | |
565 | |
| 282 | =cut |
566 | =cut |
| 283 | |
567 | |
|
|
568 | sub put_to_bench { |
|
|
569 | my ($self, $bench) = @_; |
|
|
570 | |
|
|
571 | my $ingred = $self->{ingredients}; |
|
|
572 | |
|
|
573 | for my $ik (keys %$ingred) { |
|
|
574 | for (@{$ingred->{$ik} || []}) { |
|
|
575 | $bench->put ($_); |
|
|
576 | } |
|
|
577 | } |
|
|
578 | } |
|
|
579 | |
|
|
580 | package Jeweler::Object; |
|
|
581 | use strict; |
|
|
582 | use POSIX; |
|
|
583 | use List::Util qw/max min sum/; |
|
|
584 | |
|
|
585 | sub new { |
|
|
586 | my ($class, %arg) = @_; |
|
|
587 | |
|
|
588 | my $self = bless { }, $class; |
|
|
589 | |
|
|
590 | $self->ring_or_ammy_to_hash ($arg{object}); |
|
|
591 | |
|
|
592 | $self; |
|
|
593 | } |
|
|
594 | |
|
|
595 | sub fx { |
|
|
596 | my ($res, $cfg) = @_; |
|
|
597 | my $or = $res; |
|
|
598 | my $ar = $Jeweler::CFG->{functions}->{$cfg}; |
|
|
599 | if (ref $ar->[0] eq 'ARRAY') { |
|
|
600 | $res = $res - 1; |
|
|
601 | } else { |
|
|
602 | $res = ceil ($res / 5) - 1; |
|
|
603 | } |
|
|
604 | $ar->[max (min ($res, @$ar - 1), 0)]; |
|
|
605 | } |
|
|
606 | |
|
|
607 | sub improve_by_ring { |
|
|
608 | my ($self, @rings) = @_; |
|
|
609 | my $ring = $self; |
|
|
610 | for my $iring (@rings) { |
|
|
611 | for my $cat (qw/stat spec resist/) { |
|
|
612 | for my $k (keys %{$iring->{hash}->{$cat}}) { |
|
|
613 | if ($ring->{hash}->{$cat}->{$k} < $iring->{hash}->{$cat}->{$k}) { |
|
|
614 | $ring->{hash}->{$cat}->{$k} = $iring->{hash}->{$cat}->{$k}; |
|
|
615 | } |
|
|
616 | } |
|
|
617 | } |
|
|
618 | } |
|
|
619 | } |
|
|
620 | |
|
|
621 | sub ring_or_ammy_to_hash { |
|
|
622 | my ($self, $thing) = @_; |
|
|
623 | |
|
|
624 | my $obj = {}; |
|
|
625 | |
|
|
626 | for (@Jeweler::RESISTS) { |
|
|
627 | $obj->{resist}->{$_} = $thing->get_resistance ($_); |
|
|
628 | } |
|
|
629 | |
|
|
630 | my $stats = $thing->stats; |
|
|
631 | |
|
|
632 | for (qw/Str Dex Con Wis Cha Int Pow/) { |
|
|
633 | $obj->{stat}->{lc $_} = $stats->$_; |
|
|
634 | } |
|
|
635 | |
|
|
636 | $obj->{spec}->{regen} = $thing->hp; |
|
|
637 | $obj->{spec}->{magic} = $thing->sp; |
|
|
638 | $obj->{spec}->{wc} = $thing->wc; |
|
|
639 | $obj->{spec}->{dam} = $thing->dam; |
|
|
640 | $obj->{spec}->{ac} = $thing->ac; |
|
|
641 | $obj->{spec}->{speed} = $thing->stats->exp; |
|
|
642 | $obj->{spec}->{suste} = $thing->food; |
|
|
643 | |
|
|
644 | $obj->{name} = $thing->name; |
|
|
645 | $obj->{arch} = $thing->archetype->name; |
|
|
646 | $obj->{face} = $thing->face; |
|
|
647 | |
|
|
648 | $self->{hash} = $obj |
|
|
649 | } |
|
|
650 | |
|
|
651 | sub to_object { |
|
|
652 | my ($self) = @_; |
|
|
653 | my $obj = cf::object::new $self->{hash}->{arch}; |
|
|
654 | $obj->set_face ($self->{hash}->{face}); |
|
|
655 | |
|
|
656 | $obj->set_hp ($self->{hash}->{spec}->{regen} * 1); |
|
|
657 | $obj->set_sp ($self->{hash}->{spec}->{magic} * 1); |
|
|
658 | $obj->set_wc ($self->{hash}->{spec}->{wc} * 1); |
|
|
659 | $obj->set_dam ($self->{hash}->{spec}->{dam} * 1); |
|
|
660 | $obj->set_ac ($self->{hash}->{spec}->{ac} * 1); |
|
|
661 | $obj->stats->exp ($self->{hash}->{spec}->{speed} * 1); |
|
|
662 | $obj->set_food ($self->{hash}->{spec}->{suste} * 1); |
|
|
663 | |
|
|
664 | for (qw/Str Dex Con Wis Cha Int Pow/) { |
|
|
665 | $obj->stats->$_ ($self->{hash}->{stat}->{lc $_} * 1); |
|
|
666 | } |
|
|
667 | |
|
|
668 | for (@Jeweler::RESISTS) { |
|
|
669 | $obj->set_resistance ($_, $self->{hash}->{resist}->{$_} * 1); |
|
|
670 | } |
|
|
671 | |
|
|
672 | $obj->set_flag (cf::FLAG_IDENTIFIED, 1); |
|
|
673 | |
|
|
674 | return $obj; |
|
|
675 | } |
|
|
676 | |
|
|
677 | sub stat_level { |
|
|
678 | my ($self) = @_; |
|
|
679 | my $stats = $self->{hash}->{stat} || {}; |
|
|
680 | |
|
|
681 | my $maxlevel = Jeweler::getcfg (maxlevels => 'stat_level'); |
|
|
682 | my $maxstat = Jeweler::getcfg (maximprovements => 'stats'); |
|
|
683 | |
|
|
684 | my $stat_cnt = scalar (grep { $_ > 0 } values %$stats); |
|
|
685 | my $stat_sum = sum (values %$stats); |
|
|
686 | my $level = int (($maxlevel / $maxstat) * $stat_sum); |
|
|
687 | |
|
|
688 | ($level, $stat_cnt) |
|
|
689 | } |
|
|
690 | |
|
|
691 | sub resist_level { |
|
|
692 | my ($self) = @_; |
|
|
693 | |
|
|
694 | my $resists = $self->{hash}->{resist} || {}; |
|
|
695 | |
|
|
696 | my $att_res_lvl = Jeweler::getcfg (maxlevels => 'resist_level'); |
|
|
697 | my $efc_res_lvl = Jeweler::getcfg (maxlevels => 'effect_resist_level'); |
|
|
698 | my $max_att_res = Jeweler::getcfg (maximprovements => 'attack_resistances'); |
|
|
699 | my $max_efc_res = Jeweler::getcfg (maximprovements => 'effect_resistances'); |
|
|
700 | my $max_ovr_res = Jeweler::getcfg (maximprovements => 'resistances'); |
|
|
701 | |
|
|
702 | my $ressum = 0; |
|
|
703 | my $rescnt = 0; |
|
|
704 | my @reslevels; |
|
|
705 | |
|
|
706 | for my $resnam (keys %$resists) { |
|
|
707 | my $res = $resists->{$resnam}; |
|
|
708 | |
|
|
709 | $rescnt++ |
|
|
710 | if $res > 0; # negative resistancies are not an improvement |
|
|
711 | |
|
|
712 | $ressum += $res; # note: negative resistancies lower the sum |
|
|
713 | |
|
|
714 | next unless $res > 0; |
|
|
715 | |
|
|
716 | my $level = 0; |
|
|
717 | if (grep { $resnam eq $_ } @Jeweler::EFFECT_RESISTS) { |
|
|
718 | $level = ceil (($efc_res_lvl / $max_efc_res) * $res); |
|
|
719 | } else { |
|
|
720 | $level = ceil (($att_res_lvl / $max_att_res) * $res); |
|
|
721 | } |
|
|
722 | push @reslevels, $level; |
|
|
723 | } |
|
|
724 | |
|
|
725 | my $overall_lvl = ($att_res_lvl / $max_ovr_res) * $ressum; |
|
|
726 | |
|
|
727 | (max (@reslevels, $overall_lvl), $rescnt); |
|
|
728 | } |
|
|
729 | |
|
|
730 | sub special_level { |
|
|
731 | my ($self) = @_; |
|
|
732 | |
|
|
733 | my $specials = $self->{hash}->{spec} || {}; |
|
|
734 | |
|
|
735 | my $max_spc_lvl = Jeweler::getcfg (maxlevels => 'spec_level'); |
|
|
736 | my $max_specials = Jeweler::getcfg (maximprovements => 'specials'); |
|
|
737 | |
|
|
738 | my @speclvls; |
|
|
739 | my $specsum = 0; |
|
|
740 | my $imprs = 0; |
|
|
741 | |
|
|
742 | for my $spcnam (keys %$specials) { |
|
|
743 | my $spc = $specials->{$spcnam}; |
|
|
744 | next unless $spc > 0; |
|
|
745 | |
|
|
746 | $specsum += $spc; |
|
|
747 | $imprs++; |
|
|
748 | |
|
|
749 | my $max_spc = Jeweler::getcfg (maxspecial => $spcnam); |
|
|
750 | |
|
|
751 | my $lvl = ($max_spc_lvl / $max_spc) * $spc; |
|
|
752 | push @speclvls, $lvl; |
|
|
753 | } |
|
|
754 | |
|
|
755 | my $sumlvl = ($max_spc_lvl / $max_specials) * $specsum; |
|
|
756 | |
|
|
757 | (max (@speclvls, $sumlvl), $imprs) |
|
|
758 | } |
|
|
759 | |
|
|
760 | |
|
|
761 | # this function calculated the 'level' of an amulet or a ring |
|
|
762 | sub power_to_level { |
|
|
763 | my ($self) = @_; |
|
|
764 | |
|
|
765 | my $max_imprs = Jeweler::getcfg (maximprovements => 'improvements'); |
|
|
766 | my $max_impr_lvl = Jeweler::getcfg (maxlevels => 'improve_level'); |
|
|
767 | |
|
|
768 | my ($stat_lvl, $stat_imprs) = $self->stat_level; |
|
|
769 | my ($resist_lvl, $res_imprs) = $self->resist_level; |
|
|
770 | my ($spec_lvl, $spec_imprs) = $self->special_level; |
|
|
771 | |
|
|
772 | my $impr_sum = $stat_imprs + $res_imprs + $spec_imprs; |
|
|
773 | |
|
|
774 | my $impr_lvl = ceil (($max_impr_lvl / ($max_imprs + 1)) * ($impr_sum - 1)); # 1 improvemnt bonus |
|
|
775 | |
|
|
776 | my $levl = int max ($stat_lvl, $resist_lvl, $impr_lvl, $spec_lvl, 0); |
|
|
777 | |
|
|
778 | my $cost = $self->calc_costs; |
|
|
779 | warn |
|
|
780 | sprintf "%3d: %50s: %s\n", $levl, $self->{hash}->{name}, |
|
|
781 | "stat: $stat_lvl, resist: $resist_lvl, improve: $impr_lvl, " |
|
|
782 | ."spec: $spec_lvl (num impr $stat_imprs + $res_imprs + $spec_imprs - 1)"; |
|
|
783 | |
|
|
784 | $levl |
|
|
785 | } |
|
|
786 | |
|
|
787 | sub add_stat_costs { |
|
|
788 | my ($self, $cost) = @_; |
|
|
789 | |
|
|
790 | my $stats = $self->{hash}->{stat}; |
|
|
791 | |
|
|
792 | for my $stat (keys %$stats) { |
|
|
793 | my $sum = $stats->{$stat}; |
|
|
794 | |
|
|
795 | next unless $sum > 0; |
|
|
796 | |
|
|
797 | my $statfx = fx ($sum, 'stat_potions'); |
|
|
798 | $cost->{"stat_$stat"} += $statfx->[0]; |
|
|
799 | split_diamonds ($cost, $statfx->[1], 'stat_' . $stat); |
|
|
800 | } |
|
|
801 | } |
|
|
802 | |
|
|
803 | sub add_special_costs { |
|
|
804 | my ($self, $cost) = @_; |
|
|
805 | |
|
|
806 | my $specials = $self->{hash}->{spec}; |
|
|
807 | |
|
|
808 | for my $spec (keys %$specials) { |
|
|
809 | my $sum = $specials->{$spec}; |
|
|
810 | |
|
|
811 | next unless $sum > 0; |
|
|
812 | |
|
|
813 | my $specfx = fx ($sum, 'spec_potions'); |
|
|
814 | $cost->{"spec_$spec"} += $specfx->[0]; |
|
|
815 | split_diamonds ($cost, $specfx->[1], 'spec_' . $spec); |
|
|
816 | } |
|
|
817 | } |
|
|
818 | |
|
|
819 | sub calc_costs { |
|
|
820 | my ($self) = @_; |
|
|
821 | |
|
|
822 | my $costs = {}; |
|
|
823 | |
|
|
824 | my $ring = $self->{hash}; |
|
|
825 | |
|
|
826 | for my $resnam (keys %{$ring->{resist} || {}}) { |
|
|
827 | |
|
|
828 | my $res = $ring->{resist}->{$resnam}; |
|
|
829 | |
|
|
830 | next unless $res > 0; |
|
|
831 | |
|
|
832 | $costs->{"resist_" . $Jeweler::RESMAP{$resnam} . "_item"} += $res; |
|
|
833 | |
|
|
834 | my $diamonds; |
|
|
835 | if (grep { $resnam eq $_ } @Jeweler::EFFECT_RESISTS) { |
|
|
836 | $diamonds += fx ($res, 'effect_resist_diamonds'); |
|
|
837 | } else { |
|
|
838 | $diamonds += fx ($res, 'attack_resist_diamonds'); |
|
|
839 | } |
|
|
840 | |
|
|
841 | split_diamonds ($costs, $diamonds, 'resist_' . $Jeweler::RESMAP{$resnam}); |
|
|
842 | } |
|
|
843 | |
|
|
844 | $self->add_stat_costs ($costs); |
|
|
845 | $self->add_special_costs ($costs); |
|
|
846 | |
|
|
847 | warn |
|
|
848 | sprintf "JEWEL ANALYSE: %40s: %s" , |
|
|
849 | $ring->{name}, |
|
|
850 | join (', ', map { "$_: " . sprintf "%.2f", $costs->{$_} } keys %$costs); |
|
|
851 | |
|
|
852 | return $costs; |
|
|
853 | } |
|
|
854 | |
|
|
855 | sub split_diamonds { |
|
|
856 | my ($cost, $diamonds, $category) = @_; |
|
|
857 | |
|
|
858 | my $stat_split = Jeweler::getcfg (diamond_split => $category); |
|
|
859 | |
|
|
860 | my $sum = sum (@$stat_split); |
|
|
861 | if ($sum < (1 - 0.0001)) { |
|
|
862 | warn "JEWELER BUG: sum (@$stat_split) = $sum < 1 for $category!"; |
|
|
863 | } |
|
|
864 | |
|
|
865 | my $emarch = Jeweler::get_arch ('emerald'); |
|
|
866 | my $saarch = Jeweler::get_arch ('sapphire'); |
|
|
867 | my $pearch = Jeweler::get_arch ('pearl'); |
|
|
868 | my $ruarch = Jeweler::get_arch ('ruby'); |
|
|
869 | my $diarch = Jeweler::get_arch ('gem'); |
|
|
870 | |
|
|
871 | my $sumvalue = $diarch->value * $diamonds; |
|
|
872 | |
|
|
873 | $cost->{emerald} += ceil (($sumvalue * $stat_split->[0]) / max (1, $emarch->value)); |
|
|
874 | $cost->{sapphire} += ceil (($sumvalue * $stat_split->[1]) / max (1, $saarch->value)); |
|
|
875 | $cost->{pearl} += ceil (($sumvalue * $stat_split->[2]) / max (1, $pearch->value)); |
|
|
876 | $cost->{ruby} += ceil (($sumvalue * $stat_split->[3]) / max (1, $ruarch->value)); |
|
|
877 | $cost->{gem} += ceil (($sumvalue * $stat_split->[4]) / max (1, $diarch->value)); |
|
|
878 | } |
|
|
879 | |
|
|
880 | |
|
|
881 | |
| 284 | package Jeweler::Util; |
882 | package Jeweler::Util; |
|
|
883 | use strict; |
| 285 | |
884 | |
| 286 | =head2 Util |
885 | =head2 Util |
| 287 | |
886 | |
| 288 | Some utility functions for the Jeweler skill. |
887 | Some utility functions for the Jeweler skill. |
| 289 | |
888 | |
| 290 | =over 4 |
889 | =over 4 |
| 291 | |
890 | |
| 292 | =item remove ($object) |
891 | =item remove ($object[, $nrof]) |
| 293 | |
892 | |
| 294 | Removes the C<$object> and it's inventory recursivley from the game. |
893 | Removes the C<$object>. If C<$nrof> is given, remove only C<$nrof> objects. |
|
|
894 | The returnvalue is the number of 'single' objects that couldn't be removed. |
| 295 | |
895 | |
| 296 | =cut |
896 | =cut |
| 297 | |
897 | |
| 298 | sub remove { |
898 | sub remove { |
| 299 | my ($obj) = @_; |
899 | my ($obj, $nrof) = @_; |
| 300 | |
900 | |
| 301 | remove ($_) for ($obj->inv); |
901 | #XXX: waht about this: remove ($_) for ($obj->inv) ? |
|
|
902 | |
|
|
903 | my $cnt = $obj->nrof - (1 * $nrof); |
|
|
904 | |
|
|
905 | if ($cnt > 0) { |
|
|
906 | $obj->set_nrof ($cnt); |
|
|
907 | return 0; |
|
|
908 | } else { |
| 302 | $obj->remove; |
909 | $obj->remove; |
| 303 | $obj->free; |
910 | $obj->free; |
|
|
911 | return $cnt; |
|
|
912 | } |
|
|
913 | } |
|
|
914 | |
|
|
915 | sub grep_for_match { |
|
|
916 | my ($thing, @matchar) = @_; |
|
|
917 | |
|
|
918 | my $i = 0; |
|
|
919 | for my $match (@matchar) { |
|
|
920 | if ($match =~ m/^\s*$/) { |
|
|
921 | $i++; |
|
|
922 | next; |
|
|
923 | } |
|
|
924 | |
|
|
925 | if ($i % 3 == 0) { |
|
|
926 | $thing->name eq $match |
|
|
927 | and return 1; |
|
|
928 | } elsif ($i % 3 == 1) { |
|
|
929 | $thing->title eq $match |
|
|
930 | and return 1; |
|
|
931 | } else { # $i % 3 == 2 |
|
|
932 | $thing->archetype->name eq $match |
|
|
933 | and return 1; |
|
|
934 | } |
|
|
935 | $i++; |
|
|
936 | } |
|
|
937 | return 0; |
| 304 | } |
938 | } |
| 305 | |
939 | |
| 306 | =back |
940 | =back |
| 307 | |
941 | |
| 308 | =back |
942 | =back |
