ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/server/ext/jeweler.ext
(Generate patch)

Comparing deliantra/server/ext/jeweler.ext (file contents):
Revision 1.6 by elmex, Fri Feb 2 12:05:28 2007 UTC vs.
Revision 1.18 by elmex, Thu Nov 12 06:37:57 2009 UTC

1#! perl 1#! perl
2 2
3use Data::Dumper; 3use strict;
4
4use Jeweler; 5use Jeweler;
5use List::Util qw/max min sum/; 6use List::Util qw/max min sum/;
6use strict;
7 7
8sub ingred_alias { 8sub ingred_alias {
9 my ($ing) = @_; 9 my ($ing) = @_;
10 10
11 my %aliases = ( 11 my %aliases = (
… …
14 wis => 'wisdom', 14 wis => 'wisdom',
15 int => 'intelligence', 15 int => 'intelligence',
16 dex => 'dexterity', 16 dex => 'dexterity',
17 con => 'constitution', 17 con => 'constitution',
18 str => 'strength', 18 str => 'strength',
19 gem => 'diamond',
19 ); 20 );
20 21
21 if ($ing =~ m/resist_(\S+)/) { 22 if ($ing =~ m/resist_(\S+)/) {
22 my $a = $aliases{lc $1} || $1; 23 my $a = $aliases{lc $1} || $1;
23 "something for '". lc ($a). "' resistance"; 24 "something for '". lc ($a). "' resistance";
… …
28 29
29 } elsif ($ing =~ m/spec_(\S+)/) { 30 } elsif ($ing =~ m/spec_(\S+)/) {
30 my $a = $aliases{lc $1} || $1; 31 my $a = $aliases{lc $1} || $1;
31 "something for the ". lc ($a). "' special"; 32 "something for the ". lc ($a). "' special";
32 33
34 } elsif ($aliases{$ing}) {
35 $aliases{$ing}
36
33 } else { 37 } else {
34 $ing 38 $ing
35 } 39 }
36} 40}
37 41
… …
44 48
45 my @ring = $ingred->get_ring; 49 my @ring = $ingred->get_ring;
46 my @rings = map { Jeweler::Object->new (object => $_) } @ring; 50 my @rings = map { Jeweler::Object->new (object => $_) } @ring;
47 51
48 @rings >= 2 52 @rings >= 2
49 or return $pl->reply (undef, "You slap yourself, you forgot to put at least 2 jewels in!"); 53 or return $pl->message ("You slap yourself, you forgot to put at least 2 jewels in!");
50 54
51 my $input_level; 55 my $input_level = 0;
56 my $value;
57 for (@rings) {
52 $input_level = max ($_->power_to_level, $input_level) for @rings; 58 $input_level = max ($_->power_to_level, $input_level);
59 $value += $_->{hash}->{value};
60 }
53 61
54 my $ring = shift @rings; 62 my $ring = shift @rings;
55 $ring->improve_by_ring (@rings); 63 $ring->improve_by_ring (@rings);
56 64
57 if ($do_analyze) { 65 if ($do_analyze) {
58 $pl->reply (undef, "You want to make a " . $ring->to_string . ": " . $ring->analyze ($sk, $pl)); 66 $pl->message ("You want to make a " . $ring->to_string . ": " . $ring->analyze ($sk, $pl, $input_level));
59 $ring->wiz_analyze ($pl) 67 $ring->wiz_analyze ($pl)
60 if $pl->flag (cf::FLAG_WIZ); 68 if $pl->flag (cf::FLAG_WIZ);
61 return; 69 return;
62 } 70 }
63 71
64 make_ring ($chdl, $ingred, $ring, $sk, $pl, $input_level); 72 make_ring ($chdl, $ingred, $ring, $value, $sk, $pl, $input_level);
65} 73}
66 74
67sub make_ring { 75sub make_ring {
68 my ($chdl, $ingred, $ring, $sk, $pl, $input_level) = @_; 76 my ($chdl, $ingred, $ring, $value, $sk, $pl, $input_level) = @_;
69 77
70 if (!$pl->flag (cf::FLAG_WIZ)) { 78 if (!$pl->flag (cf::FLAG_WIZ)) {
71 $ingred->remove ('rings'); 79 $ingred->remove ('rings');
72 $ingred->remove ('ammys'); 80 $ingred->remove ('ammys');
73 } 81 }
74 82
75 my $ch = $ring->get_chance_perc ($sk); 83 my $ch = $ring->get_chance_perc ($sk);
76 my $succ = 0; 84 my $succ = 0;
77 my $r = cf::random_roll (0, 100, $pl, cf::PREFER_HIGH); 85 my $r = cf::random_roll (0, 100, $pl, cf::PREFER_HIGH);
78 86
87 my $make_status;
88 my $exp;
89
79 if ($r <= $ch or $pl->flag (cf::FLAG_WIZ)) { 90 if ($r <= $ch or $pl->flag (cf::FLAG_WIZ)) {
80 my $lvl = max ($ring->power_to_level, 1); 91 $exp = $ring->projected_exp ($input_level);
81 my $exp = (cf::level_to_min_exp ($lvl) - cf::level_to_min_exp ($lvl - 1)) / 100;
82
83 if (defined $input_level) {
84 my $subexp =
85 (cf::level_to_min_exp ($input_level)
86 - cf::level_to_min_exp ($input_level - 1))
87 / 100;
88 warn "INPUT: $lvl <-> $input_level ($exp <-> $subexp)\n";
89 $exp -= $subexp;
90 $exp = max ($exp, 0);
91 }
92 92
93 $pl->change_exp ($exp, "jeweler", cf::SK_EXP_SKILL_ONLY); 93 $pl->change_exp ($exp, "jeweler", cf::SK_EXP_SKILL_ONLY);
94 $pl->message ("You succeed and get $exp experience."); 94 $pl->message (
95 "You succeed and get " . int ($exp) . " experience points.");
96 $make_status = "succeeded";
97
98 $ring->set_value ($value * 0.8); # 20% of the input values will vanish
99
95 } else { 100 } else {
96 $pl->message ("You fail!"); 101 $pl->message ("You fail!");
97 $ring->negate; 102 $ring->negate;
103 $make_status = "fail";
104 $exp = 0;
98 } 105 }
106
107 my $ring_ob = $ring->to_object;
108
109 { # some audit info calculation
110 my $sklvl = cf::exp_to_level ($sk->stats->exp);
111
112 my $make_info = sprintf
113 "JEWELER AUDIT: '%s' made '%s' (%s) (sk lvl %d, ring lvl %d, got %d exp): %s",
114 $pl->name, $ring->to_string, $ring_ob->uuid, $sklvl,
115 $ring->power_to_level, $exp, $make_status;
116
117 warn "$make_info\n" if $make_status eq 'succeeded';
118 }
119
99 $chdl->put ($ring->to_object); 120 $chdl->put ($ring_ob);
100} 121}
101 122
102sub get_ingred { 123sub get_ingred {
103 my ($pl, $chdl) = @_; 124 my ($pl, $chdl) = @_;
104 my $ingred = eval { $chdl->extract_jeweler_ingredients }; 125 my $ingred = eval { $chdl->extract_jeweler_ingredients };
… …
129 if ($ringo->has_resist ($1)) { 150 if ($ringo->has_resist ($1)) {
130 $self->map->trigger ( 151 $self->map->trigger (
131 $cfg->{connection}, 152 $cfg->{connection},
132 $cfg->{state} 153 $cfg->{state}
133 ); 154 );
155 $obj->decrease (1);
134 cf::override; 156 cf::override;
135 } 157 }
136 } 158 }
137 } 159 }
138 } 160 }
… …
189 my $plan = $ingred->get_plan; 211 my $plan = $ingred->get_plan;
190 212
191 if ($plan) { 213 if ($plan) {
192 my @ring = $ingred->get_ring; 214 my @ring = $ingred->get_ring;
193 215
216 if (!@ring) {
217 # actually the algorithm cant
218 $pl->message ("You slap yourself, you forgot the jewelery!");
219 return;
220
194 if ((@ring > 1) || ($ring[0]->nrof > 1)) { 221 } elsif ((@ring > 1) || (grep { $_->nrof > 1 } @ring)) {
195 # actually the algorithm cant handle more than one improvement at a time 222 # actually the algorithm cant handle more than one improvement at a time
196 $pl->message ("You can't manage to improve more than one thing at a time!"); 223 $pl->message ("You can't manage to improve more than one thing at a time!");
197 return; 224 return;
198
199 } elsif (@ring < 1) {
200 # actually the algorithm cant
201 $pl->message ("You slap yourself, you forgot the jewelery!");
202 return;
203
204 } else { 225 } else {
205 my $ringo = Jeweler::Object->new (object => $ring[0]); 226 my $ringo = Jeweler::Object->new (object => $ring[0]);
206 my $iring = $ingred->improve_ring_by_plan ($plan, $ringo); 227 my $iring = $ingred->improve_ring_by_plan ($plan, $ringo);
207 my $c1 = $ringo->calc_costs; 228 my $c1 = $ringo->calc_costs;
208 my $c2 = $iring->calc_costs; 229 my $c2 = $iring->calc_costs;
230 my $value = $iring->calc_value_from_cost ($c2);
231
232 if ((not defined $c1) || (not defined $c2)) {
233 $pl->message ("The jewel has or will become a resistancy above 99%,\n"
234 ."that is completly impossible to make!");
235 return;
236 }
209 237
210 my %keys; 238 my %keys;
211 my %cdiff; 239 my %cdiff;
212 for (keys %$c1, keys %$c2) { $keys{$_} = 1 } 240 for (keys %$c1, keys %$c2) { $keys{$_} = 1 }
213 for (keys %keys) { $cdiff{$_} = $c2->{$_} - $c1->{$_}; warn "$_: $c2->{$_} | $c1->{$_}\n"; } 241 for (keys %keys) { $cdiff{$_} = $c2->{$_} - $c1->{$_}; }
214 242
215 unless ($iring->is_better_than ($ringo)) { 243 unless ($iring->is_better_than ($ringo)) {
216 $pl->message ("This plan doesn't improve anything, you find yourself puzzled about what you missed..."); 244 $pl->message ("This plan doesn't improve anything, you find yourself puzzled about what you missed...");
217 return; 245 return;
218 } 246 }
… …
231 } 259 }
232 } else { 260 } else {
233 if (!$pl->flag (cf::FLAG_WIZ)) { 261 if (!$pl->flag (cf::FLAG_WIZ)) {
234 $ingred->check_costs (\%cdiff, 1); 262 $ingred->check_costs (\%cdiff, 1);
235 } 263 }
236 make_ring ($chdl, $ingred, $iring, $sk, $pl); 264 make_ring ($chdl, $ingred, $iring, $value, $sk, $pl);
237 } 265 }
238 } 266 }
239 } else { 267 } else {
240 $pl->message ("You've got no idea what you are planning to do!"); 268 $pl->message ("You've got no idea what you are planning to do!");
241 } 269 }
… …
243 }; 271 };
244 $@ and warn "ERROR: $@\n"; 272 $@ and warn "ERROR: $@\n";
245 } 273 }
246); 274);
247 275
248Jeweler::read_config (cf::datadir . '/jeweler.yaml'); 276Jeweler::read_config "res/jeweler.yaml";
277

Diff Legend

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