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.3 by elmex, Thu Aug 31 12:39:19 2006 UTC vs.
Revision 1.9 by root, Tue Dec 12 16:59:34 2006 UTC

… …
7The Jeweler skill helper module. 7The Jeweler skill helper module.
8 8
9=cut 9=cut
10 10
11package Jeweler; 11package Jeweler;
12
12use strict; 13use strict;
13use YAML; 14use YAML;
14 15
15=over 4 16=over 4
16 17
… …
163sub analyze { 164sub analyze {
164 my ($sk, $chdl, $pl) = @_; 165 my ($sk, $chdl, $pl) = @_;
165 166
166 my $hadunid = 0; 167 my $hadunid = 0;
167 for ($chdl->grep_by_type (cf::RING, cf::AMULET)) { 168 for ($chdl->grep_by_type (cf::RING, cf::AMULET)) {
168 if (!$_->get_flag (cf::FLAG_IDENTIFIED) && $_->need_identify) { 169 if (!$_->flag (cf::FLAG_IDENTIFIED) && $_->need_identify) {
169 $hadunid = 1; 170 $hadunid = 1;
170 next; 171 next;
171 } 172 }
172 my $r = Jeweler::Object->new (object => $_); 173 my $r = Jeweler::Object->new (object => $_);
173 my $msg = $r->analyze ($sk, $pl); 174 my $msg = $r->analyze ($sk, $pl);
174 $pl->message ($r->to_string . ": " . $msg); 175 $pl->message ($r->to_string . ": " . $msg);
176 if ($pl->flag (cf::FLAG_WIZ)) {
175 $r->wiz_analyze ($pl); 177 $r->wiz_analyze ($pl);
178 }
176 } 179 }
177 if ($hadunid) { 180 if ($hadunid) {
178 $pl->message ("You couldn't identify the other rings and not analyze them!"); 181 $pl->message ("You couldn't identify the other rings and not analyze them!");
179 } 182 }
180} 183}
… …
203 warn "WARNING: xp gain isn't > 0 in convesion '$outarch'\n"; 206 warn "WARNING: xp gain isn't > 0 in convesion '$outarch'\n";
204 return; 207 return;
205 } 208 }
206 209
207 unless ($outarchvalfact) { 210 unless ($outarchvalfact) {
208 warn "ERROR: source-arch-value-multiplier == 0 in convesion '$outarch'\n"; 211 warn "ERROR: source-arch-value-multiplier == 0 in conversion '$outarch'\n";
209 return; 212 return;
210 } 213 }
211 214
212 unless ($outarchvalfact >= 1) { 215 unless ($outarchvalfact >= 1) {
213 warn "WARNING: source-arch-value-multiplier < 1 in convesion '$outarch', results in more valuable output!\n"; 216 warn "WARNING: source-arch-value-multiplier < 1 in conversion '$outarch', results in more valuable output!\n";
214 } 217 }
215 218
216 my $archvalsum = $ingred->value ($ingr_grp, $srcarchname); 219 my $archvalsum = $ingred->value ($ingr_grp, $srcarchname);
217 $ingred->remove ($ingr_grp, $srcarchname); 220 $ingred->remove ($ingr_grp, $srcarchname);
218 221
… …
232 } 235 }
233} 236}
234 237
235 238
236package Jeweler::CauldronHandler; 239package Jeweler::CauldronHandler;
240
237use strict; 241use strict;
238 242
239=head2 CauldronHandler 243=head2 CauldronHandler
240 244
241The Jeweler::CauldronHandler package, that helps you with handling the 245The Jeweler::CauldronHandler package, that helps you with handling the
… …
267 my ($self, $arch_name, @map_stack) = @_; 271 my ($self, $arch_name, @map_stack) = @_;
268 272
269 my @c = 273 my @c =
270 grep { 274 grep {
271 $_->flag (cf::FLAG_IS_CAULDRON) 275 $_->flag (cf::FLAG_IS_CAULDRON)
272 and $_->archetype->name eq $arch_name 276 and $_->arch->name eq $arch_name
273 } @map_stack; 277 } @map_stack;
274 278
275 $self->{cauldron} = $c[0]; 279 $self->{cauldron} = $c[0];
276} 280}
277 281
… …
378 382
379sub value { 383sub value {
380 my ($self, $group, $archname) = @_; 384 my ($self, $group, $archname) = @_;
381 385
382 my @objs = grep { 386 my @objs = grep {
383 $_->archetype->name eq $archname 387 $_->arch->name eq $archname
384 } @{$self->{ingredients}->{$group} || []}; 388 } @{$self->{ingredients}->{$group} || []};
385 389
386 my $sum = 0; 390 my $sum = 0;
387 for (@objs) { 391 for (@objs) {
388 $sum += ($_->nrof || 1) * $_->value; 392 $sum += ($_->nrof || 1) * $_->value;
… …
405 409
406 my @out; 410 my @out;
407 411
408 for (@{$ingred->{$group}}) { 412 for (@{$ingred->{$group}}) {
409 if (defined $archname) { 413 if (defined $archname) {
410 if ($_->archetype->name eq $archname) { 414 if ($_->arch->name eq $archname) {
411 Jeweler::Util::remove ($_); 415 Jeweler::Util::remove ($_);
412 } else { 416 } else {
413 push @out, $_; 417 push @out, $_;
414 } 418 }
415 } else { 419 } else {
… …
580 584
581 my $sklvl = cf::exp_to_level ($sk->stats->exp); 585 my $sklvl = cf::exp_to_level ($sk->stats->exp);
582 my $ringlvl = $self->power_to_level; 586 my $ringlvl = $self->power_to_level;
583 587
584 my $tmpl; 588 my $tmpl;
585 if ($pl->get_flag (cf::FLAG_WIZ)) { 589 if ($pl->flag (cf::FLAG_WIZ)) {
586 $tmpl = Jeweler::level_diff_to_chance_perc ($sklvl - $ringlvl); 590 $tmpl = Jeweler::level_diff_to_chance_perc ($sklvl - $ringlvl);
587 } else { 591 } else {
588 $tmpl = Jeweler::level_diff_to_str ($sklvl - $ringlvl); 592 $tmpl = Jeweler::level_diff_to_str ($sklvl - $ringlvl);
589 } 593 }
590 my $msg = sprintf "Projected success rate: %s", $tmpl; 594 my $msg = sprintf "Projected success rate: %s", $tmpl;
… …
657 my $rv = $r->{resist}->{$_}; 661 my $rv = $r->{resist}->{$_};
658 "(resist " . (lc $Jeweler::RESMAP{$_}) . " " . ($rv > 0 ? '+' : '') . $rv . ")" 662 "(resist " . (lc $Jeweler::RESMAP{$_}) . " " . ($rv > 0 ? '+' : '') . $rv . ")"
659 } grep { $r->{resist}->{$_} } @Jeweler::RESISTS), 663 } grep { $r->{resist}->{$_} } @Jeweler::RESISTS),
660 (map { 664 (map {
661 my $rv = $r->{stat}->{$_}; 665 my $rv = $r->{stat}->{$_};
662 "(" . (lc $_) . ($rv > 0 ? '+' : '') . $rv . ")" 666 "(" . (ucfirst lc $_) . ($rv > 0 ? '+' : '') . $rv . ")"
663 } grep { $r->{stat}->{$_} } keys %{$r->{stat}}), 667 } grep { $r->{stat}->{$_} } keys %{$r->{stat}}),
664 (map { 668 (map {
665 my $rv = $r->{spec}->{$_}; 669 my $rv = $r->{spec}->{$_};
666 "(" . (lc $_) . ($rv > 0 ? '+' : '') . $rv . ")" 670 "(" . (lc $_) . ($rv > 0 ? '+' : '') . $rv . ")"
667 } grep { $r->{spec}->{$_} } keys %{$r->{spec}}))) 671 } grep { $r->{spec}->{$_} } keys %{$r->{spec}})))
… …
671 my ($self, $thing) = @_; 675 my ($self, $thing) = @_;
672 676
673 my $obj = {}; 677 my $obj = {};
674 678
675 for (@Jeweler::RESISTS) { 679 for (@Jeweler::RESISTS) {
676 $obj->{resist}->{$_} = $thing->get_resistance ($_); 680 $obj->{resist}->{$_} = $thing->resistance ($_);
677 } 681 }
678 682
679 my $stats = $thing->stats; 683 my $stats = $thing->stats;
680 684
681 for (qw/Str Dex Con Wis Cha Int Pow/) { 685 for (qw/Str Dex Con Wis Cha Int Pow/) {
682 $obj->{stat}->{lc $_} = $stats->$_; 686 $obj->{stat}->{lc $_} = $stats->$_;
683 } 687 }
684 688
685 $obj->{spec}->{regen} = $thing->hp; 689 $obj->{spec}{regen} = $stats->hp;
686 $obj->{spec}->{magic} = $thing->sp; 690 $obj->{spec}{magic} = $stats->sp;
687 $obj->{spec}->{wc} = $thing->wc; 691 $obj->{spec}{wc} = $stats->wc;
688 $obj->{spec}->{dam} = $thing->dam; 692 $obj->{spec}{dam} = $stats->dam;
689 $obj->{spec}->{ac} = $thing->ac; 693 $obj->{spec}{ac} = $stats->ac;
690 $obj->{spec}->{speed} = $thing->stats->exp; 694 $obj->{spec}{speed} = $stats->exp;
691 $obj->{spec}->{suste} = $thing->food; 695 $obj->{spec}{food} = $stats->food;
692 696
693 $obj->{name} = $thing->name; 697 $obj->{name} = $thing->name;
694 $obj->{arch} = $thing->archetype->name; 698 $obj->{arch} = $thing->arch->name;
695 $obj->{face} = $thing->face; 699 $obj->{face} = $thing->face;
696 700
697 $self->{hash} = $obj 701 $self->{hash} = $obj
698} 702}
699 703
700sub to_object { 704sub to_object {
701 my ($self) = @_; 705 my ($self) = @_;
706
702 my $obj = cf::object::new $self->{hash}->{arch}; 707 my $obj = cf::object::new $self->{hash}->{arch};
708
703 $obj->set_face ($self->{hash}->{face}); 709 $obj->face ($self->{hash}{face});
704 710
711 my $stats = $obj->stats;
712
705 $obj->set_hp ($self->{hash}->{spec}->{regen} * 1); 713 $stats->hp ($self->{hash}{spec}{regen});
706 $obj->set_sp ($self->{hash}->{spec}->{magic} * 1); 714 $stats->sp ($self->{hash}{spec}{magic});
707 $obj->set_wc ($self->{hash}->{spec}->{wc} * 1); 715 $stats->wc ($self->{hash}{spec}{wc});
708 $obj->set_dam ($self->{hash}->{spec}->{dam} * 1); 716 $stats->dam ($self->{hash}{spec}{dam});
709 $obj->set_ac ($self->{hash}->{spec}->{ac} * 1); 717 $stats->ac ($self->{hash}{spec}{ac});
710 $obj->stats->exp ($self->{hash}->{spec}->{speed} * 1); 718 $stats->exp ($self->{hash}{spec}{speed});
711 $obj->set_food ($self->{hash}->{spec}->{suste} * 1); 719 $stats->food ($self->{hash}{spec}{food});
712 720
721 $stats->$_ ($self->{hash}{stat}{lc $_})
713 for (qw/Str Dex Con Wis Cha Int Pow/) { 722 for qw/Str Dex Con Wis Cha Int Pow/;
714 $obj->stats->$_ ($self->{hash}->{stat}->{lc $_} * 1);
715 }
716 723
717 for (@Jeweler::RESISTS) { 724 for (@Jeweler::RESISTS) {
718 $obj->set_resistance ($_, $self->{hash}->{resist}->{$_} * 1); 725 $obj->resistance ($_, $self->{hash}->{resist}->{$_});
719 } 726 }
720 727
721 $obj->set_flag (cf::FLAG_IDENTIFIED, 1); 728 $obj->flag (cf::FLAG_IDENTIFIED, 1);
722 729
723 return $obj; 730 return $obj;
724} 731}
725 732
726sub stat_level { 733sub stat_level {
… …
729 736
730 my $maxlevel = Jeweler::getcfg (maxlevels => 'stat_level'); 737 my $maxlevel = Jeweler::getcfg (maxlevels => 'stat_level');
731 my $maxstat = Jeweler::getcfg (maximprovements => 'stats'); 738 my $maxstat = Jeweler::getcfg (maximprovements => 'stats');
732 739
733 my $stat_cnt = scalar (grep { $_ > 0 } values %$stats); 740 my $stat_cnt = scalar (grep { $_ > 0 } values %$stats);
734 my $stat_sum = sum (values %$stats); 741 my $stat_sum = sum (values %$stats); # also count the negative stats!
735 my $level = int (($maxlevel / $maxstat) * $stat_sum); 742 my $level = int (($maxlevel / $maxstat) * $stat_sum);
736 743
737 ($level, $stat_cnt) 744 ($level, $stat_cnt)
738} 745}
739 746
… …
905 my $sum = sum (@$stat_split); 912 my $sum = sum (@$stat_split);
906 if ($sum < (1 - 0.0001)) { 913 if ($sum < (1 - 0.0001)) {
907 warn "JEWELER BUG: sum (@$stat_split) = $sum < 1 for $category!"; 914 warn "JEWELER BUG: sum (@$stat_split) = $sum < 1 for $category!";
908 } 915 }
909 916
910 my $emarch = cf::arch::find ('emerald'); 917 my $emarch = cf::arch::find 'emerald';
911 my $saarch = cf::arch::find ('sapphire'); 918 my $saarch = cf::arch::find 'sapphire';
912 my $pearch = cf::arch::find ('pearl'); 919 my $pearch = cf::arch::find 'pearl';
913 my $ruarch = cf::arch::find ('ruby'); 920 my $ruarch = cf::arch::find 'ruby';
914 my $diarch = cf::arch::find ('gem'); 921 my $diarch = cf::arch::find 'gem';
915 922
916 my $sumvalue = $diarch->clone->value * $diamonds; 923 my $sumvalue = $diarch->clone->value * $diamonds;
917 924
918 $cost->{emerald} += ceil (($sumvalue * $stat_split->[0]) / max (1, $emarch->clone->value)); 925 $cost->{emerald} += ceil $sumvalue * $stat_split->[0] / max 1, $emarch->clone->value;
919 $cost->{sapphire} += ceil (($sumvalue * $stat_split->[1]) / max (1, $saarch->clone->value)); 926 $cost->{sapphire} += ceil $sumvalue * $stat_split->[1] / max 1, $saarch->clone->value;
920 $cost->{pearl} += ceil (($sumvalue * $stat_split->[2]) / max (1, $pearch->clone->value)); 927 $cost->{pearl} += ceil $sumvalue * $stat_split->[2] / max 1, $pearch->clone->value;
921 $cost->{ruby} += ceil (($sumvalue * $stat_split->[3]) / max (1, $ruarch->clone->value)); 928 $cost->{ruby} += ceil $sumvalue * $stat_split->[3] / max 1, $ruarch->clone->value;
922 $cost->{gem} += ceil (($sumvalue * $stat_split->[4]) / max (1, $diarch->clone->value)); 929 $cost->{gem} += ceil $sumvalue * $stat_split->[4] / max 1, $diarch->clone->value;
923} 930}
924
925
926 931
927package Jeweler::Util; 932package Jeweler::Util;
933
928use strict; 934use strict;
929 935
930=head2 Util 936=head2 Util
931 937
932Some utility functions for the Jeweler skill. 938Some utility functions for the Jeweler skill.
… …
948 if (defined $nrof) { 954 if (defined $nrof) {
949 return 0 if ($nrof * 1) == 0; 955 return 0 if ($nrof * 1) == 0;
950 $cnt = int (($obj->nrof || 1) - (1 * $nrof)); 956 $cnt = int (($obj->nrof || 1) - (1 * $nrof));
951 957
952 if ($cnt > 0) { 958 if ($cnt > 0) {
953 $obj->set_nrof ($cnt); 959 $obj->nrof ($cnt);
954 return 0; 960 return 0;
955 } 961 }
956 } 962 }
957 963
958 remove ($_) for ($obj->inv); 964 remove ($_) for $obj->inv;
959 $obj->remove; 965 $obj->destroy;
960 $obj->free;
961 return $cnt; 966 return $cnt;
962} 967}
963 968
964sub grep_for_match { 969sub grep_for_match {
965 my ($thing, @matchar) = @_; 970 my ($thing, @matchar) = @_;
… …
976 and return 1; 981 and return 1;
977 } elsif ($i % 3 == 1) { 982 } elsif ($i % 3 == 1) {
978 $thing->title eq $match 983 $thing->title eq $match
979 and return 1; 984 and return 1;
980 } else { # $i % 3 == 2 985 } else { # $i % 3 == 2
981 $thing->archetype->name eq $match 986 $thing->arch->name eq $match
982 and return 1; 987 and return 1;
983 } 988 }
984 $i++; 989 $i++;
985 } 990 }
986 return 0; 991 return 0;

Diff Legend

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