ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/maps/perl/Jeweler.pm
(Generate patch)

Comparing deliantra/maps/perl/Jeweler.pm (file contents):
Revision 1.1 by elmex, Sat Jul 15 12:57:41 2006 UTC vs.
Revision 1.6 by root, Fri Sep 8 16:22:14 2006 UTC

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

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines