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.224 by root, Wed Nov 7 00:25:46 2012 UTC vs.
Revision 1.229 by root, Mon Nov 26 13:02:28 2012 UTC

… …
7use Deliantra::Protocol::Constants; 7use Deliantra::Protocol::Constants;
8 8
9use DC; 9use DC;
10use DC::DB; 10use DC::DB;
11use DC::UI; 11use DC::UI;
12use DC::Pod;
13use DC::Macro; 12use DC::Macro;
14use DC::Item; 13use DC::Item;
15 14
16use base 'Deliantra::Protocol::Base'; 15use base 'Deliantra::Protocol::Base';
17 16
… …
67 }); 66 });
68 67
69 () 68 ()
70 }); 69 });
71 70
72 $self->{map_widget}->clr_commands; 71 $::COMPLETER->reset;
73
74 my @cmd_help = map {
75 $_->[DC::Pod::N_KW][0] =~ /^(\S+) (?:\s+ \( ([^\)]*) \) )?/x
76 or die "unparseable command help: $_->[DC::Pod::N_KW][0]";
77
78 my $cmd = $1;
79 my @args = split /\|/, $2;
80 @args = (".*") unless @args;
81
82 my (undef, @par) = DC::Pod::section_of $_;
83 my $text = DC::Pod::as_label @par;
84
85 $_ = $_ eq ".*" ? "" : " $_"
86 for @args;
87
88 map ["$cmd$_", $text],
89 sort { (length $a) <=> (length $b) }
90 @args
91 } sort { $a->[DC::Pod::N_PAR] <=> $b->[DC::Pod::N_PAR] }
92 DC::Pod::find command => "*";
93 72
94 $self->{json_coder} 73 $self->{json_coder}
95 ->convert_blessed 74 ->convert_blessed
96 ->filter_json_single_key_object ("\fw" => sub { 75 ->filter_json_single_key_object ("\fw" => sub {
97 $self->{widget}{$_[0]} 76 $self->{widget}{$_[0]}
… …
114 $::INV->clear; 93 $::INV->clear;
115 $::INVR->clear; 94 $::INVR->clear;
116 $::INVR_HB->clear; 95 $::INVR_HB->clear;
117 $::FLOORBOX->clear; 96 $::FLOORBOX->clear;
118 }); 97 });
119
120 $self->{map_widget}->add_command (@$_)
121 for @cmd_help;
122 98
123 { 99 {
124 $self->{dialogue} = my $tex = $TEX_DIALOGUE; 100 $self->{dialogue} = my $tex = $TEX_DIALOGUE;
125 $self->{map}->set_texture (1, @$tex{qw(name w h s t)}, @{$tex->{minified}}); 101 $self->{map}->set_texture (1, @$tex{qw(name w h s t)}, @{$tex->{minified}});
126 } 102 }
… …
151 $self->{mapcache} = "mapcache_$self->{host}_$self->{port}"; 127 $self->{mapcache} = "mapcache_$self->{host}_$self->{port}";
152 128
153 $self 129 $self
154} 130}
155 131
132 #$self->send_exti_req (nickmon => 1, sub { use Data::Dump; ddx \@_ });#d#
133#sub ext_nicklist { shift; use Data::Dump; ddx \@_; } #d#
134
156sub update_fx_want { 135sub update_fx_want {
157 my ($self) = @_; 136 my ($self) = @_;
158 137
159 $self->send_exti_msg (fx_want => { 138 $self->send_exti_msg (fx_want => {
160 3 => !!$::CFG->{bgm_enable}, # FT_MUSIC 139 3 => !!$::CFG->{bgm_enable}, # FT_MUSIC
… …
181} 160}
182 161
183sub ext_ambient_music { 162sub ext_ambient_music {
184 my ($self, $songs) = @_; 163 my ($self, $songs) = @_;
185 &::audio_music_set_ambient ($songs); 164 &::audio_music_set_ambient ($songs);
165}
166
167sub ext_command_list {
168 my ($self, @faces) = @_;
169
170 my $handler = $self->{command_facehandler} = {};
171 my $commands = $::COMPLETER->{command_list} = {};
172
173 $::COMPLETER->{command_lists} = \@faces;
174
175 for my $idx (@faces) {
176 $handler->{$idx} = $self->register_face_handler ($idx, sub {
177 my ($face) = @_;
178
179 $commands->{$idx} =
180 $face->{cache} ||= $self->{json_coder}->decode ($face->{data});
181 });
182 }
186} 183}
187 184
188############################################################################# 185#############################################################################
189 186
190sub widget_associate { 187sub widget_associate {
… …
631 # progress 628 # progress
632 (new DC::UI::ExperienceProgress), 629 (new DC::UI::ExperienceProgress),
633 630
634 # label 631 # label
635 (new DC::UI::Label text => $name, on_button_down => $spell_cb, align => 0, 632 (new DC::UI::Label text => $name, on_button_down => $spell_cb, align => 0,
636 can_events => 1, can_hover => 1, tooltip => (DC::Pod::section_label skill_description => $name) . $TOOLTIP_ALL), 633 can_events => 1, can_hover => 1, tooltip => "#(skill/$name)$TOOLTIP_ALL"),
637 ]; 634 ];
638 635
639 push @add, 636 push @add,
640 $x * 4 + 0, $y, $sw->[0], 637 $x * 4 + 0, $y, $sw->[0],
641 $x * 4 + 1, $y, $sw->[1], 638 $x * 4 + 1, $y, $sw->[1],
… …
1062 1059
1063 $prompt = $LAST_QUERY unless length $prompt; 1060 $prompt = $LAST_QUERY unless length $prompt;
1064 $LAST_QUERY = $prompt; 1061 $LAST_QUERY = $prompt;
1065 1062
1066 $self->{query}->($self, $flags, $prompt); 1063 $self->{query}->($self, $flags, $prompt);
1067}
1068
1069sub sanitise_xml($) {
1070 local $_ = shift;
1071
1072 # we now weed out all tags we do not support
1073 s{ <(?! /?i> | /?u> | /?b> | /?big | /?small | /?s | /?tt | fg\ | /fg>)
1074 }{
1075 "&lt;"
1076 }gex;
1077
1078 # now all entities
1079 s/&(?!amp;|lt;|gt;|apos;|quot;|#[0-9]+;|#x[0-9a-fA-F]+;)/&amp;/g;
1080
1081 # handle some elements
1082 s/<fg name='([^']*)'>(.*?)<\/fg>/<span foreground='$1'>$2<\/span>/gs;
1083 s/<fg name="([^"]*)">(.*?)<\/fg>/<span foreground="$1">$2<\/span>/gs;
1084
1085 s/\s+$//;
1086
1087 $_
1088} 1064}
1089 1065
1090our %NAME_TO_COLOR = ( 1066our %NAME_TO_COLOR = (
1091 black => 0, 1067 black => 0,
1092 white => 1, 1068 white => 1,
… …
1120); 1096);
1121 1097
1122sub msg { 1098sub msg {
1123 my ($self, $color, $type, $text, @extra) = @_; 1099 my ($self, $color, $type, $text, @extra) = @_;
1124 1100
1125 $text = sanitise_xml $text; 1101 $text = DC::sanitise_cfxml $text;
1126 1102
1127 if (my $cb = $self->{cb_msg}{$type}) { 1103 if (my $cb = $self->{cb_msg}{$type}) {
1128 $_->($self, $color, $type, $text, @extra) for values %$cb; 1104 $_->($self, $color, $type, $text, @extra) for values %$cb;
1129 } elsif ($type =~ /^(?:chargen-race-title|chargen-race-description)$/) { 1105 } elsif ($type =~ /^(?:chargen-race-title|chargen-race-description)$/) {
1130 $type =~ s/-/_/g; 1106 $type =~ s/-/_/g;
… …
1159} 1135}
1160 1136
1161sub spell_add { 1137sub spell_add {
1162 my ($self, $spell) = @_; 1138 my ($self, $spell) = @_;
1163 1139
1164 # try to create single paragraphs out of the multiple lines sent by the server
1165 $spell->{message} =~ s/(?<=\S)\n(?=\w)/ /g;
1166 $spell->{message} =~ s/\n+$//;
1167 $spell->{message} ||= "Server did not provide a description for this spell.";
1168
1169 $::SPELL_LIST->add_spell ($spell); 1140 $::SPELL_LIST->add_spell ($spell);
1170 1141 delete $::COMPLETER->{command_list}{spells};
1171 $self->{map_widget}->add_command ("invoke $spell->{name}", DC::asxml $spell->{message});
1172 $self->{map_widget}->add_command ("cast $spell->{name}", DC::asxml $spell->{message});
1173} 1142}
1174 1143
1175sub spell_delete { 1144sub spell_delete {
1176 my ($self, $spell) = @_; 1145 my ($self, $spell) = @_;
1177 1146
1178 $::SPELL_LIST->remove_spell ($spell); 1147 $::SPELL_LIST->remove_spell ($spell);
1148 delete $::COMPLETER->{command_list}{spells};
1179} 1149}
1180 1150
1181sub setup { 1151sub setup {
1182 my ($self, $setup) = @_; 1152 my ($self, $setup) = @_;
1183 1153
1184 $self->{map_widget}->set_tilesize ($self->{tilesize}); 1154 $self->{map_widget}->set_tilesize ($self->{tilesize});
1185 $::MAP->resize ($self->{mapw}, $self->{maph}); 1155 $::MAP->resize ($self->{mapw}, $self->{maph});
1186} 1156}
1187 1157
1188sub addme_success {
1189 my ($self) = @_;
1190
1191 my %skill_help;
1192
1193 for my $node (DC::Pod::find skill_description => "*") {
1194 my (undef, @par) = DC::Pod::section_of $node;
1195 $skill_help{$node->[DC::Pod::N_KW][0]} = DC::Pod::as_label @par;
1196 };
1197
1198 for my $skill (values %{$self->{skill_info}}) {
1199 $self->{map_widget}->add_command ("ready_skill $skill",
1200 (DC::asxml "Ready the skill '$skill'\n\n")
1201 . $skill_help{$skill});
1202 $self->{map_widget}->add_command ("use_skill $skill",
1203 (DC::asxml "Immediately use the skill '$skill'\n\n")
1204 . $skill_help{$skill});
1205 }
1206}
1207
1208sub eof { 1158sub eof {
1209 my ($self) = @_; 1159 my ($self) = @_;
1210 1160
1211 $self->{map_widget}->clr_commands; 1161 $::COMPLETER->reset;
1212 1162
1213 ::stop_game (); 1163 ::stop_game ();
1214} 1164}
1215 1165
1216sub update_floorbox { 1166sub update_floorbox {
… …
1537 1487
1538 $self->{kw}{$_} = 1 for @{$info{add_topics} || []}; 1488 $self->{kw}{$_} = 1 for @{$info{add_topics} || []};
1539 $self->{kw}{$_} = 0 for @{$info{del_topics} || []}; 1489 $self->{kw}{$_} = 0 for @{$info{del_topics} || []};
1540 1490
1541 if (exists $info{msg}) { 1491 if (exists $info{msg}) {
1542 my $text = "\n" . DC::Protocol::sanitise_xml $info{msg}; 1492 my $text = "\n" . DC::sanitise_cfxml $info{msg};
1543 my $match = join "|", map "\\b\Q$_\E\\b", sort { (length $b) <=> (length $a) } keys %{ $self->{kw} }; 1493 my $match = join "|", map "\\b\Q$_\E\\b", sort { (length $b) <=> (length $a) } keys %{ $self->{kw} };
1544 my @link; 1494 my @link;
1545 $text =~ s{ 1495 $text =~ s{
1546 ($match) 1496 ($match)
1547 }{ 1497 }{

Diff Legend

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