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.33 by pippijn, Fri Mar 2 15:09:05 2007 UTC vs.
Revision 1.44 by root, Mon May 7 07:47:32 2007 UTC

1#! perl 1#! perl # MANDATORY
2 2
3use POSIX (); 3use POSIX ();
4 4
5# miscellaneous commands 5# miscellaneous commands
6 6
… …
38 1 38 1
39} 39}
40 40
41sub ext::schmorp_irc::users; # HACK: TODO: replace by signal 41sub ext::schmorp_irc::users; # HACK: TODO: replace by signal
42 42
43sub who_listing(;$) { 43sub who_listing(;$$) {
44 my ($privileged) = @_; 44 my ($privileged, $select) = @_;
45 45
46 my ($numwiz, $numafk) = (0, 0); 46 my ($numwiz, $numafk) = (0, 0);
47 my @pl; 47 my @pl;
48 48
49 foreach my $pl (cf::player::list) { 49 foreach my $pl (cf::player::list) {
… …
59 push @pl, $pl; 59 push @pl, $pl;
60 } 60 }
61 61
62 ( 62 (
63 "Total Players in The World. (" . (scalar @pl) . ") -- WIZ($numwiz) AFK($numafk) BOT(0)", 63 "Total Players in The World. (" . (scalar @pl) . ") -- WIZ($numwiz) AFK($numafk) BOT(0)",
64 ( 64 (grep /$select/,
65 map { 65 map {
66 my ($pl, $ob, $ns) = ($_, $_->ob, $_->ns); 66 my ($pl, $ob, $ns) = ($_, $_->ob, $_->ns);
67 67
68 "* " . $ob->name . "/" . $ob->level . " " . (length $pl->own_title ? $pl->own_title : "the " . $pl->title) 68 "* " . $ob->name . "/" . $ob->level . " " . (length $pl->own_title ? $pl->own_title : "the " . $pl->title)
69 . ($pl->peaceful ? " [peaceful]" : " [HOSTILE]") 69 . ($pl->peaceful ? " [peaceful]" : " [HOSTILE]")
70 . ($ns->afk ? " [AFK]" : "") 70 . ($ns->afk ? " [AFK]" : "")
71 . ($ob->flag (cf::FLAG_WIZ) ? " [WIZ]" : "") 71 . ($ob->flag (cf::FLAG_WIZ) ? " [WIZ]" : "")
72 . " [" . $pl->ns->version . "]" 72 . " [" . $pl->ns->version . "]"
73 . " [" . ($pl->peaceful || $privileged ? $ob->map->visible_name : $ob->region->name) . "]" 73 . " [" . ($pl->peaceful || $privileged ? $ob->map->visible_name : $ob->region->name) . "]"
74 . (sprintf " [rtt %.3fs]", $pl->ns->rtt * 1e-6) 74 . (sprintf " [rtt %.3fs]", $pl->ns->rtt * 1e-6)
75 . ($privileged ? " " . $pl->ns->host : "") 75 . ($privileged ? " " . $pl->ns->host : "")
76 } sort { (lc $a->ob->name) cmp (lc $b->ob->name) } @pl 76 } sort { (lc $a->ob->name) cmp (lc $b->ob->name) } @pl
77 ), 77 ),
78 eval { "* IRC: " . join ", ", ext::schmorp_irc::users }, 78 eval { "* IRC: " . join ", ", ext::schmorp_irc::users },
79 ) 79 )
80} 80}
81 81
82cf::register_command who => sub { 82cf::register_command who => sub {
83 my ($ob, $arg) = @_; 83 my ($ob, $arg) = @_;
84 84
85 $ob->speed_left ($ob->speed_left - 0.25); 85 $ob->speed_left ($ob->speed_left - 4);
86 86
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"), $arg), cf::NDI_UNIQUE | cf::NDI_DK_ORANGE);
88 88
89 1
90};
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);
89 1 112 }
90}; 113};
91 114
92cf::register_command body => sub { 115cf::register_command body => sub {
93 my ($ob) = @_; 116 my ($ob) = @_;
94 117
95 my @body_locations = ("in your range slot", "on your arm", "on your body", "on your head",
96 "around your neck", "in your skill slot", "on your finger", "around your shoulders",
97 "on your feet", "on your hands", "around your wrists", "around your waist");
98
99 # Too hard to try and make a header that lines everything up, so just 118 # Too hard to try and make a header that lines everything up, so just
100 # give a description. (comment from C++) 119 # give a description. (comment from C++)
120 my $reply =
101 $ob->reply (undef, "The first column is the name of the body location."); 121 "The first column is the name of the body location.\n"
102 $ob->reply (undef, "The second column is how many of those locations your body has."); 122 . "The second column is how many of those locations your body has.\n"
103 $ob->reply (undef, "The third column is how many slots in that location are available."); 123 . "The third column is how many slots in that location are available.\n";
104 124
105 for (0 .. scalar @body_locations - 1) { 125 $reply .= sprintf "%-20s %3s %5s\n", "Location", "You", "Avail";
106 $ob->reply (undef, (sprintf "%-30s %5d %5d", $body_locations[$_], $ob->body_info($_), $ob->body_used($_))) 126 for (0 .. cf::NUM_BODY_LOCATIONS - 1) {
127 my $msg = cf::object::slot_nonuse_name $_;
128 $msg =~ s/^.*? a //;
129 $reply .= sprintf "%-20s %3d %5d\n", $msg, $ob->slot_info ($_), $ob->slot_used ($_)
107 if $ob->body_info($_) or $ob->body_used($_); 130 if $ob->slot_info ($_) or $ob->slot_used ($_);
108 } 131 }
109 132
110 $ob->reply (undef, "You are not allowed to wear armor") 133 $reply .= "You are not allowed to wear armor\n"
111 unless $ob->flag (cf::FLAG_USE_ARMOUR); 134 unless $ob->flag (cf::FLAG_USE_ARMOUR);
112 $ob->reply (undef, "You are not allowed to use weapons") 135 $reply .= "You are not allowed to use weapons\n"
113 unless $ob->flag (cf::FLAG_USE_WEAPON); 136 unless $ob->flag (cf::FLAG_USE_WEAPON);
137
138 $ob->reply (undef, $reply);
114 139
115 1 140 1
116}; 141};
117 142
118cf::register_command mark => sub { 143cf::register_command mark => sub {
… …
135 } 160 }
136 161
137 1 162 1
138}; 163};
139 164
140cf::register_command who => sub {
141 my ($ob, $arg) = @_;
142
143 $ob->speed_left ($ob->speed_left - 0.25);
144
145 $ob->reply (undef, (join "\n", who_listing $ob->may ("extended_who")), cf::NDI_UNIQUE | cf::NDI_DK_ORANGE);
146
147 1
148};
149
150for my $cmd ("run", "fire") { 165for my $cmd ("run", "fire") {
151 my $oncmd = "${cmd}_on"; 166 my $oncmd = "${cmd}_on";
152 cf::register_command $cmd => sub { 167 cf::register_command $cmd => sub {
153 my ($ob, $arg) = @_; 168 my ($ob, $arg) = @_;
154 169
170 $ob->reply (undef, "Can't $cmd into a non adjacent square.")
171 if $arg < 0 or $arg >= 9;
172
155 $ob->contr->$oncmd (1); 173 $ob->contr->$oncmd (1);
156
157 return $ob->reply (undef, "Can't $cmd into a non adjacent square.")
158 if $arg < 0 or $arg >= 9;
159
160 $ob->move ($arg); 174 $ob->move_player ($arg);
161 175
162 1 176 1
163 }; 177 };
164 178
165 cf::register_command "${cmd}_stop" => sub { 179 cf::register_command "${cmd}_stop" => sub {
166 my ($ob) = @_; 180 my ($ob) = @_;
167 181
168 $ob->contr->$oncmd (0); 182 $ob->contr->$oncmd (0);
169 183
… …
258 $ob->reply (undef, $ob->contr->braced ? "You are braced." : "Not braced."); 272 $ob->reply (undef, $ob->contr->braced ? "You are braced." : "Not braced.");
259 273
260 1 274 1
261}; 275};
262 276
277cf::register_command 'output-rate' => sub {
278 my ($ob, $arg) = @_;
279
280 return $ob->reply (undef, sprintf "Output rate is presently %dbps.", $ob->contr->ns->max_rate / $cf::TICK)
281 unless $arg > 0;
282
283 # minimum is 2k/s
284 $ob->contr->ns->max_rate ((List::Util::max 2048, $arg) * $cf::TICK);
285 $ob->reply (undef, sprintf "Output rate now set to %dbps.", $ob->contr->ns->max_rate / $cf::TICK);
286
287 1
288};
289
263cf::register_command 'output-count' => sub { 290cf::register_command 'output-count' => sub {
264 my ($ob, $arg) = @_; 291 my ($ob, $arg) = @_;
265 292
266 return $ob->reply (undef, "Output count is presently " . $ob->contr->outputs_count) 293 return $ob->reply (undef, "Output count is presently " . $ob->contr->outputs_count)
267 unless $arg > 0; 294 unless $arg > 0;
268 295
296 $arg = 4 if $arg < 4;
297
269 $ob->contr->outputs_count ($arg); 298 $ob->contr->outputs_count ($arg);
270 $ob->reply (undef, "Output count now set to " . $ob->contr->outputs_count); 299 $ob->reply (undef, "Output count now set to " . $ob->contr->outputs_count);
271 300
272 1 301 1
273}; 302};
274 303
275cf::register_command 'output-sync' => sub { 304cf::register_command 'output-sync' => sub {
276 my ($ob, $arg) = @_; 305 my ($ob, $arg) = @_;
277 306
278 return $ob->reply (undef, "Output sync time is presently " . $ob->contr->outputs_sync) 307 return $ob->reply (undef, sprintf "Output sync time is presently %.1fs", $ob->contr->outputs_sync * $cf::TICK)
279 unless $arg > 0; 308 unless length $arg;
280 309
310 $arg = 0.5 if $arg < 0.5;
311
281 $ob->contr->outputs_sync ($arg); 312 $ob->contr->outputs_sync ($arg / $cf::TICK);
282 $ob->reply (undef, "Output sync time now set to " . $ob->contr->outputs_sync); 313 $ob->reply (undef, sprintf "Output sync time now set to %.1fs", $ob->contr->outputs_sync * $cf::TICK);
283 314
284 1 315 1
285}; 316};
286 317
287# XXX: This has a bug. After one sets his wimpy level to 0 and resets it to 318# 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