ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/maps/perl/reseller.ext
(Generate patch)

Comparing deliantra/maps/perl/reseller.ext (file contents):
Revision 1.1 by elmex, Mon Aug 14 04:19:28 2006 UTC vs.
Revision 1.5 by elmex, Tue Aug 15 06:02:49 2006 UTC

… …
10my %aliases = ( 10my %aliases = (
11 platinum => 'platina', 11 platinum => 'platina',
12 royalties => 'royalty' 12 royalties => 'royalty'
13); 13);
14 14
15sub find_rec {
16 my ($ob, $cb) = @_;
17
18 my @unpaid;
19 for my $i ($ob->inv) {
20 push @unpaid, $i if $cb->($i);
21 push @unpaid, find_unpaid ($i, $cb)
22 if $i->inv;
23 }
24 return @unpaid;
25}
26
15sub find_unpaid { 27sub find_unpaid {
16 my ($ob) = @_; 28 my ($ob) = @_;
17 29 my @r = find_rec ($ob, sub { $_[0]->get_flag (cf::FLAG_UNPAID) });
18 my @unpaid;
19 for ($ob->inv) {
20 push @unpaid, $_
21 if $_->get_flag (cf::FLAG_UNPAID);
22
23 if ($_->inv) {
24 push @unpaid, find_unpaid ($_->inv);
25 }
26 }
27 return @unpaid; 30 return @r;
28} 31}
32
33sub find_traded {
34 my ($ob) = @_;
35 my @r = find_rec ($ob, sub { $_[0]->get_ob_key_value ('ext_reseller_seller') ne '' });
36 return @r;
37}
38
39cf::register_script_function "reseller::list_sells" => sub {
40 my ($who, $msg, $npc) = @_;
41 my $sells = cf::from_json $npc->get_ob_key_value ('ext_reseller_sales');
42 my $hissells = $sells->{$who->name};
43
44 unless (keys %{$hissells || {}}) {
45 $who->reply ($npc, "I'm sorry, but you sold nothing.\n");
46 return 0;
47 }
48
49 $who->reply ($npc, "You sold:\n", cf::NDI_BROWN);
50 for (keys %$hissells) {
51 my $n = $_;
52 $n =~ s/\s*\(unpaid\)//g;
53 $who->reply ($npc, "$n for " . cf::cost_string_from_value ($hissells->{$_}), cf::NDI_BROWN);
54 }
55
56 0
57};
58
59cf::register_script_function "reseller::pay_player" => sub {
60 my ($who, $msg, $npc) = @_;
61 my $sells = cf::from_json $npc->get_ob_key_value ('ext_reseller_sales');
62 my $hissells = $sells->{$who->name};
63
64 unless (keys %{$hissells || {}}) {
65 $who->reply ($npc, "I'm sorry, but you sold nothing.\n");
66 return 0;
67 }
68
69 my $sum = 0;
70 $sum += $_ for values %$hissells;
71
72 $who->pay_player ($sum);
73 $who->reply ($npc, "Here are the " . cf::cost_string_from_value ($sum) . " for your sales");
74
75 $sells->{$who->name} = {};
76
77 $npc->set_ob_key_value (ext_reseller_sales => cf::to_json $sells);
78
79 0
80};
29 81
30sub on_trigger { 82sub on_trigger {
31 my ($ev, $ob, $who_caused, $who) = @_; 83 my ($ev, $ob, $who_caused, $who) = @_;
32 my $opt = $ev->options; 84 my $opt = $ev->options;
33 return 0 unless $opt =~ m/(\d+),(\d+)/; 85 return 1 unless $opt =~ m/(\S+),(\d+),(\d+)/;
34 my $val = 0; 86
35 $val += $_->value for find_unpaid ($who); 87 my @obs = grep { $_->name eq $1 } $who->map->at ($2, $3);
36 warn "PAID $val\n"; 88 unless (@obs) {
89 warn "Couldn't find shop keeper in " . $who->map . "\n";
90 return 1;
91 }
92
93 my $sells = cf::from_json $obs[0]->get_ob_key_value ('ext_reseller_sales');
94
95 for my $item (find_unpaid ($who)) {
96 if ($item->get_ob_key_value ('ext_reseller_seller') eq $who->name) {
97 $item->set_flag (cf::FLAG_UNPAID, 0);
98 $item->remove;
99 $item->insert_ob_in_ob ($who);
100 next;
101 }
102
103 my $value = $item->query_cost ($who, cf::F_BUY | cf::F_SHOP);
104
105 warn "Object " . $item->name . " bought by " . $who->name . " on map "
106 . $who->map->path . " for $value silver has no seller set\n"
107 unless $item->get_ob_key_value ('ext_reseller_seller') ne '';
108
109 $sells->{$item->get_ob_key_value ('ext_reseller_seller')}->{$item->name} += $value;
110 }
111
112 $ob->apply_shop_mat ($who);
113
114 for my $item (find_traded ($who)) {
115 next if $item->get_flag (cf::FLAG_UNPAID);
116 $item->set_value ($item->get_ob_key_value ('ext_reseller_orig_value'));
117 $item->set_ob_key_value (ext_reseller_seller => '');
118 }
119
120 $obs[0]->set_ob_key_value (ext_reseller_sales => cf::to_json $sells);
121
37 return 0; 122 return 0;
38} 123}
39 124
40sub on_drop_on { 125sub on_drop_on {
41 my ($ev, $on, $who, $what) = @_; 126 my ($ev, $on, $who, $what) = @_;
… …
43 128
44 if ($what->get_flag (cf::FLAG_UNPAID)) { 129 if ($what->get_flag (cf::FLAG_UNPAID)) {
45 return 0; 130 return 0;
46 } 131 }
47 132
48 unless ($name =~ m/\d+\s*\S+/) { 133 if ($what->type == cf::MONEY) {
49 $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'"); 134 $who->message ("The shopkeeper says: Sorry, you can't sell money here.", cf::NDI_BROWN);
50 $what->insert_ob_in_ob ($who); 135 $what->insert_ob_in_ob ($who);
51 return 1; 136 return 1;
52 } 137 }
53 138
139 if (!$what->get_flag (cf::FLAG_IDENTIFIED) && $what->need_identify) {
140 $who->message ("The shopkeeper says: Sorry, you can't sell unidentified stuff here.", cf::NDI_BROWN);
141 $what->insert_ob_in_ob ($who);
142 return 1;
143 }
144
145 my $orig_value = $what->value;
54 my $value = 0; 146 my $value = 0;
55 while ($name =~ s/^\s*(\d+)\s*(\S+)//) { 147
56 if ($aliases{lc $2} or $unit{lc $2}) { 148 if ($name =~ m/\S/) {
57 $value += $1 * ($unit{lc $2} ? $unit{lc $2} : $unit{$aliases{lc $2}}); 149 unless ($name =~ m/\d+\s*\S+/) {
58 } else { 150 $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);
59 $what->insert_ob_in_ob ($who); 151 $what->insert_ob_in_ob ($who);
60 $who->message ("The shopkeeper says: I don't know the currency '$2'");
61 return 1; 152 return 1;
62 } 153 }
154
155 while ($name =~ s/^\s*(\d+)\s*(\S+)//) {
156 if ($aliases{lc $2} or $unit{lc $2}) {
157 $value += $1 * ($unit{lc $2} ? $unit{lc $2} : $unit{$aliases{lc $2}});
158 } else {
159 $what->insert_ob_in_ob ($who);
160 $who->message ("The shopkeeper says: I don't know the currency '$2'", cf::NDI_BROWN);
161 return 1;
162 }
163 }
164 } else {
165 $value = $what->query_cost ($who, cf::F_SELL | cf::F_SHOP) / ($what->nrof || 1);
63 } 166 }
167
168 my $fee = $value / 100; # 1% selling fee
169
170 unless ($who->pay_amount ($fee)) {
171 $who->message (
172 "The shopkeeper says: You need " . cf::cost_string_from_value ($fee) . " to pay the 1% fee for this item",
173 cf::NDI_BROWN
174 );
175 $what->insert_ob_in_ob ($who);
176 return 1;
177 } else {
178 $who->message (
179 "The shopkeeper says: Ok, got the fee of " . cf::cost_string_from_value ($fee) . " for the item",
180 cf::NDI_BROWN
181 );
182 }
183
64 184
65 $what->set_value ($value); 185 $what->set_value ($value);
66 my $cost = $what->query_cost ($who, cf::F_BUY | cf::F_SHOP); 186 my $cost = $what->query_cost ($who, cf::F_BUY | cf::F_SHOP) / ($what->nrof || 1);
67 187
188 my $fact = 0;
68 if ($cost) { 189 if ($cost) {
69 my $fact = $value / $cost; 190 $fact = $value / $cost;
70 $what->set_value (cf::ceil ($value * $fact)); 191 $what->set_value (cf::ceil ($value * $fact));
71 } 192 }
72 193
194# warn "END VALUE: $value * $fact => " . $what->value . "\n";
195
196# my $cost = $what->query_cost ($who, cf::F_BUY | cf::F_SHOP) / $what->nrof;
197# warn "COSTS NOW: $cost\n";
198
199 $who->message (
200 "The shopkeeper says: Ok, I marked "
201 . ($what->nrof || 1) . " " . $what->name . " to be sold for at least "
202 . cf::cost_string_from_value ($value)
203 . ($what->nrof > 1 ? " each" : ""), cf::NDI_BROWN
204 );
205
206 $what->set_ob_key_value (ext_reseller_seller => $who->name);
207 $what->set_ob_key_value (ext_reseller_orig_value => $orig_value);
208# warn "SET SELLER ON " . $what->name . " + " . $what->{seller}->[0] . "\n";
209 $what->set_custom_name (
210 $what->name . " (property of " . $who->name . ")"
211 );
73 $what->set_flag (cf::FLAG_UNPAID, 1); 212 $what->set_flag (cf::FLAG_UNPAID, 1);
74 $what->{seller} = $who->name;
75 $what->set_custom_name (undef);
76 $what->insert_ob_in_map_at ($who->map, $who, cf::INS_BELOW_ORIGINATOR, $who->x, $who->y); 213 $what->insert_ob_in_map_at ($who->map, $who, cf::INS_BELOW_ORIGINATOR, $who->x, $who->y);
77 1; 214 1;
78} 215}

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines