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.8 by root, Fri Aug 25 15:07:43 2006 UTC vs.
Revision 1.17 by root, Sun Nov 19 13:58:24 2006 UTC

1#!perl 1#!perl
2#CONVERSION: NONE
3 2
4my %unit = ( 3my %unit = (
5 silver => 1, 4 silver => 1,
6 gold => 10, 5 gold => 10,
7 platina => 50, 6 platina => 50,
8 royalty => 5000, 7 royalty => 5000,
9); 8);
10 9
11my %aliases = ( 10my %aliases = (
12 platinum => 'platina', 11 platinum => 'platina',
13 royalties => 'royalty' 12 royalties => 'royalty',
14); 13);
15 14
16sub find_rec { 15sub find_rec {
17 my ($ob, $cb) = @_; 16 my ($ob, $cb) = @_;
18 17
19 my @unpaid; 18 my @unpaid;
20 for my $i ($ob->inv) { 19 for my $i ($ob->inv) {
21 push @unpaid, $i if $cb->($i); 20 push @unpaid, $i if $cb->($i);
21
22 push @unpaid, find_unpaid ($i, $cb) 22 push @unpaid, find_unpaid ($i, $cb)
23 if $i->inv; 23 if $i->inv;
24 } 24 }
25 return @unpaid; 25 return @unpaid;
26} 26}
27 27
28sub find_unpaid { 28sub find_unpaid {
29 my ($ob) = @_; 29 my ($ob) = @_;
30 my @r = find_rec ($ob, sub { $_[0]->get_flag (cf::FLAG_UNPAID) }); 30 my @r = find_rec ($ob, sub { $_[0]->flag (cf::FLAG_UNPAID) });
31 return @r; 31 return @r;
32} 32}
33 33
34sub find_traded { 34sub find_traded {
35 my ($ob) = @_; 35 my ($ob) = @_;
… …
78 $npc->set_ob_key_value (ext_reseller_sales => cf::to_json $sells); 78 $npc->set_ob_key_value (ext_reseller_sales => cf::to_json $sells);
79 79
80 0 80 0
81}; 81};
82 82
83sub on_trigger { 83cf::register_attachment "reseller_shopmat",
84 on_move_trigger => sub {
84 my ($ev, $ob, $who_caused, $who) = @_; 85 my ($self, $who_caused, $who) = @_;
85 my $opt = $ev->options;
86 return 1 unless $opt =~ m/(\S+),(\d+),(\d+)/;
87 86
88 my @obs = grep { $_->name eq $1 } $who->map->at ($2, $3); 87 my @obs = grep { $_->name eq $self->{reseller_shopmat}{npc_name} }
88 $who->map->at ($self->{reseller_shopmat}{npc_x}, $self->{reseller_shopmat}{npc_y});
89
89 unless (@obs) { 90 unless (@obs) {
90 warn "Couldn't find shop keeper in " . $who->map . "\n"; 91 warn "Couldn't find shop keeper in " . $who->map . "\n";
91 return 1; 92 return cf::override;
92 } 93 }
93 94
94 my $sells = cf::from_json $obs[0]->get_ob_key_value ('ext_reseller_sales'); 95 my $sells = cf::from_json $obs[0]->get_ob_key_value ('ext_reseller_sales');
95 96
97 my $unpaid_items = {};
98
96 for my $item (find_unpaid ($who)) { 99 for my $item (find_unpaid ($who)) {
97 if ($item->get_ob_key_value ('ext_reseller_seller') eq $who->name) { 100 if ($item->get_ob_key_value ('ext_reseller_seller') eq $who->name) {
98 $item->set_flag (cf::FLAG_UNPAID, 0); 101 $item->flag (cf::FLAG_UNPAID, 0);
99 $item->remove; 102 $item->remove;
100 $item->insert_ob_in_ob ($who); 103 $item->insert_ob_in_ob ($who);
101 next; 104 next;
102 } 105 }
103 106
104 my $value = $item->query_cost ($who, cf::F_BUY | cf::F_SHOP); 107 my $value = $item->query_cost ($who, cf::F_BUY | cf::F_SHOP);
105 108
106 warn "Object " . $item->name . " bought by " . $who->name . " on map " 109 warn "Object " . $item->name . " bought by " . $who->name . " on map "
107 . $who->map->path . " for $value silver has no seller set\n" 110 . $who->map->path . " for $value silver has no seller set\n"
108 unless $item->get_ob_key_value ('ext_reseller_seller') ne ''; 111 if $item->get_ob_key_value ('ext_reseller_seller') eq '';
109 112
113 $unpaid_items->{$item} = [$value, $item];
114 }
115
116 $self->apply_shop_mat ($who);
117
118 for my $item (find_traded ($who)) {
119 next if $item->flag (cf::FLAG_UNPAID);
120 if (my $value = $unpaid_items->{$item}[0]) {
110 $sells->{$item->get_ob_key_value ('ext_reseller_seller')}->{$item->name} += $value; 121 $sells->{$item->get_ob_key_value ('ext_reseller_seller')}->{$item->name} += $value;
111 } 122 }
112 123
113 $ob->apply_shop_mat ($who);
114
115 for my $item (find_traded ($who)) {
116 next if $item->get_flag (cf::FLAG_UNPAID);
117 $item->set_value ($item->get_ob_key_value ('ext_reseller_orig_value')); 124 $item->value ($item->get_ob_key_value ('ext_reseller_orig_value'));
118 $item->set_ob_key_value (ext_reseller_seller => ''); 125 $item->set_ob_key_value (ext_reseller_seller => '');
119 } 126 }
120 127
121 $obs[0]->set_ob_key_value (ext_reseller_sales => cf::to_json $sells); 128 $obs[0]->set_ob_key_value (ext_reseller_sales => cf::to_json $sells);
122 129
123 return 0; 130 cf::override;
124} 131 },
132;
125 133
126sub on_drop_on { 134cf::register_attachment "reseller_floor",
127 my ($ev, $on, $who, $what) = @_; 135 on_drop_on => sub {
136 my ($on, $what, $who) = @_;
128 my $name = $what->custom_name; 137 my $name = $what->custom_name;
129 138
130 if ($what->get_flag (cf::FLAG_UNPAID)) { 139 return if $what->flag (cf::FLAG_UNPAID);
131 return 0;
132 }
133 140
134 if ($what->type == cf::MONEY) { 141 if ($what->type == cf::MONEY) {
135 $who->message ("The shopkeeper says: Sorry, you can't sell money here.", cf::NDI_BROWN); 142 $who->message ("The shopkeeper says: Sorry, you can't sell money here.", cf::NDI_BROWN);
136 $what->insert_ob_in_ob ($who); 143 $what->insert_ob_in_ob ($who);
137 return 1; 144 return cf::override;
138 } 145 }
139 146
140 if (!$what->get_flag (cf::FLAG_IDENTIFIED) && $what->need_identify) { 147 if (!$what->flag (cf::FLAG_IDENTIFIED) && $what->need_identify) {
141 $who->message ("The shopkeeper says: Sorry, you can't sell unidentified stuff here.", cf::NDI_BROWN); 148 $who->message ("The shopkeeper says: Sorry, you can't sell unidentified stuff here.", cf::NDI_BROWN);
142 $what->insert_ob_in_ob ($who); 149 $what->insert_ob_in_ob ($who);
143 return 1; 150 return cf::override;
144 } 151 }
145 152
146 my $orig_value = $what->value; 153 my $orig_value = $what->value;
147 my $value = 0; 154 my $value = 0;
148 155
149 if ($name =~ m/\S/) { 156 if ($name =~ m/\S/) {
150 unless ($name =~ m/\d+\s*\S+/) { 157 unless ($name =~ m/\d+\s*\S+/) {
151 $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); 158 $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);
152 $what->insert_ob_in_ob ($who);
153 return 1;
154 }
155
156 while ($name =~ s/^\s*(\d+)\s*(\S+)//) {
157 if ($aliases{lc $2} or $unit{lc $2}) {
158 $value += $1 * ($unit{lc $2} ? $unit{lc $2} : $unit{$aliases{lc $2}});
159 } else {
160 $what->insert_ob_in_ob ($who); 159 $what->insert_ob_in_ob ($who);
160 return cf::override;
161 }
162
163 while ($name =~ s/^\s*(\d+)\s*(\S+)//) {
164 if ($aliases{lc $2} or $unit{lc $2}) {
165 $value += $1 * ($unit{lc $2} ? $unit{lc $2} : $unit{$aliases{lc $2}});
166 } else {
167 $what->insert_ob_in_ob ($who);
161 $who->message ("The shopkeeper says: I don't know the currency '$2'", cf::NDI_BROWN); 168 $who->message ("The shopkeeper says: I don't know the currency '$2'", cf::NDI_BROWN);
162 return 1; 169 return cf::override;
163 } 170 }
164 } 171 }
165 } else { 172 } else {
166 $value = $what->query_cost ($who, cf::F_SELL | cf::F_SHOP) / ($what->nrof || 1); 173 $value = $what->query_cost ($who, cf::F_SELL | cf::F_SHOP) / ($what->nrof || 1);
167 } 174 }
168 175
169 if ($value < 0) { 176 if ($value < 0) {
170 $what->insert_ob_in_ob ($who); 177 $what->insert_ob_in_ob ($who);
171 $who->message ("The shopkeeper says: You can't sell something for a negative value: $value", cf::NDI_BROWN); 178 $who->message ("The shopkeeper says: You can't sell something for a negative value: $value", cf::NDI_BROWN);
172 return 1; 179 return cf::override;
173 } 180 }
174 181
175 my $fee = $value / 100; # 1% selling fee 182 my $fee = $value / 100; # 1% selling fee
176 183
177 unless ($who->pay_amount ($fee)) { 184 unless ($who->pay_amount ($fee)) {
178 $who->message ( 185 $who->message (
179 "The shopkeeper says: You need " . cf::cost_string_from_value ($fee) . " to pay the 1% fee for this item", 186 "The shopkeeper says: You need " . cf::cost_string_from_value ($fee) . " to pay the 1% fee for this item",
180 cf::NDI_BROWN 187 cf::NDI_BROWN
181 ); 188 );
182 $what->insert_ob_in_ob ($who); 189 $what->insert_ob_in_ob ($who);
183 return 1; 190 return cf::override;
184 } else { 191 } else {
185 $who->message ( 192 $who->message (
186 "The shopkeeper says: Ok, got the fee of " . cf::cost_string_from_value ($fee) . " for the item", 193 "The shopkeeper says: Ok, got the fee of " . cf::cost_string_from_value ($fee) . " for the item",
187 cf::NDI_BROWN 194 cf::NDI_BROWN
188 ); 195 );
189 } 196 }
190 197
191
192 $what->set_value ($value); 198 $what->value ($value);
193 my $cost = $what->query_cost ($who, cf::F_BUY | cf::F_SHOP) / ($what->nrof || 1); 199 my $cost = $what->query_cost ($who, cf::F_BUY | cf::F_SHOP) / ($what->nrof || 1);
194 200
195 my $fact = 0; 201 my $fact = 0;
196 if ($cost) { 202 if ($cost) {
197 $fact = $value / $cost; 203 $fact = $value / $cost;
198 $what->set_value (cf::ceil ($value * $fact)); 204 $what->value (cf::ceil ($value * $fact));
199 } 205 }
200 206
201# warn "END VALUE: $value * $fact => " . $what->value . "\n"; 207# warn "END VALUE: $value * $fact => " . $what->value . "\n";
202 208
203# my $cost = $what->query_cost ($who, cf::F_BUY | cf::F_SHOP) / $what->nrof; 209# my $cost = $what->query_cost ($who, cf::F_BUY | cf::F_SHOP) / $what->nrof;
204# warn "COSTS NOW: $cost\n"; 210# warn "COSTS NOW: $cost\n";
205 211
206 $who->message ( 212 $who->message (
207 "The shopkeeper says: Ok, I marked " 213 "The shopkeeper says: Ok, I marked "
208 . ($what->nrof || 1) . " " . $what->name . " to be sold for at least " 214 . ($what->nrof || 1) . " " . $what->name . " to be sold for at least "
209 . cf::cost_string_from_value ($value) 215 . cf::cost_string_from_value ($value)
210 . ($what->nrof > 1 ? " each" : ""), cf::NDI_BROWN 216 . ($what->nrof > 1 ? " each" : ""), cf::NDI_BROWN
211 ); 217 );
212 218
213 $what->set_ob_key_value (ext_reseller_seller => $who->name); 219 $what->set_ob_key_value (ext_reseller_seller => $who->name);
214 $what->set_ob_key_value (ext_reseller_orig_value => $orig_value); 220 $what->set_ob_key_value (ext_reseller_orig_value => $orig_value);
215# warn "SET SELLER ON " . $what->name . " + " . $what->{seller}->[0] . "\n"; 221# warn "SET SELLER ON " . $what->name . " + " . $what->{seller}->[0] . "\n";
216 $what->set_custom_name (
217 $what->name . " (by " . $who->name . ")" 222 $what->custom_name ($what->name . " (by " . $who->name . ")");
218 );
219 $what->set_flag (cf::FLAG_UNPAID, 1); 223 $what->flag (cf::FLAG_UNPAID, 1);
220 $what->insert_ob_in_map_at ($who->map, $who, cf::INS_BELOW_ORIGINATOR, $who->x, $who->y); 224 $what->insert_ob_in_map_at ($who->map, $who, cf::INS_BELOW_ORIGINATOR, $who->x, $who->y);
221 1; 225
222} 226 cf::override;
227 },
228;

Diff Legend

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