maps/perl/reseller.ext

#!perl

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

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

sub find_unpaid {
   my ($ob) = @_;

   my @unpaid;
   for ($ob->inv) {
      push @unpaid, $_
         if $_->get_flag (cf::FLAG_UNPAID);

      if ($_->inv) {
         push @unpaid, find_unpaid ($_->inv);
      }
   }
   return @unpaid;
}

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

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

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

   0
};

sub on_trigger {
   my ($ev, $ob, $who_caused, $who) = @_;
   my $opt = $ev->options;
   warn "OPT $opt\n";
   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;
   }
   warn "FOOOOGEOG ".$obs[0]->name." <<\n";

   for my $item (find_unpaid ($who)) {
      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->{seller};

      $obs[0]->{sells}->{$item->{seller} || ''}->{$item->name} += $value;

      1 and
         warn "Object " . $item->name . " bought by " . $who->name . " on map " 
              . $who->map->path . " for $value silver sold by " . $item->{seller} . "\n";
   }
   use Data::Dumper;
   warn "DO[" .Data::Dumper::Dumper ([$obs[0]]) . "]\n";
   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->get_flag (cf::FLAG_IDENTIFIED)) {
      $who->message ("The shopkeeper says: Sorry, i don't accept unidentified stuff.");
      $what->insert_ob_in_ob ($who);
      return 1;
   }

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

   my $value = 0;
   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;
      }
   }


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

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

   $what->set_nrof ($nrof);
   $who->message ("The shopkeeper says: Ok, I marked " . $what->nrof . " " . $what->name . " to sell for " . cf::cost_string_from_value ($value) . " a piece", cf::NDI_BROWN);
   $what->set_flag (cf::FLAG_UNPAID, 1);
   $what->{seller} = $who->name;
   $what->set_custom_name (undef);
   $what->insert_ob_in_map_at ($who->map, $who, cf::INS_BELOW_ORIGINATOR, $who->x, $who->y);
   1;
}
Revision:	1.2
Committed:	Mon Aug 14 07:11:10 2006 UTC (17 years, 9 months ago) by elmex
Branch:	MAIN
Changes since 1.1:	+56 -6 lines
Log Message:	further tests and stuff for the trade shops
#	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			platinum => 'platina',
12			royalties => 'royalty'
13			);
14
15			sub find_unpaid {
16			my ($ob) = @_;
17
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;
28			}
29
30	elmex	1.2	cf::register_script_function "reseller::list_sells" => sub {
31			my ($who, $msg, $npc) = @_;
32			my $sells = $npc->{sells}->{$who->name};
33
34			unless (keys %{$sells \|\| {}}) {
35			$who->reply ($npc, "I'm sorry, but you sold nothing.\n");
36			return 0;
37			}
38
39			$who->message ($npc->name . " says: You sold:\n", cf::NDI_BROWN);
40			for (keys %$sells) {
41			my $n = $_;
42			$n =~ s/\s*\(unpaid\)//g;
43			$who->message ("$n for " . cf::cost_string_from_value ($sells->{$_}), cf::NDI_BROWN);
44			}
45
46			0
47			};
48
49	elmex	1.1	sub on_trigger {
50			my ($ev, $ob, $who_caused, $who) = @_;
51			my $opt = $ev->options;
52	elmex	1.2	warn "OPT $opt\n";
53			return 1 unless $opt =~ m/(\S+),(\d+),(\d+)/;
54			my @obs = grep { $_->name eq $1 } $who->map->at ($2, $3);
55			unless (@obs) {
56			warn "Couldn't find shop keeper in " . $who->map . "\n";
57			return 1;
58			}
59			warn "FOOOOGEOG ".$obs[0]->name." <<\n";
60
61			for my $item (find_unpaid ($who)) {
62			my $value = $item->query_cost ($who, cf::F_BUY \| cf::F_SHOP);
63
64			warn "Object " . $item->name . " bought by " . $who->name . " on map "
65			. $who->map->path . " for $value silver has no seller set\n"
66			unless $item->{seller};
67
68			$obs[0]->{sells}->{$item->{seller} \|\| ''}->{$item->name} += $value;
69
70			1 and
71			warn "Object " . $item->name . " bought by " . $who->name . " on map "
72			. $who->map->path . " for $value silver sold by " . $item->{seller} . "\n";
73			}
74			use Data::Dumper;
75			warn "DO[" .Data::Dumper::Dumper ([$obs[0]]) . "]\n";
76	elmex	1.1	return 0;
77			}
78
79			sub on_drop_on {
80			my ($ev, $on, $who, $what) = @_;
81			my $name = $what->custom_name;
82
83			if ($what->get_flag (cf::FLAG_UNPAID)) {
84			return 0;
85			}
86
87	elmex	1.2	if (!$what->get_flag (cf::FLAG_IDENTIFIED)) {
88			$who->message ("The shopkeeper says: Sorry, i don't accept unidentified stuff.");
89			$what->insert_ob_in_ob ($who);
90			return 1;
91			}
92
93	elmex	1.1	unless ($name =~ m/\d+\s*\S+/) {
94	elmex	1.2	$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);
95	elmex	1.1	$what->insert_ob_in_ob ($who);
96			return 1;
97			}
98
99			my $value = 0;
100			while ($name =~ s/^\s(\d+)\s(\S+)//) {
101			if ($aliases{lc $2} or $unit{lc $2}) {
102			$value += $1 * ($unit{lc $2} ? $unit{lc $2} : $unit{$aliases{lc $2}});
103			} else {
104			$what->insert_ob_in_ob ($who);
105	elmex	1.2	$who->message ("The shopkeeper says: I don't know the currency '$2'", cf::NDI_BROWN);
106	elmex	1.1	return 1;
107			}
108			}
109
110	elmex	1.2
111			my $nrof = $what->nrof;
112			$what->set_nrof (1);
113	elmex	1.1	$what->set_value ($value);
114			my $cost = $what->query_cost ($who, cf::F_BUY \| cf::F_SHOP);
115
116			if ($cost) {
117			my $fact = $value / $cost;
118			$what->set_value (cf::ceil ($value * $fact));
119			}
120
121	elmex	1.2	$what->set_nrof ($nrof);
122			$who->message ("The shopkeeper says: Ok, I marked " . $what->nrof . " " . $what->name . " to sell for " . cf::cost_string_from_value ($value) . " a piece", cf::NDI_BROWN);
123	elmex	1.1	$what->set_flag (cf::FLAG_UNPAID, 1);
124			$what->{seller} = $who->name;
125			$what->set_custom_name (undef);
126			$what->insert_ob_in_map_at ($who->map, $who, cf::INS_BELOW_ORIGINATOR, $who->x, $who->y);
127			1;
128			}