maps/perl/Jeweler.pm

=head1 NAME

Jeweler

=head1 DESCRIPTION

The Jeweler skill helper module.

=cut

package Jeweler;

=over 4

=item @RESISTS

List of all resistancies that can occur on rings and amulets.

=cut

my @RESISTS = (
   cf::ATNR_PHYSICAL,
   cf::ATNR_MAGIC,
   cf::ATNR_FIRE,
   cf::ATNR_ELECTRICITY,
   cf::ATNR_COLD,
   cf::ATNR_CONFUSION,

   cf::ATNR_ACID,
   cf::ATNR_DRAIN,
   cf::ATNR_GHOSTHIT,
   cf::ATNR_POISON,
   cf::ATNR_SLOW,
   cf::ATNR_PARALYZE,

   cf::ATNR_TURN_UNDEAD,
   cf::ATNR_FEAR,
   cf::ATNR_DEPLETE,
   cf::ATNR_DEATH,
   cf::ATNR_HOLYWORD,
   cf::ATNR_LIFE_STEALING,

   cf::ATNR_BLIND,
   cf::ATNR_DISEASE,
);

=item @EFFECT_RESISTS

List of all effect resistancies that occur on rings and amulets.
The difference is made because effect resistancies are less effective at lower levels.

=cut

my @EFFECT_RESISTS = (
   cf::ATNR_CONFUSION,
   cf::ATNR_DRAIN,
   cf::ATNR_POISON,
   cf::ATNR_SLOW,
   cf::ATNR_PARALYZE,
   cf::ATNR_TURN_UNDEAD,
   cf::ATNR_FEAR,
   cf::ATNR_DEPLETE,
   cf::ATNR_DEATH,
   cf::ATNR_BLIND,
   cf::ATNR_DISEASE,
);

my %RESMAP = (
   cf::ATNR_PHYSICAL => "PHYSICAL",
   cf::ATNR_MAGIC => "MAGIC",
   cf::ATNR_FIRE => "FIRE",
   cf::ATNR_ELECTRICITY => "ELECTRICITY",
   cf::ATNR_COLD => "COLD",
   cf::ATNR_CONFUSION => "CONFUSION",
   cf::ATNR_ACID => "ACID",

   cf::ATNR_DRAIN => "DRAIN",
   cf::ATNR_GHOSTHIT => "GHOSTHIT",
   cf::ATNR_POISON => "POISON",
   cf::ATNR_SLOW => "SLOW",
   cf::ATNR_PARALYZE => "PARALYZE",
   cf::ATNR_TURN_UNDEAD => "TURN_UNDEAD",

   cf::ATNR_FEAR => "FEAR",
   cf::ATNR_DEPLETE => "DEPLETE",
   cf::ATNR_DEATH => "DEATH",
   cf::ATNR_HOLYWORD => "HOLYWORD",
   cf::ATNR_LIFE_STEALING => "LIFE_STEALING",
   cf::ATNR_BLIND => "BLIND",
   cf::ATNR_DISEASE => "DISEASE",
);

=back

=cut

package Jeweler::CauldronHandler;

=head2 CauldronHandler

The Jeweler::CauldronHandler package, that helps you with handling the
cauldron stuff. Can also be used for other skills.

=cut

sub new {
   my ($class, %arg) = @_;

   my $self = bless {
      %arg,
   }, $class;

   $self;
}

=over 4

=item find_cauldron ($arch_name, @map_stack)

This finds the cauldron with C<$arch_name> on the C<@map_stack> and initalises the CauldronHandler.
It takes the topmost cauldron that is found. Returns undef if no cauldron was found.
Returns the cauldron object if it was found.

=cut

sub find_cauldron {
   my ($self, $arch_name, @map_stack) = @_;

   my @c =
      grep {
         $_->flag (cf::FLAG_IS_CAULDRON)
            and $_->archetype->name eq $arch_name
      } @map_stack;

   $self->{cauldron} = $c[0];
}

