ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/bin/pclient
(Generate patch)

Comparing deliantra/Deliantra-Client/bin/pclient (file contents):
Revision 1.115 by root, Sat Apr 15 22:56:00 2006 UTC vs.
Revision 1.123 by root, Mon Apr 17 19:36:27 2006 UTC

13use SDL::OpenGL; 13use SDL::OpenGL;
14 14
15use Crossfire; 15use Crossfire;
16use Crossfire::Protocol; 16use Crossfire::Protocol;
17 17
18use Compress::LZF;
19
18use CFClient; 20use CFClient;
19use CFClient::UI; 21use CFClient::UI;
20 22
21our $VERSION = '0.1'; 23our $VERSION = '0.1';
22 24
23my $MAX_FPS = 60; 25my $MAX_FPS = 60;
24my $MIN_FPS = 5; # unused as of yet 26my $MIN_FPS = 5; # unused as of yet
25 27
26our $META_SERVER = "crossfire.real-time.com:13326"; 28our $META_SERVER = "crossfire.real-time.com:13326";
27 29
30our $FACEMAP;
31our $TILECACHE;
28our $FACECACHE; 32our $MAPCACHE;
29 33
30our $LAST_REFRESH; 34our $LAST_REFRESH;
31our $NOW; 35our $NOW;
32 36
33our $CFG; 37our $CFG;
69 73
70sub start_game { 74sub start_game {
71 status "logging in..."; 75 status "logging in...";
72 76
73 my $mapsize = List::Util::min 32, List::Util::max 11, int $WIDTH * $CFG->{mapsize} * 0.01 / 32; 77 my $mapsize = List::Util::min 32, List::Util::max 11, int $WIDTH * $CFG->{mapsize} * 0.01 / 32;
78
79 $MAPCACHE = CFClient::db_table "mapcache_$CFG->{host}";
74 80
75 $MAP = new CFClient::Map $mapsize, $mapsize; 81 $MAP = new CFClient::Map $mapsize, $mapsize;
76 82
77 my ($host, $port) = split /:/, $CFG->{host}; 83 my ($host, $port) = split /:/, $CFG->{host};
78 84
303 $vbox->add ($LOGVIEW = new CFClient::UI::TextView 309 $vbox->add ($LOGVIEW = new CFClient::UI::TextView
304 expand => 1, 310 expand => 1,
305 fontsize => $::CFG->{log_fontsize}, 311 fontsize => $::CFG->{log_fontsize},
306 ); 312 );
307 313
308 $vbox->add (my $input = new CFClient::UI::LineEntry); 314 $vbox->add (my $input = new CFClient::UI::Entry
315 connect_focus_in => sub {
316 my ($input, $prev_focus) = @_;
317
318 delete $input->{refocus_map};
319
320 if ($prev_focus == $MAPWIDGET && $input->{auto_activated}) {
321 $input->{refocus_map} = 1;
322 }
323 delete $input->{auto_activated};
324 },
309 $input->connect (activate => sub { 325 connect_activate => sub {
310 my ($input, $text) = @_; 326 my ($input, $text) = @_;
311 $input->set_text (''); 327 $input->set_text ('');
312 328
313 if ($text =~ /^\/(.*)/) { 329 if ($text =~ /^\/(.*)/) {
314 $::CONN->user_send ("command $1"); 330 $::CONN->user_send ($1);
315 } else { 331 } else {
316 my $say_cmd = $::CFG->{say_command} || 'say'; 332 my $say_cmd = $::CFG->{say_command} || 'say';
317 $::CONN->user_send ("command $say_cmd $text"); 333 $::CONN->user_send ("$say_cmd $text");
318 } 334 }
335 if ($input->{refocus_map}) {
336 delete $input->{refocus_map};
337 $MAPWIDGET->focus_in
319 1 338 }
320 }); 339 },
321 $input->connect (escape => sub { 340 connect_escape => sub {
322 $MAPWIDGET->focus_in 341 $MAPWIDGET->focus_in
323 }); 342 },
324 $input->focus_in; 343 );
325 344
326 $CONSOLE = { 345 $CONSOLE = {
327 window => $window, 346 window => $window,
328 input => $input 347 input => $input
329 }; 348 };
385 padding => 0, 404 padding => 0,
386 y => $HEIGHT * 44 / 45 - $FONTSIZE; 405 y => $HEIGHT * 44 / 45 - $FONTSIZE;
387 $CFClient::UI::ROOT->add ($STATUS_LINE); 406 $CFClient::UI::ROOT->add ($STATUS_LINE);
388 407
389 $ALT_ENTER_MESSAGE = new CFClient::UI::Label 408 $ALT_ENTER_MESSAGE = new CFClient::UI::Label
390 padding => 0, 409 padding => 0,
391 y => $HEIGHT * 44 / 45, 410 y => $HEIGHT * 44 / 45,
392 height => $HEIGHT / 45, 411 fontsize => $HEIGHT / 45,
393 text => "Use <b>Alt-Enter</b> to toggle fullscreen mode"; 412 markup => "Use <b>Alt-Enter</b> to toggle fullscreen mode";
394 $CFClient::UI::ROOT->add ($ALT_ENTER_MESSAGE); 413 $CFClient::UI::ROOT->add ($ALT_ENTER_MESSAGE);
395 414
396 $CFClient::UI::ROOT->add ($MAPWIDGET = new CFClient::UI::MapWidget); 415 $CFClient::UI::ROOT->add ($MAPWIDGET = new CFClient::UI::MapWidget);
397 $MAPWIDGET->focus_in; 416 $MAPWIDGET->focus_in;
398 $MAPWIDGET->connect (activate_console => sub { 417 $MAPWIDGET->connect (activate_console => sub {
399 my ($mapwidget, $preset) = @_; 418 my ($mapwidget, $preset) = @_;
400 419
401 if ($CONSOLE) { 420 if ($CONSOLE) {
421 $CONSOLE->{input}->{auto_activated} = 1;
402 $CONSOLE->{input}->focus_in; 422 $CONSOLE->{input}->focus_in;
403 423
404 if ($preset && $CONSOLE->{input}->get_text eq '') { 424 if ($preset && $CONSOLE->{input}->get_text eq '') {
405 $CONSOLE->{input}->set_text ($preset); 425 $CONSOLE->{input}->set_text ($preset);
406 } 426 }
416 $BUTTONBAR->add (new CFClient::UI::Button text => "Save Config", connect_activate => sub { 436 $BUTTONBAR->add (new CFClient::UI::Button text => "Save Config", connect_activate => sub {
417 CFClient::write_cfg "$Crossfire::VARDIR/pclientrc"; 437 CFClient::write_cfg "$Crossfire::VARDIR/pclientrc";
418 status "Configuration Saved"; 438 status "Configuration Saved";
419 }); 439 });
420 440
421 $BUTTONBAR->{children}[0]->emit ("activate"); 441 $BUTTONBAR->{children}[1]->emit ("activate"); # pop up server setup
422} 442}
423 443
424sub destroy_screen { 444sub destroy_screen {
425 $CFClient::UI::ROOT->{children} = []; 445 $CFClient::UI::ROOT->{children} = [];
426 undef $SDL_ACTIVE; 446 undef $SDL_ACTIVE;
485@conn::ISA = Crossfire::Protocol::; 505@conn::ISA = Crossfire::Protocol::;
486 506
487sub conn::user_send { 507sub conn::user_send {
488 my ($self, $command) = @_; 508 my ($self, $command) = @_;
489 509
490 $self->send ($command); 510 $self->send_command ($command);
491 status $command; 511 status $command;
512}
513
514sub conn::map_scroll {
515 my ($self, $dx, $dy) = @_;
516
517 $MAP->scroll ($dx, $dy);
492} 518}
493 519
494sub conn::feed_map1a { 520sub conn::feed_map1a {
495 my ($self, $data) = @_; 521 my ($self, $data) = @_;
496 522
497# $self->Crossfire::Protocol::feed_map1a ($data); 523# $self->Crossfire::Protocol::feed_map1a ($data);
498 524
499 $MAP->scroll (delete $self->{delayed_scroll_x}, delete $self->{delayed_scroll_y});
500 $MAP->map1a_update ($data); 525 $MAP->map1a_update ($data);
501 $MAPWIDGET->update; 526 $MAPWIDGET->update;
502} 527}
503 528
504#sub conn::map_update { 529sub conn::flush_map {
505# my ($self, $dirty) = @_; 530 my ($self) = @_;
506# 531
507# $MAPWIDGET->update; 532 my $map_info = delete $self->{map_info}
508#} 533 or return;
534
535 my ($hash, $x, $y, $w, $h) = @$map_info;
536
537 my $data = $MAP->get_rect ($x, $y, $w, $h);
538 $MAPCACHE->put ($hash => Compress::LZF::compress $data);
539
540 warn sprintf "SAVEmap[%s] length %d\n", $hash, length $data;#d#
541
542}
509 543
510sub conn::map_clear { 544sub conn::map_clear {
511 my ($self) = @_; 545 my ($self) = @_;
512 546
547 $self->flush_map;
548 delete $self->{neigh};
549
513 $MAP->clear; 550 $MAP->clear;
514
515# refresh;
516} 551}
517 552
553
554sub conn::load_map($$$) {
555 my ($self, $hash, $x, $y) = @_;
556
557 if (defined (my $data = $MAPCACHE->get ($hash))) {
558 $data = Compress::LZF::decompress $data;
559 warn sprintf "LOADmap[%s,%d,%d] length %d\n", $hash, $x, $y, length $data;#d#
560 for my $id ($MAP->set_rect ($x, $y, $data)) {
561 my $data = $TILECACHE->get ($id)
562 or next;
563
564 $self->set_texture ($id => $data);
565 }
566 }
567}
568
569sub conn::flood_fill {
570 my ($self, $path, $hash, $flags, $x0, $y0, $x1, $y1) = @_;
571
572 # the server does not allow map paths > 6
573 return if 6 <= length $path;
574
575 for my $tile (1..4) {
576 next if $self->{neigh}{$hash}[$tile];
577 next unless $flags & (1 << ($tile - 1));
578
579 my $neigh = $self->{neigh}{$hash} ||= [];
580
581 $self->send_mapinfo ("spatial $path$tile", sub {
582 my ($mode, $flags, $x, $y, $w, $h, $hash) = @_;
583
584 #warn "map<$path>_$tile=<$mode,$x,$y,$w,$h,$hash>\n";#d#
585 return if $mode ne "spatial";
586
587 $x += $MAP->ox;
588 $y += $MAP->oy;
589
590 $self->load_map ($hash, $x, $y);
591
592 $neigh->[$tile] = [$x, $y, $w, $h];
593
594 $self->flood_fill ("$path$tile", $hash, $flags, $x0, $y0, $x1, $y1)
595 if $x >= $x0 && $x + $w < $x1 && $y >= $y0 && $y + $h < $y1;
596 });
597 }
598}
599
518sub conn::map_info { 600sub conn::map_change {
519 my ($self, $mode, $x, $y, $w, $h, $hash) = @_; 601 my ($self, $mode, $flags, $x, $y, $w, $h, $hash) = @_;
520 602
603 $self->flush_map;
604
605 my ($ox, $oy) = ($::MAP->ox, $::MAP->oy);
606
521 warn "mapinfo <$mode,$x,$y,$w,$h,$hash>\n";#d# 607 warn "$ox $oy map_info<$flags, $x, $y, $w, $h, $hash>\n";#d#
608
609 my $mapmapw = 250;
610 my $mapmaph = 250;
611
612 $self->flood_fill ("", $hash, $flags,
613 $ox - $mapmapw * 0.5, $oy - $mapmapw * 0.5,
614 $ox + $mapmapw * 0.5, $oy + $mapmapw * 0.5);
615
616 $x += $ox;
617 $y += $oy;
618
619 $self->{map_info} = [$hash, $x, $y, $w, $h];
620
621 $self->load_map ($hash, $x, $y);
522} 622}
523 623
524sub conn::face_find { 624sub conn::face_find {
525 my ($self, $face) = @_; 625 my ($self, $facenum, $face) = @_;
526 626
527 my $data; 627 my $hash = "$face->{chksum},$face->{name}";
528 628
529 $FACECACHE->get ("$face->{chksum},$face->{name}") 629 my $id = $FACEMAP->get ($hash);
630
631 unless ($id) {
632 # create new id for face
633 # i love transactions
634 for (1..100) {
635 my $txn = $CFClient::DB_ENV->txn_begin;
636 my $status = $FACEMAP->db_get (id => $id, BerkeleyDB::DB_RMW);
637 if ($status == 0 || $status == BerkeleyDB::DB_NOTFOUND) {
638 $id++;
639 if ($FACEMAP->put (id => $id) == 0
640 && $FACEMAP->put ($hash => $id) == 0) {
641 $txn->txn_commit;
642
643 goto gotid;
644 }
645 }
646 $txn->abort;
647 }
648
649 CFClient::fatal "maximum number of transaction retries reached - database problems?";
650 }
651
652gotid:
653 $face->{id} = $id;
654 $MAP->set_face ($facenum => $id);
655 $TILECACHE->get ($id)
530} 656}
531 657
532sub conn::face_update { 658sub conn::face_update {
533 my ($self, $facenum, $face) = @_; 659 my ($self, $facenum, $face) = @_;
534 660
535 $FACECACHE->put ("$face->{chksum},$face->{name}" => $face->{image}); 661 $TILECACHE->put ($face->{id} => $face->{image}); #TODO: try to avoid duplicate writes
536 662
537 my $tex = $face->{texture} = 663 $self->set_texture ($face->{id} => delete $face->{image});
664}
665
666sub conn::set_texture {
667 my ($self, $id, $data) = @_;
668
669 $self->{texture}[$id] ||= do {
670 my $tex =
538 new_from_image CFClient::Texture 671 new_from_image CFClient::Texture
539 delete $face->{image}, minify => 1; 672 $data, minify => 1;
540 673
541 $MAP->set_texture ($facenum, @$tex{qw(name w h s t)}, @{$tex->{minified}}); 674 $MAP->set_texture ($id, @$tex{qw(name w h s t)}, @{$tex->{minified}});
542 $MAPWIDGET->update; 675 $MAPWIDGET->update;
676
677 $tex
678 };
543} 679}
544 680
545sub conn::query { 681sub conn::query {
546 my ($self, $flags, $prompt) = @_; 682 my ($self, $flags, $prompt) = @_;
547 683
553 my ($self, $color, $text) = @_; 689 my ($self, $color, $text) = @_;
554 690
555 my @color = ( 691 my @color = (
556 [1.00, 1.00, 1.00], #[0.00, 0.00, 0.00], 692 [1.00, 1.00, 1.00], #[0.00, 0.00, 0.00],
557 [1.00, 1.00, 1.00], 693 [1.00, 1.00, 1.00],
558 [0.00, 0.00, 0.55], 694 [0.50, 0.50, 1.00], #[0.00, 0.00, 0.55]
559 [1.00, 0.00, 0.00], 695 [1.00, 0.00, 0.00],
560 [1.00, 0.54, 0.00], 696 [1.00, 0.54, 0.00],
561 [0.11, 0.56, 1.00], 697 [0.11, 0.56, 1.00],
562 [0.93, 0.46, 0.00], 698 [0.93, 0.46, 0.00],
563 [0.18, 0.54, 0.34], 699 [0.18, 0.54, 0.34],
607 }, 743 },
608); 744);
609 745
610############################################################################# 746#############################################################################
611 747
612$FACECACHE = CFClient::db_table "facecache"; 748$TILECACHE = CFClient::db_table "tilecache";
749$FACEMAP = CFClient::db_table "facemap";
613 750
614CFClient::read_cfg "$Crossfire::VARDIR/pclientrc"; 751CFClient::read_cfg "$Crossfire::VARDIR/pclientrc";
615 752
616my %DEF_CFG = ( 753my %DEF_CFG = (
617 sdl_mode => 0, 754 sdl_mode => 0,
641 778
642@SDL_MODES or CFClient::fatal "Unable to find a usable video mode\n(hardware accelerated opengl fullscreen)"; 779@SDL_MODES or CFClient::fatal "Unable to find a usable video mode\n(hardware accelerated opengl fullscreen)";
643 780
644$CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} > @SDL_MODES; 781$CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} > @SDL_MODES;
645 782
646init_screen;
647
648{ 783{
649 my @fonts = map CFClient::find_rcfile $_, qw(uifont.ttf uifontb.ttf uifonti.ttf uifontbi.ttf); 784 my @fonts = map CFClient::find_rcfile $_, qw(uifont.ttf uifontb.ttf uifonti.ttf uifontbi.ttf);
650 785
651 CFClient::add_font $_ for @fonts; 786 CFClient::add_font $_ for @fonts;
652 CFClient::set_font $fonts[0]; 787 CFClient::set_font $fonts[0];
653} 788}
654 789
790init_screen;
791
655Event::loop; 792Event::loop;
656 793
657 794

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines