ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/server/ext/dmcommands.ext
Revision: 1.11
Committed: Fri Jan 5 20:04:02 2007 UTC (17 years, 4 months ago) by root
Branch: MAIN
Changes since 1.10: +1 -1 lines
Log Message:
fix the bug: on_destroy is obviously not being called on pooled coroutines, aslo use more sensible names than 'coro'

File Contents

# Content
1 #! perl
2
3 # wizard commands
4
5 cf::register_command goto => sub {
6 my ($ob, $arg) = @_;
7
8 return unless $ob->may ("command_goto");
9
10 my $portal = cf::object::new "exit";
11
12 $portal->slaying ($arg);
13 $portal->stats->hp (0);
14 $portal->stats->sp (0);
15
16 $portal->apply ($ob);
17
18 $portal->destroy;
19
20 1
21 };
22
23 cf::register_command wizpass => sub {
24 my ($ob, $arg) = @_;
25
26 return unless $ob->may ("command_wizpass");
27
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
38 1
39 };
40
41 cf::register_command wizcast => sub {
42 my ($ob, $arg) = @_;
43
44 return unless $ob->may ("command_wizcast");
45
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
56 1
57 };
58
59 cf::register_command wizlook => sub {
60 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
68 1
69 };
70
71 cf::register_command reset => sub {
72 my ($ob, $arg) = @_;
73
74 return unless $ob->may ("command_reset");
75
76 my $map = $ob->map;
77
78 my @pl = $map->players;
79 $_->enter_link for @pl;
80 cf::async {
81 my $name = $map->{path}->as_string;
82
83 $map->reset;
84 $_->leave_link for @pl;
85
86 $ob->reply (undef, "$name was reset.");
87 };
88
89 1
90 };
91
92 for my $command (qw(teleport summon arrest kick banish)) {
93 my $method = "command_$command";
94
95 cf::register_command $command => sub {
96 my ($ob, $arg) = @_;
97
98 return unless $ob->may ($method);
99
100 $ob->$method ($arg)
101 };
102 }
103