ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/cf.schmorp.de/maps/perl/jeweler.ext
Revision: 1.13
Committed: Fri Dec 15 19:11:46 2006 UTC (17 years, 7 months ago) by root
Branch: MAIN
CVS Tags: HEAD
Changes since 1.12: +0 -0 lines
State: FILE REMOVED
Log Message:
move .ext to server

File Contents

# Content
1 #! perl
2
3 use Data::Dumper;
4 use Jeweler;
5 use List::Util qw/max min sum/;
6 use strict;
7
8 sub ingred_alias {
9 my ($ing) = @_;
10
11 my %aliases = (
12 pow => 'power',
13 cha => 'charisma',
14 wis => 'wisdom',
15 int => 'intelligence',
16 dex => 'dexterity',
17 con => 'constitution',
18 str => 'strength',
19 );
20
21 if ($ing =~ m/resist_(\S+)/) {
22 my $a = $aliases{lc $1} || $1;
23 "something for '". lc ($a). "' resistance";
24
25 } elsif ($ing =~ m/stat_(\S+)/) {
26 my $a = $aliases{lc $1} || $1;
27 "something for the ". lc ($a). " stat";
28
29 } elsif ($ing =~ m/spec_(\S+)/) {
30 my $a = $aliases{lc $1} || $1;
31 "something for the ". lc ($a). "' special";
32
33 } else {
34 $ing
35 }
36 }
37
38 my $DEBUG = 1;
39
40 sub merge {
41 my ($chdl, $sk, $pl, $do_analyze) = @_;
42
43 my $ingred = $chdl->extract_jeweler_ingredients;
44 my @ring = $ingred->get_ring;
45 my @rings = map { Jeweler::Object->new (object => $_) } @ring;
46
47 @rings >= 2
48 or return $pl->reply (undef, "You slap yourself, you forgot to put at least 2 jewels in!");
49
50 my $ring = shift @rings;
51 $ring->improve_by_ring (@rings);
52
53 if ($do_analyze) {
54 $pl->reply (undef, "You want to make a " . $ring->to_string . ": " . $ring->analyze ($sk, $pl));
55 $ring->wiz_analyze ($pl)
56 if $pl->flag (cf::FLAG_WIZ);
57 return;
58 }
59
60 make_ring ($chdl, $ingred, $ring, $sk, $pl);
61 }
62
63 sub make_ring {
64 my ($chdl, $ingred, $ring, $sk, $pl) = @_;
65
66 if (!$pl->flag (cf::FLAG_WIZ)) {
67 $ingred->remove ('rings');
68 $ingred->remove ('ammys');
69 }
70
71 my $ch = $ring->get_chance_perc ($sk);
72 my $succ = 0;
73 my $r = cf::random_roll (0, 100, $pl, cf::PREFER_HIGH);
74 if ($r <= $ch or $pl->flag (cf::FLAG_WIZ)) {
75 my $lvl = max ($ring->power_to_level, 1);
76 my $exp = (cf::level_to_min_exp ($lvl) - cf::level_to_min_exp ($lvl - 1)) / 100;
77 $pl->change_exp ($exp, "jeweler", cf::SK_EXP_SKILL_ONLY);
78 $pl->message ("You succeed and get $exp experience.");
79 } else {
80 $pl->message ("You fail!");
81 $ring->negate;
82 }
83 $chdl->put ($ring->to_object);
84 }
85
86 cf::attach_to_type cf::SKILL, cf::SK_JEWELER,
87 on_use_skill => sub {
88 my ($sk, $ob, $part, $dir, $msg) = @_;
89 my $pl = $ob;
90
91 my $skobj = $sk;
92
93 my $chdl = new Jeweler::CauldronHandler;
94
95 my $rv = 1;
96 eval {
97 Jeweler::read_config ($ENV{CROSSFIRE_LIBDIR} . '/jeweler.yaml');
98 $DEBUG = 1;
99
100 my $player = $ob->contr;
101
102 unless ($chdl->find_cauldron ('jeweler_bench', $ob->map->at ($ob->x, $ob->y))) {
103 return;
104 }
105
106 cf::override;
107
108 if ($msg =~ m/^\s*analy[sz]e\s*$/i) {
109 Jeweler::analyze ($sk, $chdl, $pl);
110
111 } elsif ($msg =~ m/^\s*make\s*$/i) {
112 $pl->message ("You can make: " . (join ', ', keys %{Jeweler::getcfg ('conversions') || {}}));
113
114 } elsif ($msg =~ m/^\s*make\s+(\S+)\s*$/i) {
115 my $ingred = $chdl->extract_jeweler_ingredients;
116
117 unless ($Jeweler::CFG->{conversions}->{lc $1}) {
118 $pl->message ("You don't know how to make '$1', is does such a thing even exist?");
119 return
120 }
121
122 Jeweler::simple_converter ($player, $ingred, $chdl, $1);
123
124 } elsif ($msg =~ m/^\s*merge\s*analy[sz]e\s*$/i) {
125 merge ($chdl, $sk, $pl, 1);
126
127 } elsif ($msg =~ m/^\s*merge\s*$/i) {
128 merge ($chdl, $sk, $pl, 0);
129
130 } else {
131 my $ingred = $chdl->extract_jeweler_ingredients;
132 my $plan = $ingred->get_plan;
133
134 if ($plan) {
135 my @ring = $ingred->get_ring;
136
137 if ((@ring > 1) || ($ring[0]->nrof > 1)) {
138 # 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!");
140 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 {
148 my $ringo = Jeweler::Object->new (object => $ring[0]);
149 my $iring = $ingred->improve_ring_by_plan ($plan, $ringo);
150 my $c1 = $ringo->calc_costs;
151 my $c2 = $iring->calc_costs;
152
153 my %keys;
154 my %cdiff;
155 for (keys %$c1, keys %$c2) { $keys{$_} = 1 }
156 for (keys %keys) { $cdiff{$_} = $c2->{$_} - $c1->{$_} }
157
158 unless (grep { $_ > 0 } values %cdiff) {
159 $pl->message ("This plan doesn't improve anything, you find yourself puzzled about what you missed...");
160 return;
161 }
162
163 my $remcosts = $ingred->check_costs (\%cdiff);
164
165 if (grep { $_ > 0 } values %$remcosts) {
166 $pl->message ("You want to make a " . $iring->to_string . ": " . $iring->analyze ($sk, $pl));
167 $pl->message ("You recognize that you are short of: "
168 . (join ", ",
169 map { my $cost = $remcosts->{$_}; $cost . " " . ($cost > 1 ? "times" : "time") . " " . ingred_alias ($_) }
170 grep { $remcosts->{$_} > 0 } keys %$remcosts));
171
172 if ($pl->flag (cf::FLAG_WIZ)) {
173 $iring->wiz_analyze ($pl);
174 }
175 } else {
176 if (!$pl->flag (cf::FLAG_WIZ)) {
177 $ingred->check_costs (\%cdiff, 1);
178 }
179 make_ring ($chdl, $ingred, $iring, $sk, $pl);
180 }
181 }
182 } else {
183 $pl->message ("You've got no idea what you are planning to do!");
184 }
185 }
186 };
187 $@ and warn "ERROR: $@\n";
188 }
189 ;
190