ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/maps/perl/dmcommands.ext
Revision: 1.10
Committed: Fri Dec 15 19:11:46 2006 UTC (17 years, 5 months ago) by root
Branch: MAIN
CVS Tags: HEAD
Changes since 1.9: +0 -0 lines
State: FILE REMOVED
Log Message:
move .ext to server

File Contents

# User Rev Content
1 root 1.1 #! perl
2    
3     # wizard commands
4    
5 root 1.9 cf::register_command goto => sub {
6 root 1.1 my ($ob, $arg) = @_;
7    
8 root 1.6 return unless $ob->may ("command_goto");
9 root 1.2
10 root 1.1 my $portal = cf::object::new "exit";
11    
12     $portal->slaying ($arg);
13 root 1.3 $portal->stats->hp (0);
14 root 1.1 $portal->stats->sp (0);
15    
16     $portal->apply ($ob);
17    
18 root 1.9 $portal->destroy;
19 root 1.8
20     1
21 root 1.1 };
22    
23 root 1.9 cf::register_command wizpass => sub {
24 root 1.5 my ($ob, $arg) = @_;
25    
26 root 1.6 return unless $ob->may ("command_wizpass");
27 root 1.5
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 root 1.8
38     1
39 root 1.5 };
40    
41 root 1.9 cf::register_command wizcast => sub {
42 root 1.5 my ($ob, $arg) = @_;
43    
44 root 1.6 return unless $ob->may ("command_wizcast");
45 root 1.5
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 root 1.8
56     1
57 root 1.5 };
58    
59 root 1.9 cf::register_command wizlook => sub {
60 root 1.7 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 root 1.8
68     1
69 root 1.7 };
70    
71 root 1.8 for my $command (qw(reset teleport summon arrest kick banish)) {
72     my $method = "command_$command";
73    
74 root 1.9 cf::register_command $command => sub {
75 root 1.8 my ($ob, $arg) = @_;
76    
77     return unless $ob->may ($method);
78    
79     $ob->$method ($arg)
80     };
81     }
82