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

Diff Legend

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