ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/maps/perl/follow.ext
Revision: 1.8
Committed: Tue Feb 7 02:08:22 2006 UTC (18 years, 3 months ago) by root
Branch: MAIN
Changes since 1.7: +4 -3 lines
Log Message:
*** empty log message ***

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    
8     my %follow;
9    
10     cf::register_command follow => 0, sub {
11     my ($who, $args) = @_;
12    
13     my $name = $who->name;
14    
15     if ($args ne "" && $name ne $args) {
16 root 1.5 if (my $other = cf::player::find $args) {
17     if ($other->ob->map->path eq $who->map->path
18     && abs ($other->ob->x - $who->x) <= 1
19     && abs ($other->ob->y - $who->y) <= 1) {
20     $who->message ("Following player '$args', to stop, type: 'follow");
21 root 1.8 $other->ob->message ("$name is now following your every step...");
22 root 1.5 $follow{$name} = [
23     $args,
24     [$other->ob->map->path, $other->ob->x, $other->ob->y],
25     [$who->map->path, $who->x, $who->y],
26     ];
27     } else {
28     $who->message ("You must stand directly beside '$args' to follow her/him");
29     delete $follow{$name};
30     }
31 root 1.1 } else {
32 root 1.5 $who->message ("Cannot follow '$args': no such player");
33     delete $follow{$name};
34 root 1.1 }
35     } else {
36     $who->message ("follow mode off");
37     delete $follow{$name};
38     }
39     };
40    
41 root 1.3 sub teleport {
42     my ($pl, $map, $x, $y) = @_;
43    
44 root 1.5 return if $pl->ob->map->path eq $map
45     && abs ($pl->ob->x - $x) <= 1
46     && abs ($pl->ob->y - $y) <= 1;
47    
48 root 1.3 my $portal = cf::object::new ("exit");
49    
50 root 1.5 $portal->set_slaying ($map);
51 root 1.3 $portal->set_hp ($x);
52     $portal->set_sp ($y);
53    
54     $portal->apply ($pl->ob, 0);
55    
56     $portal->free;
57     }
58    
59 root 1.1 sub on_clock {
60     my ($event) = @_;
61    
62     return unless %follow;
63    
64 root 1.5 while (my ($name, $v) = each %follow) {
65     my ($target, $his, $mine) = @$v;
66 root 1.1 my ($who, $other) = (cf::player::find $name, cf::player::find $target);
67 root 1.5
68 root 1.8 if ($who && $other && $other->ob->map) {
69 root 1.5 my ($map, $x, $y) = ($other->ob->map->path, $other->ob->x, $other->ob->y);
70    
71     if ($map ne $his->[0] || $x != $his->[1] || $y != $his->[2]) {
72     @$mine = @$his;
73     @$his = ($map, $x, $y);
74     }
75    
76 root 1.6 my $map;
77    
78     if ($map = cf::map::map $mine->[0]
79 root 1.7 and !grep $_->flag (cf::FLAG_UNIQUE) && $_->flag (cf::FLAG_IS_FLOOR),
80     $map->at ($mine->[1], $mine->[2])) {
81 root 1.6 teleport $who, @$mine;
82     } else {
83     delete $follow{$name};
84 root 1.8 $who->ob->message ("You can't follow $target anymore!");
85 root 1.6 }
86 root 1.1 } else {
87     delete $follow{$name};
88 root 1.8 $who->ob->message ("$target is gone...");
89 root 1.1 }
90     }
91     }
92    
93    
94    
95