server/ext/jeweler.ext

#! perl

use strict;

use Jeweler;
use List::Util qw/max min sum/;

sub ingred_alias {
   my ($ing) = @_;

   my %aliases = (
      pow => 'power',
      cha => 'charisma',
      wis => 'wisdom',
      int => 'intelligence',
      dex => 'dexterity',
      con => 'constitution',
      str => 'strength',
      gem => 'diamond',
   );

   if ($ing =~ m/resist_(\S+)/) {
      my $a = $aliases{lc $1} || $1;
      "something for '". lc ($a). "' resistance";

   } elsif ($ing =~ m/stat_(\S+)/) {
      my $a = $aliases{lc $1} || $1;
      "something for the ". lc ($a). " stat";

   } elsif ($ing =~ m/spec_(\S+)/) {
      my $a = $aliases{lc $1} || $1;
      "something for the ". lc ($a). "' special";

   } elsif ($aliases{$ing}) {
      $aliases{$ing}

   } else {
      $ing
   }
}

my $DEBUG = 1;

sub merge {
   my ($chdl, $sk, $pl, $do_analyze) = @_;

   my $ingred = get_ingred ($pl, $chdl) || return;

   my @ring = $ingred->get_ring;
   my @rings = map { Jeweler::Object->new (object => $_) } @ring;

   @rings >= 2
      or return $pl->message ("You slap yourself, you forgot to put at least 2 jewels in!");

   my $input_level = 0;
   my $value;
   for (@rings) {
      $input_level = max ($_->power_to_level, $input_level);
      $value += $_->{hash}->{value};
   }

   my $ring = shift @rings;
   $ring->improve_by_ring (@rings);

   if ($do_analyze) {
      $pl->message ("You want to make a " . $ring->to_string . ": " . $ring->analyze ($sk, $pl, $input_level));
      $ring->wiz_analyze ($pl)
         if $pl->flag (cf::FLAG_WIZ);
      return;
   }

   make_ring ($chdl, $ingred, $ring, $value, $sk, $pl, $input_level);
}

sub make_ring {
   my ($chdl, $ingred, $ring, $value, $sk, $pl, $input_level) = @_;

   if (!$pl->flag (cf::FLAG_WIZ)) {
      $ingred->remove ('rings');
      $ingred->remove ('ammys');
   }

   my $ch = $ring->get_chance_perc ($sk);
   my $succ = 0;
   my $r = cf::random_roll (0, 100, $pl, cf::PREFER_LOW);

   my $make_status;
   my $exp;

   if ($r <= $ch or $pl->flag (cf::FLAG_WIZ)) {
      $exp = $ring->projected_exp ($input_level);

      $pl->change_exp ($exp, "jeweler", cf::SK_EXP_SKILL_ONLY);
      $pl->message (
         "You succeed and get " . (int $exp) . " experience points.");
      $make_status = "succeeded";

      $ring->set_value ($value);

   } else {
      $pl->message ("You fail!");
      $ring->negate;
      $make_status = "fail";
      $exp = 0;
   }

   my $ring_ob = $ring->to_object;

   $ring_ob->kv_set (ext_jeweler_maker => $pl->name);

   { # some audit info calculation
      my $sklvl = cf::exp_to_level ($sk->stats->exp);

      my $make_info = sprintf
         "JEWELER AUDIT: '%s' made '%s' (%s) (sk lvl %d, ring lvl %d, got %d exp): %s",
            $pl->name, $ring->to_string, $ring_ob->uuid, $sklvl,
            $ring->power_to_level, $exp, $make_status;

      cf::debug "$make_info\n"
         if $make_status eq 'succeeded';
   }

   $chdl->put ($ring_ob);
}

sub get_ingred {
   my ($pl, $chdl) = @_;
   my $ingred = eval { $chdl->extract_jeweler_ingredients };
   if ($@ =~ /cursed/) {
      $pl->message ("There are cursed items in the workbench, take them out before you do anything.").
      return
   } elsif ($@ =~ /unidentified/) {
      $pl->message ("There are unidentified items in the workbench, identify them before you do anything.").
      return
   } elsif ($@) {
      cf::error "error in jeweler ingredient extraction: $@";
      return;
   }
   $ingred;
}

