server/ext/cfplus.ext

#! perl

# additional support for cfplus client

use NPC_Dialogue;

=head1 CF+ protocol extensions

This module implements protocol extensions for use by the CF+ client, but
can be used by other clients as well. It uses the C<extcmd> mechanism
exclusively.

=over 4

=item ... = extcmd cfplus_support { version => $client_version }

Registers the client the the server. the client should send the highest
version of the protocol it supports itself, and the server returns the
highest version of the protocol it supports in the C<version> key itself.

=cut

cf::register_extcmd cfplus_support => sub {
   my ($pl, $msg) = @_;

   # $msg->{version}

   (
      version => 2,
   )
};

sub dialog_tell {
   my ($id, $dialog, $msg) = @_;

   my $pl = $dialog->{pl};
   my ($reply, @kw) = $dialog->tell ($msg);
   $reply = "..." unless $reply;

   $pl->ext_reply ($id => msgtype => "reply", msg => $reply, add_topics => \@kw);
}

=item ... = extcmd lookat { dx => $dx, dy => $dy }

"Looks at" the mapspace displaced (dx|dy) relative to the player
and returns "interesting" information about it.

Keys it can return include:

   npc_dialog => $name
      There is an npc or other object that can "talk" to the player.

=cut

cf::register_extcmd lookat => sub {
   my ($pl, $msg) = @_;
   my ($dx, $dy) = @$msg{qw(dx dy)};

   return unless $pl->ob && $pl->ob->map;

   my $near = (abs $dx) <= 2 && (abs $dy) <= 2;

   my %res;

   if ($pl->cell_visible ($dx, $dy)) {
      for my $ob ($pl->ob->map->at ($pl->ob->x + $dx, $pl->ob->y + $dy)) {
         $res{npc_dialog} = $ob->name
            if $near && NPC_Dialogue::has_dialogue $ob && !$pl->{npc_dialog};
      }
   }

   %res
};

=item ... = extcmd npc_dialog_begin { msgid => $id, dx => $dx, dy => $dy }

Tries to start a dialogue with the mapspace specified by $dx and $dy (see
C<extcmd lookat>). The $msgid will be used as a handle for all future
messages related to this dialog interaction.

It either replies with an error reply or starts a dialog by telling
the npc "hi" and returning a reply structure as with C<extcmd
npc_dialog_tell>.

=cut

cf::register_extcmd npc_dialog_begin => sub {
   my ($pl, $msg) = @_;
   my ($id, $dx, $dy) = @$msg{qw(msgid dx dy)};

   return unless $pl->ob && $pl->ob->map;
   return unless (abs $dx) <= 2 && (abs $dy) <= 2;
   return unless $pl->cell_visible ($dx, $dy);
   return if $pl->{npc_dialog}; # only one dialog at a time

   for my $npc ($pl->ob->map->at ($pl->ob->x + $dx, $pl->ob->y + $dy)) {
      if (NPC_Dialogue::has_dialogue $npc) {
         $pl->attach ("npc_dialog_active");
         $pl->{npc_dialog} = new NPC_Dialogue pl => $pl, npc => $npc;
         dialog_tell $id, $pl->{npc_dialog}, "hi";
         return;
      }
   }

   (msgtype => "error", msg => "nothing to talk to found")
};

=item ... = extcmd npc_dialog_tell { msgid => $id, msg => $text }

Tells the NPC the given $text message and returns a reply structure which
can have the following keys:

   msgtype => "reply"
   msg => $reply_text,
   add_topics => [additional topic strings]
   del_topics => [invalidated topic strings]

=cut

cf::register_extcmd npc_dialog_tell => sub {
   my ($pl, $msg) = @_;

   if (my $dialog = $pl->{npc_dialog}) {
      dialog_tell $msg->{msgid}, $dialog, $msg->{msg};
   }

   ()
};

=item extcmd npc_dialog_end { msgid => $id }

Finishes the dialog, invalidating the handle.

=cut

cf::register_extcmd npc_dialog_end => sub {
   my ($pl, $msg) = @_;

   if (my $dialog = delete $pl->{npc_dialog}) {
      $pl->detach ("ncpa_dialog_active");
   }

   ()
};

=item ... = extcmd editor_support

Returns the value required by clients that have an editor to download and
upload maps from/to the server.

   servertype => (game|test) type of this server
   gameserver => the hostname:port of the normal game server
   testserver => the hostname:port of the test server the maps can be tested on
   cvs_root   => the (http) url where the cvs root for downloading is located
   lib_root   => the (http) url where crossfire.0 and archetypes can be found
   upload     => the (http) url where clients can upload maps

If those values are not supplied or empty strings, the server does not
support downloading, uploading, testing, respectively.

The upload script expects the following values in a multipart form upload:

   client: a descriptive string describing the editor and version used to upload
   path: absolute server-side map path beginning with /
   map: the map file itself
   mapdir: the cvs root url originally used to download the map
   revision: cvs-revision originally used to download the map
   comment: a comment supplied by the user that documents the changes
   cf_login: crossfire server login
   cf_password: crossfire server password, optionally used for authentication purposes

