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 "USE SKILL JEWEL[$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+(\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
            }

            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) {
                  # actually the algorithm cant handle more than one improvement at a time
                  $pl->message ("You can't manage to improve more than one ring!");

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

               } 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 }
                  warn 'COSTS[' . (join ",", map { $cdiff{$_} = $c2->{$_} - $c1->{$_}; "$_: $cdiff{$_}" } keys %keys) . "]\n";

                  unless (grep { $_ > 0 } values %cdiff) {
                     $pl->message ("This plan doesn't improve the ring, you find yourself puzzled about what you missed...");
                     return;
                  }

                  my $remcosts = $ingred->check_costs (\%cdiff);
                  warn 'REMCOSTS[' . (join ",", map { "$_: $remcosts->{$_}" } keys %$remcosts) . "]\n";

                  if (grep { $_ > 0 } values %$remcosts) {
                     $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))
                  } else {
                     $ingred->check_costs (\%cdiff, 1);
                     $ingred->remove ('rings');
                     $ingred->remove ('ammys');
                     $chdl->put ($iring->to_object);
                     $pl->message ("You succeed!");
                  }
               }
            } else {
               $pl->message ("You've got no idea what you are planning to do!");
            }
         }
      };
      $@ and warn "ERROR: $@\n";

      my $r = cf::random_roll (0, 101, $pl, cf::PREFER_LOW);
   }
Revision:	1.5
Committed:	Thu Aug 31 00:58:17 2006 UTC (17 years, 8 months ago) by elmex
Branch:	MAIN
Changes since 1.4:	+108 -568 lines
Log Message:	revived 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			warn "USE SKILL JEWEL[$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.5	} elsif ($msg =~ m/^\smake\s+(\S+)\s$/i) {
67			my $ingred = $chdl->extract_jeweler_ingredients;
68	elmex	1.1
69	elmex	1.5	unless ($Jeweler::CFG->{conversions}->{lc $1}) {
70			$pl->message ("You don't know how to make '$1', is does such a thing even exist?");
71			return
72	elmex	1.1	}
73
74	elmex	1.5	simple_converter ($player, $ingred, $chdl, $1);
75			} elsif ($msg =~ m/^\smerge\s$/i) {
76			my $ingred = $chdl->extract_jeweler_ingredients;
77			my @ring = $ingred->get_ring;
78			my @rings = map { Jeweler::Object->new (object => $_) } @ring;
79
80			my $ring = shift @rings;
81			$ring->improve_by_ring (@rings);
82			$ring->power_to_level;
83	elmex	1.1
84	elmex	1.5	} else {
85			my $ingred = $chdl->extract_jeweler_ingredients;
86			my $plan = $ingred->get_plan;
87	elmex	1.1
88	elmex	1.5	if ($plan) {
89			my @ring = $ingred->get_ring;
90	elmex	1.1
91	elmex	1.5	if (@ring > 1) {
92			# actually the algorithm cant handle more than one improvement at a time
93			$pl->message ("You can't manage to improve more than one ring!");
94
95			} elsif (@ring < 1) {
96			# actually the algorithm cant
97			$pl->message ("You slap yourself, you forgot the ring!");
98
99			} else {
100			my $ringo = Jeweler::Object->new (object => $ring[0]);
101			my $iring = $ingred->improve_ring_by_plan ($plan, $ringo);
102			my $c1 = $ringo->calc_costs;
103			my $c2 = $iring->calc_costs;
104
105			my %keys;
106			my %cdiff;
107			for (keys %$c1, keys %$c2) { $keys{$_} = 1 }
108			warn 'COSTS[' . (join ",", map { $cdiff{$_} = $c2->{$_} - $c1->{$_}; "$_: $cdiff{$_}" } keys %keys) . "]\n";
109
110			unless (grep { $_ > 0 } values %cdiff) {
111			$pl->message ("This plan doesn't improve the ring, you find yourself puzzled about what you missed...");
112			return;
113			}
114
115			my $remcosts = $ingred->check_costs (\%cdiff);
116			warn 'REMCOSTS[' . (join ",", map { "$_: $remcosts->{$_}" } keys %$remcosts) . "]\n";
117
118			if (grep { $_ > 0 } values %$remcosts) {
119			$pl->message ("You recognize that you are short of: "
120			. (join ", ",
121			map { my $cost = $remcosts->{$_}; $cost . " " . ($cost > 1 ? "times" : "time") . " " . ingred_alias ($_) }
122			grep { $remcosts->{$_} > 0 } keys %$remcosts))
123			} else {
124			$ingred->check_costs (\%cdiff, 1);
125			$ingred->remove ('rings');
126			$ingred->remove ('ammys');
127			$chdl->put ($iring->to_object);
128			$pl->message ("You succeed!");
129			}
130			}
131	elmex	1.1	} else {
132	elmex	1.5	$pl->message ("You've got no idea what you are planning to do!");
133	elmex	1.1	}
134			}
135	elmex	1.5	};
136			$@ and warn "ERROR: $@\n";
137	elmex	1.1
138	elmex	1.5	my $r = cf::random_roll (0, 101, $pl, cf::PREFER_LOW);
139			}