=item grep_by_type (@types)

Finds all objects in the cauldron that have the type of one of C<@types>.

=cut

sub grep_by_type {
   my ($self, @types) = @_;

   return () unless $self->{cauldron};

   my @res = grep {
      my $ob = $_;
      (grep { $ob->type == $_ } @types) > 0
   } $self->{cauldron}->inv;

   return @res
}

=item extract_jeweler_ingredients

Extracts the ingredients that matter for the Jeweler skill
and returns a Jeweler::Ingredients object.

=cut

sub extract_jeweler_ingredients {
   my ($self) = @_;

   return () unless $self->{cauldron};

   my $ingreds = {};

   my %type_to_key = (
         cf::RING      => 'rings',
         cf::AMULET    => 'ammys',
         cf::INORGANIC => 'mets_and_mins',
         cf::GEM       => 'gems',
         cf::POTION    => 'potions',
         cf::SCROLL    => 'scrolls',
   );

   for ($self->{cauldron}->inv) {

      if (my $k = $type_to_key{$_->type}) {
         push @{$ingreds->{$k}}, $_;

      } else {
         Jeweler::Util::remove ($_);
      }
   }

   return Jeweler::Ingredients->new (ingredients => $ingreds, cauldron_helper => $self)
}

=item put ($object)

Just puts the C<$object> into the cauldron.

=cut

sub put {
   my ($self, $obj) = @_;

   return undef unless $self->{cauldron};

   $obj->insert_ob_in_ob ($self->{cauldron});
}

=back

=cut

package Jeweler::Ingredients;

=head2 Ingredients

This class handles the ingredients.

=over 4

=item new (ingredients => $ingred_hash)

This is called from the CauldronHandler that gives you the ingredients.

=cut

sub new {
   my ($class, %arg) = @_;

   my $self = bless {
      %arg,
   }, $class;

   $self;
}

=item value ($group, $archname)

Returns the value of the ingredients in C<$group> with the archetypename C<$archname>.

=cut

sub value {
   my ($self, $group, $archname) = @_;

   my @objs = grep {
      $_->archetype->name eq $archname
   } @{$self->{ingredients}->{$group} || []};

   my $sum = 0;
   for (@objs) {
      $sum += $_->nrof * $_->value;
   }

   return $sum;
}

=item remove ($group, $archname)

Removes the ingredients in C<$group> with archname C<$archname>.

=cut

sub remove {
   my ($self, $group, $archname) = @_;

   my $ingred = $self->{ingredients};

   my @out;

   for (@{$ingred->{$group}}) {
      if ($_->archetype->name eq $archname) {
         Jeweler::Util::remove ($_);
      } else {
         push @out, $_;
      }
   }

   @{$ingred->{$grp}} = @out;
}

=back

=cut

package Jeweler::Util;

=head2 Util

Some utility functions for the Jeweler skill.

=over 4

=item remove ($object)

Removes the C<$object> and it's inventory recursivley from the game.

=cut

sub remove {
   my ($obj) = @_;

   remove ($_) for ($obj->inv);
   $obj->remove;
   $obj->free;
}

=back

=back

