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 (11 years, 4 months ago) by root
Branch:	MAIN
CVS Tags:	rel-3_1, HEAD
Changes since 1.26:	+4 -0 lines
Log Message:	reste --unique
#	Content
1	#! perl # mandatory
2
3	# wizard commands
4
5	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	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	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	cf::register_command goto => sub {
117	my ($ob, $arg) = @_;
118
119	return unless $ob->may ("command_goto");
120
121	my ($path, $x, $y) = split /\s+/, $arg, 3;
122
123	$ob->goto ($path, $x, $y);
124
125	1
126	};
127
128	cf::register_command teleport => sub {
129	my ($ob, $arg) = @_;
130
131	return unless $ob->may ("command_teleport");
132
133	cf::async {
134	$Coro::current->{desc} = "teleport $arg";
135
136	my $other = cf::player::find $arg
137	or return $ob->reply (undef, "$arg: no such player.");
138
139	$ob->goto ($other->maplevel, $other->ob->x, $other->ob->y);
140	};
141
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	my $new_val = length $arg ? $arg * 1 : !$ob->flag (cf::FLAG_WIZLOOK);
187
188	$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
198	1
199	};
200
201	cf::register_command reset => sub {
202	my ($ob, $arg) = @_;
203
204	return unless $ob->may ("command_reset");
205
206	my $unique = $arg =~ s/^\s--unique\s//;
207
208	my $map = $ob->map;
209
210	my @pl = $map->players;
211	$_->enter_link for @pl;
212	cf::async {
213	my $name = $map->visible_name;
214	$Coro::current->{desc} = "reset $name";
215
216	$map->clear_unique_items if $unique;
217	$map->reset;
218
219	$_->leave_link for @pl;
220
221	$ob->reply (undef, "$name was reset.");
222	};
223
224	1
225	};
226
227	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	for my $command (qw(summon arrest banish)) {
239	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