=cut

cf::register_extcmd editor_support => sub {
   my ($pl, $msg) = @_;

   map +($_ => $cf::CFG{"editor_$_"}), qw(servertype gameserver testserver cvs_root lib_root builder_ui)
};

sub unload {
   for my $pl (cf::player::list) {
      if (my $dialog = delete $pl->{npc_dialog}) {
         $pl->detach ("npc_dialog_active");
         $pl->ext_reply ($dialog->{id} => msgtype => "error", msg => "npc dialogue module was reloaded");
      }
   }
}

cf::player::attachment npc_dialog_active =>
   on_logout => sub {
      my ($pl) = @_;

      delete $pl->{npc_dialog};
      $pl->detach ("npc_dialog_active");
   },
   on_move => sub {
      my ($pl, $dir) = @_;

      if (my $dialog = $pl->{npc_dialog}) {
      warn "on_move<@_>\n";#d#
      warn $pl->ob;
      warn $dialog;
      warn $dialog->{npc};
      warn $dialog->{npc}->is_valid;

         my (undef, $dx, $dy) = $pl->ob->rangevector ($dialog->{npc});
      
         return if (abs $dx) <= 2 && (abs $dy) <= 2;

         $pl->ext_reply ($dialog->{id} => msgtype => "error", msg => "out of range");
      }

      delete $pl->{npc_dialog};
      $pl->detach ("npc_dialog_active");
   },
;

cf::player->attach (
   on_login => sub {
      my ($pl) = @_;

      delete $pl->{npc_dialog};
   },
);

=back

=cut

