--- deliantra/server/ext/widget.ext 2007/07/23 23:38:17 1.14 +++ deliantra/server/ext/widget.ext 2007/08/17 21:18:01 1.17 @@ -1,16 +1,17 @@ #! perl # mandatory depends=login # sends the following ext message types +# ws_a id name... # associate well-known widget with given id # ws_n ws # widgetset new # ws_d ws # widgetset destroy -# ws_c ws id class args # widgetset create -# w_c id rid name args # widget method call +# ws_c ws id class @args # widgetset create +# w_c id rid name @args # widget method call # 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 +# w_e id rid @args # widget_event our $DEBUG = 1; @@ -21,7 +22,7 @@ Scalar::Util::weaken (my $weakns = $ns); $ns->{id} = "a"; - $ns->{json_coder}->filter_json_single_key_object (__widget_ref__ => sub { + $ns->{json_coder}->filter_json_single_key_object (__w_ => sub { # cannot deserialise ATM undef }); @@ -36,6 +37,17 @@ } } +sub demo_start { + my ($ns) = @_; + + my $ws = $ns->{csc} = $ns->new_widgetset; + + $ws->{tab} = $ws->new (Label => text => "dumb tst", c_tab => ["hull"]); + + $ws->find ("setup_notebook")->add ($ws->{tab}); + $ws->find ("setup_dialog")->toggle_visibility; +} + sub csc_start { my ($ns) = @_; @@ -55,9 +67,9 @@ $w->add (my $ntb = $ws->new (Notebook => expand => 1)); - $ntb->add (Statistics => (my $stats = $ws->new (Table => expand => 1)), "Basic statistics of your new character"); + $ntb->add_tab (Statistics => (my $stats = $ws->new (Table => expand => 1)), "Basic statistics of your new character"); - $stats->add (0, 0, (my $statstable = $ws->new ("Table"))); + $stats->add_at (0, 0, (my $statstable = $ws->new ("Table"))); for ( [0, "Str"], @@ -82,6 +94,7 @@ csc_update_stats $ns; + $ws->{tl} = $w; $w->show; } @@ -95,16 +108,16 @@ return unless $ns->{can_widget}; #csc_start $ns; + demo_start $ns; }, ); cf::register_exticmd w_e => sub { - my ($ns, $id, $name, $args) = @_; + my ($ns, $id, $rid, @args) = @_; if (my $w = $ns->{widget}{$id}) { - if (my $cb = $w->{ev}{$name}) { - $_->($w, @$args) - for @$cb; + if (my $cb = $w->{ev}{$rid}) { + $cb->($w, @args); } } @@ -163,8 +176,8 @@ } } -sub new { - my ($self, $class, %args) = @_; +sub alloc { + my ($self) = @_; my $id = ++$self->{ns}{id}; @@ -172,19 +185,29 @@ 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); + $proxy +} + +sub new { + my ($self, $class, %args) = @_; + + my $proxy = $self->alloc; + + Scalar::Util::weaken ($self->{_w}{$proxy->{id}} = $proxy); + Scalar::Util::weaken ($proxy->{ws} = $self); + for my $ev (grep /^on_/, keys %args) { - push @{$proxy->{ev}{$ev}}, $args{$ev}; - $args{$ev} = 0; + my $rid = ++$self->{ns}{id}; + $proxy->{ev}{$rid} = $args{$ev}; + $args{$ev} = $rid; } $self->msg (ws_c => + $self->{id}, $proxy->{id}, - $id, $class, \%args, ); @@ -192,6 +215,28 @@ $proxy } +sub find { + my ($self, @names) = @_; + + my @res; + my @alloc; + + for my $name (@names) { + push @res, $self->{ns}{widget_wkw}{$name} ||= do { + my $proxy = $self->alloc; + + push @alloc, $proxy->{id} => $name; + + $proxy + }; + } + + $self->msg (ws_a => @alloc) + if @alloc; + + wantarray ? @res : $res[0] +} + ############################################################################# package ext::widget::proxy; @@ -210,8 +255,10 @@ sub msg { my ($self, $type, @arg) = @_; - if (my $ws = $self->{ws}) { - $ws->msg ($type, $self->{id}, @arg); + if (my $ns = $self->{ns}) { + my @msg = ($type, $self->{id}, @arg); + warn "MSG " . $ns->{json_coder}->encode (\@msg) if $DEBUG;#d# + $ns->send_packet ("ext " . $ns->{json_coder}->encode (\@msg)); } } @@ -256,7 +303,7 @@ } sub TO_JSON { - { __widget_ref__ => $_[0]{id} } + { __w_ => $_[0]{id} } } our $AUTOLOAD; @@ -267,7 +314,8 @@ my $self = shift; - $self->msg (w_c => 0, $AUTOLOAD, \@_); + #TODO: handle non-void context + $self->msg (w_c => 0, $AUTOLOAD, @_); () }