1
Revision:	1.1
Committed:	Sat Jul 15 12:57:41 2006 UTC (17 years, 10 months ago) by elmex
Branch:	MAIN
Log Message:	Checking in the jeweler extension. It's still undfinished, but it has been too long on my hard drive alone.
#	User	Rev	Content
1	elmex	1.1	=head1 NAME
2
3			Jeweler
4
5			=head1 DESCRIPTION
6
7			The Jeweler skill helper module.
8
9			=cut
10
11			package Jeweler;
12
13			=over 4
14
15			=item @RESISTS
16
17			List of all resistancies that can occur on rings and amulets.
18
19			=cut
20
21			my @RESISTS = (
22			cf::ATNR_PHYSICAL,
23			cf::ATNR_MAGIC,
24			cf::ATNR_FIRE,
25			cf::ATNR_ELECTRICITY,
26			cf::ATNR_COLD,
27			cf::ATNR_CONFUSION,
28
29			cf::ATNR_ACID,
30			cf::ATNR_DRAIN,
31			cf::ATNR_GHOSTHIT,
32			cf::ATNR_POISON,
33			cf::ATNR_SLOW,
34			cf::ATNR_PARALYZE,
35
36			cf::ATNR_TURN_UNDEAD,
37			cf::ATNR_FEAR,
38			cf::ATNR_DEPLETE,
39			cf::ATNR_DEATH,
40			cf::ATNR_HOLYWORD,
41			cf::ATNR_LIFE_STEALING,
42
43			cf::ATNR_BLIND,
44			cf::ATNR_DISEASE,
45			);
46
47			=item @EFFECT_RESISTS
48
49			List of all effect resistancies that occur on rings and amulets.
50			The difference is made because effect resistancies are less effective at lower levels.
51
52			=cut
53
54			my @EFFECT_RESISTS = (
55			cf::ATNR_CONFUSION,
56			cf::ATNR_DRAIN,
57			cf::ATNR_POISON,
58			cf::ATNR_SLOW,
59			cf::ATNR_PARALYZE,
60			cf::ATNR_TURN_UNDEAD,
61			cf::ATNR_FEAR,
62			cf::ATNR_DEPLETE,
63			cf::ATNR_DEATH,
64			cf::ATNR_BLIND,
65			cf::ATNR_DISEASE,
66			);
67
68			my %RESMAP = (
69			cf::ATNR_PHYSICAL => "PHYSICAL",
70			cf::ATNR_MAGIC => "MAGIC",
71			cf::ATNR_FIRE => "FIRE",
72			cf::ATNR_ELECTRICITY => "ELECTRICITY",
73			cf::ATNR_COLD => "COLD",
74			cf::ATNR_CONFUSION => "CONFUSION",
75			cf::ATNR_ACID => "ACID",
76
77			cf::ATNR_DRAIN => "DRAIN",
78			cf::ATNR_GHOSTHIT => "GHOSTHIT",
79			cf::ATNR_POISON => "POISON",
80			cf::ATNR_SLOW => "SLOW",
81			cf::ATNR_PARALYZE => "PARALYZE",
82			cf::ATNR_TURN_UNDEAD => "TURN_UNDEAD",
83
84			cf::ATNR_FEAR => "FEAR",
85			cf::ATNR_DEPLETE => "DEPLETE",
86			cf::ATNR_DEATH => "DEATH",
87			cf::ATNR_HOLYWORD => "HOLYWORD",
88			cf::ATNR_LIFE_STEALING => "LIFE_STEALING",
89			cf::ATNR_BLIND => "BLIND",
90			cf::ATNR_DISEASE => "DISEASE",
91			);
92
93			=back
94
95			=cut
96
97			package Jeweler::CauldronHandler;
98
99			=head2 CauldronHandler
100
101			The Jeweler::CauldronHandler package, that helps you with handling the
102			cauldron stuff. Can also be used for other skills.
103
104			=cut
105
106			sub new {
107			my ($class, %arg) = @_;
108
109			my $self = bless {
110			%arg,
111			}, $class;
112
113			$self;
114			}
115
116			=over 4
117
118			=item find_cauldron ($arch_name, @map_stack)
119
120			This finds the cauldron with C<$arch_name> on the C<@map_stack> and initalises the CauldronHandler.
121			It takes the topmost cauldron that is found. Returns undef if no cauldron was found.
122			Returns the cauldron object if it was found.
123
124			=cut
125
126			sub find_cauldron {
127			my ($self, $arch_name, @map_stack) = @_;
128
129			my @c =
130			grep {
131			$_->flag (cf::FLAG_IS_CAULDRON)
132			and $_->archetype->name eq $arch_name
133			} @map_stack;
134
135			$self->{cauldron} = $c[0];
136			}
137
138			=item grep_by_type (@types)
139
140			Finds all objects in the cauldron that have the type of one of C<@types>.
141
142			=cut
143
144			sub grep_by_type {
145			my ($self, @types) = @_;
146
147			return () unless $self->{cauldron};
148
149			my @res = grep {
150			my $ob = $_;
151			(grep { $ob->type == $_ } @types) > 0
152			} $self->{cauldron}->inv;
153
154			return @res
155			}
156
157			=item extract_jeweler_ingredients
158
159			Extracts the ingredients that matter for the Jeweler skill
160			and returns a Jeweler::Ingredients object.
161
162			=cut
163
164			sub extract_jeweler_ingredients {
165			my ($self) = @_;
166
167			return () unless $self->{cauldron};
168
169			my $ingreds = {};
170
171			my %type_to_key = (
172			cf::RING => 'rings',
173			cf::AMULET => 'ammys',
174			cf::INORGANIC => 'mets_and_mins',
175			cf::GEM => 'gems',
176			cf::POTION => 'potions',
177			cf::SCROLL => 'scrolls',
178			);
179
180			for ($self->{cauldron}->inv) {
181
182			if (my $k = $type_to_key{$_->type}) {
183			push @{$ingreds->{$k}}, $_;
184
185			} else {
186			Jeweler::Util::remove ($_);
187			}
188			}
189
190			return Jeweler::Ingredients->new (ingredients => $ingreds, cauldron_helper => $self)
191			}
192
193			=item put ($object)
194
195			Just puts the C<$object> into the cauldron.
196
197			=cut
198
199			sub put {
200			my ($self, $obj) = @_;
201
202			return undef unless $self->{cauldron};
203
204			$obj->insert_ob_in_ob ($self->{cauldron});
205			}
206
207			=back
208
209			=cut
210
211			package Jeweler::Ingredients;
212
213			=head2 Ingredients
214
215			This class handles the ingredients.
216
217			=over 4
218
219			=item new (ingredients => $ingred_hash)
220
221			This is called from the CauldronHandler that gives you the ingredients.
222
223			=cut
224
225			sub new {
226			my ($class, %arg) = @_;
227
228			my $self = bless {
229			%arg,
230			}, $class;
231
232			$self;
233			}
234
235			=item value ($group, $archname)
236
237			Returns the value of the ingredients in C<$group> with the archetypename C<$archname>.
238
239			=cut
240
241			sub value {
242			my ($self, $group, $archname) = @_;
243
244			my @objs = grep {
245			$_->archetype->name eq $archname
246			} @{$self->{ingredients}->{$group} \|\| []};
247
248			my $sum = 0;
249			for (@objs) {
250			$sum += $_->nrof * $_->value;
251			}
252
253			return $sum;
254			}
255
256			=item remove ($group, $archname)
257
258			Removes the ingredients in C<$group> with archname C<$archname>.
259
260			=cut
261
262			sub remove {
263			my ($self, $group, $archname) = @_;
264
265			my $ingred = $self->{ingredients};
266
267			my @out;
268
269			for (@{$ingred->{$group}}) {
270			if ($_->archetype->name eq $archname) {
271			Jeweler::Util::remove ($_);
272			} else {
273			push @out, $_;
274			}
275			}
276
277			@{$ingred->{$grp}} = @out;
278			}
279
280			=back
281
282			=cut
283
284			package Jeweler::Util;
285
286			=head2 Util
287
288			Some utility functions for the Jeweler skill.
289
290			=over 4
291
292			=item remove ($object)
293
294			Removes the C<$object> and it's inventory recursivley from the game.
295
296			=cut
297
298			sub remove {
299			my ($obj) = @_;
300
301			remove ($_) for ($obj->inv);
302			$obj->remove;
303			$obj->free;
304			}
305
306			=back
307
308			=back
309
310			1