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.2 by elmex, Thu Aug 31 00:58:17 2006 UTC vs.
Revision 1.3 by elmex, Thu Aug 31 12:39:19 2006 UTC

… …
34 $CFG = YAML::LoadFile $filename; 34 $CFG = YAML::LoadFile $filename;
35} 35}
36 36
37sub getcfg { 37sub getcfg {
38 my ($sect, $key) = @_; 38 my ($sect, $key) = @_;
39 return $CFG->{$sect} unless defined $key;
40
39 my $cfg = $CFG->{$sect}->{$key} 41 my $cfg = $CFG->{$sect}->{$key}
40 or die "Couldn't find $sect/$key in configuration!"; 42 or die "Couldn't find $sect/$key in configuration!";
41 43
42 $cfg 44 $cfg
43}
44
45# makes a template arch (for example to get the value)
46sub get_arch {
47 my ($outarch) = @_;
48 unless ($CFG->{arch}->{$outarch}) {
49 $CFG->{arch}->{$outarch} = cf::object::new $outarch;
50
51 unless ($CFG->{arch}->{$outarch}) {
52 warn "ERROR: Couldn't make $outarch in conversion for $outarch!";
53 return;
54 }
55 }
56 $CFG->{arch}->{$outarch}
57} 45}
58 46
59our @RESISTS = ( 47our @RESISTS = (
60 cf::ATNR_PHYSICAL, 48 cf::ATNR_PHYSICAL,
61 cf::ATNR_MAGIC, 49 cf::ATNR_MAGIC,
… …
143 -4 => 10, 131 -4 => 10,
144 -5 => 0 132 -5 => 0
145); 133);
146 134
147our %LVL_DIFF_MSG = ( 135our %LVL_DIFF_MSG = (
148 -5 => '%s is way above your skill', 136 -5 => 'Way above your skill',
149 -4 => 'The chance to make %s is very low', 137 -4 => 'Very low',
150 -3 => 'You hava a slight chance to make %s', 138 -3 => 'Slight chance',
151 -2 => 'There is a low chance you finish %s', 139 -2 => 'Low',
152 -1 => 'You could make %s with a chance of nearly 50:50', 140 -1 => 'Nearly 50:50',
153 0 => 'The chances to fininsh %s is 50:50', 141 0 => '50:50',
154 1 => 'To make %s your chance is slightly above 50:50', 142 1 => 'Slightly above 50:50',
155 2 => 'You could make with a good chance %s if you concentrate a lot', 143 2 => 'Good',
156 3 => 'The chance you finish %s with some efford is high', 144 3 => 'High',
157 4 => 'You are nearly confident to finish %s', 145 4 => 'Nearly confident',
158 5 => 'There is no chance you could fail to make %s', 146 5 => '100%',
159); 147);
160 148
161sub level_diff_to_str { 149sub level_diff_to_str {
162 my ($delta) = @_; 150 my ($delta) = @_;
163 $delta = -5 if $delta < -5; 151 $delta = -5 if $delta < -5;
… …
173} 161}
174 162
175sub analyze { 163sub analyze {
176 my ($sk, $chdl, $pl) = @_; 164 my ($sk, $chdl, $pl) = @_;
177 165
166 my $hadunid = 0;
178 for ($chdl->grep_by_type (cf::RING, cf::AMULET)) { 167 for ($chdl->grep_by_type (cf::RING, cf::AMULET)) {
179 my $sklvl = cf::exp_to_level ($sk->stats->exp); 168 if (!$_->get_flag (cf::FLAG_IDENTIFIED) && $_->need_identify) {
169 $hadunid = 1;
170 next;
171 }
180 my $ringlvl = Jeweler::Object->new (object => $_)->power_to_level; 172 my $r = Jeweler::Object->new (object => $_);
181 173 my $msg = $r->analyze ($sk, $pl);
182 if ($pl->get_flag (cf::FLAG_WIZ)) { 174 $pl->message ($r->to_string . ": " . $msg);
183 $pl->message ("The " . $_->name . " is at level $ringlvl chance for you: " . level_diff_to_chance_perc ($sklvl - $ringlvl)); 175 $r->wiz_analyze ($pl);
184 } else { 176 }
185 my $tmpl = level_diff_to_str ($sklvl - $ringlvl); 177 if ($hadunid) {
186 my $msg = sprintf $tmpl, $_->name; 178 $pl->message ("You couldn't identify the other rings and not analyze them!");
187 $pl->message ($msg);
188 }
189 } 179 }
190} 180}
191 181
192# this function converts metals/minerals into a raw ring (of adornment) 182# this function converts metals/minerals into a raw ring (of adornment)
193sub simple_converter { 183sub simple_converter {
… …
221 211
222 unless ($outarchvalfact >= 1) { 212 unless ($outarchvalfact >= 1) {
223 warn "WARNING: source-arch-value-multiplier < 1 in convesion '$outarch', results in more valuable output!\n"; 213 warn "WARNING: source-arch-value-multiplier < 1 in convesion '$outarch', results in more valuable output!\n";
224 } 214 }
225 215
226 my $archvalsum = $ingred->value ($cnvs->{$outarch}->[0], $cnvs->{$outarch}->[2]); 216 my $archvalsum = $ingred->value ($ingr_grp, $srcarchname);
227 $ingred->remove ($cnvs->{$outarch}->[0], $cnvs->{$outarch}->[2]); 217 $ingred->remove ($ingr_grp, $srcarchname);
228 218
229 my $outarchval = Jeweler::get_arch ($outarch)->value; 219 my $outarchval = cf::arch::find ($outarch)->clone->value;
230 220
231 my $nrof = int ($archvalsum / (($outarchval || 1000) * $outarchvalfact)); 221 my $nrof = int ($archvalsum / (($outarchval || 1000) * $outarchvalfact));
232 if ($nrof) { 222 if ($nrof) {
233 # XXX: yes, i know what i'm doing here, i don't set nrof, but it didn't work somehow (pls. chek sometimes) 223 # XXX: yes, i know what i'm doing here, i don't set nrof, but it didn't work somehow (pls. chek sometimes)
234 $chdl->put (cf::object::new $outarch) for 1..$nrof; 224 $chdl->put (cf::object::new $outarch) for 1..$nrof;
… …
329 319
330 for ($self->{cauldron}->inv) { 320 for ($self->{cauldron}->inv) {
331 321
332 if (my $k = $type_to_key{$_->type}) { 322 if (my $k = $type_to_key{$_->type}) {
333 push @{$ingreds->{$k}}, $_; 323 push @{$ingreds->{$k}}, $_;
334
335 } else {
336 Jeweler::Util::remove ($_);
337 } 324 }
338 } 325 }
339 326
340 return Jeweler::Ingredients->new (ingredients => $ingreds, cauldron_helper => $self) 327 return Jeweler::Ingredients->new (ingredients => $ingreds, cauldron_helper => $self)
341} 328}
… …
348 335
349sub put { 336sub put {
350 my ($self, $obj) = @_; 337 my ($self, $obj) = @_;
351 338
352 return undef unless $self->{cauldron}; 339 return undef unless $self->{cauldron};
353
354 $obj->insert_ob_in_ob ($self->{cauldron}); 340 $obj->insert_ob_in_ob ($self->{cauldron});
355} 341}
356 342
357=back 343=back
358 344
… …
397 $_->archetype->name eq $archname 383 $_->archetype->name eq $archname
398 } @{$self->{ingredients}->{$group} || []}; 384 } @{$self->{ingredients}->{$group} || []};
399 385
400 my $sum = 0; 386 my $sum = 0;
401 for (@objs) { 387 for (@objs) {
402 $sum += $_->nrof * $_->value; 388 $sum += ($_->nrof || 1) * $_->value;
403 } 389 }
404 390
405 return $sum; 391 return $sum;
406} 392}
407 393
… …
449 } else { 435 } else {
450 @plga = @$plg; 436 @plga = @$plg;
451 } 437 }
452 next unless @plga > 0; 438 next unless @plga > 0;
453 if (Jeweler::Util::grep_for_match ($pot, @plga)) { 439 if (Jeweler::Util::grep_for_match ($pot, @plga)) {
454 warn "MATCHED: $plan: @plga\n";
455 return $plan; 440 return $plan;
456 } 441 }
457 } 442 }
458 } 443 }
459 } 444 }
… …
484 for my $pot (@{$ingred->{potions}}) { 469 for my $pot (@{$ingred->{potions}}) {
485 if (Jeweler::Util::grep_for_match ($pot, @$plingred)) { 470 if (Jeweler::Util::grep_for_match ($pot, @$plingred)) {
486 $cnt += $pot->nrof; 471 $cnt += $pot->nrof;
487 } 472 }
488 } 473 }
489 warn "Found $cnt potions for plan $plan\n";
490 474
475 my $maxstat = Jeweler::getcfg (maximprovements => 'stats');
491 my $did_impr = 0; 476 my $did_impr = 0;
492 for my $x (reverse 1..10) { 477 for my $x (1..$maxstat) {
493 my $y = Jeweler::Object::fx ($x, 'stat_potions'); 478 my $y = Jeweler::Object::fx ($x, 'stat_potions');
494 warn "TEST: fx($x): $y->[0] <= $cnt \n"; 479
495 warn "FE: " . ($y->[0] == $cnt) . "\n";
496 if ($cnt >= $y->[0]) { 480 if ($cnt <= $y->[0]) {
497 $ring->{hash}->{stat}->{$statname} += $x; 481 $ring->{hash}->{stat}->{$statname} += $x;
498 $did_impr = 1; 482 $did_impr = 1;
499 warn "Found stat increase of $statname +$x\n";
500 last; 483 last;
501 } 484 }
502 } 485 }
503 486
504 # we want at least this improvement if we have a plan... 487 # we want at least this improvement if we have a plan...
… …
551 if ($rem > 0) { 534 if ($rem > 0) {
552 warn "JEWELER BUG: removed ingredients $rem > 0 after removing!"; 535 warn "JEWELER BUG: removed ingredients $rem > 0 after removing!";
553 } 536 }
554 } else { 537 } else {
555 my $nr; 538 my $nr;
556 $self->do_grep (sub { warn "CNT!\n"; $nr += $_[0]->nrof; 0 }, @grepar); 539 $self->do_grep (sub { $nr += $_[0]->nrof; 0 }, @grepar);
557 $costs->{$key} -= $nr; 540 $costs->{$key} -= $nr;
558 } 541 }
559 } 542 }
560 543
561 return $costs; 544 return $costs;
… …
588 my $self = bless { }, $class; 571 my $self = bless { }, $class;
589 572
590 $self->ring_or_ammy_to_hash ($arg{object}); 573 $self->ring_or_ammy_to_hash ($arg{object});
591 574
592 $self; 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);
593} 609}
594 610
595sub fx { 611sub fx {
596 my ($res, $cfg) = @_; 612 my ($res, $cfg) = @_;
597 my $or = $res; 613 my $or = $res;
… …
616 } 632 }
617 } 633 }
618 } 634 }
619} 635}
620 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
621sub ring_or_ammy_to_hash { 670sub ring_or_ammy_to_hash {
622 my ($self, $thing) = @_; 671 my ($self, $thing) = @_;
623 672
624 my $obj = {}; 673 my $obj = {};
625 674
… …
758} 807}
759 808
760 809
761# this function calculated the 'level' of an amulet or a ring 810# this function calculated the 'level' of an amulet or a ring
762sub power_to_level { 811sub power_to_level {
763 my ($self) = @_; 812 my ($self, $lvldescr) = @_;
764 813
765 my $max_imprs = Jeweler::getcfg (maximprovements => 'improvements'); 814 my $max_imprs = Jeweler::getcfg (maximprovements => 'improvements');
766 my $max_impr_lvl = Jeweler::getcfg (maxlevels => 'improve_level'); 815 my $max_impr_lvl = Jeweler::getcfg (maxlevels => 'improve_level');
767 816
768 my ($stat_lvl, $stat_imprs) = $self->stat_level; 817 my ($stat_lvl, $stat_imprs) = $self->stat_level;
… …
773 822
774 my $impr_lvl = ceil (($max_impr_lvl / ($max_imprs + 1)) * ($impr_sum - 1)); # 1 improvemnt bonus 823 my $impr_lvl = ceil (($max_impr_lvl / ($max_imprs + 1)) * ($impr_sum - 1)); # 1 improvemnt bonus
775 824
776 my $levl = int max ($stat_lvl, $resist_lvl, $impr_lvl, $spec_lvl, 0); 825 my $levl = int max ($stat_lvl, $resist_lvl, $impr_lvl, $spec_lvl, 0);
777 826
778 my $cost = $self->calc_costs; 827 if ($lvldescr) {
779 warn 828 $$lvldescr =
780 sprintf "%3d: %50s: %s\n", $levl, $self->{hash}->{name}, 829 sprintf "%3d: %s\n", $levl,
781 "stat: $stat_lvl, resist: $resist_lvl, improve: $impr_lvl, " 830 "stat: $stat_lvl, resist: $resist_lvl, improve: $impr_lvl, "
782 ."spec: $spec_lvl (num impr $stat_imprs + $res_imprs + $spec_imprs - 1)"; 831 ."spec: $spec_lvl (num impr $stat_imprs + $res_imprs + $spec_imprs - 1)";
832 }
783 833
784 $levl 834 $levl
785} 835}
786 836
787sub add_stat_costs { 837sub add_stat_costs {
… …
842 } 892 }
843 893
844 $self->add_stat_costs ($costs); 894 $self->add_stat_costs ($costs);
845 $self->add_special_costs ($costs); 895 $self->add_special_costs ($costs);
846 896
847 warn
848 sprintf "JEWEL ANALYSE: %40s: %s" ,
849 $ring->{name},
850 join (', ', map { "$_: " . sprintf "%.2f", $costs->{$_} } keys %$costs);
851
852 return $costs; 897 return $costs;
853} 898}
854 899
855sub split_diamonds { 900sub split_diamonds {
856 my ($cost, $diamonds, $category) = @_; 901 my ($cost, $diamonds, $category) = @_;
… …
860 my $sum = sum (@$stat_split); 905 my $sum = sum (@$stat_split);
861 if ($sum < (1 - 0.0001)) { 906 if ($sum < (1 - 0.0001)) {
862 warn "JEWELER BUG: sum (@$stat_split) = $sum < 1 for $category!"; 907 warn "JEWELER BUG: sum (@$stat_split) = $sum < 1 for $category!";
863 } 908 }
864 909
865 my $emarch = Jeweler::get_arch ('emerald'); 910 my $emarch = cf::arch::find ('emerald');
866 my $saarch = Jeweler::get_arch ('sapphire'); 911 my $saarch = cf::arch::find ('sapphire');
867 my $pearch = Jeweler::get_arch ('pearl'); 912 my $pearch = cf::arch::find ('pearl');
868 my $ruarch = Jeweler::get_arch ('ruby'); 913 my $ruarch = cf::arch::find ('ruby');
869 my $diarch = Jeweler::get_arch ('gem'); 914 my $diarch = cf::arch::find ('gem');
870 915
871 my $sumvalue = $diarch->value * $diamonds; 916 my $sumvalue = $diarch->clone->value * $diamonds;
872 917
873 $cost->{emerald} += ceil (($sumvalue * $stat_split->[0]) / max (1, $emarch->value)); 918 $cost->{emerald} += ceil (($sumvalue * $stat_split->[0]) / max (1, $emarch->clone->value));
874 $cost->{sapphire} += ceil (($sumvalue * $stat_split->[1]) / max (1, $saarch->value)); 919 $cost->{sapphire} += ceil (($sumvalue * $stat_split->[1]) / max (1, $saarch->clone->value));
875 $cost->{pearl} += ceil (($sumvalue * $stat_split->[2]) / max (1, $pearch->value)); 920 $cost->{pearl} += ceil (($sumvalue * $stat_split->[2]) / max (1, $pearch->clone->value));
876 $cost->{ruby} += ceil (($sumvalue * $stat_split->[3]) / max (1, $ruarch->value)); 921 $cost->{ruby} += ceil (($sumvalue * $stat_split->[3]) / max (1, $ruarch->clone->value));
877 $cost->{gem} += ceil (($sumvalue * $stat_split->[4]) / max (1, $diarch->value)); 922 $cost->{gem} += ceil (($sumvalue * $stat_split->[4]) / max (1, $diarch->clone->value));
878} 923}
879 924
880 925
881 926
882package Jeweler::Util; 927package Jeweler::Util;
… …
896=cut 941=cut
897 942
898sub remove { 943sub remove {
899 my ($obj, $nrof) = @_; 944 my ($obj, $nrof) = @_;
900 945
901#XXX: waht about this: remove ($_) for ($obj->inv) ? 946 my $cnt;
902 947
948 if (defined $nrof) {
949 return 0 if ($nrof * 1) == 0;
903 my $cnt = $obj->nrof - (1 * $nrof); 950 $cnt = int (($obj->nrof || 1) - (1 * $nrof));
904 951
905 if ($cnt > 0) { 952 if ($cnt > 0) {
906 $obj->set_nrof ($cnt); 953 $obj->set_nrof ($cnt);
907 return 0; 954 return 0;
908 } else { 955 }
956 }
957
958 remove ($_) for ($obj->inv);
909 $obj->remove; 959 $obj->remove;
910 $obj->free; 960 $obj->free;
911 return $cnt; 961 return $cnt;
912 }
913} 962}
914 963
915sub grep_for_match { 964sub grep_for_match {
916 my ($thing, @matchar) = @_; 965 my ($thing, @matchar) = @_;
917 966

Diff Legend

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