ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/cf.schmorp.de/maps/perl/cfplus.ext
(Generate patch)

Comparing cf.schmorp.de/maps/perl/cfplus.ext (file contents):
Revision 1.2 by root, Mon Jun 12 14:13:39 2006 UTC vs.
Revision 1.7 by root, Wed Jul 19 23:00:50 2006 UTC

1#! perl 1#! perl
2 2
3# additional support for cfplus client 3# additional support for cfplus client
4
5use NPC_Dialogue;
4 6
5cf::register_extcmd cfplus_support => sub { 7cf::register_extcmd cfplus_support => sub {
6 my ($pl, $data) = @_; 8 my ($pl, $data) = @_;
7 9
8 my ($token, $client_version) = split / /, $data, 2; 10 my ($token, $client_version) = split / /, $data, 2;
9 11
10 $pl->send ("ext $token 1"); 12 $pl->send ("ext $token 1");
11}; 13};
12 14
13sub parse_message($) {
14 map [split /\n/, $_, 2],
15 grep length,
16 split /^\@match /m,
17 $_[0]
18}
19
20my %dialog; # currently active dialogs 15my %dialog; # currently active dialogs
21 16
22sub dialog_tell { 17my $timer = Event->timer (interval => 0.2, parked => 1, cb => sub {
23 my ($dialog, $msg) = @_; 18 while (my ($token, $dialog) = each %dialog) {
19 my (undef, $dx, $dy) = $dialog->{ob}->rangevector ($dialog->{npc});
20 next if (abs $dx) <= 2 && (abs $dy) <= 2;
24 21
25 my $pl = cf::player::find $dialog->{name}; 22 $dialog->{ob}->contr->send ("ext $token out_of_range");
26 23 delete $dialog{$token};
27 for my $match (@{ $dialog->{match} }) {
28 for (split /\|/, $match->[0]) {
29 if ($_ eq "*" || 0 <= index $msg, $_) {
30 my $reply = $match->[1];
31
32 # combine lines into paragraphs
33 $reply =~ s/(?<=\S)\n(?=\w)/ /g;
34 $reply =~ s/\n\n/\n/g;
35
36 my @kw;
37 # now mark up all matching keywords
38 for my $match (@{ $dialog->{match} }) {
39 for (sort { (length $b) <=> (length $a) } split /\|/, $match->[0]) {
40 if ($reply =~ /\b\Q$_\E\b/i) {
41 push @kw, $_;
42 last;
43 }
44 }
45 }
46
47 $pl->send ("ext $dialog->{token} msg " . join "\x00", $reply, @kw);
48 return;
49 }
50 }
51 } 24 }
52 25
53 $pl->send ("ext $dialog->{token} msg ..."); 26 $_[0]->w->stop unless keys %dialog;
27});
28
29sub dialog_tell {
30 my ($token, $dialog, $msg) = @_;
31
32 utf8::decode $msg;
33 my $pl = $dialog->{ob}->contr;
34 my ($reply, @kw) = $dialog->tell ($msg);
35 $reply = "..." unless $reply;
36 utf8::encode $_ for ($reply, @kw);
37 $pl->send ("ext $token msg " . join "\x00", $reply, @kw);
54} 38}
55 39
56# return "interesting" information about the given tile 40# return "interesting" information about the given tile
57# currently only returns the npc_dialog title when a dialog is possible 41# currently only returns the npc_dialog title when a dialog is possible
58cf::register_extcmd lookat => sub { 42cf::register_extcmd lookat => sub {
59 my ($pl, $data) = @_; 43 my ($pl, $data) = @_;
60 44
61 my ($token, $dx, $dy) = split / /, $data; 45 my ($token, $dx, $dy) = split / /, $data;
46 my $near = (abs $dx) <= 2 && (abs $dy) <= 2;
62 47
63 my %res; 48 my %res;
64
65 my $near = (abs $dx) <= 2 && (abs $dy) <= 2;
66 49
67 if ($pl->cell_visible ($dx, $dy)) { 50 if ($pl->cell_visible ($dx, $dy)) {
68 for my $ob ($pl->ob->map->at ($pl->ob->x + $dx, $pl->ob->y + $dy)) { 51 for my $ob ($pl->ob->map->at ($pl->ob->x + $dx, $pl->ob->y + $dy)) {
69 $res{npc_dialog} = $ob->name 52 $res{npc_dialog} = $ob->name
70 if $near && $ob->message =~ /^\@match /; 53 if $near && NPC_Dialogue::has_dialogue $ob;
71 } 54 }
72 } 55 }
73 56
74 $pl->send ("ext $token " . join "\x00", %res); 57 $pl->send ("ext $token " . join "\x00", %res);
75}; 58};
… …
81 64
82 return unless (abs $dx) <= 2 && (abs $dy) <= 2; 65 return unless (abs $dx) <= 2 && (abs $dy) <= 2;
83 return unless $pl->cell_visible ($dx, $dy); 66 return unless $pl->cell_visible ($dx, $dy);
84 67
85 for my $npc ($pl->ob->map->at ($pl->ob->x + $dx, $pl->ob->y + $dy)) { 68 for my $npc ($pl->ob->map->at ($pl->ob->x + $dx, $pl->ob->y + $dy)) {
86 if (my @match = parse_message $npc->get_message) { 69 if (NPC_Dialogue::has_dialogue $npc) {
87 $dialog{$token} = { 70 $dialog{$token} = new NPC_Dialogue ob => $pl->ob, npc => $npc;
88 name => $pl->ob->name,
89 token => $token,
90 npc => $npc,
91 match => \@match,
92 };
93
94 dialog_tell $dialog{$token}, "hi"; 71 dialog_tell $token, $dialog{$token}, "hi";
72 $timer->start;
95 return; 73 return;
96 } 74 }
97 } 75 }
98 76
99 $pl->send ("ext $token error"); 77 $pl->send ("ext $token error");
… …
102cf::register_extcmd npc_dialog_tell => sub { 80cf::register_extcmd npc_dialog_tell => sub {
103 my ($pl, $data) = @_; 81 my ($pl, $data) = @_;
104 82
105 my ($token, $msg) = split / /, $data, 2; 83 my ($token, $msg) = split / /, $data, 2;
106 84
107 dialog_tell $dialog{$token}, $msg 85 dialog_tell $token, $dialog{$token}, $msg
108 if $dialog{$token}; 86 if $dialog{$token};
109}; 87};
110 88
111cf::register_extcmd npc_dialog_end => sub { 89cf::register_extcmd npc_dialog_end => sub {
112 my ($pl, $token) = @_; 90 my ($pl, $token) = @_;
113 91
114 delete $dialog{$token}; 92 delete $dialog{$token};
115}; 93};
116 94
117sub on_clock { 95sub on_logout {
118 return 0 unless %dialog; 96 my ($pl, $host) = @_;
119 97
120 while (my ($token, $dialog) = each %dialog) { 98 delete $dialog{$_} for grep $pl->ob == $dialog{$_}{ob}, keys %dialog;
121 if (my $pl = cf::player::find $dialog->{name}) {
122 my (undef, $dx, $dy) = $pl->ob->rangevector ($dialog->{npc});
123 next if (abs $dx) <= 2 && (abs $dy) <= 2;
124
125 $pl->send ("ext $token out_of_range");
126 }
127 delete $dialog{$token};
128 }
129 99
130 0 100 0
131} 101}
132 102
103sub on_unload {
104 while (my ($token, $dialog) = each %dialog) {
105 $dialog->{ob}->contr->send ("ext $token perl_reload");
106 }
107
108 %dialog = ();
109
110 0
111}
112
113

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines