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 = $chdl->extract_jeweler_ingredients;
   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 $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);
}

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

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

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 = $chdl->extract_jeweler_ingredients;

            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 = $chdl->extract_jeweler_ingredients;
            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->{$_} }

                  unless (grep { $_ > 0 } values %cdiff) {
                     $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.2
Committed:	Thu Dec 21 22:41:34 2006 UTC (17 years, 5 months ago) by root
Branch:	MAIN
Changes since 1.1:	+5 -3 lines
Log Message:	- updated cf.pm to use a more generic and extendable syntax, now that it is clear that we will have multiple "attachable" objects. maybe bite the bullet in C++ and make attachable virtual? - completely rework the syntax for attaching and attachments - update all extensions
#	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::object->attach (
87	type => cf::SKILL,
88	subtype => cf::SK_JEWELER,
89	on_use_skill => sub {
90	my ($sk, $ob, $part, $dir, $msg) = @_;
91	my $pl = $ob;
92
93	my $skobj = $sk;
94
95	my $chdl = new Jeweler::CauldronHandler;
96
97	my $rv = 1;
98	eval {
99	$DEBUG = 1;
100
101	my $player = $ob->contr;
102
103	unless ($chdl->find_cauldron ('jeweler_bench', $ob->map->at ($ob->x, $ob->y))) {
104	return;
105	}
106
107	cf::override;
108
109	if ($msg =~ m/^\sanaly[sz]e\s$/i) {
110	Jeweler::analyze ($sk, $chdl, $pl);
111
112	} elsif ($msg =~ m/^\smake\s$/i) {
113	$pl->message ("You can make: " . (join ', ', keys %{Jeweler::getcfg ('conversions') \|\| {}}));
114
115	} elsif ($msg =~ m/^\smake\s+(\S+)\s$/i) {
116	my $ingred = $chdl->extract_jeweler_ingredients;
117
118	unless ($Jeweler::CFG->{conversions}->{lc $1}) {
119	$pl->message ("You don't know how to make '$1', is does such a thing even exist?");
120	return
121	}
122
123	Jeweler::simple_converter ($player, $ingred, $chdl, $1);
124
125	} elsif ($msg =~ m/^\smerge\sanaly[sz]e\s*$/i) {
126	merge ($chdl, $sk, $pl, 1);
127
128	} elsif ($msg =~ m/^\smerge\s$/i) {
129	merge ($chdl, $sk, $pl, 0);
130
131	} else {
132	my $ingred = $chdl->extract_jeweler_ingredients;
133	my $plan = $ingred->get_plan;
134
135	if ($plan) {
136	my @ring = $ingred->get_ring;
137
138	if ((@ring > 1) \|\| ($ring[0]->nrof > 1)) {
139	# actually the algorithm cant handle more than one improvement at a time
140	$pl->message ("You can't manage to improve more than one thing at a time!");
141	return;
142
143	} elsif (@ring < 1) {
144	# actually the algorithm cant
145	$pl->message ("You slap yourself, you forgot the jewelery!");
146	return;
147
148	} else {
149	my $ringo = Jeweler::Object->new (object => $ring[0]);
150	my $iring = $ingred->improve_ring_by_plan ($plan, $ringo);
151	my $c1 = $ringo->calc_costs;
152	my $c2 = $iring->calc_costs;
153
154	my %keys;
155	my %cdiff;
156	for (keys %$c1, keys %$c2) { $keys{$_} = 1 }
157	for (keys %keys) { $cdiff{$_} = $c2->{$_} - $c1->{$_} }
158
159	unless (grep { $_ > 0 } values %cdiff) {
160	$pl->message ("This plan doesn't improve anything, you find yourself puzzled about what you missed...");
161	return;
162	}
163
164	my $remcosts = $ingred->check_costs (\%cdiff);
165
166	if (grep { $_ > 0 } values %$remcosts) {
167	$pl->message ("You want to make a " . $iring->to_string . ": " . $iring->analyze ($sk, $pl));
168	$pl->message ("You recognize that you are short of: "
169	. (join ", ",
170	map { my $cost = $remcosts->{$_}; $cost . " " . ($cost > 1 ? "times" : "time") . " " . ingred_alias ($_) }
171	grep { $remcosts->{$_} > 0 } keys %$remcosts));
172
173	if ($pl->flag (cf::FLAG_WIZ)) {
174	$iring->wiz_analyze ($pl);
175	}
176	} else {
177	if (!$pl->flag (cf::FLAG_WIZ)) {
178	$ingred->check_costs (\%cdiff, 1);
179	}
180	make_ring ($chdl, $ingred, $iring, $sk, $pl);
181	}
182	}
183	} else {
184	$pl->message ("You've got no idea what you are planning to do!");
185	}
186	}
187	};
188	$@ and warn "ERROR: $@\n";
189	}
190	);
191
192	Jeweler::read_config (cf::datadir . '/jeweler.yaml');