maps/perl/reseller.ext

#!perl
#CONVERSION: NONE

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]->get_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
};

sub on_trigger {
   my ($ev, $ob, $who_caused, $who) = @_;
   my $opt = $ev->options;
   return 1 unless $opt =~ m/(\S+),(\d+),(\d+)/;

   my @obs = grep { $_->name eq $1 } $who->map->at ($2, $3);
   unless (@obs) {
      warn "Couldn't find shop keeper in " . $who->map . "\n";
      return 1;
   }

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

   for my $item (find_unpaid ($who)) {
      if ($item->get_ob_key_value ('ext_reseller_seller') eq $who->name) {
         $item->set_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"
         unless $item->get_ob_key_value ('ext_reseller_seller') ne '';

      $sells->{$item->get_ob_key_value ('ext_reseller_seller')}->{$item->name} += $value;
   }

   $ob->apply_shop_mat ($who);

   for my $item (find_traded ($who)) {
      next if $item->get_flag (cf::FLAG_UNPAID);
      $item->set_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);

   return 0;
}

sub on_drop_on {
   my ($ev, $on, $who, $what) = @_;
   my $name = $what->custom_name;

   if ($what->get_flag (cf::FLAG_UNPAID)) {
      return 0;
   }

   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 1;
   }

   if (!$what->get_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 1;
   }

   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 1;
      }

      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 1;
         }
      }
   } 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 1;
   }

   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 1;
   } else {
      $who->message (
         "The shopkeeper says: Ok, got the fee of " . cf::cost_string_from_value ($fee) . " for the item",
         cf::NDI_BROWN
      );
   }


   $what->set_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->set_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->set_custom_name (
      $what->name . " (by " . $who->name . ")"
   );
   $what->set_flag (cf::FLAG_UNPAID, 1);
   $what->insert_ob_in_map_at ($who->map, $who, cf::INS_BELOW_ORIGINATOR, $who->x, $who->y);
   1;
}
Revision:	1.8
Committed:	Fri Aug 25 15:07:43 2006 UTC (17 years, 8 months ago) by root
Branch:	MAIN
Changes since 1.7:	+1 -0 lines
Log Message:	Convert remainin scripts to new event system, noted conversion status of all plugins in second line, to aid in further event conversions.
#	User	Rev	Content
1	elmex	1.1	#!perl
2	root	1.8	#CONVERSION: NONE
3	elmex	1.1
4			my %unit = (
5			silver => 1,
6			gold => 10,
7			platina => 50,
8			royalty => 5000,
9			);
10
11			my %aliases = (
12			platinum => 'platina',
13			royalties => 'royalty'
14			);
15
16	elmex	1.3	sub find_rec {
17			my ($ob, $cb) = @_;
18	elmex	1.1
19			my @unpaid;
20	elmex	1.3	for my $i ($ob->inv) {
21			push @unpaid, $i if $cb->($i);
22			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			my @r = find_rec ($ob, sub { $_[0]->get_flag (cf::FLAG_UNPAID) });
31			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	elmex	1.1	sub on_trigger {
84			my ($ev, $ob, $who_caused, $who) = @_;
85			my $opt = $ev->options;
86	elmex	1.2	return 1 unless $opt =~ m/(\S+),(\d+),(\d+)/;
87	elmex	1.3
88	elmex	1.2	my @obs = grep { $_->name eq $1 } $who->map->at ($2, $3);
89			unless (@obs) {
90			warn "Couldn't find shop keeper in " . $who->map . "\n";
91			return 1;
92			}
93	elmex	1.3
94			my $sells = cf::from_json $obs[0]->get_ob_key_value ('ext_reseller_sales');
95	elmex	1.2
96			for my $item (find_unpaid ($who)) {
97	elmex	1.3	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	elmex	1.2	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	elmex	1.3	unless $item->get_ob_key_value ('ext_reseller_seller') ne '';
109
110			$sells->{$item->get_ob_key_value ('ext_reseller_seller')}->{$item->name} += $value;
111			}
112	elmex	1.2
113	elmex	1.3	$ob->apply_shop_mat ($who);
114	elmex	1.2
115	elmex	1.3	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'));
118			$item->set_ob_key_value (ext_reseller_seller => '');
119	elmex	1.2	}
120	elmex	1.3
121			$obs[0]->set_ob_key_value (ext_reseller_sales => cf::to_json $sells);
122
123	elmex	1.1	return 0;
124			}
125
126			sub on_drop_on {
127			my ($ev, $on, $who, $what) = @_;
128			my $name = $what->custom_name;
129
130			if ($what->get_flag (cf::FLAG_UNPAID)) {
131			return 0;
132			}
133
134	elmex	1.3	if ($what->type == cf::MONEY) {
135			$who->message ("The shopkeeper says: Sorry, you can't sell money here.", cf::NDI_BROWN);
136	elmex	1.2	$what->insert_ob_in_ob ($who);
137			return 1;
138			}
139
140	elmex	1.5	if (!$what->get_flag (cf::FLAG_IDENTIFIED) && $what->need_identify) {
141	elmex	1.3	$who->message ("The shopkeeper says: Sorry, you can't sell unidentified stuff here.", cf::NDI_BROWN);
142	elmex	1.1	$what->insert_ob_in_ob ($who);
143			return 1;
144			}
145
146	elmex	1.3	my $orig_value = $what->value;
147	elmex	1.1	my $value = 0;
148	elmex	1.3
149			if ($name =~ m/\S/) {
150			unless ($name =~ m/\d+\s*\S+/) {
151	elmex	1.4	$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	elmex	1.1	$what->insert_ob_in_ob ($who);
153			return 1;
154			}
155	elmex	1.3
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);
161			$who->message ("The shopkeeper says: I don't know the currency '$2'", cf::NDI_BROWN);
162			return 1;
163			}
164			}
165			} else {
166			$value = $what->query_cost ($who, cf::F_SELL \| cf::F_SHOP) / ($what->nrof \|\| 1);
167			}
168
169	elmex	1.7	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 1;
173			}
174
175	elmex	1.3	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 1;
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	elmex	1.1	}
190
191	elmex	1.2
192	elmex	1.1	$what->set_value ($value);
193	elmex	1.3	my $cost = $what->query_cost ($who, cf::F_BUY \| cf::F_SHOP) / ($what->nrof \|\| 1);
194	elmex	1.1
195	elmex	1.3	my $fact = 0;
196	elmex	1.1	if ($cost) {
197	elmex	1.3	$fact = $value / $cost;
198	elmex	1.1	$what->set_value (cf::ceil ($value * $fact));
199			}
200
201	elmex	1.3	# warn "END VALUE: $value * $fact => " . $what->value . "\n";
202
203			# my $cost = $what->query_cost ($who, cf::F_BUY \| cf::F_SHOP) / $what->nrof;
204			# warn "COSTS NOW: $cost\n";
205
206			$who->message (
207			"The shopkeeper says: Ok, I marked "
208			. ($what->nrof \|\| 1) . " " . $what->name . " to be sold for at least "
209			. cf::cost_string_from_value ($value)
210			. ($what->nrof > 1 ? " each" : ""), cf::NDI_BROWN
211			);
212
213			$what->set_ob_key_value (ext_reseller_seller => $who->name);
214			$what->set_ob_key_value (ext_reseller_orig_value => $orig_value);
215			# warn "SET SELLER ON " . $what->name . " + " . $what->{seller}->[0] . "\n";
216			$what->set_custom_name (
217	elmex	1.6	$what->name . " (by " . $who->name . ")"
218	elmex	1.3	);
219	elmex	1.1	$what->set_flag (cf::FLAG_UNPAID, 1);
220			$what->insert_ob_in_map_at ($who->map, $who, cf::INS_BELOW_ORIGINATOR, $who->x, $who->y);
221			1;
222			}