server/ext/follow.ext

#! perl

# TODO: skip arena
# TODO: check for player leaving

# implement a 'follow' command
# don't follow on damned ground

our $MAX_QUEUE = 5; # the # of positions somebody else can lead
our %follow; # $followername => [$follower, $target, [$queue]]

sub unfollow($) {
   my $name = shift;

   if (my $f = delete $follow{$name}) {
      my ($who, $target, undef) = @$f;
      $who->contr->detach ("follow_aborter");
      $target->message ("$name no longer follows you.");
      $who->message ("You no longer follow " . $target->name . ".");
   }
}

cf::player::attachment follow_aborter =>
   on_move => sub {
      my ($pl, $dir) = @_;
      unfollow $pl->ob->name;
   },
   on_login => sub {
      my ($pl, $dir) = @_;
      $pl->detach ("follow_aborter");
   },
;

our $CORO = cf::async {
   $Coro::current->{desc} = "follow handler";

   while () {
      cf::wait_for_tick;

      for (values %follow) {
         my ($who, $target, $queue) = @$_;

         my ($map, $x, $y) = ($target->map, $target->x, $target->y);

         # add new position to queue, if any
         push @$queue, [$map, $x, $y]
            if $map != $queue->[-1][0]
               || $x != $queue->[-1][1]
               || $y != $queue->[-1][2];

         # try to move to oldest position
         if (@$queue > $MAX_QUEUE) {
            $who->message ($target->name . " is too far away - you can't follow anymore!");
            unfollow $target->name;
         } else {
            my ($map, $x, $y) = @{ $queue->[0] };

            $map->load;

            if (
               !$map->valid
               or $map->path !~ /^(\{link\}|\/)/
               or grep $_->flag (cf::FLAG_IS_FLOOR) && ($_->flag (cf::FLAG_UNIQUE) || $_->type == cf::SHOP_FLOOR),
                  $map->at ($x, $y))
            ) {
               $who->message ("You can't follow " . $target->name . " anymore!");
               unfollow $who->name;
            } elsif (!$who->blocked ($map, $x, $y)) {
               shift @$queue;
               $who->goto ($map, $x, $y);
            }
         }
      }

      Coro::schedule unless keys %follow;
   }
};

cf::register_command follow => sub {
   my ($who, $args) = @_;

   my $name = $who->name;

   if ($args ne "" && $name ne $args) {
      if (my $other = cf::player::find_active $args) {
         $other = $other->ob;

         if ($other->map == $who->map
             && abs ($other->x - $who->x) <= 1
             && abs ($other->y - $who->y) <= 1
         ) {
            $who->message ("Following player '$args', to stop, type: 'follow");
            $other->message ("$name is now following your every step...");
            $follow{$name} = [
               $who,
               $other,
               [[$other->map, $other->x, $other->y]],
            ];
            $who->contr->attach ("follow_aborter");
            $CORO->ready;
         } else {
            $who->message ("You must stand directly beside '$args' to follow her/him");
            delete $follow{$name};
         }
      } else {
         $who->message ("Cannot follow '$args': no such player");
         delete $follow{$name};
      }
   } else {
      $who->message ("follow mode off");
      delete $follow{$name};
   }
};

sub unregister {
   my ($pl) = @_;

   my $name = $pl->ob->name;

   unfollow $name;

   while (my ($k, $v) = each %follow) {
      unfollow $k
         if $v->[1]->name eq $name;
   }
}

cf::player->attach (
   on_death  => \&unregister,
   on_logout => \&unregister,
);

