1 |
root |
1.1 |
#! perl |
2 |
|
|
|
3 |
|
|
# additional support for cfplus client |
4 |
|
|
|
5 |
|
|
cf::register_extcmd cfplus_support => sub { |
6 |
|
|
my ($pl, $data) = @_; |
7 |
|
|
|
8 |
|
|
my ($token, $client_version) = split / /, $data, 2; |
9 |
|
|
|
10 |
|
|
$pl->send ("ext $token 1"); |
11 |
|
|
}; |
12 |
|
|
|
13 |
|
|
sub parse_message($) { |
14 |
|
|
map [split /\n/, $_, 2], |
15 |
|
|
grep length, |
16 |
|
|
split /^\@match /m, |
17 |
|
|
$_[0] |
18 |
|
|
} |
19 |
|
|
|
20 |
|
|
my %dialog; # currently active dialogs |
21 |
|
|
|
22 |
|
|
sub dialog_tell { |
23 |
|
|
my ($dialog, $msg) = @_; |
24 |
|
|
|
25 |
|
|
my $pl = cf::player::find $dialog->{name}; |
26 |
|
|
|
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 |
|
|
} |
52 |
|
|
|
53 |
|
|
$pl->send ("ext $dialog->{token} msg ..."); |
54 |
|
|
} |
55 |
|
|
|
56 |
|
|
# return "interesting" information about the given tile |
57 |
|
|
# currently only returns the npc_dialog title when a dialog is possible |
58 |
|
|
cf::register_extcmd lookat => sub { |
59 |
|
|
my ($pl, $data) = @_; |
60 |
|
|
|
61 |
|
|
my ($token, $dx, $dy) = split / /, $data; |
62 |
|
|
|
63 |
|
|
my %res; |
64 |
|
|
|
65 |
root |
1.2 |
my $near = (abs $dx) <= 2 && (abs $dy) <= 2; |
66 |
root |
1.1 |
|
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 |
|
|
if $near && $ob->message =~ /^\@match /; |
71 |
|
|
} |
72 |
|
|
} |
73 |
|
|
|
74 |
|
|
$pl->send ("ext $token " . join "\x00", %res); |
75 |
|
|
}; |
76 |
|
|
|
77 |
|
|
cf::register_extcmd npc_dialog_begin => sub { |
78 |
|
|
my ($pl, $data) = @_; |
79 |
|
|
|
80 |
|
|
my ($token, $dx, $dy) = split / /, $data; |
81 |
|
|
|
82 |
root |
1.2 |
return unless (abs $dx) <= 2 && (abs $dy) <= 2; |
83 |
root |
1.1 |
return unless $pl->cell_visible ($dx, $dy); |
84 |
|
|
|
85 |
|
|
for my $npc ($pl->ob->map->at ($pl->ob->x + $dx, $pl->ob->y + $dy)) { |
86 |
|
|
if (my @match = parse_message $npc->get_message) { |
87 |
|
|
$dialog{$token} = { |
88 |
|
|
name => $pl->ob->name, |
89 |
|
|
token => $token, |
90 |
|
|
npc => $npc, |
91 |
|
|
match => \@match, |
92 |
|
|
}; |
93 |
|
|
|
94 |
|
|
dialog_tell $dialog{$token}, "hi"; |
95 |
|
|
return; |
96 |
|
|
} |
97 |
|
|
} |
98 |
|
|
|
99 |
|
|
$pl->send ("ext $token error"); |
100 |
|
|
}; |
101 |
|
|
|
102 |
|
|
cf::register_extcmd npc_dialog_tell => sub { |
103 |
|
|
my ($pl, $data) = @_; |
104 |
|
|
|
105 |
|
|
my ($token, $msg) = split / /, $data, 2; |
106 |
|
|
|
107 |
|
|
dialog_tell $dialog{$token}, $msg |
108 |
|
|
if $dialog{$token}; |
109 |
|
|
}; |
110 |
|
|
|
111 |
|
|
cf::register_extcmd npc_dialog_end => sub { |
112 |
|
|
my ($pl, $token) = @_; |
113 |
|
|
|
114 |
|
|
delete $dialog{$token}; |
115 |
|
|
}; |
116 |
|
|
|
117 |
root |
1.2 |
sub on_clock { |
118 |
|
|
return 0 unless %dialog; |
119 |
|
|
|
120 |
|
|
while (my ($token, $dialog) = each %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 |
|
|
|
130 |
|
|
0 |
131 |
|
|
} |
132 |
|
|
|