server/ext/jeweler.ext

#! perl

use Data::Dumper;
use Jeweler;
use List::Util qw/max min sum/;
use strict;

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

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

   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";

   } 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->reply (undef, "You slap yourself, you forgot to put at least 2 jewels in!");

   my $input_level;
   $input_level = max ($_->power_to_level, $input_level) for @rings;

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

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

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

sub make_ring {
   my ($chdl, $ingred, $ring, $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_HIGH);

   if ($r <= $ch or $pl->flag (cf::FLAG_WIZ)) {
      my $lvl = max ($ring->power_to_level, 1);
      my $exp = (cf::level_to_min_exp ($lvl) - cf::level_to_min_exp ($lvl - 1)) / 100;

      if (defined $input_level) {
         my $subexp =
            (cf::level_to_min_exp ($input_level)
               - cf::level_to_min_exp ($input_level - 1))
                  / 100;
         warn "INPUT: $lvl <-> $input_level ($exp <-> $subexp)\n";
         $exp -= $subexp;
         $exp = max ($exp, 0);
      }

      $pl->change_exp ($exp, "jeweler", cf::SK_EXP_SKILL_ONLY);
      $pl->message ("You succeed and get $exp experience.");
   } else {
      $pl->message ("You fail!");
      $ring->negate;
   }
   $chdl->put ($ring->to_object);
}

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 ($@) {
      warn "error in jeweler ingredient extraction: $@";
      return;
   }
   $ingred;
}

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);

         } 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 > 1) || ($ring[0]->nrof > 1)) {
                  # 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;

               } elsif (@ring < 1) {
                  # actually the algorithm cant
                  $pl->message ("You slap yourself, you forgot the jewelery!");
                  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 %keys;
                  my %cdiff;
                  for (keys %$c1, keys %$c2) { $keys{$_} = 1 }
                  for (keys %keys) { $cdiff{$_} = $c2->{$_} - $c1->{$_}; warn "$_: $c2->{$_} | $c1->{$_}\n"; }

                  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, $sk, $pl);
                  }
               }
            } else {
               $pl->message ("You've got no idea what you are planning to do!");
            }
         }
      };
      $@ and warn "ERROR: $@\n";
   }
);

