maps/perl/dmcommands.ext

#! perl

# wizard commands

cf::register_command goto => sub {
   my ($ob, $arg) = @_;

   return unless $ob->may ("command_goto");

   my $portal = cf::object::new "exit";

   $portal->slaying   ($arg);
   $portal->stats->hp (0);
   $portal->stats->sp (0);

   $portal->apply ($ob);

   $portal->destroy;

   1
};

cf::register_command wizpass => sub {
   my ($ob, $arg) = @_;

   return unless $ob->may ("command_wizpass");

   my $new_val = length $arg ? $arg * 1 : !$ob->flag (cf::FLAG_WIZPASS);

   $ob->flag (cf::FLAG_WIZPASS, $new_val);

   $ob->reply (undef,
      $new_val
         ? "You will now walk through walls.\n"
         : "You will now be stopped by walls.\n",
   );

   1
};

cf::register_command wizcast => sub {
   my ($ob, $arg) = @_;

   return unless $ob->may ("command_wizcast");

   my $new_val = length $arg ? $arg * 1 : !$ob->flag (cf::FLAG_WIZCAST);

   $ob->flag (cf::FLAG_WIZCAST, $new_val);

   $ob->reply (undef,
      $new_val
         ? "You can now cast spells anywhere."
         : "You now cannot cast spells in no-magic areas.",
   );

   1
};

cf::register_command wizlook => sub {
   my ($ob, $arg) = @_;

   return unless $ob->may ("command_wizlook");

   $ob->clear_los;

   $ob->reply (undef, "You can temporarily see through walls.");

   1
};

for my $command (qw(reset teleport summon arrest kick banish)) {
   my $method = "command_$command";

   cf::register_command $command => sub {
      my ($ob, $arg) = @_;

      return unless $ob->may ($method);

      $ob->$method ($arg)
   };
}

Revision:	1.10
Committed:	Fri Dec 15 19:11:46 2006 UTC (19 years, 9 months ago) by root
Branch:	MAIN
CVS Tags:	HEAD
Changes since 1.9:	+0 -0 lines
State:	*FILE REMOVED*
Log Message:	move .ext to server
#	User	Rev	Content
1	root	1.1	#! perl
2
3			# wizard commands
4
5	root	1.9	cf::register_command goto => sub {
6	root	1.1	my ($ob, $arg) = @_;
7
8	root	1.6	return unless $ob->may ("command_goto");
9	root	1.2
10	root	1.1	my $portal = cf::object::new "exit";
11
12			$portal->slaying ($arg);
13	root	1.3	$portal->stats->hp (0);
14	root	1.1	$portal->stats->sp (0);
15
16			$portal->apply ($ob);
17
18	root	1.9	$portal->destroy;
19	root	1.8
20			1
21	root	1.1	};
22
23	root	1.9	cf::register_command wizpass => sub {
24	root	1.5	my ($ob, $arg) = @_;
25
26	root	1.6	return unless $ob->may ("command_wizpass");
27	root	1.5
28			my $new_val = length $arg ? $arg * 1 : !$ob->flag (cf::FLAG_WIZPASS);
29
30			$ob->flag (cf::FLAG_WIZPASS, $new_val);
31
32			$ob->reply (undef,
33			$new_val
34			? "You will now walk through walls.\n"
35			: "You will now be stopped by walls.\n",
36			);
37	root	1.8
38			1
39	root	1.5	};
40
41	root	1.9	cf::register_command wizcast => sub {
42	root	1.5	my ($ob, $arg) = @_;
43
44	root	1.6	return unless $ob->may ("command_wizcast");
45	root	1.5
46			my $new_val = length $arg ? $arg * 1 : !$ob->flag (cf::FLAG_WIZCAST);
47
48			$ob->flag (cf::FLAG_WIZCAST, $new_val);
49
50			$ob->reply (undef,
51			$new_val
52			? "You can now cast spells anywhere."
53			: "You now cannot cast spells in no-magic areas.",
54			);
55	root	1.8
56			1
57	root	1.5	};
58
59	root	1.9	cf::register_command wizlook => sub {
60	root	1.7	my ($ob, $arg) = @_;
61
62			return unless $ob->may ("command_wizlook");
63
64			$ob->clear_los;
65
66			$ob->reply (undef, "You can temporarily see through walls.");
67	root	1.8
68			1
69	root	1.7	};
70
71	root	1.8	for my $command (qw(reset teleport summon arrest kick banish)) {
72			my $method = "command_$command";
73
74	root	1.9	cf::register_command $command => sub {
75	root	1.8	my ($ob, $arg) = @_;
76
77			return unless $ob->may ($method);
78
79			$ob->$method ($arg)
80			};
81			}
82