ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/server/ext/commands.ext
(Generate patch)

Comparing deliantra/server/ext/commands.ext (file contents):
Revision 1.26 by pippijn, Fri Mar 2 11:23:17 2007 UTC vs.
Revision 1.40 by root, Fri Apr 13 05:32:12 2007 UTC

1#! perl 1#! perl # MANDATORY
2 2
3use POSIX (); 3use POSIX ();
4 4
5# miscellaneous commands 5# miscellaneous commands
6 6
… …
17 17
18 if (length $from) { 18 if (length $from) {
19 $item = $ob->find_best_object_match ($from) 19 $item = $ob->find_best_object_match ($from)
20 or return $ob->message ("rename: could not find a matching item to rename."); 20 or return $ob->message ("rename: could not find a matching item to rename.");
21 } else { 21 } else {
22 $item = $ob->find_marked_object () 22 $item = $ob->find_marked_object
23 or return $ob->message ("rename: no from name and no marked item found to rename."); 23 or return $ob->message ("rename: no from name and no marked item found to rename.");
24 } 24 }
25 25
26 $item->custom_name (length $to ? $to : undef); 26 $item->custom_name (length $to ? $to : undef);
27 27
… …
87 $ob->reply (undef, (join "\n", who_listing $ob->may ("extended_who")), cf::NDI_UNIQUE | cf::NDI_DK_ORANGE); 87 $ob->reply (undef, (join "\n", who_listing $ob->may ("extended_who")), cf::NDI_UNIQUE | cf::NDI_DK_ORANGE);
88 88
89 1 89 1
90}; 90};
91 91
92cf::register_command seen => sub {
93 my ($pl, $args) = @_;
94
95 if (my ($login) = $args =~ /(\S+)/) {
96 if ($login eq $pl->name) {
97 $pl->message ("Very funny, $login. Ha. Ha.", cf::NDI_UNIQUE);
98 } elsif (cf::player::find_active $login) {
99 $pl->message ("$login is right here on this server!", cf::NDI_UNIQUE);
100 } elsif (cf::player::exists $login
101 and stat cf::player::path $login) {
102 my $time = (stat _)[9];
103
104 $pl->message ("$login was last seen here "
105 . (POSIX::strftime "%Y-%m-%d %H:%M:%S +0000", gmtime $time)
106 . " which was " . (int +(time - $time) / 3600) . " hours ago.", cf::NDI_UNIQUE);
107 } else {
108 $pl->message ("No player named $login is known to me.", cf::NDI_UNIQUE);
109 }
110 } else {
111 $pl->message ("Usage: seen <player>", cf::NDI_UNIQUE);
112 }
113};
114
115cf::register_command body => sub {
116 my ($ob) = @_;
117
118 my @body_locations = ("in your range slot", "on your arm", "on your body", "on your head",
119 "around your neck", "in your skill slot", "on your finger", "around your shoulders",
120 "on your feet", "on your hands", "around your wrists", "around your waist");
121
122 # Too hard to try and make a header that lines everything up, so just
123 # give a description. (comment from C++)
124 $ob->reply (undef, "The first column is the name of the body location.");
125 $ob->reply (undef, "The second column is how many of those locations your body has.");
126 $ob->reply (undef, "The third column is how many slots in that location are available.");
127
128 for (0 .. scalar @body_locations - 1) {
129 $ob->reply (undef, (sprintf "%-30s %5d %5d", $body_locations[$_], $ob->body_info($_), $ob->body_used($_)))
130 if $ob->body_info($_) or $ob->body_used($_);
131 }
132
133 $ob->reply (undef, "You are not allowed to wear armor")
134 unless $ob->flag (cf::FLAG_USE_ARMOUR);
135 $ob->reply (undef, "You are not allowed to use weapons")
136 unless $ob->flag (cf::FLAG_USE_WEAPON);
137
138 1
139};
140
141cf::register_command mark => sub {
142 my ($pl, $arg) = @_;
143
144 if (length $arg) {
145 my $ob = $pl->find_best_object_match ($arg);
146
147 return $pl->reply (undef, "Could not find an object that matches $arg")
148 unless $ob;
149
150 $pl->contr->mark ($ob);
151 $pl->reply (undef, (sprintf "Marked item %s", $ob->name, $ob->title));
152 } else {
153 my $ob = $pl->find_marked_object;
154
155 $pl->reply (undef, $ob
156 ? (sprintf "%s %s * is marked.", $ob->name, $ob->title)
157 : "You have no marked object.");
158 }
159
160 1
161};
162
163for my $cmd ("run", "fire") {
164 my $oncmd = "${cmd}_on";
165 cf::register_command $cmd => sub {
166 my ($ob, $arg) = @_;
167
168 $ob->reply (undef, "Can't $cmd into a non adjacent square.")
169 if $arg < 0 or $arg >= 9;
170
171 $ob->contr->$oncmd (1);
172 $ob->move_player ($arg);
173
174 1
175 };
176
177 cf::register_command "${cmd}_stop" => sub {
178 my ($ob) = @_;
179
180 $ob->contr->$oncmd (0);
181
182 1
183 };
184}
185
92cf::register_command mapinfo => sub { 186cf::register_command mapinfo => sub {
93 my ($ob) = @_; 187 my ($ob) = @_;
94 188
95 my $map = $ob->map 189 my $map = $ob->map
96 or return; 190 or return;
… …
110 $ob->reply (undef, (sprintf "You are %s.\n%s", $reg->longname, $reg->msg)); 204 $ob->reply (undef, (sprintf "You are %s.\n%s", $reg->longname, $reg->msg));
111 205
112 1 206 1
113}; 207};
114 208
209sub _set_mode($$$@) {
210 my ($name, $ob, $arg, $slot, @choices) = @_;
211
212 my $oldmode = $ob->contr->$slot;
213
214 return $ob->reply (undef, "$name is set to $choices[$oldmode]")
215 unless $arg;
216
217 my ($idx) = grep $choices[$_] eq $arg, 0 .. $#choices
218 or return $ob->reply (undef, "$name: Unknown options '$arg', valid options are @choices"), 1;
219
220 $ob->contr->$slot ($idx);
221 $ob->reply (undef, "$name" . ($oldmode == $ob->contr->unapply ? "" : " now") . " set to " . $choices[$ob->contr->$slot]);
222}
223
115cf::register_command applymode => sub { 224cf::register_command applymode => sub {
116 my ($ob, $arg) = @_; 225 my ($ob, $arg) = @_;
117 my @types = ("nochoice", "never", "always");
118 my $mapping = {
119 nochoice => 1,
120 never => 2,
121 always => 3,
122 };
123 226
124 my $oldmode = $ob->contr->unapply; 227 _set_mode "applymode", $ob, $arg, unapply => qw(nochoice never always);
125 my $oldmode_name = $types[$oldmode];
126
127 return $ob->reply (undef, "applymode is set to $oldmode_name")
128 unless $arg;
129
130 return $ob->reply (undef, "applymode: Unknown options '$arg', valid options are @types")
131 unless $mapping->{$arg};
132
133 $ob->contr->unapply ($mapping->{$arg} - 1); # HACK: because of the $mapping->{$arg} check before, where $arg should not be 0
134 # but $arg would be 0 if a user enters an incorrect value
135 $ob->reply (undef, "applymode" . ($oldmode == $ob->contr->unapply ? "" : " now") . " set to " . $types[$ob->contr->unapply]);
136 228
137 1 229 1
138}; 230};
139 231
140cf::register_command petmode => sub { 232cf::register_command petmode => sub {
141 my ($ob, $arg) = @_; 233 my ($ob, $arg) = @_;
142 my @types = ("normal", "sad", "defend", "arena");
143 my $mapping = {
144 normal => 1,
145 sad => 2,
146 defend => 3,
147 arena => 4,
148 };
149 234
150 my $oldtype = $ob->contr->petmode; 235 _set_mode "petmode", $ob, $arg, petmode => qw(normal sad defend arena);
151 my $oldtype_name = $types[$oldtype];
152
153 return $ob->reply (undef, "petmode is set to $oldtype_name")
154 unless $arg;
155
156 return $ob->reply (undef, "petmode: Unknown options '$arg', valid options are @types")
157 unless $mapping->{$arg};
158
159 $ob->contr->petmode ($mapping->{$arg} - 1); # HACK: because of the $mapping->{$arg} check before, where $arg should not be 0
160 # but $arg would be 0 if a user enters an incorrect value
161 $ob->reply (undef, "petmode" . ($oldtype == $ob->contr->petmode ? "" : " now") . " set to " . $types[$ob->contr->petmode]);
162 236
163 1 237 1
164}; 238};
165 239
166cf::register_command usekeys => sub { 240cf::register_command usekeys => sub {
167 my ($ob, $arg) = @_; 241 my ($ob, $arg) = @_;
168 my @types = ("inventory", "keyrings", "containers");
169 my $mapping = {
170 inventory => 1,
171 keyrings => 2,
172 containers => 3,
173 };
174 242
175 my $oldtype = $ob->contr->usekeys; 243 _set_mode "usekeys", $ob, $arg, usekeys => qw(inventory keyrings containers);
176 my $oldtype_name = $types[$oldtype];
177
178 return $ob->reply (undef, "usekeys is set to $oldtype_name")
179 unless $arg;
180
181 return $ob->reply (undef, "usekeys: Unknown options '$arg', valid options are @types")
182 unless $mapping->{$arg};
183
184 $ob->contr->usekeys ($mapping->{$arg} - 1); # HACK: because of the $mapping->{$arg} check before, where $arg should not be 0
185 # but $arg would be 0 if a user enters an incorrect value
186 $ob->reply (undef, "usekeys" . ($oldtype == $ob->contr->usekeys ? "" : " now") . " set to " . $types[$ob->contr->usekeys]);
187 244
188 1 245 1
189}; 246};
190 247
191cf::register_command afk => sub { 248cf::register_command afk => sub {
… …
213 $ob->reply (undef, $ob->contr->braced ? "You are braced." : "Not braced."); 270 $ob->reply (undef, $ob->contr->braced ? "You are braced." : "Not braced.");
214 271
215 1 272 1
216}; 273};
217 274
275cf::register_command 'output-rate' => sub {
276 my ($ob, $arg) = @_;
277
278 return $ob->reply (undef, sprintf "Output rate is presently %dbps.", $ob->contr->ns->max_rate / $cf::TICK)
279 unless $arg > 0;
280
281 # minimum is 2k/s
282 $ob->contr->ns->max_rate ((List::Util::max 2048, $arg) * $cf::TICK);
283 $ob->reply (undef, sprintf "Output rate now set to %dbps.", $ob->contr->ns->max_rate / $cf::TICK);
284
285 1
286};
287
218cf::register_command 'output-count' => sub { 288cf::register_command 'output-count' => sub {
219 my ($ob, $arg) = @_; 289 my ($ob, $arg) = @_;
220 290
221 return $ob->reply (undef, "Output count is presently " . $ob->contr->outputs_count) 291 return $ob->reply (undef, "Output count is presently " . $ob->contr->outputs_count)
222 unless $arg > 0; 292 unless $arg > 0;
… …
228}; 298};
229 299
230cf::register_command 'output-sync' => sub { 300cf::register_command 'output-sync' => sub {
231 my ($ob, $arg) = @_; 301 my ($ob, $arg) = @_;
232 302
233 return $ob->reply (undef, "Output sync time is presently " . $ob->contr->outputs_sync) 303 return $ob->reply (undef, sprintf "Output sync time is presently %.1fs", $ob->contr->outputs_sync * $cf::TICK)
234 unless $arg > 0; 304 unless length $arg;
235 305
236 $ob->contr->outputs_sync ($arg); 306 $ob->contr->outputs_sync ($arg / $cf::TICK);
237 $ob->reply (undef, "Output sync time now set to " . $ob->contr->outputs_sync); 307 $ob->reply (undef, sprintf "Output sync time now set to %.1fs", $ob->contr->outputs_sync * $cf::TICK);
238 308
239 1 309 1
240}; 310};
241 311
242# XXX: This has a bug. After one sets his wimpy level to 0 and resets it to 312# XXX: This has a bug. After one sets his wimpy level to 0 and resets it to

Diff Legend

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