cf::object::attachment check_ring_drop_on =>
   on_drop_on => sub {
      my ($self, $obj, $who) = @_;
      my $cfg = $self->{check_ring_drop_on};
      if ($obj->type == cf::RING
          && !$obj->flag (cf::FLAG_CURSED)
          && !$obj->flag (cf::FLAG_DAMNED)
      ) {
         my $ringo = Jeweler::Object->new (object => $obj);
         for (grep { /^resist_/ } keys %$cfg) {
            if (/^resist_(\S+)$/) {
               if ($ringo->has_resist ($1)) {
                  $self->map->trigger (
                     $cfg->{connection},
                     $cfg->{state}
                  );
                  $obj->decrease (1);
                  cf::override;
               }
            }
         }
      }
   };

cf::object->attach (
   type         => cf::SKILL,
   subtype      => cf::SK_JEWELER,
   on_use_skill => sub {
      my ($sk, $ob, $part, $dir, $msg) = @_;
      my $pl = $ob;

      my $skobj = $sk;

      my $chdl = new Jeweler::CauldronHandler;

      my $rv = 1;
      eval {
         $DEBUG = 1;

         my $player = $ob->contr;

         unless ($chdl->find_cauldron ('jeweler_bench', $ob->map->at ($ob->x, $ob->y))) {
            return;
         }

         cf::override;

         if ($msg =~ m/^\s*analy[sz]e\s*$/i) {
            Jeweler::analyze ($sk, $chdl, $pl);

         } elsif ($msg =~ m/^\s*make\s*$/i) {
            $pl->message ("You can make: " . (join ', ', keys %{Jeweler::getcfg ('conversions') || {}}));

         } elsif ($msg =~ m/^\s*make\s+(\S+)\s*$/i) {
            my $ingred = get_ingred ($pl, $chdl) || return;

            unless ($Jeweler::CFG->{conversions}->{lc $1}) {
               $pl->message ("You don't know how to make '$1', is does such a thing even exist?");
               return
            }

            Jeweler::simple_converter (
               $player, $ingred, $chdl, $1,
               cf::exp_to_level ($sk->stats->exp));

         } elsif ($msg =~ m/^\s*merge\s*analy[sz]e\s*$/i) {
            merge ($chdl, $sk, $pl, 1);

         } elsif ($msg =~ m/^\s*merge\s*$/i) {
            merge ($chdl, $sk, $pl, 0);

         } else {
            my $ingred = get_ingred ($pl, $chdl) || return;

            my $plan   = $ingred->get_plan;

            if ($plan) {
               my @ring = $ingred->get_ring;

               if (!@ring) {
                  # actually the algorithm cant
                  $pl->message ("You slap yourself, you forgot the jewelery!");
                  return;

               } elsif ((@ring > 1) || (grep { $_->nrof > 1 } @ring)) {
                  # actually the algorithm cant handle more than one improvement at a time
                  $pl->message ("You can't manage to improve more than one thing at a time!");
                  return;
               } else {
                  my $ringo = Jeweler::Object->new (object => $ring[0]);
                  my $iring = $ingred->improve_ring_by_plan ($plan, $ringo);
                  my $c1    = $ringo->calc_costs;
                  my $c2    = $iring->calc_costs;
                  my $value = $iring->calc_value_from_cost ($c2);

                  if ((not defined $c1) || (not defined $c2)) {
                     $pl->message ("The jewel has or will become a resistancy above 99%,\n"
                                  ."that is completly impossible to make!");
                     return;
                  }

                  my %keys;
                  my %cdiff;
                  for (keys %$c1, keys %$c2) { $keys{$_} = 1 }
                  for (keys %keys) { $cdiff{$_} = $c2->{$_} - $c1->{$_}; }

                  unless ($iring->is_better_than ($ringo)) {
                     $pl->message ("This plan doesn't improve anything, you find yourself puzzled about what you missed...");
                     return;
                  }

                  my $remcosts = $ingred->check_costs (\%cdiff);

                  if (grep { $_ > 0 } values %$remcosts) {
                     $pl->message ("You want to make a " . $iring->to_string . ": " . $iring->analyze ($sk, $pl));
                     $pl->message ("You recognize that you are short of: "
                        . (join ", ",
                              map { my $cost = $remcosts->{$_}; $cost . " " . ($cost > 1 ? "times" : "time") . " " . ingred_alias ($_) }
                                 grep { $remcosts->{$_} > 0 } keys %$remcosts));

                     if ($pl->flag (cf::FLAG_WIZ)) {
                        $iring->wiz_analyze ($pl);
                     }
                  } else {
                     if (!$pl->flag (cf::FLAG_WIZ)) {
                        $ingred->check_costs (\%cdiff, 1);
                     }
                     make_ring ($chdl, $ingred, $iring, $value, $sk, $pl);
                  }
               }
            } else {
               $pl->message ("You've got no idea what you are planning to do!");
            }
         }
      };
      $@ and cf::error "$@\n";
   }
);

