--- deliantra/server/ext/Jeweler.pm 2007/07/31 09:40:15 1.18 +++ deliantra/server/ext/Jeweler.pm 2010/10/25 09:08:31 1.38 @@ -10,8 +10,7 @@ package Jeweler; -use strict; -use YAML; +use common::sense; =over 4 @@ -23,16 +22,13 @@ our $CFG; -sub read_config { - my ($filename) = @_; +sub load_config { + cf::trace "loading jeweler config from $cf::DATADIR/jeweler\n"; - unless (-e $filename) { - warn "$filename doesn't exists! no config for jeweler skill loaded!\n"; - $CFG = {}; - return - } + 0 < Coro::AIO::aio_load "$cf::DATADIR/jeweler", my $data + or die "$cf::DATADIR/jeweler: $!"; - $CFG = YAML::LoadFile $filename; + $CFG = cf::decode_json $data; } sub getcfg { @@ -167,26 +163,29 @@ 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); + $pl->message ("There is a '" . $r->to_string . "' in the workbench. Your analysis: " . $msg); if ($pl->flag (cf::FLAG_WIZ)) { $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) sub simple_converter { - my ($pl, $ingred, $chdl, $conv) = @_; + my ($pl, $ingred, $chdl, $conv, $sk_lvl, $low_skill_cb) = @_; $conv = lc $conv; my $cnvs = $CFG->{conversions}; @@ -205,7 +204,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; } @@ -218,22 +217,27 @@ warn "WARNING: source-arch-value-multiplier < 1 in conversion '$outarch', results in more valuable output!\n"; } - my $archvalsum = $ingred->value ($ingr_grp, $srcarchname); - $ingred->remove ($ingr_grp, $srcarchname); + my $archvalsum = $ingred->value ($ingr_grp, $srcarchname); + my $outarchval = cf::arch::find ($outarch)->value; + my $nrof = int $archvalsum / (($outarchval || 1000) * $outarchvalfact); + my $can_make_nr = int (($sk_lvl / 2) + 10); - my $outarchval = cf::arch::find ($outarch)->value; + if ($nrof > $can_make_nr) { + $pl->ob->message ("Your jeweler level is too low to make $nrof rings, you can only make $can_make_nr at your current level."); + return; + } - 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) + $ingred->remove ($ingr_grp, $srcarchname); + 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"); @@ -247,7 +251,7 @@ package Jeweler::CauldronHandler; -use strict; +use common::sense; =head2 CauldronHandler @@ -357,7 +361,7 @@ my ($self, $obj) = @_; return undef unless $self->{cauldron}; - $obj->insert_ob_in_ob ($self->{cauldron}); + $self->{cauldron}->insert ($obj); } =back @@ -365,8 +369,10 @@ =cut package Jeweler::Ingredients; + +use common::sense; + use Storable qw/dclone/; -use strict; =head2 Ingredients @@ -479,7 +485,7 @@ sub improve_ring_by_plan { my ($self, $plan, $ring) = @_; - $ring = dclone ($ring); + $ring = dclone $ring; my $ingred = $self->{ingredients}; my $impr = {}; @@ -573,7 +579,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 +592,16 @@ 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); @@ -618,7 +630,8 @@ } package Jeweler::Object; -use strict; + +use common::sense; use POSIX; use List::Util qw/max min sum/; @@ -643,29 +656,29 @@ return undef; } +sub lvl2exp { + my $lvl = shift; + (cf::level_to_min_exp ($lvl) - cf::level_to_min_exp ($lvl - 1)) + / (20 + max ($lvl - 1, 0)) # 20 + level times making such a ring + # should get you to the rings level at least. +} + sub projected_exp { my ($self, $input_level) = @_; my $lvl = max ($self->power_to_level, 1); - my $exp = - (cf::level_to_min_exp ($lvl) - cf::level_to_min_exp ($lvl - 1)) - / (10 + max ($lvl - 1, 0)); # 10 + level times making such a ring - # should get you to the rings level at least. - - if (defined $input_level) { - my $subexp = - (cf::level_to_min_exp ($input_level) - - cf::level_to_min_exp ($input_level - 1)) - / (10 + max ($input_level - 1, 0)); # see above for comment + my $exp = lvl2exp ($lvl); + if (defined $input_level) { # in case we merge rings: + my $subexp = lvl2exp ($input_level); $exp -= $subexp; $exp = max ($exp, 0); } 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 +732,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"); } @@ -833,6 +850,8 @@ $obj->{value} = $thing->value; + $obj->{is_ring} = ($thing->type == cf::RING); + $self->{hash} = $obj } @@ -841,7 +860,7 @@ my $obj = cf::object::new $self->{hash}->{arch}; - $obj->item_power (floor ($self->power_to_level / 3)); # there have to be strings attached! + $obj->item_power (floor ($self->power_to_level / 5)); # there have to be strings attached! $obj->face ($self->{hash}{face}); @@ -904,8 +923,8 @@ my $resists = $self->{hash}->{resist} || {}; - my $att_res_lvl = Jeweler::getcfg (maxlevels => 'resist_level'); - my $efc_res_lvl = Jeweler::getcfg (maxlevels => 'effect_resist_level'); + my $att_res_lvl = Jeweler::getcfg (maxlevels => 'resist_level'); + my $efc_res_lvl = Jeweler::getcfg (maxlevels => 'effect_resist_level'); my $max_att_res = Jeweler::getcfg (maximprovements => 'attack_resistances'); my $max_efc_res = Jeweler::getcfg (maximprovements => 'effect_resistances'); my $max_ovr_res = Jeweler::getcfg (maximprovements => 'resistances'); @@ -975,6 +994,7 @@ my $max_imprs = Jeweler::getcfg (maximprovements => 'improvements'); my $max_impr_lvl = Jeweler::getcfg (maxlevels => 'improve_level'); + my $ring_offs = Jeweler::getcfg (maxlevels => 'ring_offset'); my ($stat_lvl, $stat_imprs) = $self->stat_level; my ($resist_lvl, $res_imprs) = $self->resist_level; @@ -982,10 +1002,18 @@ my $impr_sum = $stat_imprs + $res_imprs + $spec_imprs; - my $impr_lvl = ceil (($max_impr_lvl / ($max_imprs + 1)) * ($impr_sum - 1)); # 1 improvemnt bonus + my $impr_lvl = + ceil (($max_impr_lvl / ($max_imprs + 1)) + * ($impr_sum - 1)); # 1 improvemnt bonus my $levl = int max ($stat_lvl, $resist_lvl, $impr_lvl, $spec_lvl, 0); + if ($self->{hash}->{is_ring}) { + $levl += $ring_offs; + } + + $levl = min ($levl, cf::settings->max_level); + if ($lvldescr) { $$lvldescr = sprintf "%3d: %s\n", $levl, @@ -1067,9 +1095,6 @@ my $stat_split = Jeweler::getcfg (diamond_split => $category); my $sum = sum (@$stat_split); - if ($sum < (1 - 0.0001)) { - warn "JEWELER BUG: sum (@$stat_split) = $sum < 1 for $category!"; - } my $emarch = cf::arch::find 'emerald'; my $saarch = cf::arch::find 'sapphire'; @@ -1088,7 +1113,7 @@ package Jeweler::Util; -use strict; +use common::sense; =head2 Util @@ -1099,29 +1124,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 $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; - } - } + my $c = $obj->number_of; + my $r = $c > $nrof ? 0 : $nrof - $c; + $obj->decrease (defined ($nrof) ? $nrof : ($obj->nrof || 1)); - remove ($_) for $obj->inv; - $obj->destroy; - return $cnt; + $r } sub check_for_match {