… | |
… | |
576 | my $costs = dclone ($costs); |
576 | my $costs = dclone ($costs); |
577 | |
577 | |
578 | for my $key (keys %$costs) { |
578 | for my $key (keys %$costs) { |
579 | my @grepar; |
579 | my @grepar; |
580 | if ($key =~ m/^(resist_|spec_|stat_)/) { # check the special items |
580 | if ($key =~ m/^(resist_|spec_|stat_)/) { # check the special items |
581 | @grepar = @{Jeweler::getcfg (plans => $key) || []}; |
581 | eval { @grepar = @{Jeweler::getcfg (plans => $key) || []} }; |
|
|
582 | next if $@; |
582 | } else { # check the gems |
583 | } else { # check the gems |
583 | @grepar = ('gems', undef, undef, $key); |
584 | @grepar = ('gems', undef, undef, $key); |
584 | } |
585 | } |
585 | |
586 | |
586 | if ($do_remove) { |
587 | if ($do_remove) { |
… | |
… | |
656 | } |
657 | } |
657 | my $msg = sprintf "Projected success rate: %s", $tmpl; |
658 | my $msg = sprintf "Projected success rate: %s", $tmpl; |
658 | return $msg; |
659 | return $msg; |
659 | } |
660 | } |
660 | |
661 | |
|
|
662 | sub calc_value_from_cost { |
|
|
663 | my ($self, $costs) = @_; |
|
|
664 | my $emarch = cf::arch::find 'emerald'; |
|
|
665 | my $saarch = cf::arch::find 'sapphire'; |
|
|
666 | my $pearch = cf::arch::find 'pearl'; |
|
|
667 | my $ruarch = cf::arch::find 'ruby'; |
|
|
668 | my $diarch = cf::arch::find 'gem'; |
|
|
669 | my $value = $emarch->clone->value * $costs->{emerald} |
|
|
670 | + $saarch->clone->value * $costs->{sapphire} |
|
|
671 | + $pearch->clone->value * $costs->{pearl} |
|
|
672 | + $ruarch->clone->value * $costs->{ruby} |
|
|
673 | + $diarch->clone->value * $costs->{gem}; |
|
|
674 | |
|
|
675 | $value |
|
|
676 | } |
|
|
677 | |
661 | sub wiz_analyze { |
678 | sub wiz_analyze { |
662 | my ($self, $pl) = @_; |
679 | my ($self, $pl) = @_; |
663 | my $costs = $self->calc_costs; |
680 | my $costs = $self->calc_costs; |
664 | my $desc = ""; |
681 | my $desc = ""; |
665 | my $lvl = $self->power_to_level (\$desc); |
682 | my $lvl = $self->power_to_level (\$desc); |
666 | my $emarch = cf::arch::find 'emerald'; |
683 | my $scosts = $self->calc_value_from_cost ($costs); |
667 | my $saarch = cf::arch::find 'sapphire'; |
|
|
668 | my $pearch = cf::arch::find 'pearl'; |
|
|
669 | my $ruarch = cf::arch::find 'ruby'; |
|
|
670 | my $diarch = cf::arch::find 'gem'; |
|
|
671 | my $scosts = $emarch->clone->value * $costs->{emerald} |
|
|
672 | + $saarch->clone->value * $costs->{sapphire} |
|
|
673 | + $pearch->clone->value * $costs->{pearl} |
|
|
674 | + $ruarch->clone->value * $costs->{ruby} |
|
|
675 | + $diarch->clone->value * $costs->{gem}; |
|
|
676 | |
684 | |
677 | $pl->message ("costs: " . (join (', ', map { "$_: " . sprintf "%.2f", $costs->{$_} } keys %$costs)) . " (".($scosts / 5000)." royalties)"); |
685 | $pl->message ("costs: " . (join (', ', map { "$_: " . sprintf "%.2f", $costs->{$_} } keys %$costs)) . " (".($scosts / 5000)." royalties)"); |
678 | $pl->message ("level: " . $desc); |
686 | $pl->message ("level: " . $desc); |
679 | } |
687 | } |
680 | |
|
|
681 | |
688 | |
682 | sub get_chance_perc { |
689 | sub get_chance_perc { |
683 | my ($self, $sk) = @_; |
690 | my ($self, $sk) = @_; |
684 | my $sklvl = cf::exp_to_level ($sk->stats->exp); |
691 | my $sklvl = cf::exp_to_level ($sk->stats->exp); |
685 | my $ringlvl = $self->power_to_level; |
692 | my $ringlvl = $self->power_to_level; |
… | |
… | |
688 | |
695 | |
689 | sub fx { |
696 | sub fx { |
690 | my ($res, $cfg) = @_; |
697 | my ($res, $cfg) = @_; |
691 | my $or = $res; |
698 | my $or = $res; |
692 | my $ar = $Jeweler::CFG->{functions}->{$cfg}; |
699 | my $ar = $Jeweler::CFG->{functions}->{$cfg}; |
|
|
700 | |
693 | if (ref $ar->[0] eq 'ARRAY') { |
701 | if (ref $ar->[0] eq 'ARRAY') { |
694 | $res = $res - 1; |
702 | $res = $res - 1; |
|
|
703 | return $ar->[max (min ($res, @$ar - 1), 0)]; |
|
|
704 | |
695 | } else { |
705 | } else { |
|
|
706 | # +0.1 is for a jump to the next index when $res / 5 is exactly 1, 2, 3... |
696 | $res = ceil ($res / 5) - 1; |
707 | my $idx = ceil (($res / 5) + 0.1) - 1; |
697 | } |
|
|
698 | $ar->[max (min ($res, @$ar - 1), 0)]; |
708 | my $a = $ar->[max (min ($idx, @$ar - 1), 0)]; |
|
|
709 | my $b = $ar->[max (min ($idx + 1, @$ar - 1), 0)]; |
|
|
710 | my $diff = $b - $a; # use the difference of the cost to the next cost |
|
|
711 | my $o_cost = $a + ($diff / 5) * ($res % 5); # and do some linear interpolation |
|
|
712 | return $o_cost; |
|
|
713 | } |
699 | } |
714 | } |
700 | |
715 | |
701 | sub improve_by_ring { |
716 | sub improve_by_ring { |
702 | my ($self, @rings) = @_; |
717 | my ($self, @rings) = @_; |
703 | my $ring = $self; |
718 | my $ring = $self; |
… | |
… | |
719 | if ($self->{hash}->{$cat}->{$k} > 0) { |
734 | if ($self->{hash}->{$cat}->{$k} > 0) { |
720 | $self->{hash}->{$cat}->{$k} *= -1; |
735 | $self->{hash}->{$cat}->{$k} *= -1; |
721 | } |
736 | } |
722 | } |
737 | } |
723 | } |
738 | } |
|
|
739 | $self->{hash}{value} = 0; |
724 | } |
740 | } |
725 | |
741 | |
726 | sub to_string { |
742 | sub to_string { |
727 | my ($self) = @_; |
743 | my ($self) = @_; |
728 | my $r = $self->{hash}; |
744 | my $r = $self->{hash}; |
… | |
… | |
770 | |
786 | |
771 | $obj->{name} = $thing->name; |
787 | $obj->{name} = $thing->name; |
772 | $obj->{arch} = $thing->arch->name; |
788 | $obj->{arch} = $thing->arch->name; |
773 | $obj->{face} = $thing->face; |
789 | $obj->{face} = $thing->face; |
774 | |
790 | |
|
|
791 | $obj->{value} = $thing->value; |
|
|
792 | |
775 | $self->{hash} = $obj |
793 | $self->{hash} = $obj |
776 | } |
794 | } |
777 | |
795 | |
778 | sub to_object { |
796 | sub to_object { |
779 | my ($self) = @_; |
797 | my ($self) = @_; |
780 | |
798 | |
781 | my $obj = cf::object::new $self->{hash}->{arch}; |
799 | my $obj = cf::object::new $self->{hash}->{arch}; |
782 | |
800 | |
783 | $obj->item_power ($self->power_to_level); # there have to be strings attached! |
801 | $obj->item_power (floor ($self->power_to_level / 3)); # there have to be strings attached! |
784 | |
802 | |
785 | $obj->face ($self->{hash}{face}); |
803 | $obj->face ($self->{hash}{face}); |
786 | |
804 | |
787 | my $stats = $obj->stats; |
805 | my $stats = $obj->stats; |
788 | |
806 | |
… | |
… | |
801 | $obj->resist ($_, $self->{hash}->{resist}->{$_}); |
819 | $obj->resist ($_, $self->{hash}->{resist}->{$_}); |
802 | } |
820 | } |
803 | |
821 | |
804 | $obj->flag (cf::FLAG_IDENTIFIED, 1); |
822 | $obj->flag (cf::FLAG_IDENTIFIED, 1); |
805 | |
823 | |
|
|
824 | $obj->value ($self->{hash}{value}); |
|
|
825 | |
806 | return $obj; |
826 | return $obj; |
807 | } |
827 | } |
|
|
828 | |
|
|
829 | sub set_value { $_[0]->{hash}{value} = $_[1] } |
808 | |
830 | |
809 | sub is_better_than { |
831 | sub is_better_than { |
810 | my ($self, $other) = @_; |
832 | my ($self, $other) = @_; |
811 | |
833 | |
812 | for my $type (qw/spec stat resist/) { |
834 | for my $type (qw/spec stat resist/) { |
… | |
… | |
1059 | |
1081 | |
1060 | sub check_for_match { |
1082 | sub check_for_match { |
1061 | my ($thing, @matchar) = @_; |
1083 | my ($thing, @matchar) = @_; |
1062 | |
1084 | |
1063 | my $i = 0; |
1085 | my $i = 0; |
|
|
1086 | my $check_cnts = 0; |
|
|
1087 | my $check_true = 0; |
1064 | for my $match (@matchar) { |
1088 | for my $match (@matchar) { |
|
|
1089 | if ($i % 3 == 0) { |
|
|
1090 | return 1 if $check_true && $check_cnts == $check_true; |
|
|
1091 | $check_cnts = 0; |
|
|
1092 | $check_true = 0; |
|
|
1093 | } |
|
|
1094 | |
1065 | if ($match =~ m/^\s*$/) { |
1095 | if ($match =~ m/^\s*$/) { |
1066 | $i++; |
1096 | $i++; |
1067 | next; |
1097 | next; |
1068 | } |
1098 | } |
1069 | |
1099 | |
|
|
1100 | $check_cnts++; |
1070 | if ($i % 3 == 0) { |
1101 | if ($i % 3 == 0) { |
1071 | $thing->name eq $match |
1102 | $thing->name eq $match |
1072 | and return 1; |
1103 | and $check_true++; |
1073 | } elsif ($i % 3 == 1) { |
1104 | } elsif ($i % 3 == 1) { |
1074 | $thing->title eq $match |
1105 | $thing->title eq $match |
1075 | and return 1; |
1106 | and $check_true++; |
1076 | } else { # $i % 3 == 2 |
1107 | } else { # $i % 3 == 2 |
1077 | $thing->arch->name eq $match |
1108 | $thing->arch->name eq $match |
1078 | and return 1; |
1109 | and $check_true++; |
1079 | } |
1110 | } |
1080 | $i++; |
1111 | $i++; |
1081 | } |
1112 | } |
|
|
1113 | #d# warn "CHECK $check_true | $check_cnts | [".(join ',', @matchar).":".join (",", ($thing->name, $thing->title, $thing->arch->name))."\n"; |
|
|
1114 | return 1 if $check_true && $check_cnts == $check_true; |
1082 | return 0; |
1115 | return 0; |
1083 | } |
1116 | } |
1084 | |
1117 | |
1085 | sub grep_for_match { |
1118 | sub grep_for_match { |
1086 | my ($ingred, $group, @matchar) = @_; |
1119 | my ($ingred, $group, @matchar) = @_; |
1087 | |
1120 | |
1088 | for my $thing (@{$ingred->{$group} || []}) { |
1121 | for my $thing (@{$ingred->{$group} || []}) { |
1089 | warn sprintf "DEB:(%s,%s,%s)<->%s\n", $thing->name, $thing->title, $thing->arch->name, "@matchar"; #d# |
1122 | #d# warn sprintf "DEB:(%s,%s,%s)<->%s\n", $thing->name, $thing->title, $thing->arch->name, "@matchar"; #d# |
1090 | if (check_for_match ($thing, @matchar)) { |
1123 | if (check_for_match ($thing, @matchar)) { |
1091 | return $thing; |
1124 | return $thing; |
1092 | } |
1125 | } |
1093 | } |
1126 | } |
1094 | return undef; |
1127 | return undef; |