--- deliantra/Deliantra-Client/DC/Protocol.pm 2007/04/24 01:13:15 1.105 +++ deliantra/Deliantra-Client/DC/Protocol.pm 2007/07/10 16:25:16 1.112 @@ -23,6 +23,7 @@ setup_req => { extmap => 1, excmd => 1, + ywidget => 1, %{$arg{setup_req} || {}}, }, ); @@ -66,6 +67,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; @@ -251,9 +356,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); @@ -636,6 +739,21 @@ $self->{query}-> ($self, $flags, $prompt); } +sub sanitise_xml($) { + local $_ = shift; + + # 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, @@ -671,6 +789,8 @@ sub msg { my ($self, $color, $type, $text, @extra) = @_; + $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)$/) { @@ -1014,6 +1134,8 @@ if $self->{npc_dialog}; $self->SUPER::destroy; + + %$self = (); } package CFPlus::NPCDialog; @@ -1114,7 +1236,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{