maps/perl/reseller.ext

#!perl

my %unit = (
   silver   => 1,
   gold     => 10,
   platina  => 50,
   royalty  => 5000,
); 

my %aliases = (
   platinum  => 'platina',
   royalties => 'royalty',
);

sub find_rec {
   my ($ob, $cb) = @_;

   my @unpaid;
   for my $i ($ob->inv) {
      push @unpaid, $i if $cb->($i);

      push @unpaid, find_unpaid ($i, $cb)
         if $i->inv;
   }
   return @unpaid;
}

sub find_unpaid {
   my ($ob) = @_;
   my @r = find_rec ($ob, sub { $_[0]->flag (cf::FLAG_UNPAID) });
   return @r;
}

sub find_traded {
   my ($ob) = @_;
   my @r = find_rec ($ob, sub { $_[0]->get_ob_key_value ('ext_reseller_seller') ne '' });
   return @r;
}

cf::register_script_function "reseller::list_sells" => sub {
   my ($who, $msg, $npc) = @_;
   my $sells = cf::from_json $npc->get_ob_key_value ('ext_reseller_sales');
   my $hissells = $sells->{$who->name};

   unless (keys %{$hissells || {}}) {
      $who->reply ($npc, "I'm sorry, but you sold nothing.\n");
      return 0;
   }

   $who->reply ($npc, "You sold:\n", cf::NDI_BROWN);
   for (keys %$hissells) {
      my $n = $_;
      $n =~ s/\s*\(unpaid\)//g;
      $who->reply ($npc, "$n for " . cf::cost_string_from_value ($hissells->{$_}), cf::NDI_BROWN);
   }

   0
};

cf::register_script_function "reseller::pay_player" => sub {
   my ($who, $msg, $npc) = @_;
   my $sells = cf::from_json $npc->get_ob_key_value ('ext_reseller_sales');
   my $hissells = $sells->{$who->name};

   unless (keys %{$hissells || {}}) {
      $who->reply ($npc, "I'm sorry, but you sold nothing.\n");
      return 0;
   }

   my $sum = 0;
   $sum += $_ for values %$hissells;

   $who->pay_player ($sum);
   $who->reply ($npc, "Here are the " . cf::cost_string_from_value ($sum) . " for your sales");

   $sells->{$who->name} = {};

   $npc->set_ob_key_value (ext_reseller_sales => cf::to_json $sells);

   0
};

cf::register_attachment "reseller_shopmat",
   on_move_trigger => sub {
      my ($self, $who_caused, $who) = @_;

      my @obs = grep { $_->name eq $self->{reseller_shopmat}{npc_name} }
                     $who->map->at ($self->{reseller_shopmat}{npc_x}, $self->{reseller_shopmat}{npc_y});

      unless (@obs) {
         warn "Couldn't find shop keeper in " . $who->map . "\n";
         return cf::override;
      }

      my $sells = cf::from_json $obs[0]->get_ob_key_value ('ext_reseller_sales');

      my $unpaid_items = {};

      for my $item (find_unpaid ($who)) {
         if ($item->get_ob_key_value ('ext_reseller_seller') eq $who->name) {
            $item->flag (cf::FLAG_UNPAID, 0);
            $item->remove;
            $item->insert_ob_in_ob ($who);
            next;
         }

         my $value = $item->query_cost ($who, cf::F_BUY | cf::F_SHOP);

         warn "Object " . $item->name . " bought by " . $who->name . " on map " 
              . $who->map->path . " for $value silver has no seller set\n"
            if $item->get_ob_key_value ('ext_reseller_seller') eq '';

         $unpaid_items->{$item} = [$value, $item];
      }

      $self->apply_shop_mat ($who);

      for my $item (find_traded ($who)) {
         next if $item->flag (cf::FLAG_UNPAID);
         if (my $value = $unpaid_items->{$item}[0]) {
            $sells->{$item->get_ob_key_value ('ext_reseller_seller')}->{$item->name} += $value;
         }

         $item->value ($item->get_ob_key_value ('ext_reseller_orig_value'));
         $item->set_ob_key_value (ext_reseller_seller => '');
      }

      $obs[0]->set_ob_key_value (ext_reseller_sales => cf::to_json $sells);

      cf::override;
   },
;

