--- deliantra/server/ext/commands.ext 2007/03/02 11:23:17 1.26 +++ deliantra/server/ext/commands.ext 2007/03/02 14:44:52 1.31 @@ -19,7 +19,7 @@ $item = $ob->find_best_object_match ($from) or return $ob->message ("rename: could not find a matching item to rename."); } else { - $item = $ob->find_marked_object () + $item = $ob->find_marked_object or return $ob->message ("rename: no from name and no marked item found to rename."); } @@ -89,6 +89,87 @@ 1 }; +cf::register_command body => sub { + my ($ob) = @_; + + my @body_locations = ("in your range slot", "on your arm", "on your body", "on your head", + "around your neck", "in your skill slot", "on your finger", "around your shoulders", + "on your feet", "on your hands", "around your wrists", "around your waist"); + + # Too hard to try and make a header that lines everything up, so just + # give a description. (comment from C++) + $ob->reply (undef, "The first column is the name of the body location."); + $ob->reply (undef, "The second column is how many of those locations your body has."); + $ob->reply (undef, "The third column is how many slots in that location are available."); + + for (0 .. scalar @body_locations - 1) { + $ob->reply (undef, (sprintf "%-30s %5d %5d", $body_locations[$_], $ob->body_info($_), $ob->body_used($_))) + if $ob->body_info($_) or $ob->body_used($_); + } + + $ob->reply (undef, "You are not allowed to wear armor") + unless $ob->flag (cf::FLAG_USE_ARMOUR); + $ob->reply (undef, "You are not allowed to use weapons") + unless $ob->flag (cf::FLAG_USE_WEAPON); + + 1 +}; + +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 { + my $ob = $pl->find_best_object_match ($arg); + + return $pl->reply (undef, "Could not find an object that matches $arg") + unless $ob; + + $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); + + $ob->reply (undef, (join "\n", who_listing $ob->may ("extended_who")), cf::NDI_UNIQUE | cf::NDI_DK_ORANGE); + + 1 +}; + +for my $cmd ("run", "fire") { + my $oncmd = "${cmd}_on"; + cf::register_command $cmd => sub { + my ($ob, $arg) = @_; + + return $ob->reply (undef, "Can't $cmd into a non adjacent square.") + if $arg < 0 or $arg >= 9; + + $ob->contr->$oncmd (1); + $ob->move ($arg); + + 1 + }; + + cf::register_command "${cmd}_stop" => sub { + my ($ob) = @_; + + $ob->contr->$oncmd (0); + + 1 + }; +} + cf::register_command mapinfo => sub { my ($ob) = @_; @@ -112,78 +193,41 @@ 1 }; -cf::register_command applymode => sub { - my ($ob, $arg) = @_; - my @types = ("nochoice", "never", "always"); - my $mapping = { - nochoice => 1, - never => 2, - always => 3, - }; +sub _set_mode($$$@) { + my ($name, $ob, $arg, $slot, @choices) = @_; - my $oldmode = $ob->contr->unapply; - my $oldmode_name = $types[$oldmode]; + my $oldmode = $ob->contr->$slot; - return $ob->reply (undef, "applymode is set to $oldmode_name") + return $ob->reply (undef, "$name is set to $choices[$oldmode]") unless $arg; - return $ob->reply (undef, "applymode: Unknown options '$arg', valid options are @types") - unless $mapping->{$arg}; + my ($idx) = grep $choices[$_] eq $arg, 0 .. $#choices + or return $ob->reply (undef, "$name: Unknown options '$arg', valid options are @choices"), 1; + + $ob->contr->$slot ($idx); + $ob->reply (undef, "$name" . ($oldmode == $ob->contr->unapply ? "" : " now") . " set to " . $choices[$ob->contr->$slot]); +} + +cf::register_command applymode => sub { + my ($ob, $arg) = @_; - $ob->contr->unapply ($mapping->{$arg} - 1); # HACK: because of the $mapping->{$arg} check before, where $arg should not be 0 - # but $arg would be 0 if a user enters an incorrect value - $ob->reply (undef, "applymode" . ($oldmode == $ob->contr->unapply ? "" : " now") . " set to " . $types[$ob->contr->unapply]); + _set_mode "applymode", $ob, $arg, unapply => qw(nochoice never always); 1 }; cf::register_command petmode => sub { my ($ob, $arg) = @_; - my @types = ("normal", "sad", "defend", "arena"); - my $mapping = { - normal => 1, - sad => 2, - defend => 3, - arena => 4, - }; - - my $oldtype = $ob->contr->petmode; - my $oldtype_name = $types[$oldtype]; - - return $ob->reply (undef, "petmode is set to $oldtype_name") - unless $arg; - return $ob->reply (undef, "petmode: Unknown options '$arg', valid options are @types") - unless $mapping->{$arg}; - - $ob->contr->petmode ($mapping->{$arg} - 1); # HACK: because of the $mapping->{$arg} check before, where $arg should not be 0 - # but $arg would be 0 if a user enters an incorrect value - $ob->reply (undef, "petmode" . ($oldtype == $ob->contr->petmode ? "" : " now") . " set to " . $types[$ob->contr->petmode]); + _set_mode "petmode", $ob, $arg, petmode => qw(normal sad defend arena); 1 }; cf::register_command usekeys => sub { my ($ob, $arg) = @_; - my @types = ("inventory", "keyrings", "containers"); - my $mapping = { - inventory => 1, - keyrings => 2, - containers => 3, - }; - - my $oldtype = $ob->contr->usekeys; - my $oldtype_name = $types[$oldtype]; - - return $ob->reply (undef, "usekeys is set to $oldtype_name") - unless $arg; - - return $ob->reply (undef, "usekeys: Unknown options '$arg', valid options are @types") - unless $mapping->{$arg}; - $ob->contr->usekeys ($mapping->{$arg} - 1); # HACK: because of the $mapping->{$arg} check before, where $arg should not be 0 - # but $arg would be 0 if a user enters an incorrect value - $ob->reply (undef, "usekeys" . ($oldtype == $ob->contr->usekeys ? "" : " now") . " set to " . $types[$ob->contr->usekeys]); + _set_mode "usekeys", $ob, $arg, usekeys => qw(inventory keyrings containers); 1 };