Jeweler::load_config;

Revision:	1.27
Committed:	Sun May 30 19:51:28 2010 UTC (13 years, 11 months ago) by root
Branch:	MAIN
CVS Tags:	rel-3_1, HEAD
Changes since 1.26:	+1 -1 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.1	#! perl
2
3	root	1.15	use strict;
4
5	root	1.1	use Jeweler;
6			use List::Util qw/max min sum/;
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	elmex	1.7	gem => 'diamond',
20	root	1.1	);
21
22			if ($ing =~ m/resist_(\S+)/) {
23			my $a = $aliases{lc $1} \|\| $1;
24			"something for '". lc ($a). "' resistance";
25
26			} elsif ($ing =~ m/stat_(\S+)/) {
27			my $a = $aliases{lc $1} \|\| $1;
28			"something for the ". lc ($a). " stat";
29
30			} elsif ($ing =~ m/spec_(\S+)/) {
31			my $a = $aliases{lc $1} \|\| $1;
32			"something for the ". lc ($a). "' special";
33
34	elmex	1.7	} elsif ($aliases{$ing}) {
35			$aliases{$ing}
36
37	root	1.1	} else {
38			$ing
39			}
40			}
41
42			my $DEBUG = 1;
43
44			sub merge {
45			my ($chdl, $sk, $pl, $do_analyze) = @_;
46
47	elmex	1.5	my $ingred = get_ingred ($pl, $chdl) \|\| return;
48	elmex	1.4
49	root	1.1	my @ring = $ingred->get_ring;
50			my @rings = map { Jeweler::Object->new (object => $_) } @ring;
51
52			@rings >= 2
53	elmex	1.16	or return $pl->message ("You slap yourself, you forgot to put at least 2 jewels in!");
54	root	1.1
55	elmex	1.12	my $input_level = 0;
56	elmex	1.7	my $value;
57			for (@rings) {
58			$input_level = max ($_->power_to_level, $input_level);
59			$value += $_->{hash}->{value};
60			}
61	elmex	1.5
62	root	1.1	my $ring = shift @rings;
63			$ring->improve_by_ring (@rings);
64
65			if ($do_analyze) {
66	elmex	1.16	$pl->message ("You want to make a " . $ring->to_string . ": " . $ring->analyze ($sk, $pl, $input_level));
67	root	1.1	$ring->wiz_analyze ($pl)
68			if $pl->flag (cf::FLAG_WIZ);
69			return;
70			}
71
72	elmex	1.7	make_ring ($chdl, $ingred, $ring, $value, $sk, $pl, $input_level);
73	root	1.1	}
74
75			sub make_ring {
76	elmex	1.7	my ($chdl, $ingred, $ring, $value, $sk, $pl, $input_level) = @_;
77	root	1.1
78			if (!$pl->flag (cf::FLAG_WIZ)) {
79			$ingred->remove ('rings');
80			$ingred->remove ('ammys');
81			}
82
83			my $ch = $ring->get_chance_perc ($sk);
84			my $succ = 0;
85	elmex	1.20	my $r = cf::random_roll (0, 100, $pl, cf::PREFER_LOW);
86	elmex	1.5
87	elmex	1.7	my $make_status;
88			my $exp;
89
90	root	1.1	if ($r <= $ch or $pl->flag (cf::FLAG_WIZ)) {
91	elmex	1.12	$exp = $ring->projected_exp ($input_level);
92	elmex	1.5
93	elmex	1.26	$pl->change_exp ($exp, "jeweler", cf::SK_EXP_SKILL_ONLY);
94	elmex	1.18	$pl->message (
95	root	1.27	"You succeed and get " . (int $exp) . " experience points.");
96	elmex	1.7	$make_status = "succeeded";
97
98	elmex	1.21	$ring->set_value ($value);
99	elmex	1.7
100	root	1.1	} else {
101			$pl->message ("You fail!");
102			$ring->negate;
103	elmex	1.7	$make_status = "fail";
104			$exp = 0;
105			}
106
107			my $ring_ob = $ring->to_object;
108
109	elmex	1.25	$ring_ob->kv_set (ext_jeweler_maker => $pl->name);
110
111	elmex	1.7	{ # some audit info calculation
112			my $sklvl = cf::exp_to_level ($sk->stats->exp);
113
114			my $make_info = sprintf
115			"JEWELER AUDIT: '%s' made '%s' (%s) (sk lvl %d, ring lvl %d, got %d exp): %s",
116			$pl->name, $ring->to_string, $ring_ob->uuid, $sklvl,
117			$ring->power_to_level, $exp, $make_status;
118
119	root	1.24	cf::debug "$make_info\n"
120			if $make_status eq 'succeeded';
121	root	1.1	}
122	elmex	1.7
123			$chdl->put ($ring_ob);
124	root	1.1	}
125
126	elmex	1.5	sub get_ingred {
127			my ($pl, $chdl) = @_;
128			my $ingred = eval { $chdl->extract_jeweler_ingredients };
129			if ($@ =~ /cursed/) {
130			$pl->message ("There are cursed items in the workbench, take them out before you do anything.").
131			return
132			} elsif ($@ =~ /unidentified/) {
133			$pl->message ("There are unidentified items in the workbench, identify them before you do anything.").
134			return
135			} elsif ($@) {
136	root	1.24	cf::error "error in jeweler ingredient extraction: $@";
137	elmex	1.5	return;
138			}
139			$ingred;
140			}
141
142	elmex	1.6	cf::object::attachment check_ring_drop_on =>
143			on_drop_on => sub {
144			my ($self, $obj, $who) = @_;
145			my $cfg = $self->{check_ring_drop_on};
146			if ($obj->type == cf::RING
147			&& !$obj->flag (cf::FLAG_CURSED)
148			&& !$obj->flag (cf::FLAG_DAMNED)
149			) {
150			my $ringo = Jeweler::Object->new (object => $obj);
151			for (grep { /^resist_/ } keys %$cfg) {
152			if (/^resist_(\S+)$/) {
153			if ($ringo->has_resist ($1)) {
154			$self->map->trigger (
155			$cfg->{connection},
156			$cfg->{state}
157			);
158	elmex	1.17	$obj->decrease (1);
159	elmex	1.6	cf::override;
160			}
161			}
162			}
163			}
164			};
165
166	root	1.2	cf::object->attach (
167			type => cf::SKILL,
168			subtype => cf::SK_JEWELER,
169	root	1.1	on_use_skill => sub {
170			my ($sk, $ob, $part, $dir, $msg) = @_;
171			my $pl = $ob;
172
173			my $skobj = $sk;
174
175			my $chdl = new Jeweler::CauldronHandler;
176
177			my $rv = 1;
178			eval {
179			$DEBUG = 1;
180
181			my $player = $ob->contr;
182
183			unless ($chdl->find_cauldron ('jeweler_bench', $ob->map->at ($ob->x, $ob->y))) {
184			return;
185			}
186
187			cf::override;
188
189			if ($msg =~ m/^\sanaly[sz]e\s$/i) {
190			Jeweler::analyze ($sk, $chdl, $pl);
191
192			} elsif ($msg =~ m/^\smake\s$/i) {
193			$pl->message ("You can make: " . (join ', ', keys %{Jeweler::getcfg ('conversions') \|\| {}}));
194
195			} elsif ($msg =~ m/^\smake\s+(\S+)\s$/i) {
196	elmex	1.5	my $ingred = get_ingred ($pl, $chdl) \|\| return;
197	root	1.1
198			unless ($Jeweler::CFG->{conversions}->{lc $1}) {
199			$pl->message ("You don't know how to make '$1', is does such a thing even exist?");
200			return
201			}
202
203	elmex	1.19	Jeweler::simple_converter (
204			$player, $ingred, $chdl, $1,
205			cf::exp_to_level ($sk->stats->exp));
206	root	1.1
207			} elsif ($msg =~ m/^\smerge\sanaly[sz]e\s*$/i) {
208			merge ($chdl, $sk, $pl, 1);
209
210			} elsif ($msg =~ m/^\smerge\s$/i) {
211			merge ($chdl, $sk, $pl, 0);
212
213			} else {
214	elmex	1.5	my $ingred = get_ingred ($pl, $chdl) \|\| return;
215	elmex	1.4
216	root	1.1	my $plan = $ingred->get_plan;
217
218			if ($plan) {
219			my @ring = $ingred->get_ring;
220
221	elmex	1.14	if (!@ring) {
222	root	1.1	# actually the algorithm cant
223			$pl->message ("You slap yourself, you forgot the jewelery!");
224			return;
225
226	elmex	1.14	} elsif ((@ring > 1) \|\| (grep { $_->nrof > 1 } @ring)) {
227			# actually the algorithm cant handle more than one improvement at a time
228			$pl->message ("You can't manage to improve more than one thing at a time!");
229			return;
230	root	1.1	} else {
231			my $ringo = Jeweler::Object->new (object => $ring[0]);
232			my $iring = $ingred->improve_ring_by_plan ($plan, $ringo);
233	elmex	1.7	my $c1 = $ringo->calc_costs;
234			my $c2 = $iring->calc_costs;
235			my $value = $iring->calc_value_from_cost ($c2);
236	root	1.1
237	elmex	1.12	if ((not defined $c1) \|\| (not defined $c2)) {
238			$pl->message ("The jewel has or will become a resistancy above 99%,\n"
239			."that is completly impossible to make!");
240			return;
241			}
242
243	root	1.1	my %keys;
244			my %cdiff;
245			for (keys %$c1, keys %$c2) { $keys{$_} = 1 }
246	elmex	1.7	for (keys %keys) { $cdiff{$_} = $c2->{$_} - $c1->{$_}; }
247	root	1.1
248	elmex	1.3	unless ($iring->is_better_than ($ringo)) {
249	root	1.1	$pl->message ("This plan doesn't improve anything, you find yourself puzzled about what you missed...");
250			return;
251			}
252
253			my $remcosts = $ingred->check_costs (\%cdiff);
254
255			if (grep { $_ > 0 } values %$remcosts) {
256			$pl->message ("You want to make a " . $iring->to_string . ": " . $iring->analyze ($sk, $pl));
257			$pl->message ("You recognize that you are short of: "
258			. (join ", ",
259			map { my $cost = $remcosts->{$_}; $cost . " " . ($cost > 1 ? "times" : "time") . " " . ingred_alias ($_) }
260			grep { $remcosts->{$_} > 0 } keys %$remcosts));
261
262			if ($pl->flag (cf::FLAG_WIZ)) {
263			$iring->wiz_analyze ($pl);
264			}
265			} else {
266			if (!$pl->flag (cf::FLAG_WIZ)) {
267			$ingred->check_costs (\%cdiff, 1);
268			}
269	elmex	1.7	make_ring ($chdl, $ingred, $iring, $value, $sk, $pl);
270	root	1.1	}
271			}
272			} else {
273			$pl->message ("You've got no idea what you are planning to do!");
274			}
275			}
276			};
277	root	1.24	$@ and cf::error "$@\n";
278	root	1.1	}
279	root	1.2	);
280	root	1.1
281	root	1.23	Jeweler::load_config;
282	root	1.10