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.9 by root, Tue Dec 12 16:59:34 2006 UTC

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