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.196 by root, Thu May 8 21:30:23 2008 UTC vs.
Revision 1.201 by root, Wed Sep 3 06:35:55 2008 UTC

… …
11use DC::Pod; 11use DC::Pod;
12use DC::Macro; 12use DC::Macro;
13use DC::Item; 13use DC::Item;
14 14
15use base 'Deliantra::Protocol::Base'; 15use base 'Deliantra::Protocol::Base';
16
17our $TEX_DIALOGUE = new_from_resource DC::Texture
18 "dialogue.png", minify => 1, mipmap => 1;
19
20our $TEX_NOFACE = new_from_resource DC::Texture
21 "noface.png", minify => 1, mipmap => 1;
16 22
17sub new { 23sub new {
18 my ($class, %arg) = @_; 24 my ($class, %arg) = @_;
19 25
20 my $self = $class->SUPER::new (%arg, 26 my $self = $class->SUPER::new (%arg,
… …
75 81
76 $self->{map_widget}->add_command (@$_) 82 $self->{map_widget}->add_command (@$_)
77 for @cmd_help; 83 for @cmd_help;
78 84
79 { 85 {
80 $self->{dialogue} = my $tex = new_from_file DC::Texture 86 $self->{dialogue} = my $tex = $TEX_DIALOGUE;
81 DC::find_rcfile "dialogue.png", minify => 1, mipmap => 1;
82 $self->{map}->set_texture (1, @$tex{qw(name w h s t)}, @{$tex->{minified}}); 87 $self->{map}->set_texture (1, @$tex{qw(name w h s t)}, @{$tex->{minified}});
83 } 88 }
84 89
85 { 90 {
86 $self->{noface} = my $tex = new_from_file DC::Texture 91 $self->{noface} = my $tex = $TEX_NOFACE;
87 DC::find_rcfile "noface.png", minify => 1, mipmap => 1;
88 $self->{map}->set_texture (2, @$tex{qw(name w h s t)}, @{$tex->{minified}}); 92 $self->{map}->set_texture (2, @$tex{qw(name w h s t)}, @{$tex->{minified}});
89 } 93 }
90 94
91 $self->{open_container} = 0; 95 $self->{open_container} = 0;
92 96
… …
637} 641}
638 642
639sub map_scroll { 643sub map_scroll {
640 my ($self, $dx, $dy) = @_; 644 my ($self, $dx, $dy) = @_;
641 645
642 $self->{map}->scroll ($dx, $dy); 646 $self->{map_widget}->scroll ($dx, $dy);
643} 647}
644 648
645sub feed_map1a { 649sub feed_map1a {
646 my ($self, $data) = @_; 650 my ($self, $data) = @_;
647 651
… …
684} 688}
685 689
686sub flush_map { 690sub flush_map {
687 my ($self) = @_; 691 my ($self) = @_;
688 692
689 my $map_info = delete $self->{map_info} 693 return unless $self->{map_info};
690 or return;
691 694
695 for my $map_info (values %{ $self->{map_cache} || {} }) {
692 my ($hash, $x, $y, $w, $h) = @$map_info; 696 my ($hash, $rdata, $x, $y, $w, $h) = @$map_info;
693 697
694 my $data = Compress::LZF::compress $self->{map}->get_rect ($x, $y, $w, $h); 698 my $data = $self->{map}->get_rect ($x, $y, $w, $h);
695 $self->{map_cache_new}{$hash} = \$data; 699
700 if ($data ne $$rdata) {
701 $map_info->[1] = \$data;
702 my $cdata = Compress::LZF::compress $data;
696 DC::DB::put $self->{mapcache} => $hash => $data, sub { }; 703 DC::DB::put $self->{mapcache} => $hash => $cdata, sub { };
704 }
705 }
697} 706}
698 707
699sub map_clear { 708sub map_clear {
700 my ($self) = @_; 709 my ($self) = @_;
701 710
702 $self->flush_map; 711 $self->flush_map;
712 delete $self->{map_info};
703 delete $self->{neigh_map}; 713 delete $self->{neigh_map};
704 714
705 $self->{map}->clear; 715 $self->{map}->clear;
706 delete $self->{map_widget}{magicmap}; 716 delete $self->{map_widget}{magicmap};
707} 717}
… …
728 738
729 $self->bg_fetch; 739 $self->bg_fetch;
730 }; 740 };
731} 741}
732 742
733sub load_map($$$) { 743sub load_map($$$$$$) {
734 my ($self, $hash, $x, $y) = @_; 744 my ($self, $hash, $x, $y, $w, $h) = @_;
735 745
736 my $gen = $self->{map_change_gen}; 746 my $map_info = $self->{map_cache}{$hash} = [$hash, \"", $x, $y, $w, $h];
737 747
738 my $cb = sub { 748 my $cb = sub {
739 return unless $gen == $self->{map_change_gen}; 749 $map_info->[1] = \$_[0];
740 750
741 my ($data) = @_;
742
743 if (defined $data) {
744 $self->{map_cache_new}{$hash} = \$data;
745
746 my $data = Compress::LZF::decompress $data;
747
748 my $inprogress = @{ $self->{bg_fetch} || [] }; 751 my $inprogress = @{ $self->{bg_fetch} || [] };
749 unshift @{ $self->{bg_fetch} }, $self->{map}->set_rect ($x, $y, $data); 752 unshift @{ $self->{bg_fetch} }, $self->{map}->set_rect ($x, $y, $_[0]);
750 $self->bg_fetch unless $inprogress; 753 $self->bg_fetch unless $inprogress;
751 }
752 }; 754 };
753 755
754 if (my $rdata = $self->{map_cache_old}{$hash}) { 756 if (my $map_info = $self->{map_cache_old}{$hash}) {
755 $cb->($$rdata); 757 $cb->(${ $map_info->[1] });
756 } else { 758 } else {
759 my $gen = $self->{map_change_gen};
760
757 DC::DB::get $self->{mapcache} => $hash, $cb; 761 DC::DB::get $self->{mapcache} => $hash, sub {
762 return unless $gen == $self->{map_change_gen};
763 return unless defined $_[0];
764 $cb->(Compress::LZF::decompress $_[0]);
765 };
758 } 766 }
759} 767}
760 768
761# hardcode /world/world_xxx_xxx map names, the savings are enourmous, 769# hardcode /world/world_xxx_xxx map names, the savings are enourmous,
762# (server resource,s latency, bandwidth), so this hack is warranted. 770# (server resources, latency, bandwidth), so this hack is warranted.
763# the right fix is to make real tiled maps with an overview file 771# the right fix is to make real tiled maps with an overview file
764sub send_mapinfo { 772sub send_mapinfo {
765 my ($self, $data, $cb) = @_; 773 my ($self, $data, $cb) = @_;
766 774
767 if ($self->{map_info}[0] =~ m%^/world/world_(\d\d\d)_(\d\d\d)$%) { 775 if ($self->{map_info}[0] =~ m%^/world/world_(\d\d\d)_(\d\d\d)$%) {
… …
792} 800}
793 801
794# this method does a "flood fill" into every tile direction 802# this method does a "flood fill" into every tile direction
795# it assumes that tiles are arranged in a rectangular grid, 803# it assumes that tiles are arranged in a rectangular grid,
796# i.e. a map is the same as the left of the right map etc. 804# i.e. a map is the same as the left of the right map etc.
797# failure to comply are harmless and result in display errors 805# failure to comply is harmless and results in display errors
798# at worst. 806# at worst.
799sub flood_fill { 807sub flood_fill {
800 my ($self, $block, $gx, $gy, $path, $hash, $flags) = @_; 808 my ($self, $block, $gx, $gy, $path, $hash, $flags) = @_;
801 809
802 # the server does not allow map paths > 6 810 # the server does not allow map paths > 6
… …
838 return if $mode ne "spatial"; 846 return if $mode ne "spatial";
839 847
840 $x += $self->{map}->ox; 848 $x += $self->{map}->ox;
841 $y += $self->{map}->oy; 849 $y += $self->{map}->oy;
842 850
843 $self->load_map ($hash, $x, $y) 851 $self->load_map ($hash, $x, $y, $w, $h)
844 unless $self->{neigh_map}{$hash}[5]++;#d# 852 unless $self->{neigh_map}{$hash}[5]++;#d#
845 853
846 $neigh->[$tile] = [$flags, $x, $y, $w, $h, $hash]; 854 $neigh->[$tile] = [$flags, $x, $y, $w, $h, $hash];
847 855
848 $self->flood_fill ($block, $gx, $gy, "$path$tile", $hash, $flags) 856 $self->flood_fill ($block, $gx, $gy, "$path$tile", $hash, $flags)
… …
856 my ($self, $mode, $flags, $x, $y, $w, $h, $hash) = @_; 864 my ($self, $mode, $flags, $x, $y, $w, $h, $hash) = @_;
857 865
858 $self->flush_map; 866 $self->flush_map;
859 867
860 ++$self->{map_change_gen}; 868 ++$self->{map_change_gen};
861 $self->{map_cache_old} = delete $self->{map_cache_new}; 869 $self->{map_cache_old} = delete $self->{map_cache};
862 870
863 my ($ox, $oy) = ($::MAP->ox, $::MAP->oy); 871 my ($ox, $oy) = ($::MAP->ox, $::MAP->oy);
864 872
865 my $mapmapw = $self->{mapmap}->{w}; 873 my $mapmapw = $self->{mapmap}->{w};
866 my $mapmaph = $self->{mapmap}->{h}; 874 my $mapmaph = $self->{mapmap}->{h};
… …
878 $self->{map_info} = [$hash, $x, $y, $w, $h]; 886 $self->{map_info} = [$hash, $x, $y, $w, $h];
879 887
880 (my $map = $hash) =~ s/^.*?\/([^\/]+)$/\1/; 888 (my $map = $hash) =~ s/^.*?\/([^\/]+)$/\1/;
881 $::STATWIDS->{map}->set_text ("Map: " . $map); 889 $::STATWIDS->{map}->set_text ("Map: " . $map);
882 890
883 $self->load_map ($hash, $x, $y); 891 $self->load_map ($hash, $x, $y, $w, $h);
884 $self->flood_fill (0, 0, 0, "", $hash, $flags); 892 $self->flood_fill (0, 0, 0, "", $hash, $flags);
885} 893}
886 894
887sub face_find { 895sub face_find {
888 my ($self, $facenum, $face, $cb) = @_; 896 my ($self, $facenum, $face, $cb) = @_;
… …
1360 1368
1361 $self->update_server_info; 1369 $self->update_server_info;
1362 1370
1363 $self->send_command ("output-rate $::CFG->{output_rate}") if $::CFG->{output_rate} > 0; 1371 $self->send_command ("output-rate $::CFG->{output_rate}") if $::CFG->{output_rate} > 0;
1364 $self->send_command ("pickup $::CFG->{pickup}"); 1372 $self->send_command ("pickup $::CFG->{pickup}");
1373
1374 $self->send_exti_msg (clientlog => sprintf "OpenGL Info: %s [%s]",
1375 DC::OpenGL::gl_vendor, DC::OpenGL::gl_version);#d#
1365} 1376}
1366 1377
1367sub lookat { 1378sub lookat {
1368 my ($self, $x, $y) = @_; 1379 my ($self, $x, $y) = @_;
1369 1380

Diff Legend

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