Revision:	1.21
Committed:	Tue May 18 21:30:16 2010 UTC (14 years, 1 month ago) by root
Branch:	MAIN
Changes since 1.20:	+3 -2 lines
Log Message:	shield follow against yuna resetting the map at the right time
#	User	Rev	Content
1	root	1.1	#! perl
2
3			# TODO: skip arena
4			# TODO: check for player leaving
5
6			# implement a 'follow' command
7			# don't follow on damned ground
8
9	root	1.18	our $MAX_QUEUE = 5; # the # of positions somebody else can lead
10			our %follow; # $followername => [$follower, $target, [$queue]]
11	root	1.1
12	root	1.19	sub unfollow($) {
13			my $name = shift;
14
15			if (my $f = delete $follow{$name}) {
16			my ($who, $target, undef) = @$f;
17			$who->contr->detach ("follow_aborter");
18			$target->message ("$name no longer follows you.");
19			$who->message ("You no longer follow " . $target->name . ".");
20			}
21			}
22
23			cf::player::attachment follow_aborter =>
24			on_move => sub {
25			my ($pl, $dir) = @_;
26			unfollow $pl->ob->name;
27			},
28			on_login => sub {
29			my ($pl, $dir) = @_;
30			$pl->detach ("follow_aborter");
31			},
32			;
33
34	root	1.13	our $CORO = cf::async {
35			$Coro::current->{desc} = "follow handler";
36	root	1.12
37	root	1.13	while () {
38			cf::wait_for_tick;
39	root	1.12
40	root	1.18	for (values %follow) {
41			my ($who, $target, $queue) = @$_;
42	root	1.13
43	root	1.18	my ($map, $x, $y) = ($target->map, $target->x, $target->y);
44
45			# add new position to queue, if any
46			push @$queue, [$map, $x, $y]
47			if $map != $queue->[-1][0]
48			\|\| $x != $queue->[-1][1]
49			\|\| $y != $queue->[-1][2];
50
51			# try to move to oldest position
52			if (@$queue > $MAX_QUEUE) {
53			$who->message ($target->name . " is too far away - you can't follow anymore!");
54	root	1.19	unfollow $target->name;
55	root	1.18	} else {
56			my ($map, $x, $y) = @{ $queue->[0] };
57
58			$map->load;
59	root	1.13
60			if (
61	root	1.21	!$map->valid
62			or $map->path !~ /^(\{link\}\|\/)/
63	root	1.18	or grep $_->flag (cf::FLAG_IS_FLOOR) && ($_->flag (cf::FLAG_UNIQUE) \|\| $_->type == cf::SHOP_FLOOR),
64	root	1.21	$map->at ($x, $y))
65	root	1.13	) {
66	root	1.19	$who->message ("You can't follow " . $target->name . " anymore!");
67			unfollow $who->name;
68	root	1.18	} elsif (!$who->blocked ($map, $x, $y)) {
69			shift @$queue;
70			$who->goto ($map, $x, $y);
71	root	1.13	}
72	root	1.1	}
73			}
74	root	1.13
75			Coro::schedule unless keys %follow;
76	root	1.12	}
77	root	1.13	};
78	root	1.1
79			cf::register_command follow => sub {
80			my ($who, $args) = @_;
81
82			my $name = $who->name;
83
84			if ($args ne "" && $name ne $args) {
85	root	1.8	if (my $other = cf::player::find_active $args) {
86	root	1.18	$other = $other->ob;
87
88			if ($other->map == $who->map
89			&& abs ($other->x - $who->x) <= 1
90			&& abs ($other->y - $who->y) <= 1
91			) {
92	root	1.1	$who->message ("Following player '$args', to stop, type: 'follow");
93	root	1.18	$other->message ("$name is now following your every step...");
94	root	1.1	$follow{$name} = [
95	root	1.18	$who,
96			$other,
97			[[$other->map, $other->x, $other->y]],
98	root	1.1	];
99	root	1.19	$who->contr->attach ("follow_aborter");
100	root	1.13	$CORO->ready;
101	root	1.1	} else {
102			$who->message ("You must stand directly beside '$args' to follow her/him");
103			delete $follow{$name};
104			}
105			} else {
106			$who->message ("Cannot follow '$args': no such player");
107			delete $follow{$name};
108			}
109			} else {
110			$who->message ("follow mode off");
111			delete $follow{$name};
112			}
113			};
114
115	root	1.18	sub unregister {
116			my ($pl) = @_;
117	root	1.19
118	root	1.18	my $name = $pl->ob->name;
119
120	root	1.19	unfollow $name;
121	root	1.18
122			while (my ($k, $v) = each %follow) {
123	root	1.19	unfollow $k
124			if $v->[1]->name eq $name;
125	root	1.18	}
126			}
127
128	root	1.3	cf::player->attach (
129	root	1.18	on_death => \&unregister,
130			on_logout => \&unregister,
131	root	1.3	);
132	root	1.1