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]]
our $FOLLOW_HANDLER;

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");
   },
;

sub start_follow_handler {
   $FOLLOW_HANDLER = cf::async_ext {
      $Coro::current->{desc} = "follow handler";

      while () {
         $cf::WAIT_FOR_TICK->wait;

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

            $target->active
               or next;

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

            # add new position to queue, if any
            push @$queue, [$map, $x, $y]
               if !@$queue
                  || $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 $who->name;
            } elsif (@$queue) {
               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;
      }
   };
}

start_follow_handler;

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");
            $FOLLOW_HANDLER->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.26
Committed:	Wed May 4 19:04:44 2011 UTC (15 years, 6 months ago) by root
Branch:	MAIN
CVS Tags:	rel-3_1, HEAD
Changes since 1.25:	+1 -1 lines
Log Message:	* empty log message *
#	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	root	1.22	our %FOLLOW; # $followername => [$follower, $target, [$queue]]
11			our $FOLLOW_HANDLER;
12	root	1.1
13	root	1.19	sub unfollow($) {
14			my $name = shift;
15
16	root	1.22	if (my $f = delete $FOLLOW{$name}) {
17	root	1.19	my ($who, $target, undef) = @$f;
18			$who->contr->detach ("follow_aborter");
19			$target->message ("$name no longer follows you.");
20			$who->message ("You no longer follow " . $target->name . ".");
21			}
22			}
23
24			cf::player::attachment follow_aborter =>
25			on_move => sub {
26			my ($pl, $dir) = @_;
27			unfollow $pl->ob->name;
28			},
29			on_login => sub {
30			my ($pl, $dir) = @_;
31			$pl->detach ("follow_aborter");
32			},
33			;
34
35	root	1.22	sub start_follow_handler {
36			$FOLLOW_HANDLER = cf::async_ext {
37			$Coro::current->{desc} = "follow handler";
38
39			while () {
40	root	1.26	$cf::WAIT_FOR_TICK->wait;
41	root	1.22
42			for (values %FOLLOW) {
43			my ($who, $target, $queue) = @$_;
44
45	root	1.23	$target->active
46			or next;
47
48	root	1.22	my ($map, $x, $y) = ($target->map, $target->x, $target->y);
49
50			# add new position to queue, if any
51			push @$queue, [$map, $x, $y]
52	root	1.24	if !@$queue
53			\|\| $map != $queue->[-1][0]
54			\|\| $x != $queue->[-1][1]
55			\|\| $y != $queue->[-1][2];
56	root	1.22
57			# try to move to oldest position
58			if (@$queue > $MAX_QUEUE) {
59			$who->message ($target->name . " is too far away - you can't follow anymore!");
60	root	1.25	unfollow $who->name;
61	root	1.23	} elsif (@$queue) {
62	root	1.22	my ($map, $x, $y) = @{ $queue->[0] };
63
64			$map->load;
65
66			if (
67			!$map->valid
68			or $map->path !~ /^(\{link\}\|\/)/
69			or grep $_->flag (cf::FLAG_IS_FLOOR) && ($_->flag (cf::FLAG_UNIQUE) \|\| $_->type == cf::SHOP_FLOOR),
70			$map->at ($x, $y)
71			) {
72			$who->message ("You can't follow " . $target->name . " anymore!");
73			unfollow $who->name;
74			} elsif (!$who->blocked ($map, $x, $y)) {
75			shift @$queue;
76			$who->goto ($map, $x, $y);
77			}
78	root	1.13	}
79	root	1.1	}
80	root	1.22
81			Coro::schedule unless keys %FOLLOW;
82	root	1.1	}
83	root	1.22	};
84			}
85	root	1.13
86	root	1.22	start_follow_handler;
87	root	1.1
88			cf::register_command follow => sub {
89			my ($who, $args) = @_;
90
91			my $name = $who->name;
92
93			if ($args ne "" && $name ne $args) {
94	root	1.8	if (my $other = cf::player::find_active $args) {
95	root	1.18	$other = $other->ob;
96
97			if ($other->map == $who->map
98			&& abs ($other->x - $who->x) <= 1
99			&& abs ($other->y - $who->y) <= 1
100			) {
101	root	1.1	$who->message ("Following player '$args', to stop, type: 'follow");
102	root	1.18	$other->message ("$name is now following your every step...");
103	root	1.22	$FOLLOW{$name} = [
104	root	1.18	$who,
105			$other,
106			[[$other->map, $other->x, $other->y]],
107	root	1.1	];
108	root	1.19	$who->contr->attach ("follow_aborter");
109	root	1.22	$FOLLOW_HANDLER->ready;
110	root	1.1	} else {
111			$who->message ("You must stand directly beside '$args' to follow her/him");
112	root	1.22	delete $FOLLOW{$name};
113	root	1.1	}
114			} else {
115			$who->message ("Cannot follow '$args': no such player");
116	root	1.22	delete $FOLLOW{$name};
117	root	1.1	}
118			} else {
119			$who->message ("follow mode off");
120	root	1.22	delete $FOLLOW{$name};
121	root	1.1	}
122			};
123
124	root	1.18	sub unregister {
125			my ($pl) = @_;
126	root	1.19
127	root	1.18	my $name = $pl->ob->name;
128
129	root	1.19	unfollow $name;
130	root	1.18
131	root	1.22	while (my ($k, $v) = each %FOLLOW) {
132	root	1.19	unfollow $k
133			if $v->[1]->name eq $name;
134	root	1.18	}
135			}
136
137	root	1.3	cf::player->attach (
138	root	1.18	on_death => \&unregister,
139			on_logout => \&unregister,
140	root	1.3	);
141	root	1.1