--- deliantra/server/ext/widget.ext 2007/06/25 05:43:53 1.1 +++ deliantra/server/ext/widget.ext 2007/07/23 21:02:50 1.13 @@ -5,62 +5,96 @@ # ws_d id # widgetset destroy # ws_c ws id class args # widgetset create # w_c id [rid] name args # widget method call -# w_s id name value # widget member set -# w_g id rid name # widget member get +# w_s id @attr # widget member set +# w_g id rid @attr # widget member get # # and expects the following exti message types # w_r rid res # widget call return # w_e id name args # widget_event +our $DEBUG = 1; + cf::client->attach ( on_connect => sub { my ($ns) = @_; + Scalar::Util::weaken (my $weakns = $ns); + $ns->{id} = "a"; + $ns->{json_coder}->filter_json_single_key_object (__widget_ref__ => sub { + # cannot deserialise ATM + undef + }); }, ); -cf::player->attach ( - on_login => sub { - my ($pl) = @_; +sub csc_update_stats { + my ($ns) = @_; - #DEMO CODE - return unless $pl->ob->name eq "schmorp"; + while (my ($k, $v) = each %{ $ns->{csc}{stat} }) { + $v->set_text ($ns->pl->ob->stats->$k); + } +} - my $ns = $pl->ns; +sub csc_start { + my ($ns) = @_; - return unless $ns->{can_widgetx}; + my $ws = $ns->{csc} = $ns->new_widgetset; - my $ws = $ns->new_widgetset; + my $w = $ws->new (Toplevel => + min_w => 600, + min_h => 400, + x => "center", + y => "center", + title => "Character Creation", + has_close_button => 1, + on_delete => sub { + $ws->destroy; + }, + ); - $ns->async (sub { - Coro::Timer::sleep 20; - warn "undef\n";#d# - undef $ws;# - });#d# - - my $w = $ws->new (Toplevel => - x => "center", - y => "center", - title => "Server Query", - has_close_button => 1, - on_delete => sub { - warn "i was being d-e-l-e-t-e-d\n"; - }, - ); + $w->add (my $ntb = $ws->new (Notebook => expand => 1)); - $w->add ($ws->new (Entry => - on_changed => sub { - warn "i was changed<@_>\n"; - } - )); + $ntb->add (Statistics => (my $stats = $ws->new (Table => expand => 1)), "Basic statistics of your new character"); - $ns->async (sub { - warn $w->get ("parent"); - }); + $stats->add (0, 0, (my $statstable = $ws->new ("Table"))); - $w->show; + for ( + [0, "Str"], + [1, "Dex"], + [2, "Con"], + [3, "Int"], + [4, "Wis"], + [5, "Pow"], + [6, "Cha"], + ) { + my ($x, $label) = @$_; + + $statstable->add_at ($x, 0, $ws->new (Label => + can_hover => 1, can_events => 1, + align => +1, text => $label, tooltip => "#stat_$label", + )); + $statstable->add_at ($x, 1, $ws->{stat}{$label} = $ws->new (Label => + can_hover => 1, can_events => 1, + align => +1, template => "88", tooltip => "#stat_$label", + )); + } + + csc_update_stats $ns; + + $w->show; +} + +cf::player->attach ( + on_login => sub { + my ($pl) = @_; + + return unless $cf::CFG{devel}; + + my $ns = $pl->ns; + return unless $ns->{can_widget}; + #csc_start $ns; }, ); @@ -95,7 +129,7 @@ my $ws = bless { id => $id, ns => $self, - w => {}, + _w => {}, }, "ext::widget::set"; $ws->msg (ws_n => id => $id); @@ -125,7 +159,8 @@ if (my $ns = shift->{ns}) { $msg{msgtype} = $type; - $ns->send_packet ("ext " . cf::to_json \%msg); + warn "msg " . $ns->{json_coder}->encode (\%msg) if $DEBUG;#d# + $ns->send_packet ("ext " . $ns->{json_coder}->encode (\%msg)); } } @@ -134,10 +169,11 @@ my $id = ++$self->{ns}{id}; - my $proxy = $self->{w}{$id} = bless { + my $proxy = bless { id => $id, }, "ext::widget::proxy"; + Scalar::Util::weaken ($self->{_w}{$id} = $proxy); Scalar::Util::weaken ($proxy->{ws} = $self); Scalar::Util::weaken ($proxy->{ns} = $self->{ns}); Scalar::Util::weaken ($self->{ns}{widget}{$id} = $proxy); @@ -148,7 +184,7 @@ } $self->msg (ws_c => - ws => $self->{w}{id}, + ws => $proxy->{id}, id => $id, class => $class, args => \%args, @@ -167,8 +203,8 @@ delete $self->{ns}{widget}{$self->{id}}; if (my $ws = $self->{ws}) { - delete $ws->{w}{$self->{id}}; $self->msg (w_c => name => "destroy"); + delete $ws->{_w}{$self->{id}}; } } @@ -213,15 +249,15 @@ } sub set { - my ($self, $member, $value) = @_; + my ($self, @kv) = @_; - $self->msg (w_s => name => $member, value => $value); + $self->msg (w_s => attr => \@kv); } sub get { my ($self, $member, $cb) = @_; - $self->msg_cb ($cb, w_g => name => $member); + $self->msg_cb ($cb, w_g => attr => [$member]); } sub TO_JSON {