maps/perl/jeweler.ext

#! perl
#CONVERSION: NONE
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;

cf::attach_to_type cf::SKILL, cf::SK_JEWELER,
   on_use_skill => sub {
      my ($sk, $ob, $part, $dir, $msg) = @_;
      my $pl = $ob;
      warn ($pl->name . " uses jeweler skill [$msg]!\n");

      my $skobj = $sk;

      my $chdl = new Jeweler::CauldronHandler;

      my $rv = 1;
      eval {
         Jeweler::read_config ($ENV{CROSSFIRE_LIBDIR} . '/jeweler.yaml');
         $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*$/i) {
            my $ingred = $chdl->extract_jeweler_ingredients;
            my @ring = $ingred->get_ring;
            my @rings = map { Jeweler::Object->new (object => $_) } @ring;

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

         } 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!");

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

               } 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->get_flag (cf::FLAG_WIZ)) {
                        $iring->wiz_analyze ($pl);
                     }
                  } else {
                     if (!$pl->get_flag (cf::FLAG_WIZ)) {
                        $ingred->check_costs (\%cdiff, 1);
                        $ingred->remove ('rings');
                        $ingred->remove ('ammys');
                     }

                     my $ch = $iring->get_chance_perc ($sk);
                     my $succ = 0;
                     my $r = cf::random_roll (0, 100, $pl, cf::PREFER_HIGH);
                     if ($r <= $ch) {
                        $pl->message ("You succeed.");
                     } else {
                        $pl->message ("You fail!");
                        $iring->negate;
                     }
                     $chdl->put ($iring->to_object);
                  }
               }
            } else {
               $pl->message ("You've got no idea what you are planning to do!");
            }
         }
      };
      $@ and warn "ERROR: $@\n";
   }
