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.4 by elmex, Wed Jan 31 15:53:17 2007 UTC vs.
Revision 1.11 by root, Sat May 19 00:11:11 2007 UTC

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
38my $DEBUG = 1; 42my $DEBUG = 1;
39 43
40sub merge { 44sub merge {
41 my ($chdl, $sk, $pl, $do_analyze) = @_; 45 my ($chdl, $sk, $pl, $do_analyze) = @_;
42 46
43 my $ingred = eval { $chdl->extract_jeweler_ingredients }; 47 my $ingred = get_ingred ($pl, $chdl) || return;
44 if ($@ =~ /cursed/) {
45 $pl->reply ("There are cursed items in the workbench, take them out before you do anything.").
46 return
47 } elsif ($@) {
48 warn "error in jeweler ingredient extraction: $@";
49 return;
50 }
51 48
52 my @ring = $ingred->get_ring; 49 my @ring = $ingred->get_ring;
53 my @rings = map { Jeweler::Object->new (object => $_) } @ring; 50 my @rings = map { Jeweler::Object->new (object => $_) } @ring;
54 51
55 @rings >= 2 52 @rings >= 2
56 or return $pl->reply (undef, "You slap yourself, you forgot to put at least 2 jewels in!"); 53 or return $pl->reply (undef, "You slap yourself, you forgot to put at least 2 jewels in!");
54
55 my $input_level;
56 my $value;
57 for (@rings) {
58 $input_level = max ($_->power_to_level, $input_level);
59 $value += $_->{hash}->{value};
60 }
57 61
58 my $ring = shift @rings; 62 my $ring = shift @rings;
59 $ring->improve_by_ring (@rings); 63 $ring->improve_by_ring (@rings);
60 64
61 if ($do_analyze) { 65 if ($do_analyze) {
63 $ring->wiz_analyze ($pl) 67 $ring->wiz_analyze ($pl)
64 if $pl->flag (cf::FLAG_WIZ); 68 if $pl->flag (cf::FLAG_WIZ);
65 return; 69 return;
66 } 70 }
67 71
68 make_ring ($chdl, $ingred, $ring, $sk, $pl); 72 make_ring ($chdl, $ingred, $ring, $value, $sk, $pl, $input_level);
69} 73}
70 74
71sub make_ring { 75sub make_ring {
72 my ($chdl, $ingred, $ring, $sk, $pl) = @_; 76 my ($chdl, $ingred, $ring, $value, $sk, $pl, $input_level) = @_;
73 77
74 if (!$pl->flag (cf::FLAG_WIZ)) { 78 if (!$pl->flag (cf::FLAG_WIZ)) {
75 $ingred->remove ('rings'); 79 $ingred->remove ('rings');
76 $ingred->remove ('ammys'); 80 $ingred->remove ('ammys');
77 } 81 }
78 82
79 my $ch = $ring->get_chance_perc ($sk); 83 my $ch = $ring->get_chance_perc ($sk);
80 my $succ = 0; 84 my $succ = 0;
81 my $r = cf::random_roll (0, 100, $pl, cf::PREFER_HIGH); 85 my $r = cf::random_roll (0, 100, $pl, cf::PREFER_HIGH);
86
87 my $make_status;
88 my $exp;
89
82 if ($r <= $ch or $pl->flag (cf::FLAG_WIZ)) { 90 if ($r <= $ch or $pl->flag (cf::FLAG_WIZ)) {
83 my $lvl = max ($ring->power_to_level, 1); 91 my $lvl = max ($ring->power_to_level, 1);
92 $exp =
84 my $exp = (cf::level_to_min_exp ($lvl) - cf::level_to_min_exp ($lvl - 1)) / 100; 93 (cf::level_to_min_exp ($lvl) - cf::level_to_min_exp ($lvl - 1))
94 / (10 + max ($lvl - 1, 0)); # 10 + level times making such a ring
95 # should get you to the rings level at least.
96
97 if (defined $input_level) {
98 my $subexp =
99 (cf::level_to_min_exp ($input_level)
100 - cf::level_to_min_exp ($input_level - 1))
101 / (10 + max ($input_level - 1, 0)); # see above for comment
102
103 $exp -= $subexp;
104 $exp = max ($exp, 0);
105
106 } else {
107 # the experience bonus here is to make level 1 rings give you at least
108 # 100 exp points when making them. This also makes leveling in the
109 # first few levels a bit easier. (probably until around level 5-6).
110 my $expbonus = cf::level_to_min_exp (2) / 10;
111 # this bonus should also only be given for _new_ rings and not for merged
112 # ones - to prevent infinite exp making.
113 $exp += $expbonus;
114 }
115
85 $pl->change_exp ($exp, "jeweler", cf::SK_EXP_SKILL_ONLY); 116 $pl->change_exp ($exp, "jeweler", cf::SK_EXP_SKILL_ONLY);
86 $pl->message ("You succeed and get $exp experience."); 117 $pl->message ("You succeed and get $exp experience points.");
118 $make_status = "succeeded";
119
120 $ring->set_value ($value * 0.8); # 20% of the input values will vanish
121
87 } else { 122 } else {
88 $pl->message ("You fail!"); 123 $pl->message ("You fail!");
89 $ring->negate; 124 $ring->negate;
125 $make_status = "fail";
126 $exp = 0;
127 }
128
129 my $ring_ob = $ring->to_object;
130
131 { # some audit info calculation
132 my $sklvl = cf::exp_to_level ($sk->stats->exp);
133
134 my $make_info = sprintf
135 "JEWELER AUDIT: '%s' made '%s' (%s) (sk lvl %d, ring lvl %d, got %d exp): %s",
136 $pl->name, $ring->to_string, $ring_ob->uuid, $sklvl,
137 $ring->power_to_level, $exp, $make_status;
138
139 warn "$make_info\n" if $make_status eq 'succeeded';
140
141 $ring_ob->set_ob_key_value (ext_jeweler_made_by => $pl->name);
142 $ring_ob->set_ob_key_value (ext_jeweler_make_info => $make_info);
143 }
144
145 $chdl->put ($ring_ob);
146}
147
148sub get_ingred {
149 my ($pl, $chdl) = @_;
150 my $ingred = eval { $chdl->extract_jeweler_ingredients };
151 if ($@ =~ /cursed/) {
152 $pl->message ("There are cursed items in the workbench, take them out before you do anything.").
153 return
154 } elsif ($@ =~ /unidentified/) {
155 $pl->message ("There are unidentified items in the workbench, identify them before you do anything.").
156 return
157 } elsif ($@) {
158 warn "error in jeweler ingredient extraction: $@";
159 return;
160 }
161 $ingred;
162}
163
164cf::object::attachment check_ring_drop_on =>
165 on_drop_on => sub {
166 my ($self, $obj, $who) = @_;
167 my $cfg = $self->{check_ring_drop_on};
168 if ($obj->type == cf::RING
169 && !$obj->flag (cf::FLAG_CURSED)
170 && !$obj->flag (cf::FLAG_DAMNED)
171 ) {
172 my $ringo = Jeweler::Object->new (object => $obj);
173 for (grep { /^resist_/ } keys %$cfg) {
174 if (/^resist_(\S+)$/) {
175 if ($ringo->has_resist ($1)) {
176 $self->map->trigger (
177 $cfg->{connection},
178 $cfg->{state}
179 );
180 cf::override;
181 }
182 }
183 }
184 }
90 } 185 };
91 $chdl->put ($ring->to_object);
92}
93 186
94cf::object->attach ( 187cf::object->attach (
95 type => cf::SKILL, 188 type => cf::SKILL,
96 subtype => cf::SK_JEWELER, 189 subtype => cf::SK_JEWELER,
97 on_use_skill => sub { 190 on_use_skill => sub {
119 212
120 } elsif ($msg =~ m/^\s*make\s*$/i) { 213 } elsif ($msg =~ m/^\s*make\s*$/i) {
121 $pl->message ("You can make: " . (join ', ', keys %{Jeweler::getcfg ('conversions') || {}})); 214 $pl->message ("You can make: " . (join ', ', keys %{Jeweler::getcfg ('conversions') || {}}));
122 215
123 } elsif ($msg =~ m/^\s*make\s+(\S+)\s*$/i) { 216 } elsif ($msg =~ m/^\s*make\s+(\S+)\s*$/i) {
124 my $ingred = eval { $chdl->extract_jeweler_ingredients }; 217 my $ingred = get_ingred ($pl, $chdl) || return;
125 if ($@ =~ /cursed/) {
126 $pl->message ("There are cursed items in the workbench, take them out before you do anything.").
127 return
128 } elsif ($@) {
129 warn "error in jeweler ingredient extraction: $@";
130 return;
131 }
132 218
133 unless ($Jeweler::CFG->{conversions}->{lc $1}) { 219 unless ($Jeweler::CFG->{conversions}->{lc $1}) {
134 $pl->message ("You don't know how to make '$1', is does such a thing even exist?"); 220 $pl->message ("You don't know how to make '$1', is does such a thing even exist?");
135 return 221 return
136 } 222 }
142 228
143 } elsif ($msg =~ m/^\s*merge\s*$/i) { 229 } elsif ($msg =~ m/^\s*merge\s*$/i) {
144 merge ($chdl, $sk, $pl, 0); 230 merge ($chdl, $sk, $pl, 0);
145 231
146 } else { 232 } else {
147 my $ingred = eval { $chdl->extract_jeweler_ingredients }; 233 my $ingred = get_ingred ($pl, $chdl) || return;
148 if ($@ =~ /cursed/) {
149 $pl->message ("There are cursed items in the workbench, take them out before you do anything.").
150 return
151 } elsif ($@) {
152 warn "error in jeweler ingredient extraction: $@";
153 return;
154 }
155 234
156 my $plan = $ingred->get_plan; 235 my $plan = $ingred->get_plan;
157 236
158 if ($plan) { 237 if ($plan) {
159 my @ring = $ingred->get_ring; 238 my @ring = $ingred->get_ring;
169 return; 248 return;
170 249
171 } else { 250 } else {
172 my $ringo = Jeweler::Object->new (object => $ring[0]); 251 my $ringo = Jeweler::Object->new (object => $ring[0]);
173 my $iring = $ingred->improve_ring_by_plan ($plan, $ringo); 252 my $iring = $ingred->improve_ring_by_plan ($plan, $ringo);
174 my $c1 = $ringo->calc_costs; 253 my $c1 = $ringo->calc_costs;
175 my $c2 = $iring->calc_costs; 254 my $c2 = $iring->calc_costs;
255 my $value = $iring->calc_value_from_cost ($c2);
176 256
177 my %keys; 257 my %keys;
178 my %cdiff; 258 my %cdiff;
179 for (keys %$c1, keys %$c2) { $keys{$_} = 1 } 259 for (keys %$c1, keys %$c2) { $keys{$_} = 1 }
180 for (keys %keys) { $cdiff{$_} = $c2->{$_} - $c1->{$_}; warn "$_: $c2->{$_} | $c1->{$_}\n"; } 260 for (keys %keys) { $cdiff{$_} = $c2->{$_} - $c1->{$_}; }
181 261
182 unless ($iring->is_better_than ($ringo)) { 262 unless ($iring->is_better_than ($ringo)) {
183 $pl->message ("This plan doesn't improve anything, you find yourself puzzled about what you missed..."); 263 $pl->message ("This plan doesn't improve anything, you find yourself puzzled about what you missed...");
184 return; 264 return;
185 } 265 }
198 } 278 }
199 } else { 279 } else {
200 if (!$pl->flag (cf::FLAG_WIZ)) { 280 if (!$pl->flag (cf::FLAG_WIZ)) {
201 $ingred->check_costs (\%cdiff, 1); 281 $ingred->check_costs (\%cdiff, 1);
202 } 282 }
203 make_ring ($chdl, $ingred, $iring, $sk, $pl); 283 make_ring ($chdl, $ingred, $iring, $value, $sk, $pl);
204 } 284 }
205 } 285 }
206 } else { 286 } else {
207 $pl->message ("You've got no idea what you are planning to do!"); 287 $pl->message ("You've got no idea what you are planning to do!");
208 } 288 }
210 }; 290 };
211 $@ and warn "ERROR: $@\n"; 291 $@ and warn "ERROR: $@\n";
212 } 292 }
213); 293);
214 294
215Jeweler::read_config (cf::datadir . '/jeweler.yaml'); 295Jeweler::read_config "$DATADIR/jeweler.yaml";
296

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines