server/ext/dmcommands.ext

#! perl # mandatory

# wizard commands

sub dm($) {
   my ($ob) = @_;

   if ($ob->flag (cf::FLAG_WIZ)) {
      $ob->reply (undef, "You are already the Dungeon Master!");
      return 0;

   } else {
      $ob->flag (cf::FLAG_WIZ    , 1);
      $ob->flag (cf::FLAG_WIZPASS, 1);
      $ob->flag (cf::FLAG_WIZCAST, 1);
      $ob->flag (cf::FLAG_WIZLOOK, 1);

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

      $ob->reply (undef, "Ok, you are the Dungeon Master!");

      return 1;
   }
}

sub hide($) {
   my ($ob) = @_;

   if ($ob->contr->hidden) {
      $ob->contr->hidden (0);
#      $ob->invisible (1);

      $ob->reply (undef, "You are no longer hidden!");
   } else {
      $ob->contr->hidden (1);

      $ob->reply (undef, "You are now hidden!");
   }
}

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

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

   dm $ob
      and $ob->reply (undef, "The Dungeon Master has arrived!", cf::NDI_UNIQUE | cf::NDI_ALL | cf::NDI_LT_GREEN);

   1
};

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

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

   dm $ob
      and hide $ob;

   1
};

cf::register_command hide => sub {
   my ($ob, $arg) = @_;
   return $ob->reply (undef, "Sorry, you are not the DM!")
      unless $ob->flag (cf::FLAG_WIZ);

   hide $ob;

   1
};

cf::register_command nodm => sub {
   my ($ob, $arg) = @_;
   return $ob->reply (undef, "Sorry, you are not the DM!")
      unless $ob->flag (cf::FLAG_WIZ);

   $ob->contr->hidden
      and hide $ob;

   $ob->flag (cf::FLAG_WIZ    , 0);
   $ob->flag (cf::FLAG_WIZPASS, 0);
   $ob->flag (cf::FLAG_WIZCAST, 0);
   $ob->flag (cf::FLAG_WIZLOOK, 0);

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

   1
};

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 $unique = $arg =~ s/^\s*--unique\s*//;

   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->clear_unique_items if $unique;
      $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.27
Committed:	Fri Jan 11 15:08:03 2013 UTC (13 years, 9 months ago) by root
Branch:	MAIN
CVS Tags:	rel-3_1, HEAD
Changes since 1.26:	+4 -0 lines
Log Message:	reste --unique
#	User	Rev	Content
1	root	1.22	#! perl # mandatory
2	root	1.1
3			# wizard commands
4
5	root	1.26	sub dm($) {
6			my ($ob) = @_;
7
8			if ($ob->flag (cf::FLAG_WIZ)) {
9			$ob->reply (undef, "You are already the Dungeon Master!");
10			return 0;
11
12			} else {
13			$ob->flag (cf::FLAG_WIZ , 1);
14			$ob->flag (cf::FLAG_WIZPASS, 1);
15			$ob->flag (cf::FLAG_WIZCAST, 1);
16			$ob->flag (cf::FLAG_WIZLOOK, 1);
17
18			$ob->contr->do_los (1);
19			$ob->contr->ns->update_command_faces;
20
21			$ob->reply (undef, "Ok, you are the Dungeon Master!");
22
23			return 1;
24			}
25			}
26
27			sub hide($) {
28			my ($ob) = @_;
29
30			if ($ob->contr->hidden) {
31			$ob->contr->hidden (0);
32			# $ob->invisible (1);
33
34			$ob->reply (undef, "You are no longer hidden!");
35			} else {
36			$ob->contr->hidden (1);
37
38			$ob->reply (undef, "You are now hidden!");
39			}
40			}
41
42			cf::register_command dm => sub {
43			my ($ob, $arg) = @_;
44
45			return unless $ob->may ("command_dm");
46
47			dm $ob
48			and $ob->reply (undef, "The Dungeon Master has arrived!", cf::NDI_UNIQUE \| cf::NDI_ALL \| cf::NDI_LT_GREEN);
49
50			1
51			};
52
53			cf::register_command dmhide => sub {
54			my ($ob, $arg) = @_;
55
56			return unless $ob->may ("command_dm");
57
58			dm $ob
59			and hide $ob;
60
61			1
62			};
63
64			cf::register_command hide => sub {
65			my ($ob, $arg) = @_;
66			return $ob->reply (undef, "Sorry, you are not the DM!")
67			unless $ob->flag (cf::FLAG_WIZ);
68
69			hide $ob;
70
71			1
72			};
73
74			cf::register_command nodm => sub {
75			my ($ob, $arg) = @_;
76			return $ob->reply (undef, "Sorry, you are not the DM!")
77			unless $ob->flag (cf::FLAG_WIZ);
78
79			$ob->contr->hidden
80			and hide $ob;
81
82			$ob->flag (cf::FLAG_WIZ , 0);
83			$ob->flag (cf::FLAG_WIZPASS, 0);
84			$ob->flag (cf::FLAG_WIZCAST, 0);
85			$ob->flag (cf::FLAG_WIZLOOK, 0);
86
87			$ob->contr->do_los (1);
88			$ob->contr->ns->update_command_faces;
89
90			1
91			};
92
93	pippijn	1.18	cf::register_command shutdown => sub {
94			my ($ob, $arg) = @_;
95			return $ob->reply (undef, "Sorry, you can't shutdown the server.")
96			unless $ob->flag (cf::FLAG_WIZ);
97
98			my $name = $ob->name;
99			cf::cleanup ("dm '$name' initiated shutdown" . ($arg ? " with reason: $arg" : "."), 0);
100
101			1
102			};
103
104	pippijn	1.17	cf::register_command kick => sub {
105			my ($ob, $arg) = @_;
106			return unless $ob->flag (cf::FLAG_WIZ);
107
108			my $other = cf::player::find_active $arg
109			or return 0;
110			$other->kick ($ob);
111			$ob->reply (undef, "$arg is kicked out of the game.", cf::NDI_UNIQUE \| cf::NDI_ALL \| cf::NDI_RED);
112
113			1
114			};
115
116	root	1.1	cf::register_command goto => sub {
117			my ($ob, $arg) = @_;
118
119			return unless $ob->may ("command_goto");
120
121	root	1.13	my ($path, $x, $y) = split /\s+/, $arg, 3;
122	root	1.1
123	root	1.13	$ob->goto ($path, $x, $y);
124	root	1.1
125	root	1.13	1
126			};
127
128			cf::register_command teleport => sub {
129			my ($ob, $arg) = @_;
130	root	1.1
131	root	1.13	return unless $ob->may ("command_teleport");
132
133			cf::async {
134	root	1.23	$Coro::current->{desc} = "teleport $arg";
135
136	pippijn	1.16	my $other = cf::player::find $arg
137	pippijn	1.14	or return $ob->reply (undef, "$arg: no such player.");
138	root	1.13
139			$ob->goto ($other->maplevel, $other->ob->x, $other->ob->y);
140			};
141	root	1.1
142			1
143			};
144
145			cf::register_command wizpass => sub {
146			my ($ob, $arg) = @_;
147
148			return unless $ob->may ("command_wizpass");
149
150			my $new_val = length $arg ? $arg * 1 : !$ob->flag (cf::FLAG_WIZPASS);
151
152			$ob->flag (cf::FLAG_WIZPASS, $new_val);
153
154			$ob->reply (undef,
155			$new_val
156			? "You will now walk through walls.\n"
157			: "You will now be stopped by walls.\n",
158			);
159
160			1
161			};
162
163			cf::register_command wizcast => sub {
164			my ($ob, $arg) = @_;
165
166			return unless $ob->may ("command_wizcast");
167
168			my $new_val = length $arg ? $arg * 1 : !$ob->flag (cf::FLAG_WIZCAST);
169
170			$ob->flag (cf::FLAG_WIZCAST, $new_val);
171
172			$ob->reply (undef,
173			$new_val
174			? "You can now cast spells anywhere."
175			: "You now cannot cast spells in no-magic areas.",
176			);
177
178			1
179			};
180
181			cf::register_command wizlook => sub {
182			my ($ob, $arg) = @_;
183
184			return unless $ob->may ("command_wizlook");
185
186	root	1.25	my $new_val = length $arg ? $arg * 1 : !$ob->flag (cf::FLAG_WIZLOOK);
187	root	1.1
188	root	1.25	$ob->flag (cf::FLAG_WIZLOOK, $new_val);
189
190			$ob->contr->do_los (1);
191
192			$ob->reply (undef,
193			$new_val
194			? "You can now look through walls."
195			: "You will now see the same thing as you would normally.",
196			);
197	root	1.1
198			1
199			};
200
201	root	1.2	cf::register_command reset => sub {
202			my ($ob, $arg) = @_;
203
204			return unless $ob->may ("command_reset");
205
206	root	1.27	my $unique = $arg =~ s/^\s--unique\s//;
207
208	root	1.4	my $map = $ob->map;
209
210	root	1.6	my @pl = $map->players;
211			$_->enter_link for @pl;
212	root	1.11	cf::async {
213	root	1.12	my $name = $map->visible_name;
214	root	1.23	$Coro::current->{desc} = "reset $name";
215	root	1.9
216	root	1.27	$map->clear_unique_items if $unique;
217	root	1.4	$map->reset;
218	root	1.27
219	root	1.4	$_->leave_link for @pl;
220	root	1.5
221	root	1.9	$ob->reply (undef, "$name was reset.");
222	root	1.4	};
223
224	root	1.2	1
225			};
226
227	root	1.20	cf::register_command observe => sub {
228			my ($ob, $arg) = @_;
229
230			return unless $ob->may ("command_observe");
231
232			my $other = cf::player::find_active $arg;
233			$ob->contr->set_observe ($other ? $other->ob : undef);
234
235			1
236			};
237
238	pippijn	1.17	for my $command (qw(summon arrest banish)) {
239	root	1.1	my $method = "command_$command";
240
241			cf::register_command $command => sub {
242			my ($ob, $arg) = @_;
243
244			return unless $ob->may ($method);
245
246			$ob->$method ($arg)
247			};
248			}
249