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.1 by root, Fri Dec 15 19:29:18 2006 UTC vs.
Revision 1.15 by root, Mon Dec 17 08:03:22 2007 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
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 = $chdl->extract_jeweler_ingredients; 47 my $ingred = get_ingred ($pl, $chdl) || return;
48
44 my @ring = $ingred->get_ring; 49 my @ring = $ingred->get_ring;
45 my @rings = map { Jeweler::Object->new (object => $_) } @ring; 50 my @rings = map { Jeweler::Object->new (object => $_) } @ring;
46 51
47 @rings >= 2 52 @rings >= 2
48 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!");
49 54
55 my $input_level = 0;
56 my $value;
57 for (@rings) {
58 $input_level = max ($_->power_to_level, $input_level);
59 $value += $_->{hash}->{value};
60 }
61
50 my $ring = shift @rings; 62 my $ring = shift @rings;
51 $ring->improve_by_ring (@rings); 63 $ring->improve_by_ring (@rings);
52 64
53 if ($do_analyze) { 65 if ($do_analyze) {
54 $pl->reply (undef, "You want to make a " . $ring->to_string . ": " . $ring->analyze ($sk, $pl)); 66 $pl->reply (undef, "You want to make a " . $ring->to_string . ": " . $ring->analyze ($sk, $pl, $input_level));
55 $ring->wiz_analyze ($pl) 67 $ring->wiz_analyze ($pl)
56 if $pl->flag (cf::FLAG_WIZ); 68 if $pl->flag (cf::FLAG_WIZ);
57 return; 69 return;
58 } 70 }
59 71
60 make_ring ($chdl, $ingred, $ring, $sk, $pl); 72 make_ring ($chdl, $ingred, $ring, $value, $sk, $pl, $input_level);
61} 73}
62 74
63sub make_ring { 75sub make_ring {
64 my ($chdl, $ingred, $ring, $sk, $pl) = @_; 76 my ($chdl, $ingred, $ring, $value, $sk, $pl, $input_level) = @_;
65 77
66 if (!$pl->flag (cf::FLAG_WIZ)) { 78 if (!$pl->flag (cf::FLAG_WIZ)) {
67 $ingred->remove ('rings'); 79 $ingred->remove ('rings');
68 $ingred->remove ('ammys'); 80 $ingred->remove ('ammys');
69 } 81 }
70 82
71 my $ch = $ring->get_chance_perc ($sk); 83 my $ch = $ring->get_chance_perc ($sk);
72 my $succ = 0; 84 my $succ = 0;
73 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
74 if ($r <= $ch or $pl->flag (cf::FLAG_WIZ)) { 90 if ($r <= $ch or $pl->flag (cf::FLAG_WIZ)) {
75 my $lvl = max ($ring->power_to_level, 1); 91 $exp = $ring->projected_exp ($input_level);
76 my $exp = (cf::level_to_min_exp ($lvl) - cf::level_to_min_exp ($lvl - 1)) / 100; 92
77 $pl->change_exp ($exp, "jeweler", cf::SK_EXP_SKILL_ONLY); 93 $pl->change_exp ($exp, "jeweler", cf::SK_EXP_SKILL_ONLY);
78 $pl->message ("You succeed and get $exp experience."); 94 $pl->message ("You succeed and get $exp experience points.");
95 $make_status = "succeeded";
96
97 $ring->set_value ($value * 0.8); # 20% of the input values will vanish
98
79 } else { 99 } else {
80 $pl->message ("You fail!"); 100 $pl->message ("You fail!");
81 $ring->negate; 101 $ring->negate;
102 $make_status = "fail";
103 $exp = 0;
104 }
105
106 my $ring_ob = $ring->to_object;
107
108 { # some audit info calculation
109 my $sklvl = cf::exp_to_level ($sk->stats->exp);
110
111 my $make_info = sprintf
112 "JEWELER AUDIT: '%s' made '%s' (%s) (sk lvl %d, ring lvl %d, got %d exp): %s",
113 $pl->name, $ring->to_string, $ring_ob->uuid, $sklvl,
114 $ring->power_to_level, $exp, $make_status;
115
116 warn "$make_info\n" if $make_status eq 'succeeded';
117 }
118
119 $chdl->put ($ring_ob);
120}
121
122sub get_ingred {
123 my ($pl, $chdl) = @_;
124 my $ingred = eval { $chdl->extract_jeweler_ingredients };
125 if ($@ =~ /cursed/) {
126 $pl->message ("There are cursed items in the workbench, take them out before you do anything.").
127 return
128 } elsif ($@ =~ /unidentified/) {
129 $pl->message ("There are unidentified items in the workbench, identify them before you do anything.").
130 return
131 } elsif ($@) {
132 warn "error in jeweler ingredient extraction: $@";
133 return;
134 }
135 $ingred;
136}
137
138cf::object::attachment check_ring_drop_on =>
139 on_drop_on => sub {
140 my ($self, $obj, $who) = @_;
141 my $cfg = $self->{check_ring_drop_on};
142 if ($obj->type == cf::RING
143 && !$obj->flag (cf::FLAG_CURSED)
144 && !$obj->flag (cf::FLAG_DAMNED)
145 ) {
146 my $ringo = Jeweler::Object->new (object => $obj);
147 for (grep { /^resist_/ } keys %$cfg) {
148 if (/^resist_(\S+)$/) {
149 if ($ringo->has_resist ($1)) {
150 $self->map->trigger (
151 $cfg->{connection},
152 $cfg->{state}
153 );
154 cf::override;
155 }
156 }
157 }
158 }
82 } 159 };
83 $chdl->put ($ring->to_object);
84}
85 160
86cf::attach_to_type cf::SKILL, cf::SK_JEWELER, 161cf::object->attach (
162 type => cf::SKILL,
163 subtype => cf::SK_JEWELER,
87 on_use_skill => sub { 164 on_use_skill => sub {
88 my ($sk, $ob, $part, $dir, $msg) = @_; 165 my ($sk, $ob, $part, $dir, $msg) = @_;
89 my $pl = $ob; 166 my $pl = $ob;
90 167
91 my $skobj = $sk; 168 my $skobj = $sk;
92 169
93 my $chdl = new Jeweler::CauldronHandler; 170 my $chdl = new Jeweler::CauldronHandler;
94 171
95 my $rv = 1; 172 my $rv = 1;
96 eval { 173 eval {
97 Jeweler::read_config ($ENV{CROSSFIRE_LIBDIR} . '/jeweler.yaml');
98 $DEBUG = 1; 174 $DEBUG = 1;
99 175
100 my $player = $ob->contr; 176 my $player = $ob->contr;
101 177
102 unless ($chdl->find_cauldron ('jeweler_bench', $ob->map->at ($ob->x, $ob->y))) { 178 unless ($chdl->find_cauldron ('jeweler_bench', $ob->map->at ($ob->x, $ob->y))) {
… …
110 186
111 } elsif ($msg =~ m/^\s*make\s*$/i) { 187 } elsif ($msg =~ m/^\s*make\s*$/i) {
112 $pl->message ("You can make: " . (join ', ', keys %{Jeweler::getcfg ('conversions') || {}})); 188 $pl->message ("You can make: " . (join ', ', keys %{Jeweler::getcfg ('conversions') || {}}));
113 189
114 } elsif ($msg =~ m/^\s*make\s+(\S+)\s*$/i) { 190 } elsif ($msg =~ m/^\s*make\s+(\S+)\s*$/i) {
115 my $ingred = $chdl->extract_jeweler_ingredients; 191 my $ingred = get_ingred ($pl, $chdl) || return;
116 192
117 unless ($Jeweler::CFG->{conversions}->{lc $1}) { 193 unless ($Jeweler::CFG->{conversions}->{lc $1}) {
118 $pl->message ("You don't know how to make '$1', is does such a thing even exist?"); 194 $pl->message ("You don't know how to make '$1', is does such a thing even exist?");
119 return 195 return
120 } 196 }
… …
126 202
127 } elsif ($msg =~ m/^\s*merge\s*$/i) { 203 } elsif ($msg =~ m/^\s*merge\s*$/i) {
128 merge ($chdl, $sk, $pl, 0); 204 merge ($chdl, $sk, $pl, 0);
129 205
130 } else { 206 } else {
131 my $ingred = $chdl->extract_jeweler_ingredients; 207 my $ingred = get_ingred ($pl, $chdl) || return;
208
132 my $plan = $ingred->get_plan; 209 my $plan = $ingred->get_plan;
133 210
134 if ($plan) { 211 if ($plan) {
135 my @ring = $ingred->get_ring; 212 my @ring = $ingred->get_ring;
136 213
214 if (!@ring) {
215 # actually the algorithm cant
216 $pl->message ("You slap yourself, you forgot the jewelery!");
217 return;
218
137 if ((@ring > 1) || ($ring[0]->nrof > 1)) { 219 } elsif ((@ring > 1) || (grep { $_->nrof > 1 } @ring)) {
138 # actually the algorithm cant handle more than one improvement at a time 220 # actually the algorithm cant handle more than one improvement at a time
139 $pl->message ("You can't manage to improve more than one thing at a time!"); 221 $pl->message ("You can't manage to improve more than one thing at a time!");
140 return; 222 return;
141
142 } elsif (@ring < 1) {
143 # actually the algorithm cant
144 $pl->message ("You slap yourself, you forgot the jewelery!");
145 return;
146
147 } else { 223 } else {
148 my $ringo = Jeweler::Object->new (object => $ring[0]); 224 my $ringo = Jeweler::Object->new (object => $ring[0]);
149 my $iring = $ingred->improve_ring_by_plan ($plan, $ringo); 225 my $iring = $ingred->improve_ring_by_plan ($plan, $ringo);
150 my $c1 = $ringo->calc_costs; 226 my $c1 = $ringo->calc_costs;
151 my $c2 = $iring->calc_costs; 227 my $c2 = $iring->calc_costs;
228 my $value = $iring->calc_value_from_cost ($c2);
229
230 if ((not defined $c1) || (not defined $c2)) {
231 $pl->message ("The jewel has or will become a resistancy above 99%,\n"
232 ."that is completly impossible to make!");
233 return;
234 }
152 235
153 my %keys; 236 my %keys;
154 my %cdiff; 237 my %cdiff;
155 for (keys %$c1, keys %$c2) { $keys{$_} = 1 } 238 for (keys %$c1, keys %$c2) { $keys{$_} = 1 }
156 for (keys %keys) { $cdiff{$_} = $c2->{$_} - $c1->{$_} } 239 for (keys %keys) { $cdiff{$_} = $c2->{$_} - $c1->{$_}; }
157 240
158 unless (grep { $_ > 0 } values %cdiff) { 241 unless ($iring->is_better_than ($ringo)) {
159 $pl->message ("This plan doesn't improve anything, you find yourself puzzled about what you missed..."); 242 $pl->message ("This plan doesn't improve anything, you find yourself puzzled about what you missed...");
160 return; 243 return;
161 } 244 }
162 245
163 my $remcosts = $ingred->check_costs (\%cdiff); 246 my $remcosts = $ingred->check_costs (\%cdiff);
… …
174 } 257 }
175 } else { 258 } else {
176 if (!$pl->flag (cf::FLAG_WIZ)) { 259 if (!$pl->flag (cf::FLAG_WIZ)) {
177 $ingred->check_costs (\%cdiff, 1); 260 $ingred->check_costs (\%cdiff, 1);
178 } 261 }
179 make_ring ($chdl, $ingred, $iring, $sk, $pl); 262 make_ring ($chdl, $ingred, $iring, $value, $sk, $pl);
180 } 263 }
181 } 264 }
182 } else { 265 } else {
183 $pl->message ("You've got no idea what you are planning to do!"); 266 $pl->message ("You've got no idea what you are planning to do!");
184 } 267 }
185 } 268 }
186 }; 269 };
187 $@ and warn "ERROR: $@\n"; 270 $@ and warn "ERROR: $@\n";
188 } 271 }
189; 272);
190 273
274Jeweler::read_config "res/jeweler.yaml";
275

Diff Legend

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