| … | |
… | |
| 98 | =item @trigger connected-id |
98 | =item @trigger connected-id |
| 99 | |
99 | |
| 100 | Trigger all objects with the given connected-id. The trigger is stateful |
100 | Trigger all objects with the given connected-id. The trigger is stateful |
| 101 | and retains state per connected-id. |
101 | and retains state per connected-id. |
| 102 | |
102 | |
|
|
103 | =item @addtopic topic |
|
|
104 | |
|
|
105 | Adds the given topic names (separated by C<|>) to the list of topics |
|
|
106 | returned. |
|
|
107 | |
| 103 | =back |
108 | =back |
| 104 | |
109 | |
| 105 | =cut |
110 | =cut |
| 106 | |
111 | |
| 107 | sub tell { |
112 | sub tell { |
| … | |
… | |
| 112 | match: |
117 | match: |
| 113 | for my $match (@{ $self->{match} }) { |
118 | for my $match (@{ $self->{match} }) { |
| 114 | for (split /\|/, $match->[0]) { |
119 | for (split /\|/, $match->[0]) { |
| 115 | if ($_ eq "*" || $lcmsg eq lc) { |
120 | if ($_ eq "*" || $lcmsg eq lc) { |
| 116 | my $reply = $match->[1]; |
121 | my $reply = $match->[1]; |
|
|
122 | my @kw; |
| 117 | |
123 | |
| 118 | my @replies; |
124 | my @replies; |
| 119 | my @match; # @match/@parse command results |
125 | my @match; # @match/@parse command results |
| 120 | local $self->{ob}{record_replies} = \@replies; |
126 | local $self->{ob}{record_replies} = \@replies; |
| 121 | |
127 | |
| … | |
… | |
| 150 | |
156 | |
| 151 | $trigger->use_trigger; |
157 | $trigger->use_trigger; |
| 152 | |
158 | |
| 153 | $trigger->remove_button_link; |
159 | $trigger->remove_button_link; |
| 154 | $trigger->remove; |
160 | $trigger->remove; |
| 155 | |
|
|
| 156 | $trigger->free; |
161 | $trigger->free; |
| 157 | |
162 | |
| 158 | $$rvalue = !$$rvalue; |
163 | $$rvalue = !$$rvalue; |
|
|
164 | |
|
|
165 | } elsif ($cmd eq "addtopic") { |
|
|
166 | push @kw, split /\|/, $args; |
| 159 | |
167 | |
| 160 | } else { |
168 | } else { |
| 161 | warn "unknown dialogue command <$cmd,$args> used (from " . $self->{npc}->get_message . ")"; |
169 | warn "unknown dialogue command <$cmd,$args> used (from " . $self->{npc}->get_message . ")"; |
| 162 | } |
170 | } |
| 163 | } |
171 | } |
| … | |
… | |
| 167 | $reply =~ s/\n\n/\n/g; |
175 | $reply =~ s/\n\n/\n/g; |
| 168 | |
176 | |
| 169 | # ignores flags and npc from replies |
177 | # ignores flags and npc from replies |
| 170 | $reply = join "\n", (map $_->[1], @replies), $reply; |
178 | $reply = join "\n", (map $_->[1], @replies), $reply; |
| 171 | |
179 | |
| 172 | my @kw; |
|
|
| 173 | # now mark up all matching keywords |
180 | # now mark up all matching keywords |
| 174 | for my $match (@{ $self->{match} }) { |
181 | for my $match (@{ $self->{match} }) { |
| 175 | for (sort { (length $b) <=> (length $a) } split /\|/, $match->[0]) { |
182 | for (sort { (length $b) <=> (length $a) } split /\|/, $match->[0]) { |
| 176 | if ($reply =~ /\b\Q$_\E\b/i) { |
183 | if ($reply =~ /\b\Q$_\E\b/i) { |
| 177 | push @kw, $_; |
184 | push @kw, $_; |
