… | |
… | |
226 | my $nrof = int ($archvalsum / (($outarchval || 1000) * $outarchvalfact)); |
226 | my $nrof = int ($archvalsum / (($outarchval || 1000) * $outarchvalfact)); |
227 | if ($nrof) { |
227 | if ($nrof) { |
228 | # XXX: yes, i know what i'm doing here, i don't set nrof, but it didn't work somehow (pls. chek sometimes) |
228 | # XXX: yes, i know what i'm doing here, i don't set nrof, but it didn't work somehow (pls. chek sometimes) |
229 | for (1..$nrof) { |
229 | for (1..$nrof) { |
230 | $chdl->put (my $ob = cf::object::new $outarch); |
230 | $chdl->put (my $ob = cf::object::new $outarch); |
231 | $ob->set_animation (cf::rndm $ob->num_animations); |
231 | $ob->set_animation (cf::rndm $ob->num_animations) |
|
|
232 | if ($ob->type == cf::RING); |
232 | $ob->flag (cf::FLAG_IDENTIFIED, 1); |
233 | $ob->flag (cf::FLAG_IDENTIFIED, 1); |
233 | } |
234 | } |
234 | |
235 | |
235 | my $xp_sum = ($xp_gain * $nrof); |
236 | my $xp_sum = ($xp_gain * $nrof); |
236 | |
237 | |
… | |
… | |
328 | cf::POTION => 'potions', |
329 | cf::POTION => 'potions', |
329 | cf::SCROLL => 'scrolls', |
330 | cf::SCROLL => 'scrolls', |
330 | ); |
331 | ); |
331 | |
332 | |
332 | for ($self->{cauldron}->inv) { |
333 | for ($self->{cauldron}->inv) { |
|
|
334 | if (!$_->flag (cf::FLAG_IDENTIFIED) && $_->need_identify) { |
|
|
335 | die "unidentified"; |
|
|
336 | } elsif ($_->flag (cf::FLAG_CURSED) || $_->flag (cf::FLAG_DAMNED)) { |
|
|
337 | die "cursed"; |
|
|
338 | } |
333 | |
339 | |
334 | if (my $k = $type_to_key{$_->type}) { |
340 | if (my $k = $type_to_key{$_->type}) { |
335 | push @{$ingreds->{$k}}, $_; |
341 | push @{$ingreds->{$k}}, $_; |
336 | } else { |
342 | } else { |
337 | push @{$ingreds->{other}}, $_; |
343 | push @{$ingreds->{other}}, $_; |
… | |
… | |
585 | } |
591 | } |
586 | } else { |
592 | } else { |
587 | my $nr; |
593 | my $nr; |
588 | $self->do_grep (sub { $nr += ($_[0]->nrof || 1); 0 }, @grepar); |
594 | $self->do_grep (sub { $nr += ($_[0]->nrof || 1); 0 }, @grepar); |
589 | $costs->{$key} -= $nr; |
595 | $costs->{$key} -= $nr; |
590 | warn "CHECKCOST $key <-> $nr -> $costs->{$key}\n"; |
|
|
591 | } |
596 | } |
592 | |
597 | |
593 | } |
598 | } |
594 | |
599 | |
595 | return $costs; |
600 | return $costs; |
… | |
… | |
622 | my $self = bless { }, $class; |
627 | my $self = bless { }, $class; |
623 | |
628 | |
624 | $self->ring_or_ammy_to_hash ($arg{object}); |
629 | $self->ring_or_ammy_to_hash ($arg{object}); |
625 | |
630 | |
626 | $self; |
631 | $self; |
|
|
632 | } |
|
|
633 | |
|
|
634 | sub has_resist { |
|
|
635 | my ($self, $resistnam, $resistval) = @_; |
|
|
636 | my $resnum = $REV_RESMAP{uc $resistnam}; |
|
|
637 | if (defined ($resistval)) { |
|
|
638 | return 1 if $self->{hash}->{resist}->{$resnum} == $resistval; |
|
|
639 | } else { |
|
|
640 | return 1 if $self->{hash}->{resist}->{$resnum}; |
|
|
641 | } |
|
|
642 | return undef; |
627 | } |
643 | } |
628 | |
644 | |
629 | sub analyze { |
645 | sub analyze { |
630 | my ($self, $sk, $pl) = @_; |
646 | my ($self, $sk, $pl) = @_; |
631 | |
647 | |
… | |
… | |
640 | } |
656 | } |
641 | my $msg = sprintf "Projected success rate: %s", $tmpl; |
657 | my $msg = sprintf "Projected success rate: %s", $tmpl; |
642 | return $msg; |
658 | return $msg; |
643 | } |
659 | } |
644 | |
660 | |
|
|
661 | sub calc_value_from_cost { |
|
|
662 | my ($self, $costs) = @_; |
|
|
663 | my $emarch = cf::arch::find 'emerald'; |
|
|
664 | my $saarch = cf::arch::find 'sapphire'; |
|
|
665 | my $pearch = cf::arch::find 'pearl'; |
|
|
666 | my $ruarch = cf::arch::find 'ruby'; |
|
|
667 | my $diarch = cf::arch::find 'gem'; |
|
|
668 | my $value = $emarch->clone->value * $costs->{emerald} |
|
|
669 | + $saarch->clone->value * $costs->{sapphire} |
|
|
670 | + $pearch->clone->value * $costs->{pearl} |
|
|
671 | + $ruarch->clone->value * $costs->{ruby} |
|
|
672 | + $diarch->clone->value * $costs->{gem}; |
|
|
673 | |
|
|
674 | $value |
|
|
675 | } |
|
|
676 | |
645 | sub wiz_analyze { |
677 | sub wiz_analyze { |
646 | my ($self, $pl) = @_; |
678 | my ($self, $pl) = @_; |
647 | my $costs = $self->calc_costs; |
679 | my $costs = $self->calc_costs; |
648 | my $desc = ""; |
680 | my $desc = ""; |
649 | my $lvl = $self->power_to_level (\$desc); |
681 | my $lvl = $self->power_to_level (\$desc); |
|
|
682 | my $scosts = $self->calc_value_from_cost ($costs); |
|
|
683 | |
650 | $pl->message ("costs: " . join (', ', map { "$_: " . sprintf "%.2f", $costs->{$_} } keys %$costs)); |
684 | $pl->message ("costs: " . (join (', ', map { "$_: " . sprintf "%.2f", $costs->{$_} } keys %$costs)) . " (".($scosts / 5000)." royalties)"); |
651 | $pl->message ("level: " . $desc); |
685 | $pl->message ("level: " . $desc); |
652 | } |
686 | } |
653 | |
|
|
654 | |
687 | |
655 | sub get_chance_perc { |
688 | sub get_chance_perc { |
656 | my ($self, $sk) = @_; |
689 | my ($self, $sk) = @_; |
657 | my $sklvl = cf::exp_to_level ($sk->stats->exp); |
690 | my $sklvl = cf::exp_to_level ($sk->stats->exp); |
658 | my $ringlvl = $self->power_to_level; |
691 | my $ringlvl = $self->power_to_level; |
… | |
… | |
661 | |
694 | |
662 | sub fx { |
695 | sub fx { |
663 | my ($res, $cfg) = @_; |
696 | my ($res, $cfg) = @_; |
664 | my $or = $res; |
697 | my $or = $res; |
665 | my $ar = $Jeweler::CFG->{functions}->{$cfg}; |
698 | my $ar = $Jeweler::CFG->{functions}->{$cfg}; |
|
|
699 | |
666 | if (ref $ar->[0] eq 'ARRAY') { |
700 | if (ref $ar->[0] eq 'ARRAY') { |
667 | $res = $res - 1; |
701 | $res = $res - 1; |
|
|
702 | return $ar->[max (min ($res, @$ar - 1), 0)]; |
|
|
703 | |
668 | } else { |
704 | } else { |
|
|
705 | # +0.1 is for a jump to the next index when $res / 5 is exactly 1, 2, 3... |
669 | $res = ceil ($res / 5) - 1; |
706 | my $idx = ceil (($res / 5) + 0.1) - 1; |
670 | } |
|
|
671 | $ar->[max (min ($res, @$ar - 1), 0)]; |
707 | my $a = $ar->[max (min ($idx, @$ar - 1), 0)]; |
|
|
708 | my $b = $ar->[max (min ($idx + 1, @$ar - 1), 0)]; |
|
|
709 | my $diff = $b - $a; # use the difference of the cost to the next cost |
|
|
710 | my $o_cost = $a + ($diff / 5) * ($res % 5); # and do some linear interpolation |
|
|
711 | return $o_cost; |
|
|
712 | } |
672 | } |
713 | } |
673 | |
714 | |
674 | sub improve_by_ring { |
715 | sub improve_by_ring { |
675 | my ($self, @rings) = @_; |
716 | my ($self, @rings) = @_; |
676 | my $ring = $self; |
717 | my $ring = $self; |
… | |
… | |
692 | if ($self->{hash}->{$cat}->{$k} > 0) { |
733 | if ($self->{hash}->{$cat}->{$k} > 0) { |
693 | $self->{hash}->{$cat}->{$k} *= -1; |
734 | $self->{hash}->{$cat}->{$k} *= -1; |
694 | } |
735 | } |
695 | } |
736 | } |
696 | } |
737 | } |
|
|
738 | $self->{hash}{value} = 0; |
697 | } |
739 | } |
698 | |
740 | |
699 | sub to_string { |
741 | sub to_string { |
700 | my ($self) = @_; |
742 | my ($self) = @_; |
701 | my $r = $self->{hash}; |
743 | my $r = $self->{hash}; |
… | |
… | |
743 | |
785 | |
744 | $obj->{name} = $thing->name; |
786 | $obj->{name} = $thing->name; |
745 | $obj->{arch} = $thing->arch->name; |
787 | $obj->{arch} = $thing->arch->name; |
746 | $obj->{face} = $thing->face; |
788 | $obj->{face} = $thing->face; |
747 | |
789 | |
|
|
790 | $obj->{value} = $thing->value; |
|
|
791 | |
748 | $self->{hash} = $obj |
792 | $self->{hash} = $obj |
749 | } |
793 | } |
750 | |
794 | |
751 | sub to_object { |
795 | sub to_object { |
752 | my ($self) = @_; |
796 | my ($self) = @_; |
753 | |
797 | |
754 | my $obj = cf::object::new $self->{hash}->{arch}; |
798 | my $obj = cf::object::new $self->{hash}->{arch}; |
|
|
799 | |
|
|
800 | $obj->item_power ($self->power_to_level); # there have to be strings attached! |
755 | |
801 | |
756 | $obj->face ($self->{hash}{face}); |
802 | $obj->face ($self->{hash}{face}); |
757 | |
803 | |
758 | my $stats = $obj->stats; |
804 | my $stats = $obj->stats; |
759 | |
805 | |
… | |
… | |
772 | $obj->resist ($_, $self->{hash}->{resist}->{$_}); |
818 | $obj->resist ($_, $self->{hash}->{resist}->{$_}); |
773 | } |
819 | } |
774 | |
820 | |
775 | $obj->flag (cf::FLAG_IDENTIFIED, 1); |
821 | $obj->flag (cf::FLAG_IDENTIFIED, 1); |
776 | |
822 | |
|
|
823 | $obj->value ($self->{hash}{value}); |
|
|
824 | |
777 | return $obj; |
825 | return $obj; |
778 | } |
826 | } |
|
|
827 | |
|
|
828 | sub set_value { $_[0]->{hash}{value} = $_[1] } |
779 | |
829 | |
780 | sub is_better_than { |
830 | sub is_better_than { |
781 | my ($self, $other) = @_; |
831 | my ($self, $other) = @_; |
782 | |
832 | |
783 | for my $type (qw/spec stat resist/) { |
833 | for my $type (qw/spec stat resist/) { |
… | |
… | |
1030 | |
1080 | |
1031 | sub check_for_match { |
1081 | sub check_for_match { |
1032 | my ($thing, @matchar) = @_; |
1082 | my ($thing, @matchar) = @_; |
1033 | |
1083 | |
1034 | my $i = 0; |
1084 | my $i = 0; |
|
|
1085 | my $check_cnts = 0; |
|
|
1086 | my $check_true = 0; |
1035 | for my $match (@matchar) { |
1087 | for my $match (@matchar) { |
|
|
1088 | $check_cnts = 0 if $i % 3 == 0; |
|
|
1089 | |
1036 | if ($match =~ m/^\s*$/) { |
1090 | if ($match =~ m/^\s*$/) { |
1037 | $i++; |
1091 | $i++; |
1038 | next; |
1092 | next; |
1039 | } |
1093 | } |
1040 | |
1094 | |
|
|
1095 | $check_cnts++; |
1041 | if ($i % 3 == 0) { |
1096 | if ($i % 3 == 0) { |
1042 | $thing->name eq $match |
1097 | $thing->name eq $match |
1043 | and return 1; |
1098 | and $check_true++; |
1044 | } elsif ($i % 3 == 1) { |
1099 | } elsif ($i % 3 == 1) { |
1045 | $thing->title eq $match |
1100 | $thing->title eq $match |
1046 | and return 1; |
1101 | and $check_true++; |
1047 | } else { # $i % 3 == 2 |
1102 | } else { # $i % 3 == 2 |
1048 | $thing->arch->name eq $match |
1103 | $thing->arch->name eq $match |
1049 | and return 1; |
1104 | and $check_true++; |
1050 | } |
1105 | } |
1051 | $i++; |
1106 | $i++; |
|
|
1107 | } |
|
|
1108 | if ($check_true && $check_cnts == $check_true) { |
|
|
1109 | return 1; |
1052 | } |
1110 | } |
1053 | return 0; |
1111 | return 0; |
1054 | } |
1112 | } |
1055 | |
1113 | |
1056 | sub grep_for_match { |
1114 | sub grep_for_match { |
1057 | my ($ingred, $group, @matchar) = @_; |
1115 | my ($ingred, $group, @matchar) = @_; |
1058 | |
1116 | |
1059 | for my $thing (@{$ingred->{$group} || []}) { |
1117 | for my $thing (@{$ingred->{$group} || []}) { |
1060 | warn sprintf "DEB:(%s,%s,%s)<->%s\n", $thing->name, $thing->title, $thing->arch->name, "@matchar"; #d# |
1118 | #d# warn sprintf "DEB:(%s,%s,%s)<->%s\n", $thing->name, $thing->title, $thing->arch->name, "@matchar"; #d# |
1061 | if (check_for_match ($thing, @matchar)) { |
1119 | if (check_for_match ($thing, @matchar)) { |
1062 | return $thing; |
1120 | return $thing; |
1063 | } |
1121 | } |
1064 | } |
1122 | } |
1065 | return undef; |
1123 | return undef; |