ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/server/ext/cfplus.ext
Revision: 1.4
Committed: Mon Apr 2 18:04:45 2007 UTC (17 years, 1 month ago) by root
Branch: MAIN
CVS Tags: rel-2_1
Changes since 1.3: +3 -1 lines
Log Message:
moved setup to perlspace to facilitate easier extensions and some cleanups. feels more secure, too

File Contents

# Content
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 (
29 version => 2,
30 )
31 };
32
33 my %dialog; # currently active dialogs
34
35 my $timer = Event->timer (interval => 0.2, parked => 1, data => cf::WF_AUTOCANCEL, cb => sub {
36 while (my ($id, $dialog) = each %dialog) {
37 my (undef, $dx, $dy) = $dialog->{ob}->rangevector ($dialog->{npc});
38 next if (abs $dx) <= 2 && (abs $dy) <= 2;
39
40 $dialog->{ob}->contr->ext_reply ($id => msgtype => "error", msg => "out of range");
41 delete $dialog{$id};
42 }
43
44 $_[0]->w->stop unless keys %dialog;
45 });
46
47 sub dialog_tell {
48 my ($id, $dialog, $msg) = @_;
49
50 my $pl = $dialog->{ob}->contr;
51 my ($reply, @kw) = $dialog->tell ($msg);
52 $reply = "..." unless $reply;
53
54 $pl->ext_reply ($id => msgtype => "reply", msg => $reply, add_topics => \@kw);
55 }
56
57 =item ... = extcmd lookat { dx => $dx, dy => $dy }
58
59 "Looks at" the mapspace displaced (dx|dy) relative to the player
60 and returns "interesting" information about it.
61
62 Keys it can return include:
63
64 npc_dialog => $name
65 There is an npc or other object that can "talk" to the player.
66
67 =cut
68
69 cf::register_extcmd lookat => sub {
70 my ($pl, $msg) = @_;
71 my ($dx, $dy) = @$msg{qw(dx dy)};
72
73 return unless $pl->ob && $pl->ob->map;
74
75 my $near = (abs $dx) <= 2 && (abs $dy) <= 2;
76
77 my %res;
78
79 if ($pl->cell_visible ($dx, $dy)) {
80 for my $ob ($pl->ob->map->at ($pl->ob->x + $dx, $pl->ob->y + $dy)) {
81 $res{npc_dialog} = $ob->name
82 if $near && NPC_Dialogue::has_dialogue $ob;
83 }
84 }
85
86 %res
87 };
88
89 =item ... = extcmd npc_dialog_begin { msgid => $id, dx => $dx, dy => $dy }
90
91 Tries to start a dialogue with the mapspace specified by $dx and $dy (see
92 C<extcmd lookat>). The $msgid will be used as a handle for all future
93 messages related to this dialog interaction.
94
95 It either replies with an error reply or starts a dialog by telling
96 the npc "hi" and returning a reply strcuture as with C<extcmd
97 npc_dialog_tell>.
98
99 =cut
100
101 cf::register_extcmd npc_dialog_begin => sub {
102 my ($pl, $msg) = @_;
103 my ($id, $dx, $dy) = @$msg{qw(msgid dx dy)};
104
105 return unless $pl->ob && $pl->ob->map;
106 return unless (abs $dx) <= 2 && (abs $dy) <= 2;
107 return unless $pl->cell_visible ($dx, $dy);
108
109 for my $npc ($pl->ob->map->at ($pl->ob->x + $dx, $pl->ob->y + $dy)) {
110 if (NPC_Dialogue::has_dialogue $npc) {
111 $dialog{$id} = new NPC_Dialogue ob => $pl->ob, npc => $npc;
112 dialog_tell $id, $dialog{$id}, "hi";
113 $timer->start;
114 return;
115 }
116 }
117
118 (msgtype => "error", msg => "nothing to talk to found")
119 };
120
121 =item ... = extcmd npc_dialog_tell { msgid => $id, msg => $text }
122
123 Tells the NPC the given $text message and returns a reply structure which
124 can have the following keys:
125
126 msgtype => "reply"
127 msg => $reply_text,
128 add_topics => [additional topic strings]
129 del_topics => [invalidated topic strings]
130
131 =cut
132
133 cf::register_extcmd npc_dialog_tell => sub {
134 my ($pl, $msg) = @_;
135
136 dialog_tell $msg->{msgid}, $dialog{$msg->{msgid}}, $msg->{msg}
137 if $dialog{$msg->{msgid}};
138
139 ()
140 };
141
142 =item extcmd npc_dialog_end { msgid => $id }
143
144 Finishes the dialog, invalidating the handle.
145
146 =cut
147
148 cf::register_extcmd npc_dialog_end => sub {
149 my ($pl, $msg) = @_;
150
151 delete $dialog{$msg->{msgid}};
152
153 ()
154 };
155
156 cf::player->attach (
157 on_logout => sub {
158 my ($pl) = @_;
159
160 delete $dialog{$_} for grep $pl->ob == $dialog{$_}{ob}, keys %dialog;
161 },
162 );
163
164 =item ... = extcmd editor_support
165
166 Returns the value required by clients that have an editor to download and
167 upload maps from/to the server.
168
169 servertype => (game|test) type of this server
170 gameserver => the hostname:port of the normal game server
171 testserver => the hostname:port of the test server the maps can be tested on
172 cvs_root => the (http) url where the cvs root for downloading is located
173 lib_root => the (http) url where crossfire.0 and archetypes can be found
174 upload => the (http) url where clients can upload maps
175
176 If those values are not supplied or empty strings, the server does not
177 support downloading, uploading, testing, respectively.
178
179 The upload script expects the following values in a multipart form upload:
180
181 client: a descriptive string describing the editor and version used to upload
182 path: absolute server-side map path beginning with /
183 map: the map file itself
184 mapdir: the cvs root url originally used to download the map
185 revision: cvs-revision originally used to download the map
186 comment: a comment supplied by the user that documents the changes
187 cf_login: crossfire server login
188 cf_password: crossfire server password, optionally used for authentication purposes
189
190 =cut
191
192 cf::register_extcmd editor_support => sub {
193 my ($pl, $msg) = @_;
194
195 map +($_ => $cf::CFG{"editor_$_"}), qw(servertype gameserver testserver cvs_root lib_root builder_ui)
196 };
197
198 sub unload {
199 while (my ($id, $dialog) = each %dialog) {
200 $dialog->{ob}->contr->ext_reply ($id => msgtype => "error", msg => "npc dialogue module was reloaded");
201 }
202
203 %dialog = ();
204 }
205
206 =back
207
208 =cut
209