ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/maps/perl/ipo.ext
(Generate patch)

Comparing deliantra/maps/perl/ipo.ext (file contents):
Revision 1.6 by root, Fri Aug 25 13:24:05 2006 UTC vs.
Revision 1.12 by root, Fri Sep 8 17:39:31 2006 UTC

… …
2 2
3my $price_fact = 50; 3my $price_fact = 50;
4 4
5sub set_package { 5sub set_package {
6 my ($pkg, $from, $to, $bagname, $weight) = @_; 6 my ($pkg, $from, $to, $bagname, $weight) = @_;
7
7 $pkg->set_name ("$bagname T: $to F: $from"); 8 $pkg->name ("$bagname T: $to F: $from");
8 $pkg->set_weight_limit ($weight); 9 $pkg->weight_limit ($weight);
9 $pkg->set_str (0); 10 $pkg->stats->Str (0);
10} 11}
11 12
12# prices in plat. 13# prices in plat.
13my %prices = ( 14my %prices = (
14 pen => [ 15 pen => [
15 40, 'stylus', 16 40, 'stylus',
16 sub { $_[0]->set_name ('IPO Writing Pen'); $_[0]->set_value (40 * $price_fact); } 17 sub { $_[0]->name ('IPO Writing Pen'); $_[0]->value (40 * $price_fact); }
17 ], 18 ],
18 literacy => [ 19 literacy => [
19 1000, 'scroll_literacy', 20 1000, 'scroll_literacy',
20 sub { $_[0]->set_value (1000 * $price_fact) } 21 sub { $_[0]->value (1000 * $price_fact) }
21 ], 22 ],
22 mailscroll => [ 23 mailscroll => [
23 1, 'scroll', 24 1, 'scroll',
24 sub { 25 sub {
25 $_[0]->set_name ("mailscroll T: $_[2] F: $_[1]"); 26 $_[0]->name ("mailscroll T: $_[2] F: $_[1]");
26 $_[0]->set_name_plural ("mailscrolls T: $_[2] F: $_[1]"); 27 $_[0]->name_pl ("mailscrolls T: $_[2] F: $_[1]");
27 $_[0]->set_value (1 * $price_fact); 28 $_[0]->value (1 * $price_fact);
28 }, 29 },
29 'plarg' 30 'plarg'
30 ], 31 ],
31 bag => [ 1, 'r_sack', sub { set_package (@_, bag => 5000) }, 'plarg' ], 32 bag => [ 1, 'r_sack', sub { set_package (@_, bag => 5000) }, 'plarg' ],
32 package => [ 5, 'r_sack', sub { set_package (@_, package => 50000) }, 'plarg' ], 33 package => [ 5, 'r_sack', sub { set_package (@_, package => 50000) }, 'plarg' ],
33 carton => [10, 'r_sack', sub { set_package (@_, carton => 100000) }, 'plarg' ], 34 carton => [10, 'r_sack', sub { set_package (@_, carton => 100000) }, 'plarg' ],
34 mailwarning => [ 35 mailwarning => [
35 0, 'diploma', 36 0, 'diploma',
36 sub { 37 sub {
37 $_[0]->set_name ("mailwarning T: $_[2] F: $_[1]"); 38 $_[0]->name ("mailwarning T: $_[2] F: $_[1]");
38 $_[0]->set_name_plural ("mailwarnings T: $_[2] F: $_[1]"); 39 $_[0]->name_pl ("mailwarnings T: $_[2] F: $_[1]");
39 $_[0]->set_value (0); 40 $_[0]->value (0);
40 }, 41 },
41 'plarg' 42 'plarg'
42 ], 43 ],
43); 44);
44 45
… …
72 $map->insert_object ($o, $x, $y); 73 $map->insert_object ($o, $x, $y);
73 $r 74 $r
74} 75}
75 76
76# this handler handles to notice the player that he has got mail 77# this handler handles to notice the player that he has got mail
77sub on_login { 78cf::attach_to_players
79 on_login => sub {
78 my ($pl) = @_; 80 my ($pl) = @_;
79 81
80 my $mails = CFMail::get_mail ($pl->ob->name); 82 my $mails = CFMail::get_mail ($pl->ob->name);
81 83
82 my $cnt = @{$mails || []}; 84 my $cnt = @{$mails || []};
83 85
84 if ($cnt == 1) { 86 if ($cnt == 1) {
85 $pl->ob->message ("You got one mail."); 87 $pl->ob->message ("You got one mail.");
86 } elsif ($cnt > 1) { 88 } elsif ($cnt > 1) {
87 $pl->ob->message ("You got $cnt mails."); 89 $pl->ob->message ("You got $cnt mails.");
88 } else { 90 } else {
89 $pl->ob->message ("You haven't got any mail."); 91 $pl->ob->message ("You haven't got any mail.");
92 }
90 } 93 },
91 94;
92 0
93}
94 95
95# this event handler handles receiving of mails 96# this event handler handles receiving of mails
96sub on_apply { 97cf::register_attachment ipo_mailbox =>
98 on_apply => sub {
97 my ($ev, $box, $pl) = @_; 99 my ($box, $pl) = @_;
98 100
99 my $cnt; 101 my $cnt;
100 my $mails = CFMail::get_mail ($pl->name) || []; 102 my $mails = CFMail::get_mail ($pl->name) || [];
101 103
102 # count the mails that are in the container 104 # count the mails that are in the container
103 # FIXME: the problem with on_apply is that it is called even when 105 # FIXME: the problem with on_apply is that it is called even when
104 # the player closes the container. so we get a 'You have X mails.' message 106 # the player closes the container. so we get a 'You have X mails.' message
105 # twice. - This bug existed also with the old python plugin 107 # twice. - This bug existed also with the old python plugin
106 108
107 my $plname = $pl->name; 109 my $plname = $pl->name;
108 for ($box->inv) { 110 for ($box->inv) {
109 $_->name =~ /\S+ F: \S+ T: \Q$plname\E/ 111 $_->name =~ /\S+ F: \S+ T: \Q$plname\E/
110 and $cnt++; 112 and $cnt++;
111 } 113 }
112 114
113 for (@$mails) { 115 for (@$mails) {
114 my ($type, $from, $msg) = @$_; 116 my ($type, $from, $msg) = @$_;
115 $type = $mailtypes{$type || 1} || ['scroll', 'mailscroll']; 117 $type = $mailtypes{$type || 1} || ['scroll', 'mailscroll'];
116 my $mail = cf::object::new $type->[0]; 118 my $mail = cf::object::new $type->[0];
117 $mail->set_name ("$type->[1] F: $from T: " .$pl->name); 119 $mail->name ("$type->[1] F: $from T: " .$pl->name);
118 $mail->set_name_plural ("$type->[1]s F: $from T: " .$pl->name); 120 $mail->name_pl ("$type->[1]s F: $from T: " .$pl->name);
119 $mail->set_message ($msg); 121 $mail->msg ($msg);
120 $mail->set_value (0); 122 $mail->value (0);
121 $mail->insert_in_ob ($box); 123 $mail->insert_in_ob ($box);
122 } 124 }
123 125
124 $cnt += @$mails; 126 $cnt += @$mails;
125 127
126 if ($cnt == 1) { 128 if ($cnt == 1) {
127 $pl->message ("You got one mail."); 129 $pl->message ("You got one mail.");
128 } elsif ($cnt > 1) { 130 } elsif ($cnt > 1) {
129 $pl->message ("You got $cnt mails."); 131 $pl->message ("You got $cnt mails.");
130 } else { 132 } else {
131 $pl->message ("You haven't got any mail."); 133 $pl->message ("You haven't got any mail.");
132 } 134 }
133 135
134 CFMail::clear_mail ($pl->name); 136 CFMail::clear_mail ($pl->name);
135 137 },
136 0;
137}
138
139# this event handler handles the sending of mails 138 # this event handler handles the sending of mails
140sub on_close { 139 on_close => sub {
141 my ($ev, $box, $pl) = @_; 140 my ($box, $pl) = @_;
142 141
143 my @mails; 142 my @mails;
144 143
145 my %sent_targets; 144 my %sent_targets;
146 145
147 for ($box->inv) { 146 for ($box->inv) {
148 if ($_->name =~ m/^mail(scroll|warning) T: (\S+) F: (\S+)/) { 147 if ($_->name =~ m/^mail(scroll|warning) T: (\S+) F: (\S+)/) {
149 CFMail::send_mail ($1 eq 'scroll' ? 1 : 3, $2, $3, $_->message); 148 CFMail::send_mail ($1 eq 'scroll' ? 1 : 3, $2, $3, $_->msg);
150 $pl->message ("Sent mail$1 to $2 (from $3)."); 149 $pl->message ("Sent mail$1 to $2 (from $3).");
151 $sent_targets{$2}++; 150 $sent_targets{$2}++;
152 push @mails, $_; 151 push @mails, $_;
153 152
154 } elsif ($_->name =~ m/^mail(scroll|warning) F: (\S+) T: (\S+)/) { 153 } elsif ($_->name =~ m/^mail(scroll|warning) F: (\S+) T: (\S+)/) {
155 # this is for mails that remain in the queue for the player 154 # this is for mails that remain in the queue for the player
156 CFMail::store_mail ($1 eq 'scroll' ? 1 : 3, $3, $2, $_->message); 155 CFMail::store_mail ($1 eq 'scroll' ? 1 : 3, $3, $2, $_->msg);
157 push @mails, $_; 156 push @mails, $_;
158 } 157 }
159 } 158 }
160 159
161 $_->remove for @mails; 160 $_->remove for @mails;
162 161
163 notify_players (%sent_targets); 162 notify_players (%sent_targets);
164 163 },
165 0; 164;
166}
167 165
168# this is the main command interface for the IPO NPC 166# this is the main command interface for the IPO NPC
169cf::register_script_function "ipo::command" => sub { 167cf::register_script_function "ipo::command" => sub {
170 my ($who, $msg, $npc) = @_; 168 my ($who, $msg, $npc) = @_;
171 my ($cmd, $arguments) = split /\s+/, $msg, 2; 169 my ($cmd, $arguments) = split /\s+/, $msg, 2;
… …
186 create_object ($pr->[1], $who->map, $x, $y, $pr->[2], $who->name, $arguments); 184 create_object ($pr->[1], $who->map, $x, $y, $pr->[2], $who->name, $arguments);
187 $who->reply ($npc, "Here is your $cmd"); 185 $who->reply ($npc, "Here is your $cmd");
188 } 186 }
189 187
190 } elsif ($cmd eq 'receive') { 188 } elsif ($cmd eq 'receive') {
191 my $storage = cf::map::get_map ("/planes/IPO_storage"); 189 my $storage = cf::map::find ("/planes/IPO_storage");
192 unless ($storage) { 190 unless ($storage) {
193 $who->reply ($npc, "Sorry, our package delivery service is currently in strike. Please come back later."); 191 $who->reply ($npc, "Sorry, our package delivery service is currently in strike. Please come back later.");
194 return 1; 192 return 1;
195 } 193 }
196 194
… …
213 unless ($arguments =~ /^\S+$/) { 211 unless ($arguments =~ /^\S+$/) {
214 $who->reply ($npc, "Send to who?"); 212 $who->reply ($npc, "Send to who?");
215 return 1; 213 return 1;
216 } 214 }
217 215
218 my $storage = cf::map::get_map ("/planes/IPO_storage"); 216 my $storage = cf::map::find ("/planes/IPO_storage");
219 unless ($storage) { 217 unless ($storage) {
220 $who->reply ($npc, "Sorry, our package delivery service is currently in strike. Please come back later."); 218 $who->reply ($npc, "Sorry, our package delivery service is currently in strike. Please come back later.");
221 return 1; 219 return 1;
222 } 220 }
223 221
224 my $cnt; 222 my $cnt;
225 for ($who->inv) { 223 for ($who->inv) {
226 if ($_->name () =~ /^(bag|package|carton) T: \Q$arguments\E F: (\S+)$/) { 224 if ($_->name () =~ /^(bag|package|carton) T: \Q$arguments\E F: (\S+)$/) {
227 $_->set_name ("$1 F: $2 T: $arguments"); 225 $_->name ("$1 F: $2 T: $arguments");
228 $_->teleport ($storage, 2, 2); 226 $_->teleport ($storage, 2, 2);
229 $cnt++; 227 $cnt++;
230 } 228 }
231 } 229 }
232 230
… …
239 } 237 }
240 238
241 } else { 239 } else {
242 $who->reply ($npc, 240 $who->reply ($npc,
243 sprintf "How can I help you?\n" 241 sprintf "How can I help you?\n"
244 ."Here is a quick list of commands I understand:\n\n" 242 . "Here is a quick list of commands I understand:\n\n"
245 ."- pen (%s platinum)\n" 243 . "- pen (%s platinum)\n"
246 ."- literacy (%s platinum)\n" 244 . "- literacy (%s platinum)\n"
247 ."- mailscroll <friend> (%s platinum)\n" 245 . "- mailscroll <friend> (%s platinum)\n"
248 ."- bag <friend> (%s platinum)\n" 246 . "- bag <friend> (%s platinum)\n"
249 ."- package <friend> (%s platinum)\n" 247 . "- package <friend> (%s platinum)\n"
250 ."- carton <friend> (%s platinum)\n" 248 . "- carton <friend> (%s platinum)\n"
251 ."- send <friend> (send bags/packages/cartons)\n" 249 . "- send <friend> (send bags/packages/cartons)\n"
252 ."- receive (to receive packages for you)\n" 250 . "- receive (to receive packages for you)\n"
253 .($who->flag (cf::FLAG_WIZ) ? "- mailwarning <player>" : ""), 251 . ($who->flag (cf::FLAG_WIZ) ? "- mailwarning <player>" : ""),
254 40, 1000, 1, 1, 5, 10 252 40, 1000, 1, 1, 5, 10
255 ); 253 );
256 } 254 }
257 1 255 1
258}; 256};
259 257
260package CFMail; 258package CFMail;
259
261use POSIX qw/strftime/; 260use POSIX qw/strftime/;
262use CFDB; 261use CFDB;
263 262
264my $MAILDB = CFDB->new (db_file => cf::localdir . "/crossfiremail.perl"); 263my $MAILDB = CFDB->new (db_file => cf::localdir . "/crossfiremail.perl");
265 264

Diff Legend

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