Revision:	1.6
Committed:	Thu Aug 31 12:39:19 2006 UTC (17 years, 8 months ago) by elmex
Branch:	MAIN
Changes since 1.5:	+31 -15 lines
Log Message:	further work on the jeweler skill
#	User	Rev	Content
1	elmex	1.1	#! perl
2	root	1.4	#CONVERSION: NONE
3	elmex	1.1	use Data::Dumper;
4	elmex	1.5	use Jeweler;
5	elmex	1.1	use List::Util qw/max min sum/;
6			use strict;
7
8	elmex	1.5	sub ingred_alias {
9			my ($ing) = @_;
10	elmex	1.1
11	elmex	1.5	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	elmex	1.1
33	elmex	1.5	} else {
34			$ing
35	elmex	1.1	}
36			}
37
38	elmex	1.5	my $DEBUG = 1;
39	elmex	1.1
40	elmex	1.5	cf::attach_to_type cf::SKILL, cf::SK_JEWELER,
41			on_use_skill => sub {
42			my ($sk, $ob, $part, $dir, $msg) = @_;
43			my $pl = $ob;
44	elmex	1.6	warn ($pl->name . " uses jeweler skill [$msg]!\n");
45	elmex	1.1
46	elmex	1.5	my $skobj = $sk;
47	elmex	1.1
48	elmex	1.5	my $chdl = new Jeweler::CauldronHandler;
49	elmex	1.1
50	elmex	1.5	my $rv = 1;
51			eval {
52			Jeweler::read_config ($ENV{CROSSFIRE_LIBDIR} . '/jeweler.yaml');
53			$DEBUG = 1;
54	elmex	1.1
55	elmex	1.5	my $player = $ob->contr;
56	elmex	1.1
57	elmex	1.5	unless ($chdl->find_cauldron ('jeweler_bench', $ob->map->at ($ob->x, $ob->y))) {
58			return;
59	elmex	1.1	}
60
61	elmex	1.5	cf::override;
62	elmex	1.1
63	elmex	1.5	if ($msg =~ m/^\sanaly[sz]e\s$/i) {
64			Jeweler::analyze ($sk, $chdl, $pl);
65	elmex	1.1
66	elmex	1.6	} elsif ($msg =~ m/^\smake\s$/i) {
67			$pl->message ("You can make: " . (join ', ', keys %{Jeweler::getcfg ('conversions') \|\| {}}));
68
69	elmex	1.5	} elsif ($msg =~ m/^\smake\s+(\S+)\s$/i) {
70			my $ingred = $chdl->extract_jeweler_ingredients;
71	elmex	1.1
72	elmex	1.5	unless ($Jeweler::CFG->{conversions}->{lc $1}) {
73			$pl->message ("You don't know how to make '$1', is does such a thing even exist?");
74			return
75	elmex	1.1	}
76
77	elmex	1.6	Jeweler::simple_converter ($player, $ingred, $chdl, $1);
78
79	elmex	1.5	} elsif ($msg =~ m/^\smerge\s$/i) {
80			my $ingred = $chdl->extract_jeweler_ingredients;
81			my @ring = $ingred->get_ring;
82			my @rings = map { Jeweler::Object->new (object => $_) } @ring;
83
84			my $ring = shift @rings;
85			$ring->improve_by_ring (@rings);
86			$ring->power_to_level;
87	elmex	1.1
88	elmex	1.5	} else {
89			my $ingred = $chdl->extract_jeweler_ingredients;
90			my $plan = $ingred->get_plan;
91	elmex	1.1
92	elmex	1.5	if ($plan) {
93			my @ring = $ingred->get_ring;
94	elmex	1.1
95	elmex	1.6	if ((@ring > 1) \|\| ($ring[0]->nrof > 1)) {
96	elmex	1.5	# actually the algorithm cant handle more than one improvement at a time
97	elmex	1.6	$pl->message ("You can't manage to improve more than one thing at a time!");
98	elmex	1.5
99			} elsif (@ring < 1) {
100			# actually the algorithm cant
101	elmex	1.6	$pl->message ("You slap yourself, you forgot the jewelery!");
102	elmex	1.5
103			} else {
104			my $ringo = Jeweler::Object->new (object => $ring[0]);
105			my $iring = $ingred->improve_ring_by_plan ($plan, $ringo);
106			my $c1 = $ringo->calc_costs;
107			my $c2 = $iring->calc_costs;
108
109			my %keys;
110			my %cdiff;
111			for (keys %$c1, keys %$c2) { $keys{$_} = 1 }
112	elmex	1.6	for (keys %keys) { $cdiff{$_} = $c2->{$_} - $c1->{$_} }
113	elmex	1.5
114			unless (grep { $_ > 0 } values %cdiff) {
115	elmex	1.6	$pl->message ("This plan doesn't improve anything, you find yourself puzzled about what you missed...");
116	elmex	1.5	return;
117			}
118
119			my $remcosts = $ingred->check_costs (\%cdiff);
120
121			if (grep { $_ > 0 } values %$remcosts) {
122	elmex	1.6	$pl->message ("You want to make a " . $iring->to_string . ": " . $iring->analyze ($sk, $pl));
123	elmex	1.5	$pl->message ("You recognize that you are short of: "
124			. (join ", ",
125			map { my $cost = $remcosts->{$_}; $cost . " " . ($cost > 1 ? "times" : "time") . " " . ingred_alias ($_) }
126	elmex	1.6	grep { $remcosts->{$_} > 0 } keys %$remcosts));
127			if ($pl->get_flag (cf::FLAG_WIZ)) {
128			$iring->wiz_analyze ($pl);
129			}
130	elmex	1.5	} else {
131	elmex	1.6	if (!$pl->get_flag (cf::FLAG_WIZ)) {
132			$ingred->check_costs (\%cdiff, 1);
133			$ingred->remove ('rings');
134			$ingred->remove ('ammys');
135			}
136
137			my $ch = $iring->get_chance_perc ($sk);
138			my $succ = 0;
139			my $r = cf::random_roll (0, 100, $pl, cf::PREFER_HIGH);
140			if ($r <= $ch) {
141			$pl->message ("You succeed.");
142			} else {
143			$pl->message ("You fail!");
144			$iring->negate;
145			}
146	elmex	1.5	$chdl->put ($iring->to_object);
147			}
148			}
149	elmex	1.1	} else {
150	elmex	1.5	$pl->message ("You've got no idea what you are planning to do!");
151	elmex	1.1	}
152			}
153	elmex	1.5	};
154			$@ and warn "ERROR: $@\n";
155			}