ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/server/ext/invite.ext
Revision: 1.1
Committed: Fri Dec 15 19:29:18 2006 UTC (17 years, 5 months ago) by root
Branch: MAIN
Log Message:
moved perl extensions into server codebase, where they belong

File Contents

# User Rev Content
1 root 1.1 #! perl
2    
3     # level 1: invite to private rooms only ~lvl 10
4     # level 2: private rooms and saving maps (guilds, some other public saving maps)
5     # level 3: invite everywhere where no monsters are on the map
6     # level 4: invite everywhere
7    
8     # implement a 'follow' command
9    
10     my $TIMEOUT = 60;
11    
12     # determine whether map cell is damned
13     sub is_damned {
14     my ($map, $x, $y) = @_;
15     return grep $_->flag (cf::FLAG_DAMNED), $map->at ($x, $y);
16     }
17    
18     # determine level available to the player
19     sub player_level {
20     my ($ob) = @_;
21    
22     return 4
23     if $ob->flag (cf::FLAG_WIZ);
24    
25     List::Util::max
26     map $_->type == cf::FORCE && $_->slaying =~ /^Invitor Level (\d+)$/ ? $1 : 0,
27     $ob->inv
28     }
29    
30     # determine level required for the given location
31     sub map_level {
32     my ($map, $x, $y) = @_;
33    
34     for my $x (0 .. $map->width - 1) {
35     for my $y (0 .. $map->height - 1) {
36     return 4
37     if grep $_->flag (cf::FLAG_MONSTER),
38     $map->at ($x, $y);
39     }
40     }
41    
42     my $path = $map->path;
43     my $player = sprintf "%s/%s/", cf::localdir, cf::playerdir;
44    
45     if ($player eq substr $path, 0, length $player) {
46     1
47     } elsif (grep $_->flag (cf::FLAG_UNIQUE) && $_->flag (cf::FLAG_IS_FLOOR), $map->at ($x, $y)) {
48     2
49     } else {
50     3
51     }
52     }
53    
54     my @maplevel = (
55     "some mysterious hideout",
56     "his home",
57     "his guild", # wrong, this is any unique place !player-specific
58     "a nice place",
59     "a place with monsters",
60     );
61    
62     my %invite;
63    
64     cf::register_command invite => sub {
65     my ($who, $args) = @_;
66    
67     $who->speed_left ($who->speed_left - 0.2);
68    
69     my $name = $who->name;
70    
71     if ($args ne "" && $name ne $args) {
72     my ($map, $x, $y) = ($who->map, $who->x, $who->y);
73    
74     my $plevel = player_level $who;
75     my $mlevel = map_level $map, $x, $y;
76    
77     if (is_damned ($map, $x, $y)) {
78     $who->message ("Your god isn't present here, you can't invite someone to unholy ground.");
79     } elsif ($plevel >= $mlevel) {
80     if (my $other = cf::player::find $args) {
81     $who->message ("inviting player '$args', to cancel, type: 'invite or wait $TIMEOUT seconds");
82     $other->ob->message ("$name invites you to $maplevel[$mlevel], to accept, use 'accept-invitation $name");
83     $invite{$name}{$args} = [time + $TIMEOUT, $map, $x, $y];
84     } else {
85     $who->message ("cannot invite '$args': no such player");
86     }
87     } elsif ($plevel) {
88     $who->message ("Valriel deems you not worthy yet. Gorokh is annoyed by your sacrilege.");
89     } else {
90     $who->message ("You haven't proven your worthyness in the mountain maze.");
91     }
92     } else {
93     $who->message ("canceling all invites");
94     delete $invite{$name};
95     }
96     };
97    
98     sub teleport {
99     my ($pl, $map, $x, $y) = @_;
100    
101     my $portal = cf::object::new "exit";
102    
103     $portal->slaying ($map->path);
104     $portal->stats->hp ($x);
105     $portal->stats->sp ($y);
106    
107     $portal->apply ($pl);
108    
109     $portal->destroy;
110     }
111    
112     cf::register_command "accept-invitation" => sub {
113     my ($who, $args) = @_;
114    
115     $who->speed_left ($who->speed_left - 0.2);
116    
117     my $name = $who->name;
118     my ($map, $x, $y) = ($who->map, $who->x, $who->y);
119    
120     if (is_damned ($map, $x, $y)) {
121     $who->message ("You can't be invited from a place where your god isn't present.");
122     } elsif (!exists $invite{$args} || !exists $invite{$args}{$name}) {
123     $who->message ("Sorry, $args hasn't invited you.");
124     } elsif ($invite{$args}{$name}[0] < time) {
125     $who->message ("Sorry, $args\'s invitation has expired.");
126     } else {
127     my $inv = delete $invite{$args}{$name};
128     $who->message ("A godly force starts to pull you up...");
129     teleport $who, @{$inv}[1,2,3];
130     $who->message ("... and sets you down where $args invited you to.");
131    
132     }
133     };
134