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

Diff Legend

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