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

Diff Legend

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