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 defined $reply;
   return if $reply eq ""; # NPC doesn't want to say, or wants to say something later

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