Jeweler::read_config (cf::datadir . '/jeweler.yaml');
Revision:	1.5
Committed:	Thu Feb 1 01:46:45 2007 UTC (17 years, 3 months ago) by elmex
Branch:	MAIN
Changes since 1.4:	+36 -26 lines
Log Message:	fixed the big big big bug in the merging experience concept. added checks for unidentified items. added itempower limits to the generated rings! jeweler skill is finally becoming a bit more balanced.
#	User	Rev	Content
1	root	1.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	elmex	1.5	my $ingred = get_ingred ($pl, $chdl) \|\| return;
44	elmex	1.4
45	root	1.1	my @ring = $ingred->get_ring;
46			my @rings = map { Jeweler::Object->new (object => $_) } @ring;
47
48			@rings >= 2
49			or return $pl->reply (undef, "You slap yourself, you forgot to put at least 2 jewels in!");
50
51	elmex	1.5	my $input_level;
52			$input_level = max ($_->power_to_level, $input_level) for @rings;
53
54	root	1.1	my $ring = shift @rings;
55			$ring->improve_by_ring (@rings);
56
57			if ($do_analyze) {
58			$pl->reply (undef, "You want to make a " . $ring->to_string . ": " . $ring->analyze ($sk, $pl));
59			$ring->wiz_analyze ($pl)
60			if $pl->flag (cf::FLAG_WIZ);
61			return;
62			}
63
64	elmex	1.5	make_ring ($chdl, $ingred, $ring, $sk, $pl, $input_level);
65	root	1.1	}
66
67			sub make_ring {
68	elmex	1.5	my ($chdl, $ingred, $ring, $sk, $pl, $input_level) = @_;
69	root	1.1
70			if (!$pl->flag (cf::FLAG_WIZ)) {
71			$ingred->remove ('rings');
72			$ingred->remove ('ammys');
73			}
74
75			my $ch = $ring->get_chance_perc ($sk);
76			my $succ = 0;
77			my $r = cf::random_roll (0, 100, $pl, cf::PREFER_HIGH);
78	elmex	1.5
79	root	1.1	if ($r <= $ch or $pl->flag (cf::FLAG_WIZ)) {
80			my $lvl = max ($ring->power_to_level, 1);
81			my $exp = (cf::level_to_min_exp ($lvl) - cf::level_to_min_exp ($lvl - 1)) / 100;
82	elmex	1.5
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
93	root	1.1	$pl->change_exp ($exp, "jeweler", cf::SK_EXP_SKILL_ONLY);
94			$pl->message ("You succeed and get $exp experience.");
95			} else {
96			$pl->message ("You fail!");
97			$ring->negate;
98			}
99			$chdl->put ($ring->to_object);
100			}
101
102	elmex	1.5	sub get_ingred {
103			my ($pl, $chdl) = @_;
104			my $ingred = eval { $chdl->extract_jeweler_ingredients };
105			if ($@ =~ /cursed/) {
106			$pl->message ("There are cursed items in the workbench, take them out before you do anything.").
107			return
108			} elsif ($@ =~ /unidentified/) {
109			$pl->message ("There are unidentified items in the workbench, identify them before you do anything.").
110			return
111			} elsif ($@) {
112			warn "error in jeweler ingredient extraction: $@";
113			return;
114			}
115			$ingred;
116			}
117
118	root	1.2	cf::object->attach (
119			type => cf::SKILL,
120			subtype => cf::SK_JEWELER,
121	root	1.1	on_use_skill => sub {
122			my ($sk, $ob, $part, $dir, $msg) = @_;
123			my $pl = $ob;
124
125			my $skobj = $sk;
126
127			my $chdl = new Jeweler::CauldronHandler;
128
129			my $rv = 1;
130			eval {
131			$DEBUG = 1;
132
133			my $player = $ob->contr;
134
135			unless ($chdl->find_cauldron ('jeweler_bench', $ob->map->at ($ob->x, $ob->y))) {
136			return;
137			}
138
139			cf::override;
140
141			if ($msg =~ m/^\sanaly[sz]e\s$/i) {
142			Jeweler::analyze ($sk, $chdl, $pl);
143
144			} elsif ($msg =~ m/^\smake\s$/i) {
145			$pl->message ("You can make: " . (join ', ', keys %{Jeweler::getcfg ('conversions') \|\| {}}));
146
147			} elsif ($msg =~ m/^\smake\s+(\S+)\s$/i) {
148	elmex	1.5	my $ingred = get_ingred ($pl, $chdl) \|\| return;
149	root	1.1
150			unless ($Jeweler::CFG->{conversions}->{lc $1}) {
151			$pl->message ("You don't know how to make '$1', is does such a thing even exist?");
152			return
153			}
154
155			Jeweler::simple_converter ($player, $ingred, $chdl, $1);
156
157			} elsif ($msg =~ m/^\smerge\sanaly[sz]e\s*$/i) {
158			merge ($chdl, $sk, $pl, 1);
159
160			} elsif ($msg =~ m/^\smerge\s$/i) {
161			merge ($chdl, $sk, $pl, 0);
162
163			} else {
164	elmex	1.5	my $ingred = get_ingred ($pl, $chdl) \|\| return;
165	elmex	1.4
166	root	1.1	my $plan = $ingred->get_plan;
167
168			if ($plan) {
169			my @ring = $ingred->get_ring;
170
171			if ((@ring > 1) \|\| ($ring[0]->nrof > 1)) {
172			# actually the algorithm cant handle more than one improvement at a time
173			$pl->message ("You can't manage to improve more than one thing at a time!");
174			return;
175
176			} elsif (@ring < 1) {
177			# actually the algorithm cant
178			$pl->message ("You slap yourself, you forgot the jewelery!");
179			return;
180
181			} else {
182			my $ringo = Jeweler::Object->new (object => $ring[0]);
183			my $iring = $ingred->improve_ring_by_plan ($plan, $ringo);
184			my $c1 = $ringo->calc_costs;
185			my $c2 = $iring->calc_costs;
186
187			my %keys;
188			my %cdiff;
189			for (keys %$c1, keys %$c2) { $keys{$_} = 1 }
190	elmex	1.3	for (keys %keys) { $cdiff{$_} = $c2->{$_} - $c1->{$_}; warn "$_: $c2->{$_} \| $c1->{$_}\n"; }
191	root	1.1
192	elmex	1.3	unless ($iring->is_better_than ($ringo)) {
193	root	1.1	$pl->message ("This plan doesn't improve anything, you find yourself puzzled about what you missed...");
194			return;
195			}
196
197			my $remcosts = $ingred->check_costs (\%cdiff);
198
199			if (grep { $_ > 0 } values %$remcosts) {
200			$pl->message ("You want to make a " . $iring->to_string . ": " . $iring->analyze ($sk, $pl));
201			$pl->message ("You recognize that you are short of: "
202			. (join ", ",
203			map { my $cost = $remcosts->{$_}; $cost . " " . ($cost > 1 ? "times" : "time") . " " . ingred_alias ($_) }
204			grep { $remcosts->{$_} > 0 } keys %$remcosts));
205
206			if ($pl->flag (cf::FLAG_WIZ)) {
207			$iring->wiz_analyze ($pl);
208			}
209			} else {
210			if (!$pl->flag (cf::FLAG_WIZ)) {
211			$ingred->check_costs (\%cdiff, 1);
212			}
213			make_ring ($chdl, $ingred, $iring, $sk, $pl);
214			}
215			}
216			} else {
217			$pl->message ("You've got no idea what you are planning to do!");
218			}
219			}
220			};
221			$@ and warn "ERROR: $@\n";
222			}
223	root	1.2	);
224	root	1.1
225	root	1.2	Jeweler::read_config (cf::datadir . '/jeweler.yaml');