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.4 by elmex, Fri Sep 1 13:40:05 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 if ($pl->get_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->get_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->get_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} = $thing->hp;
688 $obj->{spec}->{magic} = $thing->sp;
689 $obj->{spec}->{wc} = $thing->wc;
690 $obj->{spec}->{dam} = $thing->dam;
691 $obj->{spec}->{ac} = $thing->ac;
692 $obj->{spec}->{speed} = $thing->stats->exp;
693 $obj->{spec}->{suste} = $thing->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 my $obj = cf::object::new $self->{hash}->{arch};
705 $obj->set_face ($self->{hash}->{face});
706
707 $obj->set_hp ($self->{hash}->{spec}->{regen} * 1);
708 $obj->set_sp ($self->{hash}->{spec}->{magic} * 1);
709 $obj->set_wc ($self->{hash}->{spec}->{wc} * 1);
710 $obj->set_dam ($self->{hash}->{spec}->{dam} * 1);
711 $obj->set_ac ($self->{hash}->{spec}->{ac} * 1);
712 $obj->stats->exp ($self->{hash}->{spec}->{speed} * 1);
713 $obj->set_food ($self->{hash}->{spec}->{suste} * 1);
714
715 for (qw/Str Dex Con Wis Cha Int Pow/) {
716 $obj->stats->$_ ($self->{hash}->{stat}->{lc $_} * 1);
717 }
718
719 for (@Jeweler::RESISTS) {
720 $obj->set_resistance ($_, $self->{hash}->{resist}->{$_} * 1);
721 }
722
723 $obj->set_flag (cf::FLAG_IDENTIFIED, 1);
724
725 return $obj;
726}
727
728sub stat_level {
729 my ($self) = @_;
730 my $stats = $self->{hash}->{stat} || {};
731
732 my $maxlevel = Jeweler::getcfg (maxlevels => 'stat_level');
733 my $maxstat = Jeweler::getcfg (maximprovements => 'stats');
734
735 my $stat_cnt = scalar (grep { $_ > 0 } values %$stats);
736 my $stat_sum = sum (values %$stats);
737 my $level = int (($maxlevel / $maxstat) * $stat_sum);
738
739 ($level, $stat_cnt)
740}
741
742sub resist_level {
743 my ($self) = @_;
744
745 my $resists = $self->{hash}->{resist} || {};
746
747 my $att_res_lvl = Jeweler::getcfg (maxlevels => 'resist_level');
748 my $efc_res_lvl = Jeweler::getcfg (maxlevels => 'effect_resist_level');
749 my $max_att_res = Jeweler::getcfg (maximprovements => 'attack_resistances');
750 my $max_efc_res = Jeweler::getcfg (maximprovements => 'effect_resistances');
751 my $max_ovr_res = Jeweler::getcfg (maximprovements => 'resistances');
752
753 my $ressum = 0;
754 my $rescnt = 0;
755 my @reslevels;
756
757 for my $resnam (keys %$resists) {
758 my $res = $resists->{$resnam};
759
760 $rescnt++
761 if $res > 0; # negative resistancies are not an improvement
762
763 $ressum += $res; # note: negative resistancies lower the sum
764
765 next unless $res > 0;
766
767 my $level = 0;
768 if (grep { $resnam eq $_ } @Jeweler::EFFECT_RESISTS) {
769 $level = ceil (($efc_res_lvl / $max_efc_res) * $res);
770 } else {
771 $level = ceil (($att_res_lvl / $max_att_res) * $res);
772 }
773 push @reslevels, $level;
774 }
775
776 my $overall_lvl = ($att_res_lvl / $max_ovr_res) * $ressum;
777
778 (max (@reslevels, $overall_lvl), $rescnt);
779}
780
781sub special_level {
782 my ($self) = @_;
783
784 my $specials = $self->{hash}->{spec} || {};
785
786 my $max_spc_lvl = Jeweler::getcfg (maxlevels => 'spec_level');
787 my $max_specials = Jeweler::getcfg (maximprovements => 'specials');
788
789 my @speclvls;
790 my $specsum = 0;
791 my $imprs = 0;
792
793 for my $spcnam (keys %$specials) {
794 my $spc = $specials->{$spcnam};
795 next unless $spc > 0;
796
797 $specsum += $spc;
798 $imprs++;
799
800 my $max_spc = Jeweler::getcfg (maxspecial => $spcnam);
801
802 my $lvl = ($max_spc_lvl / $max_spc) * $spc;
803 push @speclvls, $lvl;
804 }
805
806 my $sumlvl = ($max_spc_lvl / $max_specials) * $specsum;
807
808 (max (@speclvls, $sumlvl), $imprs)
809}
810
811
812# this function calculated the 'level' of an amulet or a ring
813sub power_to_level {
814 my ($self, $lvldescr) = @_;
815
816 my $max_imprs = Jeweler::getcfg (maximprovements => 'improvements');
817 my $max_impr_lvl = Jeweler::getcfg (maxlevels => 'improve_level');
818
819 my ($stat_lvl, $stat_imprs) = $self->stat_level;
820 my ($resist_lvl, $res_imprs) = $self->resist_level;
821 my ($spec_lvl, $spec_imprs) = $self->special_level;
822
823 my $impr_sum = $stat_imprs + $res_imprs + $spec_imprs;
824
825 my $impr_lvl = ceil (($max_impr_lvl / ($max_imprs + 1)) * ($impr_sum - 1)); # 1 improvemnt bonus
826
827 my $levl = int max ($stat_lvl, $resist_lvl, $impr_lvl, $spec_lvl, 0);
828
829 if ($lvldescr) {
830 $$lvldescr =
831 sprintf "%3d: %s\n", $levl,
832 "stat: $stat_lvl, resist: $resist_lvl, improve: $impr_lvl, "
833 ."spec: $spec_lvl (num impr $stat_imprs + $res_imprs + $spec_imprs - 1)";
834 }
835
836 $levl
837}
838
839sub add_stat_costs {
840 my ($self, $cost) = @_;
841
842 my $stats = $self->{hash}->{stat};
843
844 for my $stat (keys %$stats) {
845 my $sum = $stats->{$stat};
846
847 next unless $sum > 0;
848
849 my $statfx = fx ($sum, 'stat_potions');
850 $cost->{"stat_$stat"} += $statfx->[0];
851 split_diamonds ($cost, $statfx->[1], 'stat_' . $stat);
852 }
853}
854
855sub add_special_costs {
856 my ($self, $cost) = @_;
857
858 my $specials = $self->{hash}->{spec};
859
860 for my $spec (keys %$specials) {
861 my $sum = $specials->{$spec};
862
863 next unless $sum > 0;
864
865 my $specfx = fx ($sum, 'spec_potions');
866 $cost->{"spec_$spec"} += $specfx->[0];
867 split_diamonds ($cost, $specfx->[1], 'spec_' . $spec);
868 }
869}
870
871sub calc_costs {
872 my ($self) = @_;
873
874 my $costs = {};
875
876 my $ring = $self->{hash};
877
878 for my $resnam (keys %{$ring->{resist} || {}}) {
879
880 my $res = $ring->{resist}->{$resnam};
881
882 next unless $res > 0;
883
884 $costs->{"resist_" . $Jeweler::RESMAP{$resnam} . "_item"} += $res;
885
886 my $diamonds;
887 if (grep { $resnam eq $_ } @Jeweler::EFFECT_RESISTS) {
888 $diamonds += fx ($res, 'effect_resist_diamonds');
889 } else {
890 $diamonds += fx ($res, 'attack_resist_diamonds');
891 }
892
893 split_diamonds ($costs, $diamonds, 'resist_' . $Jeweler::RESMAP{$resnam});
894 }
895
896 $self->add_stat_costs ($costs);
897 $self->add_special_costs ($costs);
898
899 return $costs;
900}
901
902sub split_diamonds {
903 my ($cost, $diamonds, $category) = @_;
904
905 my $stat_split = Jeweler::getcfg (diamond_split => $category);
906
907 my $sum = sum (@$stat_split);
908 if ($sum < (1 - 0.0001)) {
909 warn "JEWELER BUG: sum (@$stat_split) = $sum < 1 for $category!";
910 }
911
912 my $emarch = cf::arch::find ('emerald');
913 my $saarch = cf::arch::find ('sapphire');
914 my $pearch = cf::arch::find ('pearl');
915 my $ruarch = cf::arch::find ('ruby');
916 my $diarch = cf::arch::find ('gem');
917
918 my $sumvalue = $diarch->clone->value * $diamonds;
919
920 $cost->{emerald} += ceil (($sumvalue * $stat_split->[0]) / max (1, $emarch->clone->value));
921 $cost->{sapphire} += ceil (($sumvalue * $stat_split->[1]) / max (1, $saarch->clone->value));
922 $cost->{pearl} += ceil (($sumvalue * $stat_split->[2]) / max (1, $pearch->clone->value));
923 $cost->{ruby} += ceil (($sumvalue * $stat_split->[3]) / max (1, $ruarch->clone->value));
924 $cost->{gem} += ceil (($sumvalue * $stat_split->[4]) / max (1, $diarch->clone->value));
925}
926
927
928
284package Jeweler::Util; 929package Jeweler::Util;
930use strict;
285 931
286=head2 Util 932=head2 Util
287 933
288Some utility functions for the Jeweler skill. 934Some utility functions for the Jeweler skill.
289 935
290=over 4 936=over 4
291 937
292=item remove ($object) 938=item remove ($object[, $nrof])
293 939
294Removes the C<$object> and it's inventory recursivley from the game. 940Removes the C<$object>. If C<$nrof> is given, remove only C<$nrof> objects.
941The returnvalue is the number of 'single' objects that couldn't be removed.
295 942
296=cut 943=cut
297 944
298sub remove { 945sub remove {
299 my ($obj) = @_; 946 my ($obj, $nrof) = @_;
947
948 my $cnt;
949
950 if (defined $nrof) {
951 return 0 if ($nrof * 1) == 0;
952 $cnt = int (($obj->nrof || 1) - (1 * $nrof));
953
954 if ($cnt > 0) {
955 $obj->set_nrof ($cnt);
956 return 0;
957 }
958 }
300 959
301 remove ($_) for ($obj->inv); 960 remove ($_) for ($obj->inv);
302 $obj->remove; 961 $obj->remove;
303 $obj->free; 962 $obj->free;
963 return $cnt;
964}
965
966sub grep_for_match {
967 my ($thing, @matchar) = @_;
968
969 my $i = 0;
970 for my $match (@matchar) {
971 if ($match =~ m/^\s*$/) {
972 $i++;
973 next;
974 }
975
976 if ($i % 3 == 0) {
977 $thing->name eq $match
978 and return 1;
979 } elsif ($i % 3 == 1) {
980 $thing->title eq $match
981 and return 1;
982 } else { # $i % 3 == 2
983 $thing->archetype->name eq $match
984 and return 1;
985 }
986 $i++;
987 }
988 return 0;
304} 989}
305 990
306=back 991=back
307 992
308=back 993=back

Diff Legend

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