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 |
my $near = abs ($dx) <= 2 && abs ($dy) <= 2; |
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 |
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 |
return unless abs ($dx) <= 2 && abs ($dy) <= 2; |
83 |
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 |
|