Revision:	1.5
Committed:	Sat Jun 16 14:35:41 2007 UTC (16 years, 11 months ago) by root
Branch:	MAIN
Changes since 1.4:	+55 -35 lines
Log Message:	- use a per-player attachment in dialog code instead of a timer to detect distance. - store currently active dialog in $pl->{npc_dialog}
#	User	Rev	Content
1	root	1.1	#! perl
2
3			# additional support for cfplus client
4
5			use NPC_Dialogue;
6
7			=head1 CF+ protocol extensions
8
9			This module implements protocol extensions for use by the CF+ client, but
10			can be used by other clients as well. It uses the C<extcmd> mechanism
11			exclusively.
12
13			=over 4
14
15			=item ... = extcmd cfplus_support { version => $client_version }
16
17			Registers the client the the server. the client should send the highest
18			version of the protocol it supports itself, and the server returns the
19			highest version of the protocol it supports in the C<version> key itself.
20
21			=cut
22
23			cf::register_extcmd cfplus_support => sub {
24			my ($pl, $msg) = @_;
25
26			# $msg->{version}
27
28	root	1.4	(
29			version => 2,
30			)
31	root	1.1	};
32
33			sub dialog_tell {
34			my ($id, $dialog, $msg) = @_;
35
36	root	1.5	my $pl = $dialog->{pl};
37	root	1.1	my ($reply, @kw) = $dialog->tell ($msg);
38			$reply = "..." unless $reply;
39
40			$pl->ext_reply ($id => msgtype => "reply", msg => $reply, add_topics => \@kw);
41			}
42
43			=item ... = extcmd lookat { dx => $dx, dy => $dy }
44
45			"Looks at" the mapspace displaced (dx\|dy) relative to the player
46			and returns "interesting" information about it.
47
48			Keys it can return include:
49
50			npc_dialog => $name
51			There is an npc or other object that can "talk" to the player.
52
53			=cut
54
55			cf::register_extcmd lookat => sub {
56			my ($pl, $msg) = @_;
57			my ($dx, $dy) = @$msg{qw(dx dy)};
58
59	root	1.2	return unless $pl->ob && $pl->ob->map;
60
61	root	1.1	my $near = (abs $dx) <= 2 && (abs $dy) <= 2;
62
63			my %res;
64
65			if ($pl->cell_visible ($dx, $dy)) {
66			for my $ob ($pl->ob->map->at ($pl->ob->x + $dx, $pl->ob->y + $dy)) {
67			$res{npc_dialog} = $ob->name
68	root	1.5	if $near && NPC_Dialogue::has_dialogue $ob && !$pl->{npc_dialog};
69	root	1.1	}
70			}
71
72			%res
73			};
74
75			=item ... = extcmd npc_dialog_begin { msgid => $id, dx => $dx, dy => $dy }
76
77			Tries to start a dialogue with the mapspace specified by $dx and $dy (see
78			C<extcmd lookat>). The $msgid will be used as a handle for all future
79			messages related to this dialog interaction.
80
81			It either replies with an error reply or starts a dialog by telling
82	root	1.5	the npc "hi" and returning a reply structure as with C<extcmd
83	root	1.1	npc_dialog_tell>.
84
85			=cut
86
87			cf::register_extcmd npc_dialog_begin => sub {
88			my ($pl, $msg) = @_;
89			my ($id, $dx, $dy) = @$msg{qw(msgid dx dy)};
90
91	root	1.2	return unless $pl->ob && $pl->ob->map;
92	root	1.1	return unless (abs $dx) <= 2 && (abs $dy) <= 2;
93			return unless $pl->cell_visible ($dx, $dy);
94	root	1.5	return if $pl->{npc_dialog}; # only one dialog at a time
95	root	1.1
96			for my $npc ($pl->ob->map->at ($pl->ob->x + $dx, $pl->ob->y + $dy)) {
97			if (NPC_Dialogue::has_dialogue $npc) {
98	root	1.5	$pl->attach ("npc_dialog_active");
99			$pl->{npc_dialog} = new NPC_Dialogue pl => $pl, npc => $npc;
100			dialog_tell $id, $pl->{npc_dialog}, "hi";
101	root	1.1	return;
102			}
103			}
104
105			(msgtype => "error", msg => "nothing to talk to found")
106			};
107
108			=item ... = extcmd npc_dialog_tell { msgid => $id, msg => $text }
109
110			Tells the NPC the given $text message and returns a reply structure which
111			can have the following keys:
112
113			msgtype => "reply"
114			msg => $reply_text,
115			add_topics => [additional topic strings]
116			del_topics => [invalidated topic strings]
117
118			=cut
119
120			cf::register_extcmd npc_dialog_tell => sub {
121			my ($pl, $msg) = @_;
122
123	root	1.5	if (my $dialog = $pl->{npc_dialog}) {
124			dialog_tell $msg->{msgid}, $dialog, $msg->{msg};
125			}
126	root	1.1
127			()
128			};
129
130			=item extcmd npc_dialog_end { msgid => $id }
131
132			Finishes the dialog, invalidating the handle.
133
134			=cut
135
136			cf::register_extcmd npc_dialog_end => sub {
137			my ($pl, $msg) = @_;
138
139	root	1.5	if (my $dialog = delete $pl->{npc_dialog}) {
140			$pl->detach ("ncpa_dialog_active");
141			}
142	root	1.1
143			()
144			};
145
146			=item ... = extcmd editor_support
147
148			Returns the value required by clients that have an editor to download and
149			upload maps from/to the server.
150
151			servertype => (game\|test) type of this server
152			gameserver => the hostname:port of the normal game server
153			testserver => the hostname:port of the test server the maps can be tested on
154			cvs_root => the (http) url where the cvs root for downloading is located
155			lib_root => the (http) url where crossfire.0 and archetypes can be found
156			upload => the (http) url where clients can upload maps
157
158			If those values are not supplied or empty strings, the server does not
159			support downloading, uploading, testing, respectively.
160
161			The upload script expects the following values in a multipart form upload:
162
163			client: a descriptive string describing the editor and version used to upload
164			path: absolute server-side map path beginning with /
165			map: the map file itself
166			mapdir: the cvs root url originally used to download the map
167			revision: cvs-revision originally used to download the map
168			comment: a comment supplied by the user that documents the changes
169			cf_login: crossfire server login
170			cf_password: crossfire server password, optionally used for authentication purposes
171
172			=cut
173
174			cf::register_extcmd editor_support => sub {
175			my ($pl, $msg) = @_;
176
177			map +($_ => $cf::CFG{"editor_$_"}), qw(servertype gameserver testserver cvs_root lib_root builder_ui)
178			};
179
180			sub unload {
181	root	1.5	for my $pl (cf::player::list) {
182			if (my $dialog = delete $pl->{npc_dialog}) {
183			$pl->detach ("npc_dialog_active");
184			$pl->ext_reply ($dialog->{id} => msgtype => "error", msg => "npc dialogue module was reloaded");
185			}
186	root	1.1	}
187	root	1.5	}
188	root	1.1
189	root	1.5	cf::player::attachment npc_dialog_active =>
190			on_logout => sub {
191			my ($pl) = @_;
192
193			delete $pl->{npc_dialog};
194			$pl->detach ("npc_dialog_active");
195			},
196			on_move => sub {
197			my ($pl, $dir) = @_;
198
199			if (my $dialog = $pl->{npc_dialog}) {
200			warn "on_move<@_>\n";#d#
201			warn $pl->ob;
202			warn $dialog;
203			warn $dialog->{npc};
204			warn $dialog->{npc}->is_valid;
205
206			my (undef, $dx, $dy) = $pl->ob->rangevector ($dialog->{npc});
207
208			return if (abs $dx) <= 2 && (abs $dy) <= 2;
209
210			$pl->ext_reply ($dialog->{id} => msgtype => "error", msg => "out of range");
211			}
212
213			delete $pl->{npc_dialog};
214			$pl->detach ("npc_dialog_active");
215			},
216			;
217
218			cf::player->attach (
219			on_login => sub {
220			my ($pl) = @_;
221
222			delete $pl->{npc_dialog};
223			},
224			);
225	root	1.1
226			=back
227
228			=cut
229