cf::register_attachment "reseller_floor",
   on_drop_on => sub {
      my ($on, $what, $who) = @_;
      my $name = $what->custom_name;

      return if $what->flag (cf::FLAG_UNPAID);

      if ($what->type == cf::MONEY) {
         $who->message ("The shopkeeper says: Sorry, you can't sell money here.", cf::NDI_BROWN);
         $what->insert_ob_in_ob ($who);
         return cf::override;
      }

      if (!$what->flag (cf::FLAG_IDENTIFIED) && $what->need_identify) {
         $who->message ("The shopkeeper says: Sorry, you can't sell unidentified stuff here.", cf::NDI_BROWN);
         $what->insert_ob_in_ob ($who);
         return cf::override;
      }

      my $orig_value = $what->value;
      my $value = 0;

      if ($name =~ m/\S/) {
         unless ($name =~ m/\d+\s*\S+/) {
            $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);
            $what->insert_ob_in_ob ($who);
            return cf::override;
         }

         while ($name =~ s/^\s*(\d+)\s*(\S+)//) {
            if ($aliases{lc $2} or $unit{lc $2}) {
               $value += $1 * ($unit{lc $2} ? $unit{lc $2} : $unit{$aliases{lc $2}});
            } else {
               $what->insert_ob_in_ob ($who);
               $who->message ("The shopkeeper says: I don't know the currency '$2'", cf::NDI_BROWN);
               return cf::override;
            }
         }
      } else {
         $value = $what->query_cost ($who, cf::F_SELL | cf::F_SHOP) / ($what->nrof || 1);
      }

      if ($value < 0) {
         $what->insert_ob_in_ob ($who);
         $who->message ("The shopkeeper says: You can't sell something for a negative value: $value", cf::NDI_BROWN);
         return cf::override;
      }

      my $fee = $value / 100; # 1% selling fee

      unless ($who->pay_amount ($fee)) {
         $who->message (
            "The shopkeeper says: You need " . cf::cost_string_from_value ($fee) . " to pay the 1% fee for this item",
            cf::NDI_BROWN
         );
         $what->insert_ob_in_ob ($who);
         return cf::override;
      } else {
         $who->message (
            "The shopkeeper says: Ok, got the fee of " . cf::cost_string_from_value ($fee) . " for the item",
            cf::NDI_BROWN
         );
      }

      $what->value ($value);
      my $cost = $what->query_cost ($who, cf::F_BUY | cf::F_SHOP) / ($what->nrof || 1);

      my $fact = 0;
      if ($cost) {
         $fact = $value / $cost;
         $what->value (cf::ceil ($value * $fact));
      }

#  warn "END VALUE: $value * $fact => " . $what->value . "\n";

#   my $cost = $what->query_cost ($who, cf::F_BUY | cf::F_SHOP) / $what->nrof;
#  warn "COSTS NOW: $cost\n";

      $who->message (
         "The shopkeeper says: Ok, I marked " 
         . ($what->nrof || 1) . " " . $what->name . " to be sold for at least " 
         . cf::cost_string_from_value ($value)
         . ($what->nrof > 1 ? " each" : ""), cf::NDI_BROWN
      );

      $what->set_ob_key_value (ext_reseller_seller => $who->name);
      $what->set_ob_key_value (ext_reseller_orig_value => $orig_value);
#  warn "SET SELLER ON " . $what->name . " + " . $what->{seller}->[0] . "\n";
      $what->custom_name ($what->name . " (by " . $who->name . ")");
      $what->flag (cf::FLAG_UNPAID, 1);
      $what->insert_ob_in_map_at ($who->map, $who, cf::INS_BELOW_ORIGINATOR, $who->x, $who->y);

      cf::override;
   },
