--- deliantra/server/ext/Jeweler.pm 2007/08/09 10:49:56 1.19 +++ deliantra/server/ext/Jeweler.pm 2009/10/12 14:00:58 1.29 @@ -10,8 +10,7 @@ package Jeweler; -use strict; -use YAML; +use common::sense; =over 4 @@ -26,13 +25,12 @@ sub read_config { my ($filename) = @_; - unless (-e $filename) { - warn "$filename doesn't exists! no config for jeweler skill loaded!\n"; + if (my $meta = $cf::RESOURCE{$filename}) { + $CFG = cf::decode_json $meta->{data}; + } else { + warn "$filename doesn't exist! no config for jeweler skill loaded!\n"; $CFG = {}; - return } - - $CFG = YAML::LoadFile $filename; } sub getcfg { @@ -167,11 +165,13 @@ my ($sk, $chdl, $pl, $input_level) = @_; my $hadunid = 0; + my $found = 0; for ($chdl->grep_by_type (cf::RING, cf::AMULET)) { if (!$_->flag (cf::FLAG_IDENTIFIED) && $_->need_identify) { $hadunid = 1; next; } + $found = 1; my $r = Jeweler::Object->new (object => $_); my $msg = $r->analyze ($sk, $pl, $input_level); $pl->message ($r->to_string . ": " . $msg); @@ -179,9 +179,10 @@ $r->wiz_analyze ($pl); } } - if ($hadunid) { - $pl->message ("You couldn't identify the other rings and not analyze them!"); - } + $pl->message ("You couldn't identify the other rings and not analyze them!") + if $hadunid; + $pl->message ("You couldn't find anything in the bench to analyse!") + unless $found; } # this function converts metals/minerals into a raw ring (of adornment) @@ -205,7 +206,7 @@ } unless ($xp_gain > 0) { - warn "WARNING: xp gain isn't > 0 in convesion '$outarch'\n"; + warn "WARNING: xp gain isn't > 0 in conversion '$outarch'\n"; return; } @@ -223,17 +224,17 @@ my $outarchval = cf::arch::find ($outarch)->value; - my $nrof = int ($archvalsum / (($outarchval || 1000) * $outarchvalfact)); + my $nrof = int $archvalsum / (($outarchval || 1000) * $outarchvalfact); if ($nrof) { - # XXX: yes, i know what i'm doing here, i don't set nrof, but it didn't work somehow (pls. chek sometimes) - for (1..$nrof) { + # XXX: yes, I know what I'm doing here, I don't set nrof, but it didn't work somehow (pls. check sometimes) + for (1 .. $nrof) { $chdl->put (my $ob = cf::object::new $outarch); $ob->set_animation (cf::rndm $ob->num_animations) if ($ob->type == cf::RING); $ob->flag (cf::FLAG_IDENTIFIED, 1); } - my $xp_sum = ($xp_gain * $nrof); + my $xp_sum = $xp_gain * $nrof; if ($xp_sum) { $pl->ob->message ("You got $xp_sum xp by making $nrof ${outarch}s"); @@ -357,7 +358,7 @@ my ($self, $obj) = @_; return undef unless $self->{cauldron}; - $obj->insert_ob_in_ob ($self->{cauldron}); + $self->{cauldron}->insert ($obj); } =back @@ -479,7 +480,7 @@ sub improve_ring_by_plan { my ($self, $plan, $ring) = @_; - $ring = dclone ($ring); + $ring = dclone $ring; my $ingred = $self->{ingredients}; my $impr = {}; @@ -573,7 +574,7 @@ sub check_costs { my ($self, $costs, $do_remove) = @_; - my $costs = dclone ($costs); + my $costs = dclone $costs; for my $key (keys %$costs) { my @grepar; @@ -586,10 +587,14 @@ if ($do_remove) { my $rem = $costs->{$key}; - $self->do_grep (sub { if ($rem) { $rem = Jeweler::Util::remove ($_[0], $rem); } 1 }, @grepar); + $self->do_grep (sub { + if ($rem) { $rem = Jeweler::Util::remove ($_[0], $rem); } + 1 + }, @grepar); if ($rem > 0) { - warn "JEWELER BUG: removed ingredients $rem > 0 after removing!"; + warn "JEWELER BUG: removed ingredients ($key) $rem > 0 after removing!"; } + } else { my $nr; $self->do_grep (sub { $nr += ($_[0]->nrof || 1); 0 }, @grepar); @@ -663,9 +668,9 @@ } else { # the experience bonus here is to make level 1 rings give you at least - # 100 exp points when making them. This also makes leveling in the + # 200 exp points when making them. This also makes leveling in the # first few levels a bit easier. (probably until around level 5-6). - my $expbonus = cf::level_to_min_exp (2) / 10; + my $expbonus = cf::level_to_min_exp (2) / 5; # this bonus should also only be given for _new_ rings and not for merged # ones - to prevent infinite exp making. $exp += $expbonus; @@ -719,8 +724,12 @@ my $lvl = $self->power_to_level (\$desc); my $scosts = $self->calc_value_from_cost ($costs); - $pl->message ("costs: " . (join (', ', map { "$_: " . sprintf "%.2f", $costs->{$_} } keys %$costs)) . " (".($scosts / 5000)." royalties)"); - $pl->message ("level: " . $desc); + $pl->message ("costs: " + . (join ', ', map { "$_: " . sprintf "%.2f", $costs->{$_} } keys %$costs) + . " (" + . ($scosts / "platinacoin"->cf::arch::find->value) + . " platinum)"); + $pl->message ("level: $desc"); } else { $pl->message ("level: impossible to make, due to impossible resistancy configuration"); } @@ -1096,29 +1105,18 @@ =item remove ($object[, $nrof]) Removes the C<$object>. If C<$nrof> is given, remove only C<$nrof> objects. -The returnvalue is the number of 'single' objects that couldn't be removed. +The return value is the number of 'single' objects that couldn't be removed. =cut sub remove { my ($obj, $nrof) = @_; + + my $c = $obj->nrof || 1; + my $r = $c > $nrof ? 0 : $nrof - $c; + $obj->decrease (defined ($nrof) ? $nrof : ($obj->nrof || 1)); - my $cnt; - - if (defined $nrof) { - # TODO: Check tihis line: - return 0 if ($nrof * 1) == 0; #XXX: ??? - $cnt = int (($obj->nrof || 1) - (1 * $nrof)); - - if ($cnt > 0) { - $obj->nrof ($cnt); - return 0; - } - } - - remove ($_) for $obj->inv; - $obj->destroy; - return $cnt; + $r } sub check_for_match {