ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/DC/Protocol.pm
(Generate patch)

Comparing deliantra/Deliantra-Client/DC/Protocol.pm (file contents):
Revision 1.1 by root, Fri May 26 18:56:14 2006 UTC vs.
Revision 1.20 by root, Mon Jun 5 05:31:13 2006 UTC

1package CFClient::Protocol; 1package CFClient::Protocol;
2 2
3use utf8; 3use utf8;
4use strict; 4use strict;
5 5
6use Crossfire::Protocol::Constants;
7
8use CFClient;
6use CFClient::UI; 9use CFClient::UI;
7 10
8use base 'Crossfire::Protocol::Base'; 11use base 'Crossfire::Protocol::Base';
9 12
10sub new { 13sub new {
… …
12 15
13 my $self = $class->SUPER::new (@_); 16 my $self = $class->SUPER::new (@_);
14 17
15 $self->{map_widget}->clr_commands; 18 $self->{map_widget}->clr_commands;
16 19
17 my $parser = new Pod::POM;
18 my $pod = $parser->parse_file (CFClient::find_rcfile "pod/command_help.pod"); 20 my $pod = CFClient::load_pod CFClient::find_rcfile "pod/command_help.pod";
19 21
20 for my $head2 ($pod->head1->[-2]->head2) { 22 for my $head2 ($pod->head1->[-2]->head2) {
21 $head2->title =~ /^(\S+) (?:\s+ \( ([^\)]*) \) )?/x 23 $head2->title =~ /^(\S+) (?:\s+ \( ([^\)]*) \) )?/x
22 or next; 24 or next;
23 25
24 my $cmd = $1; 26 my $cmd = $1;
25 my @args = split /\|/, $2; 27 my @args = split /\|/, $2;
26 @args = (".*") unless @args; 28 @args = (".*") unless @args;
27 29
30 $_ = $_ eq ".*" ? "" : " $_"
31 for @args;
32
28 my $text = CFClient::pod_to_pango $head2->content; 33 my $text = CFClient::pod_to_pango $head2->content;
29 34
30 for my $arg (@args) {
31 $arg = $arg eq ".*" ? "" : " $arg";
32
33 $self->{map_widget}->add_command ("$cmd$arg", $text); 35 $self->{map_widget}->add_command ("$cmd$_", $text)
34 } 36 for sort { (length $a) <=> (length $b) }
37 @args;
35 } 38 }
36 39
37 $self->{noface} = new_from_file CFClient::Texture 40 $self->{noface} = new_from_file CFClient::Texture
38 CFClient::find_rcfile "noface.png", minify => 1, mipmap => 1; 41 CFClient::find_rcfile "noface.png", minify => 1, mipmap => 1;
39 42
… …
50} 53}
51 54
52sub stats_update { 55sub stats_update {
53 my ($self, $stats) = @_; 56 my ($self, $stats) = @_;
54 57
55 if (my $exp = $stats->{Crossfire::Protocol::Base::CS_STAT_EXP64}) { 58 if (my $exp = $stats->{+CS_STAT_EXP64}) {
56 my $diff = $exp - $self->{prev_exp}; 59 my $diff = $exp - $self->{prev_exp};
57 $self->{statusbox}->add ("$diff experience gained", group => "experience $diff", fg => [0.5, 1, 0.5, 0.8], timeout => 5) 60 $self->{statusbox}->add ("$diff experience gained", group => "experience $diff", fg => [0.5, 1, 0.5, 0.8], timeout => 5)
58 if exists $self->{prev_exp} && $diff; 61 if exists $self->{prev_exp} && $diff;
59 $self->{prev_exp} = $exp; 62 $self->{prev_exp} = $exp;
60 } 63 }
… …
63} 66}
64 67
65sub user_send { 68sub user_send {
66 my ($self, $command) = @_; 69 my ($self, $command) = @_;
67 70
71 if ($self->{record}) {
72 push @{$self->{record}}, $command;
73 }
74
68 $self->send_command ($command); 75 $self->send_command ($command);
69 status $command; 76 ::status $command;
77}
78
79sub start_record {
80 my ($self) = @_;
81
82 $self->{record} = [];
83}
84
85sub stop_record {
86 my ($self) = @_;
87 return delete $self->{record};
70} 88}
71 89
72sub map_scroll { 90sub map_scroll {
73 my ($self, $dx, $dy) = @_; 91 my ($self, $dx, $dy) = @_;
74 92
… …
250 unless ($id) { 268 unless ($id) {
251 # create new id for face 269 # create new id for face
252 # I love transactions 270 # I love transactions
253 for (1..100) { 271 for (1..100) {
254 my $txn = $CFClient::DB_ENV->txn_begin; 272 my $txn = $CFClient::DB_ENV->txn_begin;
255 my $status = $self->{facemap}->db_get (id => $id, BerkeleyDB::DB_RMW); 273 my $status = $self->{facemap}->db_get (id => $id);
256 if ($status == 0 || $status == BerkeleyDB::DB_NOTFOUND) { 274 if ($status == 0 || $status == BerkeleyDB::DB_NOTFOUND) {
257 $id = ($id || 16) + 1; 275 $id = ($id || 16) + 1;
258 if ($self->{facemap}->put (id => $id) == 0 276 if ($self->{facemap}->put (id => $id) == 0
259 && $self->{facemap}->put ($hash => $id) == 0) { 277 && $self->{facemap}->put ($hash => $id) == 0) {
260 $txn->txn_commit; 278 $txn->txn_commit;
261 279
262 goto gotid; 280 goto gotid;
263 } 281 }
264 } 282 }
265 $txn->abort; 283 $txn->txn_abort;
266 } 284 }
267 285
268 CFClient::fatal "maximum number of transaction retries reached - database problems?"; 286 CFClient::fatal "maximum number of transaction retries reached - database problems?";
269 } 287 }
270 288
… …
321 339
322 $prompt = $LAST_QUERY unless length $prompt; 340 $prompt = $LAST_QUERY unless length $prompt;
323 $LAST_QUERY = $prompt; 341 $LAST_QUERY = $prompt;
324 342
325 my $dialog = new CFClient::UI::FancyFrame 343 my $dialog = new CFClient::UI::FancyFrame
344 x => "center",
345 y => "center",
326 title => "Query", 346 title => "Query",
327 child => my $vbox = new CFClient::UI::VBox; 347 child => my $vbox = new CFClient::UI::VBox,
348 ;
328 349
329 $vbox->add (new CFClient::UI::Label 350 $vbox->add (new CFClient::UI::Label
330 max_w => $::WIDTH * 0.4, 351 max_w => $::WIDTH * 0.4,
331 ellipsise => 0, 352 ellipsise => 0,
332 text => $prompt); 353 text => $prompt);
333 354
334 if ($flags & Crossfire::Protocol::Base::CS_QUERY_YESNO) { 355 if ($flags & CS_QUERY_YESNO) {
335 $vbox->add (my $hbox = new CFClient::UI::HBox); 356 $vbox->add (my $hbox = new CFClient::UI::HBox);
336 $hbox->add (new CFClient::UI::Button 357 $hbox->add (new CFClient::UI::Button
337 text => "No", 358 text => "No",
338 connect_activate => sub { 359 on_activate => sub {
339 $self->send ("reply n"); 360 $self->send ("reply n");
340 $dialog->destroy; 361 $dialog->destroy;
341 $self->{map_widget}->focus_in; 362 $self->{map_widget}->focus_in;
342 } 363 }
343 ); 364 );
344 $hbox->add (new CFClient::UI::Button 365 $hbox->add (new CFClient::UI::Button
345 text => "Yes", 366 text => "Yes",
346 connect_activate => sub { 367 on_activate => sub {
347 $self->send ("reply y"); 368 $self->send ("reply y");
348 $dialog->destroy; 369 $dialog->destroy;
349 }, 370 },
350 ); 371 );
351 372
352 $dialog->focus_in; 373 $dialog->focus_in;
353 374
354 } elsif ($flags & Crossfire::Protocol::Base::CS_QUERY_SINGLECHAR) { 375 } elsif ($flags & CS_QUERY_SINGLECHAR) {
355 $dialog->{tooltip} = "Press a key (click on the entry to make sure it has keyboard focus)"; 376 $dialog->{tooltip} = "Press a key (click on the entry to make sure it has keyboard focus)";
356 $vbox->add (my $entry = new CFClient::UI::Entry 377 $vbox->add (my $entry = new CFClient::UI::Entry
357 connect_changed => sub { 378 on_changed => sub {
358 $self->send ("reply $_[1]"); 379 $self->send ("reply $_[1]");
359 $dialog->destroy; 380 $dialog->destroy;
360 }, 381 },
361 ); 382 );
362 383
… …
364 385
365 } else { 386 } else {
366 $dialog->{tooltip} = "Enter the reply and press return (click on the entry to make sure it has keyboard focus)"; 387 $dialog->{tooltip} = "Enter the reply and press return (click on the entry to make sure it has keyboard focus)";
367 388
368 $vbox->add (my $entry = new CFClient::UI::Entry 389 $vbox->add (my $entry = new CFClient::UI::Entry
369 $flags & Crossfire::Protocol::Base::CS_QUERY_HIDEINPUT ? (hiddenchar => "*") : (), 390 $flags & CS_QUERY_HIDEINPUT ? (hiddenchar => "*") : (),
370 connect_activate => sub { 391 on_activate => sub {
371 $self->send ("reply $_[1]"); 392 $self->send ("reply $_[1]");
372 $dialog->destroy; 393 $dialog->destroy;
373 }, 394 },
374 ); 395 );
375 396
376 $entry->focus_in; 397 $entry->focus_in;
377 } 398 }
378 399
379 $dialog->show_centered; 400 $dialog->show;
380} 401}
381 402
382sub drawinfo { 403sub drawinfo {
383 my ($self, $color, $text) = @_; 404 my ($self, $color, $text) = @_;
384 405
… …
408 join "\n", map "$time $_", split /\n/, $text); 429 join "\n", map "$time $_", split /\n/, $text);
409 430
410 $self->{statusbox}->add ($text, 431 $self->{statusbox}->add ($text,
411 group => $text, 432 group => $text,
412 fg => $color[$color], 433 fg => $color[$color],
413 timeout => 10, 434 timeout => $color >= 2 ? 60 : 10,
414 tooltip_font => $::FONT_FIXED, 435 tooltip_font => $::FONT_FIXED,
415 ); 436 );
416} 437}
417 438
418sub drawextinfo { 439sub drawextinfo {
… …
424sub spell_add { 445sub spell_add {
425 my ($self, $spell) = @_; 446 my ($self, $spell) = @_;
426 447
427 # TODO 448 # TODO
428 # create a widget dynamically, using spell face (CF::Protocol downloads them) 449 # create a widget dynamically, using spell face (CF::Protocol downloads them)
450 $::SETUP_SPELLS->add_spell ($spell);
451
429 $self->{map_widget}->add_command ("invoke $spell->{name}", CFClient::UI::Label::escape $spell->{message}); 452 $self->{map_widget}->add_command ("invoke $spell->{name}", CFClient::UI::Label::escape $spell->{message});
430 $self->{map_widget}->add_command ("cast $spell->{name}", CFClient::UI::Label::escape $spell->{message}); 453 $self->{map_widget}->add_command ("cast $spell->{name}", CFClient::UI::Label::escape $spell->{message});
431} 454}
432 455
433sub spell_delete { 456sub spell_delete {
434 my ($self, $spell) = @_; 457 my ($self, $spell) = @_;
458 $::SETUP_SPELLS->remove_spell ($spell);
435} 459}
436 460
437sub addme_success { 461sub addme_success {
438 my ($self) = @_; 462 my ($self) = @_;
439 463
440 $self->send ("command output-sync $::CFG->{output_sync}"); 464 my $pod = CFClient::load_pod CFClient::find_rcfile "pod/skill_help.pod";
441 $self->send ("command output-count $::CFG->{output_count}");
442
443 my $parser = new Pod::POM;
444 my $pod = $parser->parse_file (CFClient::find_rcfile "pod/skill_help.pod");
445 465
446 my %skill_tooltip; 466 my %skill_tooltip;
447 467
448 for my $head2 ($pod->head1->[-2]->head2) { 468 for my $head2 ($pod->head1->[-2]->head2) {
449 $skill_tooltip{$head2->title} = CFClient::pod_to_pango $head2->content; 469 $skill_tooltip{$head2->title} = CFClient::pod_to_pango $head2->content;
… …
488 my ($face) = splice @{ $self->{face_prefetch} }, + rand @{ $self->{face_prefetch} }, 1, (); 508 my ($face) = splice @{ $self->{face_prefetch} }, + rand @{ $self->{face_prefetch} }, 1, ();
489 509
490 $self->send ("requestinfo image_sums $face $face"); 510 $self->send ("requestinfo image_sums $face $face");
491 511
492 $self->{statusbox}->add (CFClient::UI::Label::escape "prefetching $todo", 512 $self->{statusbox}->add (CFClient::UI::Label::escape "prefetching $todo",
493 group => "prefetch", timeout => 2, fg => [1, 1, 0, 0.5]); 513 group => "prefetch", timeout => 3, fg => [1, 1, 0, 0.5]);
494 } elsif (!exists $self->{num_faces}) { 514 } elsif (!exists $self->{num_faces}) {
495 $self->send ("requestinfo image_info"); 515 $self->send ("requestinfo image_info");
496 516
497 $self->{num_faces} = 0; 517 $self->{num_faces} = 0;
498 518
499 $self->{statusbox}->add (CFClient::UI::Label::escape "starting to prefetch", 519 $self->{statusbox}->add (CFClient::UI::Label::escape "starting to prefetch",
500 group => "prefetch", timeout => 2, fg => [1, 1, 0, 0.5]); 520 group => "prefetch", timeout => 3, fg => [1, 1, 0, 0.5]);
501 } 521 }
502} 522}
503 523
504sub update_floorbox { 524sub update_floorbox {
505 $CFClient::UI::ROOT->on_refresh ($::FLOORBOX => sub { 525 $CFClient::UI::ROOT->on_refresh ($::FLOORBOX => sub {
… …
529} 549}
530 550
531sub set_opencont { 551sub set_opencont {
532 my ($conn, $tag, $name) = @_; 552 my ($conn, $tag, $name) = @_;
533 $conn->{open_container} = $tag; 553 $conn->{open_container} = $tag;
534 $::INVR_LBL->set_text ($name); 554
555 $::INV_RIGHT_HB->clear ();
556 $::INV_RIGHT_HB->add (new CFClient::UI::Label align => 0, expand => 1, text => $name);
557
558 if ($tag != 0) { # Floor isn't closable, is it?
559 $::INV_RIGHT_HB->add (new CFClient::UI::Button
560 text => "Close container",
561 tooltip => "Close the currently open container (if one is open)",
562 on_activate => sub {
563 $::CONN->send ("apply $tag") # $::CONN->{open_container}")
564 if $tag != 0;
565 #if $CONN->{open_container} != 0;
566 },
567 );
568 }
569
535 $::INVR->set_items ($conn->{container}{$tag}); 570 $::INVR->set_items ($conn->{container}{$tag});
536} 571}
537 572
538sub update_container { 573sub update_container {
539 my ($tag) = @_; 574 my ($tag) = @_;
… …
568 if ($tag == 0) { 603 if ($tag == 0) {
569 update_floorbox; 604 update_floorbox;
570 update_container (0); 605 update_container (0);
571 } elsif ($tag == $self->{player}{tag}) { 606 } elsif ($tag == $self->{player}{tag}) {
572 $::INV->set_items ($self->{container}{$tag}) 607 $::INV->set_items ($self->{container}{$tag})
608 } else {
609 update_container ($tag);
573 } 610 }
574 611
575# use PApp::Util; warn PApp::Util::dumpval $self->{container}{0}; 612# use PApp::Util; warn PApp::Util::dumpval $self->{container}{0};
576} 613}
577 614
… …
585 update_floorbox; 622 update_floorbox;
586 update_container ($_->{tag}); 623 update_container ($_->{tag});
587 } elsif ($_->{container} == $self->{player}{tag}) { 624 } elsif ($_->{container} == $self->{player}{tag}) {
588 $::INV->set_items ($self->{container}{$self->{player}{tag}}) 625 $::INV->set_items ($self->{container}{$self->{player}{tag}})
589 } else { 626 } else {
590 update_container ($_->{tag}); 627 update_container ($_->{container});
591 } 628 }
592 } 629 }
593} 630}
594 631
595sub item_update { 632sub item_update {
… …
602 return; 639 return;
603 } 640 }
604 641
605 CFClient::Item::update_widgets $item; 642 CFClient::Item::update_widgets $item;
606 643
607 if ($item->{tag} == $::CONN->{open_container} && not ($item->{flags} & Crossfire::Protocol::Base::F_OPEN)) { 644 if ($item->{tag} == $::CONN->{open_container} && not ($item->{flags} & F_OPEN)) {
608 set_opencont ($::CONN, 0, "Floor"); 645 set_opencont ($::CONN, 0, "Floor");
609 646
610 } elsif ($item->{flags} & Crossfire::Protocol::Base::F_OPEN) { 647 } elsif ($item->{flags} & F_OPEN) {
611 set_opencont ($::CONN, $item->{tag}, CFClient::Item::desc_string $item); 648 set_opencont ($::CONN, $item->{tag}, CFClient::Item::desc_string $item);
612 } else { 649 } else {
613 if ($item->{container} == 0) { 650 if ($item->{container} == 0) {
614 update_floorbox; 651 update_floorbox;
615 update_container (0); 652 update_container (0);
… …
617 $::INV->set_items ($self->{container}{$item->{container}}) 654 $::INV->set_items ($self->{container}{$item->{container}})
618 } 655 }
619 } 656 }
620} 657}
621 658
659sub player_update {
660 my ($self, $player) = @_;
661 $::STATWIDS->{weight}->set_text (sprintf "Weight: %.1fkg", $player->{weight} / 1000);
662
663 # do it here because it is ignored earlier, and there is no "login" event
664 $self->send_command ("output-sync $::CFG->{output_sync}");
665 $self->send_command ("output-count $::CFG->{output_count}");
666}
667
6221; 6681;

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines