ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/DC/Protocol.pm
Revision: 1.22
Committed: Tue Jun 6 02:55:50 2006 UTC (18 years ago) by root
Branch: MAIN
Changes since 1.21: +1 -58 lines
Log Message:
create hopefully helpful character creation dialogs

File Contents

# Content
1 package CFClient::Protocol;
2
3 use utf8;
4 use strict;
5
6 use Crossfire::Protocol::Constants;
7
8 use CFClient;
9 use CFClient::UI;
10
11 use base 'Crossfire::Protocol::Base';
12
13 sub new {
14 my $class = shift;
15
16 my $self = $class->SUPER::new (@_);
17
18 $self->{map_widget}->clr_commands;
19
20 my $cmd_help = CFClient::load_pod CFClient::find_rcfile "pod/command_help.pod", command_help => 1, sub {
21 my ($pom) = @_;
22
23 my @cmd_help;
24
25 for my $head2 ($pom->head1->[-2]->head2) {
26 $head2->title =~ /^(\S+) (?:\s+ \( ([^\)]*) \) )?/x
27 or next;
28
29 my $cmd = $1;
30 my @args = split /\|/, $2;
31 @args = (".*") unless @args;
32
33 $_ = $_ eq ".*" ? "" : " $_"
34 for @args;
35
36 my $text = CFClient::pod_to_pango $head2->content;
37
38 push @cmd_help, ["$cmd$_", $text]
39 for sort { (length $a) <=> (length $b) }
40 @args;
41 }
42
43 \@cmd_help
44 };
45
46 $self->{map_widget}->add_command (@$_)
47 for @$cmd_help;
48
49 $self->{noface} = new_from_file CFClient::Texture
50 CFClient::find_rcfile "noface.png", minify => 1, mipmap => 1;
51
52 $self->{open_container} = 0;
53
54 # "global"
55 $self->{tilecache} = CFClient::db_table "tilecache";
56 $self->{facemap} = CFClient::db_table "facemap";
57
58 # per server
59 $self->{mapcache} = CFClient::db_table "mapcache_$self->{host}_$self->{port}";
60
61 $self
62 }
63
64 sub stats_update {
65 my ($self, $stats) = @_;
66
67 if (my $exp = $stats->{+CS_STAT_EXP64}) {
68 my $diff = $exp - $self->{prev_exp};
69 $self->{statusbox}->add ("$diff experience gained", group => "experience $diff", fg => [0.5, 1, 0.5, 0.8], timeout => 5)
70 if exists $self->{prev_exp} && $diff;
71 $self->{prev_exp} = $exp;
72 }
73
74 ::update_stats_window ($stats);
75 }
76
77 sub user_send {
78 my ($self, $command) = @_;
79
80 if ($self->{record}) {
81 push @{$self->{record}}, $command;
82 }
83
84 $self->send_command ($command);
85 ::status $command;
86 }
87
88 sub start_record {
89 my ($self) = @_;
90
91 $self->{record} = [];
92 }
93
94 sub stop_record {
95 my ($self) = @_;
96 return delete $self->{record};
97 }
98
99 sub map_scroll {
100 my ($self, $dx, $dy) = @_;
101
102 $self->{map}->scroll ($dx, $dy);
103 }
104
105 sub feed_map1a {
106 my ($self, $data) = @_;
107
108 $self->{map}->map1a_update ($data);
109 $self->{map_widget}->update;
110 }
111
112 sub flush_map {
113 my ($self) = @_;
114
115 my $map_info = delete $self->{map_info}
116 or return;
117
118 my ($hash, $x, $y, $w, $h) = @$map_info;
119
120 my $data = $self->{map}->get_rect ($x, $y, $w, $h);
121 $self->{mapcache}->put ($hash => Compress::LZF::compress $data);
122 #warn sprintf "SAVEmap[%s] length %d\n", $hash, length $data;#d#
123 }
124
125 sub map_clear {
126 my ($self) = @_;
127
128 $self->flush_map;
129 delete $self->{neigh_map};
130
131 $self->{map}->clear;
132 }
133
134
135 sub load_map($$$) {
136 my ($self, $hash, $x, $y) = @_;
137
138 if (defined (my $data = $self->{mapcache}->get ($hash))) {
139 $data = Compress::LZF::decompress $data;
140 #warn sprintf "LOADmap[%s,%d,%d] length %d\n", $hash, $x, $y, length $data;#d#
141 for my $id ($self->{map}->set_rect ($x, $y, $data)) {
142 my $data = $self->{tilecache}->get ($id)
143 or next;
144
145 $self->set_texture ($id => $data);
146 }
147 }
148 }
149
150 # hardcode /world/world_xxx_xxx map names, the savings are enourmous,
151 # (server resource,s latency, bandwidth), so this hack is warranted.
152 # the right fix is to make real tiled maps with an overview file
153 sub send_mapinfo {
154 my ($self, $data, $cb) = @_;
155
156 if ($self->{map_info}[0] =~ m%^/world/world_(\d\d\d)_(\d\d\d)$%) {
157 my ($wx, $wy) = ($1, $2);
158
159 if ($data =~ /^spatial ([1-4]+)$/) {
160 my @dx = (0, 0, 1, 0, -1);
161 my @dy = (0, -1, 0, 1, 0);
162 my ($dx, $dy);
163
164 for (split //, $1) {
165 $dx += $dx[$_];
166 $dy += $dy[$_];
167 }
168
169 $cb->(spatial => 15,
170 $self->{map_info}[1] - $self->{map}->ox + $dx * 50,
171 $self->{map_info}[2] - $self->{map}->oy + $dy * 50,
172 50, 50,
173 sprintf "/world/world_%03d_%03d", $wx + $dx, $wy + $dy
174 );
175
176 return;
177 }
178 }
179
180 $self->SUPER::send_mapinfo ($data, $cb);
181 }
182
183 # this method does a "flood fill" into every tile direction
184 # it assumes that tiles are arranged in a rectangular grid,
185 # i.e. a map is the same as the left of the right map etc.
186 # failure to comply are harmless and result in display errors
187 # at worst.
188 sub flood_fill {
189 my ($self, $block, $gx, $gy, $path, $hash, $flags) = @_;
190
191 # the server does not allow map paths > 6
192 return if 7 <= length $path;
193
194 my ($x0, $y0, $x1, $y1) = @{$self->{neigh_rect}};
195
196 for (
197 [1, 3, 0, -1],
198 [2, 4, 1, 0],
199 [3, 1, 0, 1],
200 [4, 2, -1, 0],
201 ) {
202 my ($tile, $tile2, $dx, $dy) = @$_;
203
204 next if $block & (1 << $tile);
205 my $block = $block | (1 << $tile2);
206
207 my $gx = $gx + $dx;
208 my $gy = $gy + $dy;
209
210 next unless $flags & (1 << ($tile - 1));
211 next if $self->{neigh_grid}{$gx, $gy}++;
212
213 my $neigh = $self->{neigh_map}{$hash} ||= [];
214 if (my $info = $neigh->[$tile]) {
215 my ($flags, $x, $y, $w, $h, $hash) = @$info;
216
217 $self->flood_fill ($block, $gx, $gy, "$path$tile", $hash, $flags)
218 if $x >= $x0 && $x + $w < $x1 && $y >= $y0 && $y + $h < $y1;
219
220 } else {
221 $self->send_mapinfo ("spatial $path$tile", sub {
222 my ($mode, $flags, $x, $y, $w, $h, $hash) = @_;
223
224 return if $mode ne "spatial";
225
226 $x += $self->{map}->ox;
227 $y += $self->{map}->oy;
228
229 $self->load_map ($hash, $x, $y)
230 unless $self->{neigh_map}{$hash}[5]++;#d#
231
232 $neigh->[$tile] = [$flags, $x, $y, $w, $h, $hash];
233
234 $self->flood_fill ($block, $gx, $gy, "$path$tile", $hash, $flags)
235 if $x >= $x0 && $x + $w < $x1 && $y >= $y0 && $y + $h < $y1;
236 });
237 }
238 }
239 }
240
241 sub map_change {
242 my ($self, $mode, $flags, $x, $y, $w, $h, $hash) = @_;
243
244 $self->flush_map;
245
246 my ($ox, $oy) = ($::MAP->ox, $::MAP->oy);
247
248 my $mapmapw = $self->{mapmap}->{w};
249 my $mapmaph = $self->{mapmap}->{h};
250
251 $self->{neigh_rect} = [
252 $ox - $mapmapw * 0.5, $oy - $mapmapw * 0.5,
253 $ox + $mapmapw * 0.5 + $w, $oy + $mapmapw * 0.5 + $h,
254 ];
255
256 delete $self->{neigh_grid};
257
258 $x += $ox;
259 $y += $oy;
260
261 $self->{map_info} = [$hash, $x, $y, $w, $h];
262
263 (my $map = $hash) =~ s/^.*?\/([^\/]+)$/\1/;
264 $::STATWIDS->{map}->set_text ("Map: " . $map);
265
266 $self->load_map ($hash, $x, $y);
267 $self->flood_fill (0, 0, 0, "", $hash, $flags);
268 }
269
270 sub face_find {
271 my ($self, $facenum, $face) = @_;
272
273 my $hash = "$face->{chksum},$face->{name}";
274
275 my $id = $self->{facemap}->get ($hash);
276
277 unless ($id) {
278 # create new id for face
279 # I love transactions
280 for (1..100) {
281 my $txn = $CFClient::DB_ENV->txn_begin;
282 my $status = $self->{facemap}->db_get (id => $id);
283 if ($status == 0 || $status == BerkeleyDB::DB_NOTFOUND) {
284 $id = ($id || 16) + 1;
285 if ($self->{facemap}->put (id => $id) == 0
286 && $self->{facemap}->put ($hash => $id) == 0) {
287 $txn->txn_commit;
288
289 goto gotid;
290 }
291 }
292 $txn->txn_abort;
293 }
294
295 CFClient::fatal "maximum number of transaction retries reached - database problems?";
296 }
297
298 gotid:
299 $face->{id} = $id;
300 $self->{map}->set_face ($facenum => $id);
301 $self->{faceid}[$facenum] = $id;#d#
302
303 my $face = $self->{tilecache}->get ($id);
304
305 if ($face) {
306 #$self->face_prefetch;
307 $face
308 } else {
309 my $tex = $self->{noface};
310 $self->{map}->set_texture ($id, @$tex{qw(name w h s t)}, @{$tex->{minified}});
311 undef
312 };
313 }
314
315 sub face_update {
316 my ($self, $facenum, $face) = @_;
317
318 $self->{tilecache}->put ($face->{id} => $face->{image}); #TODO: try to avoid duplicate writes
319
320 $self->set_texture ($face->{id} => delete $face->{image});
321 }
322
323 sub set_texture {
324 my ($self, $id, $data) = @_;
325
326 $self->{texture}[$id] ||= do {
327 my $tex =
328 new_from_image CFClient::Texture
329 $data, minify => 1, mipmap => 1;
330
331 $self->{map}->set_texture ($id, @$tex{qw(name w h s t)}, @{$tex->{minified}});
332 $self->{map_widget}->update;
333
334 $tex
335 };
336 }
337
338 sub sound_play {
339 my ($self, $x, $y, $soundnum, $type) = @_;
340
341 $self->{sound_play}->($x, $y, $soundnum, $type);
342 }
343
344 my $LAST_QUERY; # server is stupid, stupid, stupid
345
346 sub query {
347 my ($self, $flags, $prompt) = @_;
348
349 $prompt = $LAST_QUERY unless length $prompt;
350 $LAST_QUERY = $prompt;
351
352 $self->{query}-> ($self, $flags, $prompt);
353 }
354
355 sub drawinfo {
356 my ($self, $color, $text) = @_;
357
358 my @color = (
359 [1.00, 1.00, 1.00], #[0.00, 0.00, 0.00],
360 [1.00, 1.00, 1.00],
361 [0.50, 0.50, 1.00], #[0.00, 0.00, 0.55]
362 [1.00, 0.00, 0.00],
363 [1.00, 0.54, 0.00],
364 [0.11, 0.56, 1.00],
365 [0.93, 0.46, 0.00],
366 [0.18, 0.54, 0.34],
367 [0.56, 0.73, 0.56],
368 [0.80, 0.80, 0.80],
369 [0.55, 0.41, 0.13],
370 [0.99, 0.77, 0.26],
371 [0.74, 0.65, 0.41],
372 );
373
374 my $time = sprintf "%02d:%02d:%02d", (localtime time)[2,1,0];
375
376 $text = CFClient::UI::Label::escape $text;
377 $text =~ s/\[b\](.*?)\[\/b\]/<b>\1<\/b>/g;
378 $text =~ s/\[color=(.*?)\](.*?)\[\/color\]/<span foreground='\1'>\2<\/span>/g;
379
380 $self->{logview}->add_paragraph ($color[$color],
381 join "\n", map "$time $_", split /\n/, $text);
382
383 $self->{statusbox}->add ($text,
384 group => $text,
385 fg => $color[$color],
386 timeout => $color >= 2 ? 60 : 10,
387 tooltip_font => $::FONT_FIXED,
388 );
389 }
390
391 sub drawextinfo {
392 my ($self, $color, $type, $subtype, $message) = @_;
393
394 $self->drawinfo ($color, $message);
395 }
396
397 sub spell_add {
398 my ($self, $spell) = @_;
399
400 # TODO
401 # create a widget dynamically, using spell face (CF::Protocol downloads them)
402 $::SETUP_SPELLS->add_spell ($spell);
403
404 $self->{map_widget}->add_command ("invoke $spell->{name}", CFClient::UI::Label::escape $spell->{message});
405 $self->{map_widget}->add_command ("cast $spell->{name}", CFClient::UI::Label::escape $spell->{message});
406 }
407
408 sub spell_delete {
409 my ($self, $spell) = @_;
410 $::SETUP_SPELLS->remove_spell ($spell);
411 }
412
413 sub addme_success {
414 my ($self) = @_;
415
416 my $skill_help = CFClient::load_pod CFClient::find_rcfile "pod/skill_help.pod", skill_help => 1, sub {
417 my ($pom) = @_;
418
419 my %skill_help;
420
421 for my $head2 ($pom->head1->[3]->head2) {
422 $skill_help{$head2->title} = CFClient::pod_to_pango $head2->content;
423 }
424
425 \%skill_help
426 };
427
428 for my $skill (values %{$self->{skill_info}}) {
429 $self->{map_widget}->add_command ("ready_skill $skill",
430 (CFClient::UI::Label::escape "Ready the skill '$skill'\n\n")
431 . $skill_help->{$skill});
432 $self->{map_widget}->add_command ("use_skill $skill",
433 (CFClient::UI::Label::escape "Immediately use the skill '$skill'\n\n")
434 . $skill_help->{$skill});
435 }
436 }
437
438 sub eof {
439 my ($self) = @_;
440
441 $self->{map_widget}->clr_commands;
442
443 ::stop_game ();
444 }
445
446 sub image_info {
447 my ($self, $numfaces) = @_;
448
449 $self->{num_faces} = $numfaces;
450 $self->{face_prefetch} = [1 .. $numfaces];
451 $self->face_prefetch;
452 }
453
454 sub face_prefetch {
455 my ($self) = @_;
456
457 return unless $::CFG->{face_prefetch};
458
459 if ($self->{num_faces}) {
460 return if @{ $self->{send_queue} || [] };
461 my $todo = @{ $self->{face_prefetch} }
462 or return;
463
464 my ($face) = splice @{ $self->{face_prefetch} }, + rand @{ $self->{face_prefetch} }, 1, ();
465
466 $self->send ("requestinfo image_sums $face $face");
467
468 $self->{statusbox}->add (CFClient::UI::Label::escape "prefetching $todo",
469 group => "prefetch", timeout => 3, fg => [1, 1, 0, 0.5]);
470 } elsif (!exists $self->{num_faces}) {
471 $self->send ("requestinfo image_info");
472
473 $self->{num_faces} = 0;
474
475 $self->{statusbox}->add (CFClient::UI::Label::escape "starting to prefetch",
476 group => "prefetch", timeout => 3, fg => [1, 1, 0, 0.5]);
477 }
478 }
479
480 sub update_floorbox {
481 $CFClient::UI::ROOT->on_refresh ($::FLOORBOX => sub {
482 return unless $::CONN;
483
484 $::FLOORBOX->clear;
485
486 my $row;
487 for (@{ $::CONN->{container}{0} }) {
488 if ($row < 7) {
489 local $_->{face_widget}; # hack to force recreation of widget
490 local $_->{desc_widget}; # hack to force recreation of widget
491 CFClient::Item::update_widgets $_;
492
493 $::FLOORBOX->add (0, $row, $_->{face_widget});
494 $::FLOORBOX->add (1, $row, $_->{desc_widget});
495
496 $row++;
497 } else {
498 $::FLOORBOX->add (1, $row, new CFClient::UI::Label text => "More...");
499 last;
500 }
501 }
502 });
503
504 $::WANT_REFRESH++;
505 }
506
507 sub set_opencont {
508 my ($conn, $tag, $name) = @_;
509 $conn->{open_container} = $tag;
510
511 $::INV_RIGHT_HB->clear ();
512 $::INV_RIGHT_HB->add (new CFClient::UI::Label align => 0, expand => 1, text => $name);
513
514 if ($tag != 0) { # Floor isn't closable, is it?
515 $::INV_RIGHT_HB->add (new CFClient::UI::Button
516 text => "Close container",
517 tooltip => "Close the currently open container (if one is open)",
518 on_activate => sub {
519 $::CONN->send ("apply $tag") # $::CONN->{open_container}")
520 if $tag != 0;
521 #if $CONN->{open_container} != 0;
522 },
523 );
524 }
525
526 $::INVR->set_items ($conn->{container}{$tag});
527 }
528
529 sub update_container {
530 my ($tag) = @_;
531
532 $::INVR->set_items ($::CONN->{container}{$::CONN->{open_container}})
533 if $tag == $::CONN->{open_container};
534 }
535
536 sub container_add {
537 my ($self, $tag, $items) = @_;
538
539 #d# print "container_add: container $tag ($self->{player}{tag})\n";
540
541 if ($tag == 0) {
542 update_floorbox;
543 update_container (0);
544 } elsif ($tag == $self->{player}{tag}) {
545 $::INV->set_items ($self->{container}{$self->{player}{tag}})
546 } else {
547 update_container ($tag);
548 }
549
550 # $self-<{player}{tag} => player inv
551 #use PApp::Util; warn PApp::Util::dumpval $self->{container}{$self->{player}{tag}};
552 }
553
554 sub container_clear {
555 my ($self, $tag) = @_;
556
557 #d# print "container_clear: container $tag ($self->{player}{tag})\n";
558
559 if ($tag == 0) {
560 update_floorbox;
561 update_container (0);
562 } elsif ($tag == $self->{player}{tag}) {
563 $::INV->set_items ($self->{container}{$tag})
564 } else {
565 update_container ($tag);
566 }
567
568 # use PApp::Util; warn PApp::Util::dumpval $self->{container}{0};
569 }
570
571 sub item_delete {
572 my ($self, @items) = @_;
573
574 for (@items) {
575 #d# print "item_delete: $_->{tag} from $_->{container} ($self->{player}{tag})\n";
576
577 if ($_->{container} == 0) {
578 update_floorbox;
579 update_container ($_->{tag});
580 } elsif ($_->{container} == $self->{player}{tag}) {
581 $::INV->set_items ($self->{container}{$self->{player}{tag}})
582 } else {
583 update_container ($_->{container});
584 }
585 }
586 }
587
588 sub item_update {
589 my ($self, $item) = @_;
590
591 #d# print "item_update: $item->{tag} in $item->{container} ($self->{player}{tag}) ($::CONN->{open_container})\n";
592
593 if ($item->{tag} == $self->{player}{tag}) {
594 $::STATWIDS->{weight}->set_text (sprintf "Weight: %.1fkg", $item->{weight} / 1000);
595 return;
596 }
597
598 CFClient::Item::update_widgets $item;
599
600 if ($item->{tag} == $::CONN->{open_container} && not ($item->{flags} & F_OPEN)) {
601 set_opencont ($::CONN, 0, "Floor");
602
603 } elsif ($item->{flags} & F_OPEN) {
604 set_opencont ($::CONN, $item->{tag}, CFClient::Item::desc_string $item);
605 } else {
606 if ($item->{container} == 0) {
607 update_floorbox;
608 update_container (0);
609 } elsif ($item->{container} == $self->{player}{tag}) {
610 $::INV->set_items ($self->{container}{$item->{container}})
611 }
612 }
613 }
614
615 sub player_update {
616 my ($self, $player) = @_;
617 $::STATWIDS->{weight}->set_text (sprintf "Weight: %.1fkg", $player->{weight} / 1000);
618
619 # do it here because it is ignored earlier, and there is no "login" event
620 $self->send_command ("output-sync $::CFG->{output_sync}");
621 $self->send_command ("output-count $::CFG->{output_count}");
622 }
623
624 1;