--- deliantra/server/ext/commands.ext 2007/03/02 14:44:52 1.31 +++ deliantra/server/ext/commands.ext 2007/04/13 05:32:12 1.40 @@ -1,4 +1,4 @@ -#! perl +#! perl # MANDATORY use POSIX (); @@ -89,6 +89,29 @@ 1 }; +cf::register_command seen => sub { + my ($pl, $args) = @_; + + if (my ($login) = $args =~ /(\S+)/) { + if ($login eq $pl->name) { + $pl->message ("Very funny, $login. Ha. Ha.", cf::NDI_UNIQUE); + } elsif (cf::player::find_active $login) { + $pl->message ("$login is right here on this server!", cf::NDI_UNIQUE); + } elsif (cf::player::exists $login + and stat cf::player::path $login) { + my $time = (stat _)[9]; + + $pl->message ("$login was last seen here " + . (POSIX::strftime "%Y-%m-%d %H:%M:%S +0000", gmtime $time) + . " which was " . (int +(time - $time) / 3600) . " hours ago.", cf::NDI_UNIQUE); + } else { + $pl->message ("No player named $login is known to me.", cf::NDI_UNIQUE); + } + } else { + $pl->message ("Usage: seen ", cf::NDI_UNIQUE); + } +}; + cf::register_command body => sub { my ($ob) = @_; @@ -118,13 +141,7 @@ cf::register_command mark => sub { my ($pl, $arg) = @_; - unless (length $arg) { - my $ob = $pl->find_marked_object; - - $pl->reply (undef, $ob - ? (sprintf "%s %s * is marked.", $ob->name, $ob->title) - : "You have no marked object."); - } else { + if (length $arg) { my $ob = $pl->find_best_object_match ($arg); return $pl->reply (undef, "Could not find an object that matches $arg") @@ -132,17 +149,13 @@ $pl->contr->mark ($ob); $pl->reply (undef, (sprintf "Marked item %s", $ob->name, $ob->title)); - } - - 1 -}; - -cf::register_command who => sub { - my ($ob, $arg) = @_; - - $ob->speed_left ($ob->speed_left - 0.25); + } else { + my $ob = $pl->find_marked_object; - $ob->reply (undef, (join "\n", who_listing $ob->may ("extended_who")), cf::NDI_UNIQUE | cf::NDI_DK_ORANGE); + $pl->reply (undef, $ob + ? (sprintf "%s %s * is marked.", $ob->name, $ob->title) + : "You have no marked object."); + } 1 }; @@ -152,15 +165,15 @@ cf::register_command $cmd => sub { my ($ob, $arg) = @_; - return $ob->reply (undef, "Can't $cmd into a non adjacent square.") + $ob->reply (undef, "Can't $cmd into a non adjacent square.") if $arg < 0 or $arg >= 9; $ob->contr->$oncmd (1); - $ob->move ($arg); + $ob->move_player ($arg); 1 }; - + cf::register_command "${cmd}_stop" => sub { my ($ob) = @_; @@ -259,6 +272,19 @@ 1 }; +cf::register_command 'output-rate' => sub { + my ($ob, $arg) = @_; + + return $ob->reply (undef, sprintf "Output rate is presently %dbps.", $ob->contr->ns->max_rate / $cf::TICK) + unless $arg > 0; + + # minimum is 2k/s + $ob->contr->ns->max_rate ((List::Util::max 2048, $arg) * $cf::TICK); + $ob->reply (undef, sprintf "Output rate now set to %dbps.", $ob->contr->ns->max_rate / $cf::TICK); + + 1 +}; + cf::register_command 'output-count' => sub { my ($ob, $arg) = @_; @@ -274,11 +300,11 @@ cf::register_command 'output-sync' => sub { my ($ob, $arg) = @_; - return $ob->reply (undef, "Output sync time is presently " . $ob->contr->outputs_sync) - unless $arg > 0; + return $ob->reply (undef, sprintf "Output sync time is presently %.1fs", $ob->contr->outputs_sync * $cf::TICK) + unless length $arg; - $ob->contr->outputs_sync ($arg); - $ob->reply (undef, "Output sync time now set to " . $ob->contr->outputs_sync); + $ob->contr->outputs_sync ($arg / $cf::TICK); + $ob->reply (undef, sprintf "Output sync time now set to %.1fs", $ob->contr->outputs_sync * $cf::TICK); 1 };