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

File Contents

# User Rev Content
1 root 1.1 #! perl
2    
3 root 1.4 # TODO: skip arena
4     # TODO: check for player leaving
5    
6 root 1.1 # implement a 'follow' command
7 root 1.10 # don't follow on damned ground
8 root 1.1
9 root 1.3 sub teleport {
10     my ($pl, $map, $x, $y) = @_;
11    
12 root 1.5 return if $pl->ob->map->path eq $map
13     && abs ($pl->ob->x - $x) <= 1
14     && abs ($pl->ob->y - $y) <= 1;
15    
16 root 1.11 my $portal = cf::object::new "exit";
17 root 1.3
18 root 1.24 $portal->slaying ($map);
19     $portal->stats->hp ($x);
20     $portal->stats->sp ($y);
21 root 1.3
22 root 1.9 $portal->apply ($pl->ob);
23 root 1.3
24     $portal->free;
25     }
26    
27 root 1.18 my %follow;
28 root 1.12
29 root 1.26 my $timer = Event->timer (interval => 0.2, parked => 1, data => cf::WF_AUTOCANCEL, cb => sub {
30 root 1.5 while (my ($name, $v) = each %follow) {
31     my ($target, $his, $mine) = @$v;
32 root 1.1 my ($who, $other) = (cf::player::find $name, cf::player::find $target);
33 root 1.5
34 root 1.8 if ($who && $other && $other->ob->map) {
35 root 1.5 my ($map, $x, $y) = ($other->ob->map->path, $other->ob->x, $other->ob->y);
36    
37     if ($map ne $his->[0] || $x != $his->[1] || $y != $his->[2]) {
38     @$mine = @$his;
39     @$his = ($map, $x, $y);
40     }
41    
42 root 1.6 my $map;
43    
44 root 1.22 if ($map = cf::map::find $mine->[0]
45 root 1.7 and !grep $_->flag (cf::FLAG_UNIQUE) && $_->flag (cf::FLAG_IS_FLOOR),
46     $map->at ($mine->[1], $mine->[2])) {
47 root 1.6 teleport $who, @$mine;
48     } else {
49     delete $follow{$name};
50 root 1.8 $who->ob->message ("You can't follow $target anymore!");
51 root 1.6 }
52 root 1.1 } else {
53     delete $follow{$name};
54 root 1.8 $who->ob->message ("$target is gone...");
55 root 1.1 }
56     }
57 root 1.17
58 root 1.18 $_[0]->w->stop unless keys %follow;
59     });
60    
61 root 1.25 cf::register_command follow => sub {
62 root 1.18 my ($who, $args) = @_;
63    
64     my $name = $who->name;
65    
66     if ($args ne "" && $name ne $args) {
67     if (my $other = cf::player::find $args) {
68     if ($other->ob->map->path eq $who->map->path
69     && abs ($other->ob->x - $who->x) <= 1
70     && abs ($other->ob->y - $who->y) <= 1) {
71     $who->message ("Following player '$args', to stop, type: 'follow");
72     $other->ob->message ("$name is now following your every step...");
73     $follow{$name} = [
74     $args,
75     [$other->ob->map->path, $other->ob->x, $other->ob->y],
76     [$who->map->path, $who->x, $who->y],
77     ];
78     $timer->start;
79     } else {
80     $who->message ("You must stand directly beside '$args' to follow her/him");
81     delete $follow{$name};
82     }
83     } else {
84     $who->message ("Cannot follow '$args': no such player");
85     delete $follow{$name};
86     }
87     } else {
88     $who->message ("follow mode off");
89     delete $follow{$name};
90     }
91     };
92    
93 root 1.21 cf::attach_to_players
94 root 1.20 on_death => sub {
95     my ($pl) = @_;
96    
97     my $name = $pl->ob->name;
98    
99     delete $follow{$name};
100    
101     while (my ($k, $v) = each %follow) {
102     if ($v->[0] eq $name) {
103     delete $follow{$k};
104     }
105 root 1.18 }
106 root 1.20 },
107     ;
108 root 1.1
109    
110    
111