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

Comparing deliantra/maps/perl/cfplus.ext (file contents):
Revision 1.1 by root, Mon Jun 12 13:23:43 2006 UTC vs.
Revision 1.4 by root, Mon Jun 19 10:19:51 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 { 17sub dialog_tell {
23 my ($dialog, $msg) = @_; 18 my ($token, $dialog, $msg) = @_;
24 19
25 my $pl = cf::player::find $dialog->{name}; 20 my $pl = $dialog->{ob}->contr;
26 21 my ($reply, @kw) = $dialog->tell ($msg);
27 for my $match (@{ $dialog->{match} }) { 22 $reply = "..." unless $reply;
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); 23 $pl->send ("ext $token msg " . join "\x00", $reply, @kw);
48 return;
49 }
50 }
51 }
52
53 $pl->send ("ext $dialog->{token} msg ...");
54} 24}
55 25
56# return "interesting" information about the given tile 26# return "interesting" information about the given tile
57# currently only returns the npc_dialog title when a dialog is possible 27# currently only returns the npc_dialog title when a dialog is possible
58cf::register_extcmd lookat => sub { 28cf::register_extcmd lookat => sub {
59 my ($pl, $data) = @_; 29 my ($pl, $data) = @_;
60 30
61 my ($token, $dx, $dy) = split / /, $data; 31 my ($token, $dx, $dy) = split / /, $data;
32 my $near = (abs $dx) <= 2 && (abs $dy) <= 2;
62 33
63 my %res; 34 my %res;
64
65 my $near = abs ($dx) <= 2 && abs ($dy) <= 2;
66 35
67 if ($pl->cell_visible ($dx, $dy)) { 36 if ($pl->cell_visible ($dx, $dy)) {
68 for my $ob ($pl->ob->map->at ($pl->ob->x + $dx, $pl->ob->y + $dy)) { 37 for my $ob ($pl->ob->map->at ($pl->ob->x + $dx, $pl->ob->y + $dy)) {
69 $res{npc_dialog} = $ob->name 38 $res{npc_dialog} = $ob->name
70 if $near && $ob->message =~ /^\@match /; 39 if $near && NPC_Dialogue::has_dialogue $ob;
71 } 40 }
72 } 41 }
73 42
74 $pl->send ("ext $token " . join "\x00", %res); 43 $pl->send ("ext $token " . join "\x00", %res);
75}; 44};
… …
77cf::register_extcmd npc_dialog_begin => sub { 46cf::register_extcmd npc_dialog_begin => sub {
78 my ($pl, $data) = @_; 47 my ($pl, $data) = @_;
79 48
80 my ($token, $dx, $dy) = split / /, $data; 49 my ($token, $dx, $dy) = split / /, $data;
81 50
82 return unless abs ($dx) <= 2 && abs ($dy) <= 2; 51 return unless (abs $dx) <= 2 && (abs $dy) <= 2;
83 return unless $pl->cell_visible ($dx, $dy); 52 return unless $pl->cell_visible ($dx, $dy);
84 53
85 for my $npc ($pl->ob->map->at ($pl->ob->x + $dx, $pl->ob->y + $dy)) { 54 for my $npc ($pl->ob->map->at ($pl->ob->x + $dx, $pl->ob->y + $dy)) {
86 if (my @match = parse_message $npc->get_message) { 55 if (NPC_Dialogue::has_dialogue $npc) {
87 $dialog{$token} = { 56 $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"; 57 dialog_tell $token, $dialog{$token}, "hi";
95 return; 58 return;
96 } 59 }
97 } 60 }
98 61
99 $pl->send ("ext $token error"); 62 $pl->send ("ext $token error");
… …
102cf::register_extcmd npc_dialog_tell => sub { 65cf::register_extcmd npc_dialog_tell => sub {
103 my ($pl, $data) = @_; 66 my ($pl, $data) = @_;
104 67
105 my ($token, $msg) = split / /, $data, 2; 68 my ($token, $msg) = split / /, $data, 2;
106 69
107 dialog_tell $dialog{$token}, $msg 70 dialog_tell $token, $dialog{$token}, $msg
108 if $dialog{$token}; 71 if $dialog{$token};
109}; 72};
110 73
111cf::register_extcmd npc_dialog_end => sub { 74cf::register_extcmd npc_dialog_end => sub {
112 my ($pl, $token) = @_; 75 my ($pl, $token) = @_;
113 76
114 delete $dialog{$token}; 77 delete $dialog{$token};
115}; 78};
116 79
80sub on_logout {
81 my ($pl, $host) = @_;
82
83 delete $dialog{$_} for grep $pl->ob == $dialog{$_}{ob}, keys %dialog;
84
85 0
86}
87
88sub on_clock {
89 return 0 unless %dialog;
90
91 while (my ($token, $dialog) = each %dialog) {
92 my (undef, $dx, $dy) = $dialog->{ob}->rangevector ($dialog->{npc});
93 next if (abs $dx) <= 2 && (abs $dy) <= 2;
94
95 $dialog->{ob}->contr->send ("ext $token out_of_range");
96 delete $dialog{$token};
97 }
98
99 0
100}
101

Diff Legend

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