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

   $ob->contr->clear_los (0);

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

   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.24
Committed:	Sat Dec 20 02:32:31 2008 UTC (15 years, 5 months ago) by root
Branch:	MAIN
Changes since 1.23:	+1 -1 lines
Log Message:	fix observe and other los issues
#	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.24	$ob->contr->clear_los (0);
99	root	1.1
100			$ob->reply (undef, "You can temporarily see through walls.");
101
102			1
103			};
104
105	root	1.2	cf::register_command reset => sub {
106			my ($ob, $arg) = @_;
107
108			return unless $ob->may ("command_reset");
109
110	root	1.4	my $map = $ob->map;
111
112	root	1.6	my @pl = $map->players;
113			$_->enter_link for @pl;
114	root	1.11	cf::async {
115	root	1.12	my $name = $map->visible_name;
116	root	1.23	$Coro::current->{desc} = "reset $name";
117	root	1.9
118	root	1.4	$map->reset;
119			$_->leave_link for @pl;
120	root	1.5
121	root	1.9	$ob->reply (undef, "$name was reset.");
122	root	1.4	};
123
124	root	1.2	1
125			};
126
127	root	1.20	cf::register_command observe => sub {
128			my ($ob, $arg) = @_;
129
130			return unless $ob->may ("command_observe");
131
132			my $other = cf::player::find_active $arg;
133			$ob->contr->set_observe ($other ? $other->ob : undef);
134
135			1
136			};
137
138	pippijn	1.17	for my $command (qw(summon arrest banish)) {
139	root	1.1	my $method = "command_$command";
140
141			cf::register_command $command => sub {
142			my ($ob, $arg) = @_;
143
144			return unless $ob->may ($method);
145
146			$ob->$method ($arg)
147			};
148			}
149