;
Revision:	1.18
Committed:	Fri Dec 15 19:11:46 2006 UTC (17 years, 5 months ago) by root
Branch:	MAIN
CVS Tags:	HEAD
Changes since 1.17:	+0 -0 lines
State:	*FILE REMOVED*
Log Message:	move .ext to server
#	User	Rev	Content
1	elmex	1.1	#!perl
2
3			my %unit = (
4			silver => 1,
5			gold => 10,
6			platina => 50,
7			royalty => 5000,
8			);
9
10			my %aliases = (
11	root	1.15	platinum => 'platina',
12			royalties => 'royalty',
13	elmex	1.1	);
14
15	elmex	1.3	sub find_rec {
16			my ($ob, $cb) = @_;
17	elmex	1.1
18			my @unpaid;
19	elmex	1.3	for my $i ($ob->inv) {
20			push @unpaid, $i if $cb->($i);
21	root	1.15
22	elmex	1.3	push @unpaid, find_unpaid ($i, $cb)
23			if $i->inv;
24	elmex	1.1	}
25			return @unpaid;
26			}
27
28	elmex	1.3	sub find_unpaid {
29			my ($ob) = @_;
30	root	1.13	my @r = find_rec ($ob, sub { $_[0]->flag (cf::FLAG_UNPAID) });
31	elmex	1.3	return @r;
32			}
33
34			sub find_traded {
35			my ($ob) = @_;
36			my @r = find_rec ($ob, sub { $_[0]->get_ob_key_value ('ext_reseller_seller') ne '' });
37			return @r;
38			}
39
40	elmex	1.2	cf::register_script_function "reseller::list_sells" => sub {
41			my ($who, $msg, $npc) = @_;
42	elmex	1.3	my $sells = cf::from_json $npc->get_ob_key_value ('ext_reseller_sales');
43			my $hissells = $sells->{$who->name};
44	elmex	1.2
45	elmex	1.3	unless (keys %{$hissells \|\| {}}) {
46	elmex	1.2	$who->reply ($npc, "I'm sorry, but you sold nothing.\n");
47			return 0;
48			}
49
50	elmex	1.3	$who->reply ($npc, "You sold:\n", cf::NDI_BROWN);
51			for (keys %$hissells) {
52	elmex	1.2	my $n = $_;
53			$n =~ s/\s*\(unpaid\)//g;
54	elmex	1.3	$who->reply ($npc, "$n for " . cf::cost_string_from_value ($hissells->{$_}), cf::NDI_BROWN);
55	elmex	1.2	}
56
57			0
58			};
59
60	elmex	1.3	cf::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
83	root	1.9	cf::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	elmex	1.3	}
94
95	root	1.10	my $sells = cf::from_json $obs[0]->get_ob_key_value ('ext_reseller_sales');
96	elmex	1.2
97	elmex	1.16	my $unpaid_items = {};
98
99	root	1.9	for my $item (find_unpaid ($who)) {
100			if ($item->get_ob_key_value ('ext_reseller_seller') eq $who->name) {
101	root	1.14	$item->flag (cf::FLAG_UNPAID, 0);
102	root	1.9	$item->remove;
103			$item->insert_ob_in_ob ($who);
104			next;
105			}
106	elmex	1.2
107	root	1.9	my $value = $item->query_cost ($who, cf::F_BUY \| cf::F_SHOP);
108	elmex	1.2
109	root	1.9	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	elmex	1.3
113	root	1.17	$unpaid_items->{$item} = [$value, $item];
114	root	1.9	}
115	elmex	1.3
116	root	1.9	$self->apply_shop_mat ($who);
117	elmex	1.1
118	root	1.9	for my $item (find_traded ($who)) {
119	root	1.13	next if $item->flag (cf::FLAG_UNPAID);
120	root	1.17	if (my $value = $unpaid_items->{$item}[0]) {
121	elmex	1.16	$sells->{$item->get_ob_key_value ('ext_reseller_seller')}->{$item->name} += $value;
122			}
123
124	root	1.14	$item->value ($item->get_ob_key_value ('ext_reseller_orig_value'));
125	root	1.9	$item->set_ob_key_value (ext_reseller_seller => '');
126			}
127	elmex	1.1
128	root	1.9	$obs[0]->set_ob_key_value (ext_reseller_sales => cf::to_json $sells);
129	elmex	1.12
130			cf::override;
131	root	1.9	},
132			;
133
134	root	1.11	cf::register_attachment "reseller_floor",
135	root	1.9	on_drop_on => sub {
136			my ($on, $what, $who) = @_;
137			my $name = $what->custom_name;
138	elmex	1.1
139	root	1.13	return if $what->flag (cf::FLAG_UNPAID);
140	elmex	1.2
141	root	1.9	if ($what->type == cf::MONEY) {
142			$who->message ("The shopkeeper says: Sorry, you can't sell money here.", cf::NDI_BROWN);
143			$what->insert_ob_in_ob ($who);
144			return cf::override;
145			}
146	elmex	1.3
147	root	1.13	if (!$what->flag (cf::FLAG_IDENTIFIED) && $what->need_identify) {
148	root	1.9	$who->message ("The shopkeeper says: Sorry, you can't sell unidentified stuff here.", cf::NDI_BROWN);
149	elmex	1.1	$what->insert_ob_in_ob ($who);
150	root	1.9	return cf::override;
151	elmex	1.1	}
152	elmex	1.3
153	root	1.9	my $orig_value = $what->value;
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	elmex	1.3	$what->insert_ob_in_ob ($who);
160	root	1.9	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);
168			$who->message ("The shopkeeper says: I don't know the currency '$2'", cf::NDI_BROWN);
169			return cf::override;
170			}
171	elmex	1.3	}
172	root	1.9	} else {
173			$value = $what->query_cost ($who, cf::F_SELL \| cf::F_SHOP) / ($what->nrof \|\| 1);
174	elmex	1.3	}
175
176	root	1.9	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	elmex	1.7
182	root	1.9	my $fee = $value / 100; # 1% selling fee
183	elmex	1.3
184	root	1.9	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	elmex	1.1
198	root	1.14	$what->value ($value);
199	root	1.9	my $cost = $what->query_cost ($who, cf::F_BUY \| cf::F_SHOP) / ($what->nrof \|\| 1);
200	elmex	1.2
201	root	1.9	my $fact = 0;
202			if ($cost) {
203			$fact = $value / $cost;
204	root	1.14	$what->value (cf::ceil ($value * $fact));
205	root	1.9	}
206	elmex	1.1
207	elmex	1.3	# 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	root	1.9	$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	elmex	1.3
219	root	1.9	$what->set_ob_key_value (ext_reseller_seller => $who->name);
220			$what->set_ob_key_value (ext_reseller_orig_value => $orig_value);
221	elmex	1.3	# warn "SET SELLER ON " . $what->name . " + " . $what->{seller}->[0] . "\n";
222	root	1.14	$what->custom_name ($what->name . " (by " . $who->name . ")");
223			$what->flag (cf::FLAG_UNPAID, 1);
224	root	1.9	$what->insert_ob_in_map_at ($who->map, $who, cf::INS_BELOW_ORIGINATOR, $who->x, $who->y);
225
226			cf::override;
227			},
228			;