#!perl my %unit = ( silver => 1, gold => 10, platina => 50, royalty => 5000, ); my %aliases = ( platinum => 'platina', royalties => 'royalty' ); sub find_rec { my ($ob, $cb) = @_; my @unpaid; for my $i ($ob->inv) { push @unpaid, $i if $cb->($i); push @unpaid, find_unpaid ($i, $cb) if $i->inv; } return @unpaid; } sub find_unpaid { my ($ob) = @_; my @r = find_rec ($ob, sub { $_[0]->get_flag (cf::FLAG_UNPAID) }); return @r; } sub find_traded { my ($ob) = @_; my @r = find_rec ($ob, sub { $_[0]->get_ob_key_value ('ext_reseller_seller') ne '' }); return @r; } cf::register_script_function "reseller::list_sells" => sub { my ($who, $msg, $npc) = @_; my $sells = cf::from_json $npc->get_ob_key_value ('ext_reseller_sales'); my $hissells = $sells->{$who->name}; unless (keys %{$hissells || {}}) { $who->reply ($npc, "I'm sorry, but you sold nothing.\n"); return 0; } $who->reply ($npc, "You sold:\n", cf::NDI_BROWN); for (keys %$hissells) { my $n = $_; $n =~ s/\s*\(unpaid\)//g; $who->reply ($npc, "$n for " . cf::cost_string_from_value ($hissells->{$_}), cf::NDI_BROWN); } 0 }; cf::register_script_function "reseller::pay_player" => sub { my ($who, $msg, $npc) = @_; my $sells = cf::from_json $npc->get_ob_key_value ('ext_reseller_sales'); my $hissells = $sells->{$who->name}; unless (keys %{$hissells || {}}) { $who->reply ($npc, "I'm sorry, but you sold nothing.\n"); return 0; } my $sum = 0; $sum += $_ for values %$hissells; $who->pay_player ($sum); $who->reply ($npc, "Here are the " . cf::cost_string_from_value ($sum) . " for your sales"); $sells->{$who->name} = {}; $npc->set_ob_key_value (ext_reseller_sales => cf::to_json $sells); 0 }; sub on_trigger { my ($ev, $ob, $who_caused, $who) = @_; my $opt = $ev->options; return 1 unless $opt =~ m/(\S+),(\d+),(\d+)/; my @obs = grep { $_->name eq $1 } $who->map->at ($2, $3); unless (@obs) { warn "Couldn't find shop keeper in " . $who->map . "\n"; return 1; } my $sells = cf::from_json $obs[0]->get_ob_key_value ('ext_reseller_sales'); for my $item (find_unpaid ($who)) { if ($item->get_ob_key_value ('ext_reseller_seller') eq $who->name) { $item->set_flag (cf::FLAG_UNPAID, 0); $item->remove; $item->insert_ob_in_ob ($who); next; } my $value = $item->query_cost ($who, cf::F_BUY | cf::F_SHOP); warn "Object " . $item->name . " bought by " . $who->name . " on map " . $who->map->path . " for $value silver has no seller set\n" unless $item->get_ob_key_value ('ext_reseller_seller') ne ''; $sells->{$item->get_ob_key_value ('ext_reseller_seller')}->{$item->name} += $value; } $ob->apply_shop_mat ($who); for my $item (find_traded ($who)) { next if $item->get_flag (cf::FLAG_UNPAID); $item->set_value ($item->get_ob_key_value ('ext_reseller_orig_value')); $item->set_ob_key_value (ext_reseller_seller => ''); } $obs[0]->set_ob_key_value (ext_reseller_sales => cf::to_json $sells); return 0; } sub on_drop_on { my ($ev, $on, $who, $what) = @_; my $name = $what->custom_name; if ($what->get_flag (cf::FLAG_UNPAID)) { return 0; } if ($what->type == cf::MONEY) { $who->message ("The shopkeeper says: Sorry, you can't sell money here.", cf::NDI_BROWN); $what->insert_ob_in_ob ($who); return 1; } if (!$what->get_flag (cf::FLAG_IDENTIFIED) && $what->need_identify) { $who->message ("The shopkeeper says: Sorry, you can't sell unidentified stuff here.", cf::NDI_BROWN); $what->insert_ob_in_ob ($who); return 1; } my $orig_value = $what->value; my $value = 0; if ($name =~ m/\S/) { unless ($name =~ m/\d+\s*\S+/) { $who->message ("The shopkeeper says: Sorry, I don't recognize '$name' as currency. Please name your item like '10 royalty' or '10 platinum 2 silver'", cf::NDI_BROWN); $what->insert_ob_in_ob ($who); return 1; } while ($name =~ s/^\s*(\d+)\s*(\S+)//) { if ($aliases{lc $2} or $unit{lc $2}) { $value += $1 * ($unit{lc $2} ? $unit{lc $2} : $unit{$aliases{lc $2}}); } else { $what->insert_ob_in_ob ($who); $who->message ("The shopkeeper says: I don't know the currency '$2'", cf::NDI_BROWN); return 1; } } } else { $value = $what->query_cost ($who, cf::F_SELL | cf::F_SHOP) / ($what->nrof || 1); } my $fee = $value / 100; # 1% selling fee unless ($who->pay_amount ($fee)) { $who->message ( "The shopkeeper says: You need " . cf::cost_string_from_value ($fee) . " to pay the 1% fee for this item", cf::NDI_BROWN ); $what->insert_ob_in_ob ($who); return 1; } else { $who->message ( "The shopkeeper says: Ok, got the fee of " . cf::cost_string_from_value ($fee) . " for the item", cf::NDI_BROWN ); } $what->set_value ($value); my $cost = $what->query_cost ($who, cf::F_BUY | cf::F_SHOP) / ($what->nrof || 1); my $fact = 0; if ($cost) { $fact = $value / $cost; $what->set_value (cf::ceil ($value * $fact)); } # warn "END VALUE: $value * $fact => " . $what->value . "\n"; # my $cost = $what->query_cost ($who, cf::F_BUY | cf::F_SHOP) / $what->nrof; # warn "COSTS NOW: $cost\n"; $who->message ( "The shopkeeper says: Ok, I marked " . ($what->nrof || 1) . " " . $what->name . " to be sold for at least " . cf::cost_string_from_value ($value) . ($what->nrof > 1 ? " each" : ""), cf::NDI_BROWN ); $what->set_ob_key_value (ext_reseller_seller => $who->name); $what->set_ob_key_value (ext_reseller_orig_value => $orig_value); # warn "SET SELLER ON " . $what->name . " + " . $what->{seller}->[0] . "\n"; $what->set_custom_name ( $what->name . " (property of " . $who->name . ")" ); $what->set_flag (cf::FLAG_UNPAID, 1); $what->insert_ob_in_map_at ($who->map, $who, cf::INS_BELOW_ORIGINATOR, $who->x, $who->y); 1; }