#!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]->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 }; cf::register_attachment "reseller_shopmat", on_move_trigger => sub { my ($self, $who_caused, $who) = @_; my @obs = grep { $_->name eq $self->{reseller_shopmat}{npc_name} } $who->map->at ($self->{reseller_shopmat}{npc_x}, $self->{reseller_shopmat}{npc_y}); unless (@obs) { warn "Couldn't find shop keeper in " . $who->map . "\n"; return cf::override; } my $sells = cf::from_json $obs[0]->get_ob_key_value ('ext_reseller_sales'); my $unpaid_items = {}; for my $item (find_unpaid ($who)) { if ($item->get_ob_key_value ('ext_reseller_seller') eq $who->name) { $item->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" if $item->get_ob_key_value ('ext_reseller_seller') eq ''; $unpaid_items->{$item->uuid} = $value; } $self->apply_shop_mat ($who); for my $item (find_traded ($who)) { next if $item->flag (cf::FLAG_UNPAID); if (my $value = $unpaid_items->{$item->uuid}) { $sells->{$item->get_ob_key_value ('ext_reseller_seller')}->{$item->name} += $value; } $item->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); cf::override; }, ; cf::register_attachment "reseller_floor", on_drop_on => sub { my ($on, $what, $who) = @_; my $name = $what->custom_name; return if $what->flag (cf::FLAG_UNPAID); 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 cf::override; } if (!$what->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 cf::override; } 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 cf::override; } 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 cf::override; } } } else { $value = $what->query_cost ($who, cf::F_SELL | cf::F_SHOP) / ($what->nrof || 1); } if ($value < 0) { $what->insert_ob_in_ob ($who); $who->message ("The shopkeeper says: You can't sell something for a negative value: $value", cf::NDI_BROWN); return cf::override; } 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 cf::override; } else { $who->message ( "The shopkeeper says: Ok, got the fee of " . cf::cost_string_from_value ($fee) . " for the item", cf::NDI_BROWN ); } $what->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->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->custom_name ($what->name . " (by " . $who->name . ")"); $what->flag (cf::FLAG_UNPAID, 1); $what->insert_ob_in_map_at ($who->map, $who, cf::INS_BELOW_ORIGINATOR, $who->x, $who->y); cf::override; }, ;