server/ext/dmcommands.ext

#! perl # mandatory

# wizard commands

cf::register_command shutdown => sub {
   my ($ob, $arg) = @_;
   return $ob->reply (undef, "Sorry, you can't shutdown the server.")
      unless $ob->flag (cf::FLAG_WIZ);

   my $name = $ob->name;
   cf::cleanup ("dm '$name' initiated shutdown" . ($arg ? " with reason: $arg" : "."), 0);

   1
};

cf::register_command kick => sub {
   my ($ob, $arg) = @_;
   return unless $ob->flag (cf::FLAG_WIZ);

   my $other = cf::player::find_active $arg
      or return 0;
   $other->kick ($ob);
   $ob->reply (undef, "$arg is kicked out of the game.", cf::NDI_UNIQUE | cf::NDI_ALL | cf::NDI_RED);

   1
};

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

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

   my ($path, $x, $y) = split /\s+/, $arg, 3;

   $ob->goto ($path, $x, $y);

   1
};

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

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

   cf::async {
      $Coro::current->{desc} = "teleport $arg";

      my $other = cf::player::find $arg
         or return $ob->reply (undef, "$arg: no such player.");

      $ob->goto ($other->maplevel, $other->ob->x, $other->ob->y);
   };

   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");

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

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

   $ob->contr->do_los (1);

   $ob->reply (undef,
      $new_val
         ? "You can now look through walls."
         : "You will now see the same thing as you would normally.",
   );

   1
};

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

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

   my $map = $ob->map;

   my @pl = $map->players;
   $_->enter_link for @pl;
   cf::async {
      my $name = $map->visible_name;
      $Coro::current->{desc} = "reset $name";

      $map->reset;
      $_->leave_link for @pl;

      $ob->reply (undef, "$name was reset.");
   };

   1
};

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

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

   my $other = cf::player::find_active $arg;
   $ob->contr->set_observe ($other ? $other->ob : undef);

   1
};

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

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

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

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

Revision:	1.25
Committed:	Tue Dec 23 06:58:23 2008 UTC (15 years, 5 months ago) by root
Branch:	MAIN
CVS Tags:	rel-2_82, rel-2_81, rel-2_80, rel-3_0, rel-2_76, rel-2_77, rel-2_74, rel-2_75, rel-2_79, rel-2_90, rel-2_92, rel-2_93, rel-2_78
Changes since 1.24:	+10 -2 lines
Log Message:	wizlook
#	User	Rev	Content
1	root	1.22	#! perl # mandatory
2	root	1.1
3			# wizard commands
4
5	pippijn	1.18	cf::register_command shutdown => sub {
6			my ($ob, $arg) = @_;
7			return $ob->reply (undef, "Sorry, you can't shutdown the server.")
8			unless $ob->flag (cf::FLAG_WIZ);
9
10			my $name = $ob->name;
11			cf::cleanup ("dm '$name' initiated shutdown" . ($arg ? " with reason: $arg" : "."), 0);
12
13			1
14			};
15
16	pippijn	1.17	cf::register_command kick => sub {
17			my ($ob, $arg) = @_;
18			return unless $ob->flag (cf::FLAG_WIZ);
19
20			my $other = cf::player::find_active $arg
21			or return 0;
22			$other->kick ($ob);
23			$ob->reply (undef, "$arg is kicked out of the game.", cf::NDI_UNIQUE \| cf::NDI_ALL \| cf::NDI_RED);
24
25			1
26			};
27
28	root	1.1	cf::register_command goto => sub {
29			my ($ob, $arg) = @_;
30
31			return unless $ob->may ("command_goto");
32
33	root	1.13	my ($path, $x, $y) = split /\s+/, $arg, 3;
34	root	1.1
35	root	1.13	$ob->goto ($path, $x, $y);
36	root	1.1
37	root	1.13	1
38			};
39
40			cf::register_command teleport => sub {
41			my ($ob, $arg) = @_;
42	root	1.1
43	root	1.13	return unless $ob->may ("command_teleport");
44
45			cf::async {
46	root	1.23	$Coro::current->{desc} = "teleport $arg";
47
48	pippijn	1.16	my $other = cf::player::find $arg
49	pippijn	1.14	or return $ob->reply (undef, "$arg: no such player.");
50	root	1.13
51			$ob->goto ($other->maplevel, $other->ob->x, $other->ob->y);
52			};
53	root	1.1
54			1
55			};
56
57			cf::register_command wizpass => sub {
58			my ($ob, $arg) = @_;
59
60			return unless $ob->may ("command_wizpass");
61
62			my $new_val = length $arg ? $arg * 1 : !$ob->flag (cf::FLAG_WIZPASS);
63
64			$ob->flag (cf::FLAG_WIZPASS, $new_val);
65
66			$ob->reply (undef,
67			$new_val
68			? "You will now walk through walls.\n"
69			: "You will now be stopped by walls.\n",
70			);
71
72			1
73			};
74
75			cf::register_command wizcast => sub {
76			my ($ob, $arg) = @_;
77
78			return unless $ob->may ("command_wizcast");
79
80			my $new_val = length $arg ? $arg * 1 : !$ob->flag (cf::FLAG_WIZCAST);
81
82			$ob->flag (cf::FLAG_WIZCAST, $new_val);
83
84			$ob->reply (undef,
85			$new_val
86			? "You can now cast spells anywhere."
87			: "You now cannot cast spells in no-magic areas.",
88			);
89
90			1
91			};
92
93			cf::register_command wizlook => sub {
94			my ($ob, $arg) = @_;
95
96			return unless $ob->may ("command_wizlook");
97
98	root	1.25	my $new_val = length $arg ? $arg * 1 : !$ob->flag (cf::FLAG_WIZLOOK);
99	root	1.1
100	root	1.25	$ob->flag (cf::FLAG_WIZLOOK, $new_val);
101
102			$ob->contr->do_los (1);
103
104			$ob->reply (undef,
105			$new_val
106			? "You can now look through walls."
107			: "You will now see the same thing as you would normally.",
108			);
109	root	1.1
110			1
111			};
112
113	root	1.2	cf::register_command reset => sub {
114			my ($ob, $arg) = @_;
115
116			return unless $ob->may ("command_reset");
117
118	root	1.4	my $map = $ob->map;
119
120	root	1.6	my @pl = $map->players;
121			$_->enter_link for @pl;
122	root	1.11	cf::async {
123	root	1.12	my $name = $map->visible_name;
124	root	1.23	$Coro::current->{desc} = "reset $name";
125	root	1.9
126	root	1.4	$map->reset;
127			$_->leave_link for @pl;
128	root	1.5
129	root	1.9	$ob->reply (undef, "$name was reset.");
130	root	1.4	};
131
132	root	1.2	1
133			};
134
135	root	1.20	cf::register_command observe => sub {
136			my ($ob, $arg) = @_;
137
138			return unless $ob->may ("command_observe");
139
140			my $other = cf::player::find_active $arg;
141			$ob->contr->set_observe ($other ? $other->ob : undef);
142
143			1
144			};
145
146	pippijn	1.17	for my $command (qw(summon arrest banish)) {
147	root	1.1	my $method = "command_$command";
148
149			cf::register_command $command => sub {
150			my ($ob, $arg) = @_;
151
152			return unless $ob->may ($method);
153
154			$ob->$method ($arg)
155			};
156			}
157