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.106 by root, Sun Apr 29 20:03:08 2007 UTC vs.
Revision 1.120 by root, Sat Jul 14 13:04:42 2007 UTC

… …
21 21
22 my $self = $class->SUPER::new (%arg, 22 my $self = $class->SUPER::new (%arg,
23 setup_req => { 23 setup_req => {
24 extmap => 1, 24 extmap => 1,
25 excmd => 1, 25 excmd => 1,
26 ywidget => 1,
26 %{$arg{setup_req} || {}}, 27 %{$arg{setup_req} || {}},
27 }, 28 },
28 ); 29 );
29 30
30 $self->{map_widget}->clr_commands; 31 $self->{map_widget}->clr_commands;
… …
47 sort { (length $a) <=> (length $b) } 48 sort { (length $a) <=> (length $b) }
48 @args 49 @args
49 } sort { $a->{par} <=> $b->{par} } 50 } sort { $a->{par} <=> $b->{par} }
50 CFPlus::Pod::find command => "*"; 51 CFPlus::Pod::find command => "*";
51 52
53 $self->connect_ext (event_music => sub {
54 my ($ev) = @_;
55
56 return unless $::CFG->{bgm_enable};
57
58 my $faces = $ev->{faces};
59 my @songs;
60
61 # request music from server if appropriate
62 if (my $faces = $ev->{faces}) {
63 for (@$faces) {
64 my ($face, $pri, $chksum) = @$_;
65 utf8::downgrade $chksum;
66
67 $chksum = unpack "H*", $chksum;
68 $self->{music_map}{$face} = $chksum;
69
70 # check if already cached
71 CFPlus::DB::get "res-metadata" => $chksum, sub {
72 my ($meta_json) = @_;
73 my $path = CFPlus::DB::path_of_res $chksum;
74
75 if (defined $meta_json) {
76 my $meta = $self->{json_coder}->decode ($meta_json);
77 $meta->{path} = $path;
78 $self->{music_meta}{$chksum} = $meta;
79 } else {
80 ::message ({ markup => "starting to download song #$face/$pri, check your output-rate setting if your connection gets laggy." });
81 $self->ask_face ($face, -100 - $pri, undef, sub {
82 my $len = length $_[1];
83 my ($meta_json, $data) = unpack "(w/a*)*", $_[1];
84
85 CFPlus::DB::write_file $path, $data, sub {
86 CFPlus::DB::put "res-metadata" => $chksum => $meta_json, sub {
87 my $meta = $self->{json_coder}->decode ($meta_json);
88 $meta->{path} = $path;
89 $self->{music_meta}{$chksum} = $meta;
90
91 ::message ({ markup => "downloaded song #$face, size $len octets" });
92 &::audio_music_set ($self->{songs});
93 };
94 };
95 });
96 }
97 }
98 }
99 }
100
101 if (my $play = $ev->{play}) {
102 &::audio_music_set ($self->{songs} = [map $self->{music_map}{$_}, @$play]);
103 }
104 });
105
52 $self->connect_ext (event_capabilities => sub { 106 $self->connect_ext (event_capabilities => sub {
53 my ($cap) = @_; 107 my ($cap) = @_;
54 108
55 if (my $ts = $cap->{tileset}) { 109 if (my $ts = $cap->{tileset}) {
56 if (my ($default) = grep $_->[2] & 1, @$ts) { 110 if (my ($default) = grep $_->[2] & 1, @$ts) {
… …
61 my $w = int $self->{mapw} * 32 / $self->{tilesize}; 115 my $w = int $self->{mapw} * 32 / $self->{tilesize};
62 my $h = int $self->{maph} * 32 / $self->{tilesize}; 116 my $h = int $self->{maph} * 32 / $self->{tilesize};
63 117
64 $self->setup_req (mapsize => "${w}x${h}"); 118 $self->setup_req (mapsize => "${w}x${h}");
65 } 119 }
120 }
121 });
122
123 $self->{json_coder}
124 ->convert_blessed
125 ->filter_json_single_key_object (__widget_ref__ => sub {
126 $self->{widget}{$_[0]}
127 });
128
129 $self->connect_ext (ws_n => sub {
130 my ($arg) = @_;
131
132 $self->{widgetset}{$arg{id}} = {
133 w => {},
134 };
135 });
136
137 $self->connect_ext (ws_d => sub {
138 my ($arg) = @_;
139
140 my $ws = delete $self->{widgetset}{$arg{id}}
141 or return;
142
143 $_->destroy
144 for values %{$ws->{w}};
145 });
146
147 $self->connect_ext (ws_c => sub {
148 my ($arg) = @_;
149
150 my $args = $arg->{args} || {};
151
152 for my $ev (grep /^on_/, keys %$args) {
153 $args->{$ev} = sub {
154 my $id = shift->{s_id};
155 $self->send_exti_msg (w_e => id => $id, name => $ev, args => \@_);
156
157 1
158 };
159 }
160
161 if (my $widget = eval {
162 local $SIG{__DIE__};
163 "CFPlus::UI::$arg->{class}"->new (
164 %$args,
165 s_ws => $arg->{ws},
166 s_id => $arg->{id},
167 )
168 }
169 ) {
170 $self->{widget}{$arg->{id}}
171 = $self->{widgetset}{$arg->{ws}}{w}{$arg->{id}}
172 = $widget;
173
174 $widget->connect (on_destroy => sub {
175 my ($widget) = @_;
176
177 delete $self->{widget}{$widget->{s_id}};
178 delete $self->{widgetset}{$widget->{s_ws}}{$widget->{s_id}};
179 });
180 } else {
181 warn "server failed creating client-side widget " . (CFPlus::to_json $arg) . ": $@\n";
182 $self->send_exti_msg (w_e => id => $arg->{id}, name => "destroy");
183 }
184 });
185
186 $self->connect_ext (w_c => sub {
187 my ($arg) = @_;
188
189 my $w = $self->{widget}{$arg->{id}}
190 or return;
191 my $m = $arg->{name};
192
193 my $a = $arg->{args} || [];
194
195 if (exists $arg->{rid}) {
196 $self->send_exti_msg (w_r => rid => $arg->{rid}, res => [$w->$m (@$a)]);
197 } else {
198 $w->$m (@$a);
199 }
200 });
201
202 $self->connect_ext (w_s => sub {
203 my ($arg) = @_;
204
205 my $w = $self->{widget}{$arg->{id}}
206 or return;
207
208 $w->{$arg->{name}} = $arg->{value};
209 });
210
211 $self->connect_ext (w_g => sub {
212 my ($arg) = @_;
213
214 my $w = $self->{widget}{$arg->{id}}
215 or return;
216
217 $self->send_exti_msg (w_r => rid => $arg->{rid}, res => [$w->{$arg->{name}}]);
218 });
219
220 $self->{on_stop_game_guard} = $self->{map_widget}{root}->connect (stop_game => sub {
221 for my $ws (values %{delete $self->{widgetset} || {}}) {
222 $_->destroy
223 for values %{delete $ws->{w} || {}};
66 } 224 }
67 }); 225 });
68 226
69 $self->{map_widget}->add_command (@$_) 227 $self->{map_widget}->add_command (@$_)
70 for @cmd_help; 228 for @cmd_help;
… …
607} 765}
608 766
609sub set_texture { 767sub set_texture {
610 my ($self, $id, $data) = @_; 768 my ($self, $id, $data) = @_;
611 769
770 return unless $self->{map};
771
612 $self->{texture}[$id] = my $tex = 772 $self->{texture}[$id] = my $tex =
613 new_from_image CFPlus::Texture 773 new_from_image CFPlus::Texture
614 $data, minify => 1, mipmap => 1; 774 $data, minify => 1, mipmap => 1;
615 775
616 $self->{map}->set_texture ($id, @$tex{qw(name w h s t)}, @{$tex->{minified}}); 776 $self->{map}->set_texture ($id, @$tex{qw(name w h s t)}, @{$tex->{minified}});
… …
630 790
631 $prompt = $LAST_QUERY unless length $prompt; 791 $prompt = $LAST_QUERY unless length $prompt;
632 $LAST_QUERY = $prompt; 792 $LAST_QUERY = $prompt;
633 793
634 $self->{query}-> ($self, $flags, $prompt); 794 $self->{query}-> ($self, $flags, $prompt);
795}
796
797sub sanitise_xml($) {
798 local $_ = shift;
799
800 # we now weed out all tags we do not support
801 s%<(?!/?i>|/?u>|/?b>|fg |/fg>)%&lt;%g;
802 # now all entities
803 s/&(?!amp;|lt;|gt;|apos;|quot;|#[0-9]+;|#x[0-9a-fA-F]+;)/&amp;/g;
804
805 # handle some elements
806 s/<fg name='([^']*)'>(.*?)<\/fg>/<span foreground='$1'>$2<\/span>/gs;
807 s/<fg name="([^"]*)">(.*?)<\/fg>/<span foreground="$1">$2<\/span>/gs;
808
809 $_
635} 810}
636 811
637our %NAME_TO_COLOR = ( 812our %NAME_TO_COLOR = (
638 black => 0, 813 black => 0,
639 white => 1, 814 white => 1,
… …
667); 842);
668 843
669sub msg { 844sub msg {
670 my ($self, $color, $type, $text, @extra) = @_; 845 my ($self, $color, $type, $text, @extra) = @_;
671 846
847 $text = sanitise_xml $text;
848
672 if (my $cb = $self->{cb_msg}{$type}) { 849 if (my $cb = $self->{cb_msg}{$type}) {
673 $_->($self, $color, $type, $text, @extra) for values %$cb; 850 $_->($self, $color, $type, $text, @extra) for values %$cb;
674 } elsif ($type =~ /^(?:chargen-race-title|chargen-race-description)$/) { 851 } elsif ($type =~ /^(?:chargen-race-title|chargen-race-description)$/) {
675 $type =~ s/-/_/g; 852 $type =~ s/-/_/g;
676 $self->{$type} = $text; 853 $self->{$type} = $text;
… …
1010 1187
1011 (delete $self->{npc_dialog})->destroy 1188 (delete $self->{npc_dialog})->destroy
1012 if $self->{npc_dialog}; 1189 if $self->{npc_dialog};
1013 1190
1014 $self->SUPER::destroy; 1191 $self->SUPER::destroy;
1192
1193 %$self = ();
1015} 1194}
1016 1195
1017package CFPlus::NPCDialog; 1196package CFPlus::NPCDialog;
1018 1197
1019our @ISA = 'CFPlus::UI::Toplevel'; 1198our @ISA = 'CFPlus::UI::Toplevel';
… …
1110 1289
1111 if ($msg->{msgtype} eq "reply") { 1290 if ($msg->{msgtype} eq "reply") {
1112 $self->{kw}{$_} = 1 for @{$msg->{add_topics} || []}; 1291 $self->{kw}{$_} = 1 for @{$msg->{add_topics} || []};
1113 $self->{kw}{$_} = 0 for @{$msg->{del_topics} || []}; 1292 $self->{kw}{$_} = 0 for @{$msg->{del_topics} || []};
1114 1293
1115 my $text = "\n" . CFPlus::asxml $msg->{msg}; 1294 my $text = "\n" . CFPlus::Protocol::sanitise_xml $msg->{msg};
1116 my $match = join "|", map "\\b\Q$_\E\\b", sort { (length $b) <=> (length $a) } keys %{ $self->{kw} }; 1295 my $match = join "|", map "\\b\Q$_\E\\b", sort { (length $b) <=> (length $a) } keys %{ $self->{kw} };
1117 my @link; 1296 my @link;
1118 $text =~ s{ 1297 $text =~ s{
1119 ($match) 1298 ($match)
1120 }{ 1299 }{

Diff Legend

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