ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/DC/Protocol.pm
Revision: 1.51
Committed: Sun Jul 2 21:07:26 2006 UTC (17 years, 10 months ago) by root
Branch: MAIN
Changes since 1.50: +4 -3 lines
Log Message:
add menu to map, bind all important dialogs to f-keys

File Contents

# User Rev Content
1 root 1.1 package CFClient::Protocol;
2    
3     use utf8;
4     use strict;
5    
6 root 1.2 use Crossfire::Protocol::Constants;
7    
8 root 1.20 use CFClient;
9 root 1.1 use CFClient::UI;
10    
11     use base 'Crossfire::Protocol::Base';
12    
13 elmex 1.34 our %open_logs;
14    
15 root 1.1 sub new {
16     my $class = shift;
17    
18     my $self = $class->SUPER::new (@_);
19    
20     $self->{map_widget}->clr_commands;
21    
22 root 1.21 my $cmd_help = CFClient::load_pod CFClient::find_rcfile "pod/command_help.pod", command_help => 1, sub {
23     my ($pom) = @_;
24 root 1.1
25 root 1.21 my @cmd_help;
26 root 1.1
27 root 1.21 for my $head2 ($pom->head1->[-2]->head2) {
28     $head2->title =~ /^(\S+) (?:\s+ \( ([^\)]*) \) )?/x
29     or next;
30 root 1.1
31 root 1.21 my $cmd = $1;
32     my @args = split /\|/, $2;
33     @args = (".*") unless @args;
34    
35     $_ = $_ eq ".*" ? "" : " $_"
36     for @args;
37    
38     my $text = CFClient::pod_to_pango $head2->content;
39    
40     push @cmd_help, ["$cmd$_", $text]
41     for sort { (length $a) <=> (length $b) }
42     @args;
43     }
44 root 1.6
45 root 1.21 \@cmd_help
46     };
47 root 1.1
48 root 1.21 $self->{map_widget}->add_command (@$_)
49     for @$cmd_help;
50 root 1.1
51     $self->{noface} = new_from_file CFClient::Texture
52     CFClient::find_rcfile "noface.png", minify => 1, mipmap => 1;
53    
54     $self->{open_container} = 0;
55    
56     # "global"
57     $self->{tilecache} = CFClient::db_table "tilecache";
58     $self->{facemap} = CFClient::db_table "facemap";
59    
60     # per server
61     $self->{mapcache} = CFClient::db_table "mapcache_$self->{host}_$self->{port}";
62    
63     $self
64     }
65    
66 elmex 1.34 sub logprint {
67     my ($self, @a) = @_;
68     my $filename = "$Crossfire::VARDIR/log.$self->{host}";
69    
70     my $fh = $open_logs{$filename};
71     unless ($fh) {
72     # FIXME: handle this more gracefully?
73     open $fh, ">>", $filename
74     or die "Couldn't open logfile: log.$self->{host}: $!";
75    
76     $open_logs{$filename} = $fh;
77     }
78    
79     my ($sec, $min, $hour, $mday, $mon, $year) = localtime (time);
80    
81     my $ts = sprintf "%04d-%02d-%02d %02d:%02d:%02d",
82     $year + 1900, $mon + 1, $mday, $hour, $min, $sec;
83    
84     print $fh "$ts ", @a, "\n";
85     $fh->flush;
86     }
87    
88 root 1.1 sub stats_update {
89     my ($self, $stats) = @_;
90    
91 elmex 1.4 if (my $exp = $stats->{+CS_STAT_EXP64}) {
92 root 1.1 my $diff = $exp - $self->{prev_exp};
93 elmex 1.5 $self->{statusbox}->add ("$diff experience gained", group => "experience $diff", fg => [0.5, 1, 0.5, 0.8], timeout => 5)
94 root 1.1 if exists $self->{prev_exp} && $diff;
95     $self->{prev_exp} = $exp;
96     }
97    
98     ::update_stats_window ($stats);
99     }
100    
101     sub user_send {
102     my ($self, $command) = @_;
103    
104 elmex 1.9 if ($self->{record}) {
105     push @{$self->{record}}, $command;
106     }
107    
108 elmex 1.34 $self->logprint ("send: ", $command);
109 root 1.1 $self->send_command ($command);
110 root 1.45 ::status ($command);
111 root 1.1 }
112    
113 elmex 1.9 sub start_record {
114     my ($self) = @_;
115    
116     $self->{record} = [];
117     }
118    
119     sub stop_record {
120     my ($self) = @_;
121     return delete $self->{record};
122     }
123    
124 root 1.1 sub map_scroll {
125     my ($self, $dx, $dy) = @_;
126    
127     $self->{map}->scroll ($dx, $dy);
128     }
129    
130     sub feed_map1a {
131     my ($self, $data) = @_;
132    
133     $self->{map}->map1a_update ($data);
134     $self->{map_widget}->update;
135     }
136    
137 root 1.36 sub magicmap {
138     my ($self, $w, $h, $x, $y, $data) = @_;
139    
140     $self->{map_widget}->set_magicmap ($w, $h, $x, $y, $data);
141     }
142    
143 root 1.1 sub flush_map {
144     my ($self) = @_;
145    
146     my $map_info = delete $self->{map_info}
147     or return;
148    
149     my ($hash, $x, $y, $w, $h) = @$map_info;
150    
151     my $data = $self->{map}->get_rect ($x, $y, $w, $h);
152     $self->{mapcache}->put ($hash => Compress::LZF::compress $data);
153     #warn sprintf "SAVEmap[%s] length %d\n", $hash, length $data;#d#
154     }
155    
156     sub map_clear {
157     my ($self) = @_;
158    
159     $self->flush_map;
160     delete $self->{neigh_map};
161    
162     $self->{map}->clear;
163 root 1.37 delete $self->{map_widget}{magicmap};
164 root 1.1 }
165    
166    
167     sub load_map($$$) {
168     my ($self, $hash, $x, $y) = @_;
169    
170     if (defined (my $data = $self->{mapcache}->get ($hash))) {
171     $data = Compress::LZF::decompress $data;
172     #warn sprintf "LOADmap[%s,%d,%d] length %d\n", $hash, $x, $y, length $data;#d#
173     for my $id ($self->{map}->set_rect ($x, $y, $data)) {
174     my $data = $self->{tilecache}->get ($id)
175     or next;
176    
177     $self->set_texture ($id => $data);
178     }
179     }
180     }
181    
182     # hardcode /world/world_xxx_xxx map names, the savings are enourmous,
183     # (server resource,s latency, bandwidth), so this hack is warranted.
184     # the right fix is to make real tiled maps with an overview file
185     sub send_mapinfo {
186     my ($self, $data, $cb) = @_;
187    
188     if ($self->{map_info}[0] =~ m%^/world/world_(\d\d\d)_(\d\d\d)$%) {
189     my ($wx, $wy) = ($1, $2);
190    
191     if ($data =~ /^spatial ([1-4]+)$/) {
192     my @dx = (0, 0, 1, 0, -1);
193     my @dy = (0, -1, 0, 1, 0);
194     my ($dx, $dy);
195    
196     for (split //, $1) {
197     $dx += $dx[$_];
198     $dy += $dy[$_];
199     }
200    
201     $cb->(spatial => 15,
202     $self->{map_info}[1] - $self->{map}->ox + $dx * 50,
203     $self->{map_info}[2] - $self->{map}->oy + $dy * 50,
204     50, 50,
205     sprintf "/world/world_%03d_%03d", $wx + $dx, $wy + $dy
206     );
207    
208     return;
209     }
210     }
211    
212     $self->SUPER::send_mapinfo ($data, $cb);
213     }
214    
215     # this method does a "flood fill" into every tile direction
216     # it assumes that tiles are arranged in a rectangular grid,
217     # i.e. a map is the same as the left of the right map etc.
218     # failure to comply are harmless and result in display errors
219     # at worst.
220     sub flood_fill {
221     my ($self, $block, $gx, $gy, $path, $hash, $flags) = @_;
222    
223     # the server does not allow map paths > 6
224     return if 7 <= length $path;
225    
226     my ($x0, $y0, $x1, $y1) = @{$self->{neigh_rect}};
227    
228     for (
229     [1, 3, 0, -1],
230     [2, 4, 1, 0],
231     [3, 1, 0, 1],
232     [4, 2, -1, 0],
233     ) {
234     my ($tile, $tile2, $dx, $dy) = @$_;
235    
236     next if $block & (1 << $tile);
237     my $block = $block | (1 << $tile2);
238    
239     my $gx = $gx + $dx;
240     my $gy = $gy + $dy;
241    
242     next unless $flags & (1 << ($tile - 1));
243     next if $self->{neigh_grid}{$gx, $gy}++;
244    
245     my $neigh = $self->{neigh_map}{$hash} ||= [];
246     if (my $info = $neigh->[$tile]) {
247     my ($flags, $x, $y, $w, $h, $hash) = @$info;
248    
249     $self->flood_fill ($block, $gx, $gy, "$path$tile", $hash, $flags)
250     if $x >= $x0 && $x + $w < $x1 && $y >= $y0 && $y + $h < $y1;
251    
252     } else {
253     $self->send_mapinfo ("spatial $path$tile", sub {
254     my ($mode, $flags, $x, $y, $w, $h, $hash) = @_;
255    
256     return if $mode ne "spatial";
257    
258     $x += $self->{map}->ox;
259     $y += $self->{map}->oy;
260    
261     $self->load_map ($hash, $x, $y)
262     unless $self->{neigh_map}{$hash}[5]++;#d#
263    
264     $neigh->[$tile] = [$flags, $x, $y, $w, $h, $hash];
265    
266     $self->flood_fill ($block, $gx, $gy, "$path$tile", $hash, $flags)
267     if $x >= $x0 && $x + $w < $x1 && $y >= $y0 && $y + $h < $y1;
268     });
269     }
270     }
271     }
272    
273     sub map_change {
274     my ($self, $mode, $flags, $x, $y, $w, $h, $hash) = @_;
275    
276     $self->flush_map;
277    
278     my ($ox, $oy) = ($::MAP->ox, $::MAP->oy);
279    
280     my $mapmapw = $self->{mapmap}->{w};
281     my $mapmaph = $self->{mapmap}->{h};
282    
283     $self->{neigh_rect} = [
284     $ox - $mapmapw * 0.5, $oy - $mapmapw * 0.5,
285     $ox + $mapmapw * 0.5 + $w, $oy + $mapmapw * 0.5 + $h,
286     ];
287    
288     delete $self->{neigh_grid};
289    
290     $x += $ox;
291     $y += $oy;
292    
293     $self->{map_info} = [$hash, $x, $y, $w, $h];
294    
295     (my $map = $hash) =~ s/^.*?\/([^\/]+)$/\1/;
296     $::STATWIDS->{map}->set_text ("Map: " . $map);
297    
298     $self->load_map ($hash, $x, $y);
299     $self->flood_fill (0, 0, 0, "", $hash, $flags);
300     }
301    
302     sub face_find {
303     my ($self, $facenum, $face) = @_;
304    
305     my $hash = "$face->{chksum},$face->{name}";
306    
307     my $id = $self->{facemap}->get ($hash);
308    
309     unless ($id) {
310     # create new id for face
311     # I love transactions
312     for (1..100) {
313     my $txn = $CFClient::DB_ENV->txn_begin;
314 root 1.15 my $status = $self->{facemap}->db_get (id => $id);
315 root 1.1 if ($status == 0 || $status == BerkeleyDB::DB_NOTFOUND) {
316 root 1.35 $id = ($id || 64) + 1;
317 root 1.1 if ($self->{facemap}->put (id => $id) == 0
318     && $self->{facemap}->put ($hash => $id) == 0) {
319     $txn->txn_commit;
320    
321     goto gotid;
322     }
323     }
324 root 1.15 $txn->txn_abort;
325 root 1.1 }
326    
327     CFClient::fatal "maximum number of transaction retries reached - database problems?";
328     }
329    
330     gotid:
331     $face->{id} = $id;
332     $self->{map}->set_face ($facenum => $id);
333     $self->{faceid}[$facenum] = $id;#d#
334    
335     my $face = $self->{tilecache}->get ($id);
336    
337     if ($face) {
338     #$self->face_prefetch;
339     $face
340     } else {
341     my $tex = $self->{noface};
342     $self->{map}->set_texture ($id, @$tex{qw(name w h s t)}, @{$tex->{minified}});
343     undef
344     };
345     }
346    
347     sub face_update {
348     my ($self, $facenum, $face) = @_;
349    
350     $self->{tilecache}->put ($face->{id} => $face->{image}); #TODO: try to avoid duplicate writes
351    
352     $self->set_texture ($face->{id} => delete $face->{image});
353     }
354    
355     sub set_texture {
356     my ($self, $id, $data) = @_;
357    
358     $self->{texture}[$id] ||= do {
359     my $tex =
360     new_from_image CFClient::Texture
361     $data, minify => 1, mipmap => 1;
362    
363     $self->{map}->set_texture ($id, @$tex{qw(name w h s t)}, @{$tex->{minified}});
364     $self->{map_widget}->update;
365    
366     $tex
367     };
368     }
369    
370     sub sound_play {
371     my ($self, $x, $y, $soundnum, $type) = @_;
372    
373     $self->{sound_play}->($x, $y, $soundnum, $type);
374     }
375    
376     my $LAST_QUERY; # server is stupid, stupid, stupid
377    
378     sub query {
379     my ($self, $flags, $prompt) = @_;
380    
381     $prompt = $LAST_QUERY unless length $prompt;
382     $LAST_QUERY = $prompt;
383    
384 root 1.22 $self->{query}-> ($self, $flags, $prompt);
385 root 1.1 }
386    
387     sub drawinfo {
388     my ($self, $color, $text) = @_;
389    
390     my @color = (
391     [1.00, 1.00, 1.00], #[0.00, 0.00, 0.00],
392     [1.00, 1.00, 1.00],
393     [0.50, 0.50, 1.00], #[0.00, 0.00, 0.55]
394     [1.00, 0.00, 0.00],
395     [1.00, 0.54, 0.00],
396     [0.11, 0.56, 1.00],
397     [0.93, 0.46, 0.00],
398     [0.18, 0.54, 0.34],
399     [0.56, 0.73, 0.56],
400     [0.80, 0.80, 0.80],
401     [0.55, 0.41, 0.13],
402     [0.99, 0.77, 0.26],
403     [0.74, 0.65, 0.41],
404     );
405    
406 elmex 1.34 $self->logprint ("info: ", $text);
407    
408 root 1.1 my $time = sprintf "%02d:%02d:%02d", (localtime time)[2,1,0];
409    
410 root 1.23 # try to create single paragraphs of multiple lines sent by the server
411 root 1.24 $text =~ s/(?<=\S)\n(?=\w)/ /g;
412 root 1.23
413 root 1.1 $text = CFClient::UI::Label::escape $text;
414     $text =~ s/\[b\](.*?)\[\/b\]/<b>\1<\/b>/g;
415     $text =~ s/\[color=(.*?)\](.*?)\[\/color\]/<span foreground='\1'>\2<\/span>/g;
416    
417 root 1.40 $self->{logview}->add_paragraph ($color[$color], $_)
418     for map "$time $_", split /\n/, $text;
419     $self->{logview}->scroll_to_bottom;
420 root 1.1
421 elmex 1.5 $self->{statusbox}->add ($text,
422 root 1.1 group => $text,
423     fg => $color[$color],
424 root 1.18 timeout => $color >= 2 ? 60 : 10,
425 root 1.1 tooltip_font => $::FONT_FIXED,
426     );
427     }
428    
429     sub drawextinfo {
430     my ($self, $color, $type, $subtype, $message) = @_;
431    
432     $self->drawinfo ($color, $message);
433     }
434    
435     sub spell_add {
436     my ($self, $spell) = @_;
437    
438 root 1.27 # try to create single paragraphs of multiple lines sent by the server
439     $spell->{message} =~ s/(?<=\S)\n(?=\w)/ /g;
440     $spell->{message} =~ s/\n+$//;
441     $spell->{message} ||= "Server did not provide a description for this spell.";
442    
443 root 1.51 $::SPELL_PAGE->add_spell ($spell);
444 elmex 1.14
445 root 1.1 $self->{map_widget}->add_command ("invoke $spell->{name}", CFClient::UI::Label::escape $spell->{message});
446     $self->{map_widget}->add_command ("cast $spell->{name}", CFClient::UI::Label::escape $spell->{message});
447     }
448    
449     sub spell_delete {
450     my ($self, $spell) = @_;
451 root 1.51
452     $::SPELL_PAGE->remove_spell ($spell);
453 root 1.1 }
454    
455     sub addme_success {
456     my ($self) = @_;
457    
458 root 1.21 my $skill_help = CFClient::load_pod CFClient::find_rcfile "pod/skill_help.pod", skill_help => 1, sub {
459     my ($pom) = @_;
460 root 1.1
461 root 1.21 my %skill_help;
462 root 1.1
463 root 1.21 for my $head2 ($pom->head1->[3]->head2) {
464     $skill_help{$head2->title} = CFClient::pod_to_pango $head2->content;
465     }
466    
467     \%skill_help
468     };
469 root 1.1
470     for my $skill (values %{$self->{skill_info}}) {
471     $self->{map_widget}->add_command ("ready_skill $skill",
472     (CFClient::UI::Label::escape "Ready the skill '$skill'\n\n")
473 root 1.21 . $skill_help->{$skill});
474 root 1.1 $self->{map_widget}->add_command ("use_skill $skill",
475     (CFClient::UI::Label::escape "Immediately use the skill '$skill'\n\n")
476 root 1.21 . $skill_help->{$skill});
477 root 1.1 }
478     }
479    
480     sub eof {
481     my ($self) = @_;
482    
483     $self->{map_widget}->clr_commands;
484    
485     ::stop_game ();
486     }
487    
488     sub image_info {
489     my ($self, $numfaces) = @_;
490    
491     $self->{num_faces} = $numfaces;
492     $self->{face_prefetch} = [1 .. $numfaces];
493     $self->face_prefetch;
494     }
495    
496     sub face_prefetch {
497     my ($self) = @_;
498    
499     return unless $::CFG->{face_prefetch};
500    
501     if ($self->{num_faces}) {
502     return if @{ $self->{send_queue} || [] };
503     my $todo = @{ $self->{face_prefetch} }
504     or return;
505    
506     my ($face) = splice @{ $self->{face_prefetch} }, + rand @{ $self->{face_prefetch} }, 1, ();
507    
508     $self->send ("requestinfo image_sums $face $face");
509    
510 elmex 1.5 $self->{statusbox}->add (CFClient::UI::Label::escape "prefetching $todo",
511 root 1.19 group => "prefetch", timeout => 3, fg => [1, 1, 0, 0.5]);
512 root 1.1 } elsif (!exists $self->{num_faces}) {
513     $self->send ("requestinfo image_info");
514    
515     $self->{num_faces} = 0;
516    
517 elmex 1.5 $self->{statusbox}->add (CFClient::UI::Label::escape "starting to prefetch",
518 root 1.19 group => "prefetch", timeout => 3, fg => [1, 1, 0, 0.5]);
519 root 1.1 }
520     }
521    
522     sub update_floorbox {
523     $CFClient::UI::ROOT->on_refresh ($::FLOORBOX => sub {
524     return unless $::CONN;
525    
526     $::FLOORBOX->clear;
527    
528     my $row;
529 root 1.46 for (sort { $a->{count} <=> $b->{count} } values %{ $::CONN->{container}{0} }) {
530 root 1.25 if ($row < 6) {
531 root 1.1 local $_->{face_widget}; # hack to force recreation of widget
532     local $_->{desc_widget}; # hack to force recreation of widget
533     CFClient::Item::update_widgets $_;
534    
535     $::FLOORBOX->add (0, $row, $_->{face_widget});
536     $::FLOORBOX->add (1, $row, $_->{desc_widget});
537    
538     $row++;
539     } else {
540 root 1.25 $::FLOORBOX->add (1, $row, new CFClient::UI::Button
541 root 1.30 text => "More...",
542 root 1.51 on_activate => sub { ::toggle_player_page ($::INVENTORY_PAGE); 0 },
543 root 1.25 );
544 root 1.1 last;
545     }
546     }
547     });
548    
549     $::WANT_REFRESH++;
550     }
551    
552     sub set_opencont {
553     my ($conn, $tag, $name) = @_;
554     $conn->{open_container} = $tag;
555 elmex 1.10
556     $::INV_RIGHT_HB->clear ();
557     $::INV_RIGHT_HB->add (new CFClient::UI::Label align => 0, expand => 1, text => $name);
558    
559     if ($tag != 0) { # Floor isn't closable, is it?
560     $::INV_RIGHT_HB->add (new CFClient::UI::Button
561     text => "Close container",
562     tooltip => "Close the currently open container (if one is open)",
563     on_activate => sub {
564     $::CONN->send ("apply $tag") # $::CONN->{open_container}")
565     if $tag != 0;
566     #if $CONN->{open_container} != 0;
567 root 1.38 0
568 elmex 1.10 },
569     );
570     }
571    
572 root 1.1 $::INVR->set_items ($conn->{container}{$tag});
573     }
574    
575 root 1.47 sub update_containers {
576     my ($self) = @_;
577 root 1.1
578 root 1.47 $CFClient::UI::ROOT->on_refresh ("update_containers_$self" => sub {
579     for my $tag (keys %{ delete $self->{update_container} }) {
580     if ($tag == 0) {
581     update_floorbox;
582 root 1.48 $::INVR->set_items ($self->{container}{0})
583     if $tag == $self->{open_container};
584 root 1.47 } elsif ($tag == $self->{player}{tag}) {
585     $::INV->set_items ($self->{container}{$tag})
586     } else {
587 root 1.48 $::INVR->set_items ($self->{container}{$tag})
588     if $tag == $self->{open_container};
589 root 1.47 }
590     }
591     });
592 root 1.1 }
593    
594 root 1.48 sub container_add {
595     my ($self, $tag, $items) = @_;
596    
597     $self->{update_container}{$tag}++;
598     $self->update_containers;
599     }
600    
601 root 1.1 sub container_clear {
602     my ($self, $tag) = @_;
603    
604 root 1.47 $self->{update_container}{$tag}++;
605     $self->update_containers;
606 root 1.1 }
607    
608     sub item_delete {
609     my ($self, @items) = @_;
610    
611 root 1.49 $self->{update_container}{$_->{container}}++
612 root 1.47 for @items;
613    
614     $self->update_containers;
615 root 1.1 }
616    
617     sub item_update {
618     my ($self, $item) = @_;
619    
620     #d# print "item_update: $item->{tag} in $item->{container} ($self->{player}{tag}) ($::CONN->{open_container})\n";
621    
622     CFClient::Item::update_widgets $item;
623    
624 root 1.2 if ($item->{tag} == $::CONN->{open_container} && not ($item->{flags} & F_OPEN)) {
625 root 1.1 set_opencont ($::CONN, 0, "Floor");
626    
627 root 1.2 } elsif ($item->{flags} & F_OPEN) {
628 root 1.1 set_opencont ($::CONN, $item->{tag}, CFClient::Item::desc_string $item);
629 root 1.47
630 root 1.1 } else {
631 root 1.47 $self->{update_container}{$item->{container}}++;
632     $self->update_containers;
633     # if ($item->{container} == 0) {
634     # update_floorbox;
635     # update_container (0);
636     # } elsif ($item->{container} == $self->{player}{tag}) {
637     # $::INV->set_items ($self->{container}{$item->{container}})
638     # }
639 root 1.1 }
640     }
641    
642 elmex 1.3 sub player_update {
643     my ($self, $player) = @_;
644     $::STATWIDS->{weight}->set_text (sprintf "Weight: %.1fkg", $player->{weight} / 1000);
645 root 1.28 }
646    
647 root 1.32 sub update_server_info {
648     my ($self) = @_;
649    
650     my @yesno = ("<span foreground='red'>no</span>", "<span foreground='green'>yes</span>");
651    
652     $::SERVER_INFO->set_markup (
653     "server <tt>$self->{host}:$self->{port}</tt>\n"
654     . "protocol version <tt>$self->{version}</tt>\n"
655     . "minimap support $yesno[$self->{setup}{mapinfocmd} > 0]\n"
656     . "extended command support $yesno[$self->{setup}{extcmd} > 0]\n"
657     . "cfplus support $yesno[$self->{cfplus_ext} > 0]"
658     . ($self->{cfplus_ext} > 0 ? ", version $self->{cfplus_ext}" : "") ."\n"
659     . "map size $self->{mapw}×$self->{maph}\n"
660     );
661     }
662    
663 root 1.28 sub logged_in {
664     my ($self) = @_;
665    
666 root 1.32 $self->send_ext_req (cfplus_support => "1", sub {
667 root 1.28 $self->{cfplus_ext} = $_[0];
668 root 1.32 $self->update_server_info;
669     });
670 root 1.31
671 root 1.32 $self->update_server_info;
672 root 1.13
673     $self->send_command ("output-sync $::CFG->{output_sync}");
674     $self->send_command ("output-count $::CFG->{output_count}");
675 root 1.29 $self->send_command ("pickup $::CFG->{pickup}");
676 elmex 1.3 }
677    
678 root 1.32 sub lookat {
679     my ($self, $x, $y) = @_;
680    
681     if ($self->{cfplus_ext}) {
682     $self->send_ext_req (lookat => "$x $y", sub {
683     my %res = split /\x00/, $_[0];
684    
685     if (exists $res{npc_dialog}) {
686     # start npc chat dialog
687     $self->{npc_dialog} = new CFClient::NPCDialog::
688     dx => $x,
689     dy => $y,
690     title => "$res{npc_dialog} (NPC)",
691     conn => $self,
692     ;
693     }
694     });
695     }
696    
697     $self->send ("lookat $x $y");
698     }
699    
700     sub destroy {
701     my ($self) = @_;
702    
703     $self->{npc_dialog}->destroy
704     if $self->{npc_dialog};
705    
706     $self->SUPER::destroy;
707     }
708    
709     package CFClient::NPCDialog;
710    
711     our @ISA = 'CFClient::UI::FancyFrame';
712    
713     sub new {
714     my $class = shift;
715    
716     my $self = $class->SUPER::new (
717     x => 'center',
718     y => 'center',
719     name => "npc_dialog",
720     force_w => $::WIDTH * 0.7,
721     force_h => $::HEIGHT * 0.7,
722     title => "NPC Dialog",
723     kw => { hi => 0, yes => 0, no => 0 },
724     @_,
725     );
726    
727     Scalar::Util::weaken (my $this = $self);
728    
729     # better use a pane...
730     $self->add (my $hbox = new CFClient::UI::HBox);
731     $hbox->add ($self->{textview} = new CFClient::UI::TextScroller expand => 1);
732    
733     $hbox->add (my $vbox = new CFClient::UI::VBox);
734    
735     $vbox->add (new CFClient::UI::Label text => "Message Entry:");
736     $vbox->add ($self->{entry} = new CFClient::UI::Entry
737     tooltip => "Enter a message you want to tell the NPC and press <b>return</b>.\n\n"
738     . "Sometimes you have to tell an NPC something you cannot find out during "
739     . "a normal conversation (such as a password). In those cases you have to use "
740     . "this text entry. You can also enter responses manually instead of using the response "
741     . "buttons below.",
742     on_activate => sub {
743     my ($entry, $text) = @_;
744    
745     return unless $text =~ /\S/;
746    
747     $entry->set_text ("");
748     $this->send ($text);
749 root 1.38
750     0
751 root 1.32 },
752     );
753    
754     $vbox->add ($self->{options} = new CFClient::UI::VBox);
755    
756 root 1.39 $self->{bye_button} = new CFClient::UI::Button
757 root 1.32 text => "Bye (close)",
758     tooltip => "Use this button to end talking to the NPC. This also closes the dialog window.",
759 root 1.38 on_activate => sub { $this->destroy; 0 },
760 root 1.32 ;
761    
762     $self->update_options;
763    
764     $self->{token} = $self->{conn}->ext_token;
765     $self->{conn}->connect_ext ($self->{token} => sub { $this->feed (@_) });
766     $self->{conn}->send ("ext npc_dialog_begin $self->{token} $self->{dx} $self->{dy}");
767    
768 root 1.38 $self->{entry}->grab_focus;
769 root 1.32
770     $self->{textview}->add_paragraph ([1, 1, 0, 1], "<small>[starting conversation with <b>$self->{title}</b>]</small>\n\n");
771    
772     $self->show;
773     $self
774     };
775    
776     sub update_options {
777     my ($self) = @_;
778    
779     Scalar::Util::weaken $self;
780    
781     $self->{options}->clear;
782 root 1.39 $self->{options}->add ($self->{bye_button});
783 root 1.32
784     for my $kw (sort keys %{ $self->{kw} }) {
785     $self->{options}->add (new CFClient::UI::Button
786     text => $kw,
787     on_activate => sub {
788     $self->send ($kw);
789 root 1.38 0
790 root 1.32 },
791     );
792     }
793     }
794    
795     sub feed {
796     my ($self, $data) = @_;
797    
798 root 1.42 Scalar::Util::weaken $self;
799    
800 root 1.32 my ($type, $msg) = split / /, $data, 2;
801    
802     if ($type eq "msg") {
803     my ($msg, @kw) = split /\x00/, $msg;
804     $self->{kw}{$_} = 1 for @kw;
805    
806 root 1.41 $msg = "\n" . CFClient::UI::Label::escape $msg;
807 root 1.32 my $match = join "|", map "\\b\Q$_\E\\b", sort { (length $b) <=> (length $a) } keys %{ $self->{kw} };
808 root 1.41 my @link;
809     $msg =~ s{
810     ($match)
811     }{
812 root 1.42 my $kw = $1;
813    
814 root 1.41 push @link, new CFClient::UI::Label
815 root 1.42 markup => "<span foreground='#c0c0ff' underline='single'>$kw</span>",
816 root 1.41 can_hover => 1,
817 root 1.42 can_events => 1,
818 root 1.43 padding_x => 0,
819     padding_y => 0,
820 root 1.42 on_button_up => sub {
821     $self->send ($kw);
822     };
823 root 1.41
824     chr 0xfffc
825     }giex;
826 root 1.32
827 root 1.41 $self->{textview}->add_paragraph ([1, 1, 1, 1], [$msg, @link]);
828 root 1.42 $self->{textview}->scroll_to_bottom;
829 root 1.32 $self->update_options;
830     } else {
831     $self->destroy;
832     }
833    
834     1
835     }
836    
837     sub send {
838     my ($self, $msg) = @_;
839    
840     $self->{conn}->send ("ext npc_dialog_tell $self->{token} $msg");
841     $self->{textview}->add_paragraph ([1, 1, 0, 1], "\n" . CFClient::UI::Label::escape $msg);
842 root 1.42 $self->{textview}->scroll_to_bottom;
843 root 1.32 }
844    
845     sub destroy {
846     my ($self) = @_;
847    
848 root 1.39 #Carp::cluck "debug\n";#d# #todo# enable: destroy gets called twice because scalar keys {} is 1
849 root 1.32
850     delete $self->{conn}{npc_dialog};
851     $self->{conn}->disconnect_ext ($self->{token});
852    
853     $self->SUPER::destroy;
854     }
855    
856 root 1.1 1;