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.5 by elmex, Tue Aug 15 06:02:49 2006 UTC vs.
Revision 1.15 by root, Fri Oct 27 23:06:36 2006 UTC

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

Diff Legend

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