--- deliantra/Deliantra-Client/DC/Protocol.pm 2007/04/18 18:16:16 1.102 +++ deliantra/Deliantra-Client/DC/Protocol.pm 2007/07/12 17:56:51 1.113 @@ -22,6 +22,8 @@ my $self = $class->SUPER::new (%arg, setup_req => { extmap => 1, + excmd => 1, + ywidget => 1, %{$arg{setup_req} || {}}, }, ); @@ -48,6 +50,46 @@ } sort { $a->{par} <=> $b->{par} } CFPlus::Pod::find command => "*"; + $self->connect_ext (event_music => sub { + my ($ev) = @_; + + return unless $::CFG->{bgm_enable}; + + my $faces = $ev->{faces}; + my @songs; + + # request music from server if appropriate + my $pri = -100; + for my $face (@$faces) { + if (defined (my $chksum = $ev->{chksum}{$face})) { + utf8::downgrade $chksum; + + $chksum = unpack "H*", $chksum; + $self->{music_map}{$face} = $chksum; + + ::message ({ markup => "starting to download song #$face, check your output-rate setting if your connection gets laggy." }); + $self->ask_face ($face, $pri, undef, sub { + my $num = $_[0]; + my $len = length $_[1]; + my ($meta, $data) = unpack "(w/a*)*", $_[1]; + + CFPlus::DB::write_file $chksum, $data, sub { }; + CFPlus::DB::put resmap => $chksum => $meta, sub { }; + + $self->{music_meta}{$chksum} = $self->{json_coder}->decode ($meta); + ::message ({ markup => "downloaded song #$face, size $len octets" }); + + &::audio_music_set ($self->{songs}); + }); + } + + push @songs, $self->{music_map}{$face}; + --$pri; + } + + &::audio_music_set ($self->{songs} = \@songs); + }); + $self->connect_ext (event_capabilities => sub { my ($cap) = @_; @@ -65,6 +107,110 @@ } }); + $self->{json_coder} + ->convert_blessed + ->filter_json_single_key_object (__widget_ref__ => sub { + $self->{widget}{$_[0]} + }); + + $self->connect_ext (ws_n => sub { + my ($arg) = @_; + + $self->{widgetset}{$arg{id}} = { + w => {}, + }; + }); + + $self->connect_ext (ws_d => sub { + my ($arg) = @_; + + my $ws = delete $self->{widgetset}{$arg{id}} + or return; + + $_->destroy + for values %{$ws->{w}}; + }); + + $self->connect_ext (ws_c => sub { + my ($arg) = @_; + + my $args = $arg->{args} || {}; + + for my $ev (grep /^on_/, keys %$args) { + $args->{$ev} = sub { + my $id = shift->{s_id}; + $self->send_exti_msg (w_e => id => $id, name => $ev, args => \@_); + + 1 + }; + } + + if (my $widget = eval { + local $SIG{__DIE__}; + "CFPlus::UI::$arg->{class}"->new ( + %$args, + s_ws => $arg->{ws}, + s_id => $arg->{id}, + ) + } + ) { + $self->{widget}{$arg->{id}} + = $self->{widgetset}{$arg->{ws}}{w}{$arg->{id}} + = $widget; + + $widget->connect (on_destroy => sub { + my ($widget) = @_; + + delete $self->{widget}{$widget->{s_id}}; + delete $self->{widgetset}{$widget->{s_ws}}{$widget->{s_id}}; + }); + } else { + warn "server failed creating client-side widget " . (CFPlus::to_json $arg) . ": $@\n"; + $self->send_exti_msg (w_e => id => $arg->{id}, name => "destroy"); + } + }); + + $self->connect_ext (w_c => sub { + my ($arg) = @_; + + my $w = $self->{widget}{$arg->{id}} + or return; + my $m = $arg->{name}; + + my $a = $arg->{args} || []; + + if (exists $arg->{rid}) { + $self->send_exti_msg (w_r => rid => $arg->{rid}, res => [$w->$m (@$a)]); + } else { + $w->$m (@$a); + } + }); + + $self->connect_ext (w_s => sub { + my ($arg) = @_; + + my $w = $self->{widget}{$arg->{id}} + or return; + + $w->{$arg->{name}} = $arg->{value}; + }); + + $self->connect_ext (w_g => sub { + my ($arg) = @_; + + my $w = $self->{widget}{$arg->{id}} + or return; + + $self->send_exti_msg (w_r => rid => $arg->{rid}, res => [$w->{$arg->{name}}]); + }); + + $self->{on_stop_game_guard} = $self->{map_widget}{root}->connect (stop_game => sub { + for my $ws (values %{delete $self->{widgetset} || {}}) { + $_->destroy + for values %{delete $ws->{w} || {}}; + } + }); + $self->{map_widget}->add_command (@$_) for @cmd_help; @@ -250,9 +396,7 @@ $::GAUGES->{grace} ->set_value ($gr, $gr_m); $::GAUGES->{exp} ->set_text ("Exp: " . (::formsep ($stats->{+CS_STAT_EXP64})) . " (lvl " . ($stats->{+CS_STAT_LEVEL} * 1) . ")"); - my $rng = $stats->{+CS_STAT_RANGE}; - $rng =~ s/^Range: //; # thank you so much dear server - $::GAUGES->{range} ->set_text ("Rng: " . $rng); + $::GAUGES->{range} ->set_text ($stats->{+CS_STAT_RANGE}); my $title = $stats->{+CS_STAT_TITLE}; $title =~ s/^Player: //; $::STATWIDS->{title} ->set_text ("Title: " . $title); @@ -635,52 +779,83 @@ $self->{query}-> ($self, $flags, $prompt); } -sub drawinfo { - my ($self, $color, $text) = @_; +sub sanitise_xml($) { + local $_ = shift; - my @color = ( - [1.00, 1.00, 1.00], #[0.00, 0.00, 0.00], - [1.00, 1.00, 1.00], - [0.50, 0.50, 1.00], #[0.00, 0.00, 0.55] - [1.00, 0.00, 0.00], - [1.00, 0.54, 0.00], - [0.11, 0.56, 1.00], - [0.93, 0.46, 0.00], - [0.18, 0.54, 0.34], - [0.56, 0.73, 0.56], - [0.80, 0.80, 0.80], - [0.75, 0.61, 0.20], - [0.99, 0.77, 0.26], - [0.74, 0.65, 0.41], - ); + # we now weed out all tags we do not support + s%<(?!/?i>|/?u>|/?b>|fg |/fg>)%<%g; + # now all entities + s/&(?!amp;|lt;|gt;|apos;|quot;|#[0-9]+;|#x[0-9a-fA-F]+;)/&/g; + + # handle some elements + s/(.*?)<\/fg>/$2<\/span>/gs; + s/(.*?)<\/fg>/$2<\/span>/gs; + + $_ +} + +our %NAME_TO_COLOR = ( + black => 0, + white => 1, + darkblue => 2, + red => 3, + orange => 4, + lightblue => 5, + darkorange => 6, + green => 7, + darkgreen => 8, + grey => 9, + brown => 10, + yellow => 11, + tan => 12, +); - my $fg = $color[$color % @color]; +our @CF_COLOR = ( + [1.00, 1.00, 1.00], #[0.00, 0.00, 0.00], + [1.00, 1.00, 1.00], + [0.50, 0.50, 1.00], #[0.00, 0.00, 0.55] + [1.00, 0.00, 0.00], + [1.00, 0.54, 0.00], + [0.11, 0.56, 1.00], + [0.93, 0.46, 0.00], + [0.18, 0.54, 0.34], + [0.56, 0.73, 0.56], + [0.80, 0.80, 0.80], + [0.75, 0.61, 0.20], + [0.99, 0.77, 0.26], + [0.74, 0.65, 0.41], +); - $self->logprint ("info: ", $text); +sub msg { + my ($self, $color, $type, $text, @extra) = @_; - ## try to create single paragraphs of multiple lines sent by the server - # no longer neecssary with TRT servers - #$text =~ s/(?<=\S)\n(?=\w)/ /g; - - $text = CFPlus::asxml $text; - $text =~ s/\[b\](.*?)\[\/b\]/\1<\/b>/g; - $text =~ s/\[color=(.*?)\](.*?)\[\/color\]/\2<\/span>/g; - - ::message ({ fg => $fg, markup => $_ }) - for split /\n/, $text; - - $self->{statusbox}->add ($text, - group => $text, - fg => $fg, - timeout => $color >= 2 ? 180 : 10, - tooltip_font => $::FONT_FIXED, - ); -} + $text = sanitise_xml $text; + + if (my $cb = $self->{cb_msg}{$type}) { + $_->($self, $color, $type, $text, @extra) for values %$cb; + } elsif ($type =~ /^(?:chargen-race-title|chargen-race-description)$/) { + $type =~ s/-/_/g; + $self->{$type} = $text; + } else { + $self->logprint ("msg: ", $text); + return if $color < 0; # negative color == ignore if not understood -sub drawextinfo { - my ($self, $color, $type, $subtype, $message) = @_; + my $fg = $CF_COLOR[$color % @CF_COLOR]; - $self->drawinfo ($color, $message); + ## try to create single paragraphs of multiple lines sent by the server + # no longer neecssary with TRT servers + #$text =~ s/(?<=\S)\n(?=\w)/ /g; + + ::message ({ fg => $fg, markup => $_ }) + for split /\n/, $text; + + $self->{statusbox}->add ($text, + group => $text, + fg => $fg, + timeout => $color >= 2 ? 180 : 10, + tooltip_font => $::FONT_FIXED, + ); + } } sub spell_add { @@ -923,8 +1098,10 @@ . "protocol version $self->{version}\n" . "minimap support $yesno[$self->{setup}{mapinfocmd} > 0]\n" . "extended command support $yesno[$self->{setup}{extcmd} > 0]\n" + . "examine command support $yesno[$self->{setup}{excmd} > 0]\n" . "editing support $yesno[!!$self->{editor_support}]\n" . "map attributes $yesno[$self->{setup}{extmap} > 0]\n" + . "big image protocol support $yesno[$self->{setup}{fxix} > 0]\n" . "cfplus support $yesno[$self->{cfplus_ext} > 0]" . ($self->{cfplus_ext} > 0 ? ", version $self->{cfplus_ext}" : "") ."\n" . "map size $self->{mapw}×$self->{maph}\n" @@ -997,6 +1174,8 @@ if $self->{npc_dialog}; $self->SUPER::destroy; + + %$self = (); } package CFPlus::NPCDialog; @@ -1097,7 +1276,7 @@ $self->{kw}{$_} = 1 for @{$msg->{add_topics} || []}; $self->{kw}{$_} = 0 for @{$msg->{del_topics} || []}; - my $text = "\n" . CFPlus::asxml $msg->{msg}; + my $text = "\n" . CFPlus::Protocol::sanitise_xml $msg->{msg}; my $match = join "|", map "\\b\Q$_\E\\b", sort { (length $b) <=> (length $a) } keys %{ $self->{kw} }; my @link; $text =~ s{