--- deliantra/server/ext/widget.ext 2007/08/19 09:27:08 1.18 +++ deliantra/server/ext/widget.ext 2007/09/01 07:22:20 1.19 @@ -10,8 +10,7 @@ # 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 rid @args # widget_event +# w_e id @args # widget_call our $DEBUG = 1; @@ -22,9 +21,8 @@ Scalar::Util::weaken (my $weakns = $ns); $ns->{id} = "a"; - $ns->{json_coder}->filter_json_single_key_object (__w_ => sub { - # cannot deserialise ATM - undef + $ns->{json_coder}->filter_json_single_key_object ("\fw" => sub { + $weakns->{widget}{$_[0]} }); }, ); @@ -113,22 +111,10 @@ ); cf::register_exticmd w_e => sub { - my ($ns, $id, $rid, @args) = @_; + my ($ns, $id, @args) = @_; - if (my $w = $ns->{widget}{$id}) { - if (my $cb = $w->{ev}{$rid}) { - $cb->($w, @args); - } - } - - () -}; - -cf::register_exticmd w_r => sub { - my ($ns, $rid, $res) = @_; - - if (my $cb = delete $ns->{widget_return}{$rid}) { - $cb->(@$res); + if (my $cb = $ns->{widget_cb}{$id}) { + $cb->(@args); } () @@ -150,6 +136,15 @@ $ws } +sub cf::client::alloc_wid { + pop @{ $_[0]{ids} } + or ++$_[0]{id} +} + +sub cf::client::free_wid { + push @{ $_[0]{ids} }, $_[1]; +} + ############################################################################# package ext::widget::set; @@ -179,7 +174,7 @@ sub alloc { my ($self) = @_; - my $id = ++$self->{ns}{id}; + my $id = $self->{ns}->alloc_wid; my $proxy = bless { id => $id, @@ -200,9 +195,7 @@ Scalar::Util::weaken ($proxy->{ws} = $self); for my $ev (grep /^on_/, keys %args) { - my $rid = ++$self->{ns}{id}; - $proxy->{ev}{$rid} = $args{$ev}; - $args{$ev} = $rid; + $args{$ev} = $proxy->{"_$ev"} = $proxy->cb ($args{$ev}); } $self->msg (ws_c => @@ -252,6 +245,35 @@ } } +sub cb { + my ($self, $cb) = @_; + + my $proxy = bless { + ns => $self->{ns}, + id => $self->{ns}->alloc_wid, + }, "ext::widget::callback"; + + Scalar::Util::weaken $proxy->{ns}; + + $self->{ns}{widget_cb}{$proxy->{id}} = $cb; + + $proxy +} + +sub oneshot_cb { + my ($self, $cb) = @_; + + if ("CODE" eq ref $cb) { + my $ocb = $cb; + $cb = $self->cb (sub { + undef $cb; + &$ocb + }); + } + + $cb +} + sub msg { my ($self, $type, @arg) = @_; @@ -266,21 +288,29 @@ my ($self, $cb, $type, @arg) = @_; if (my $ws = $self->{ws}) { - my $rid = ++$ws->{ns}{id}; - - $self->msg ($type, $rid, @arg); + my $rid = $ws->{ns}->alloc_wid; if ($cb) { - $ws->{ns}{widget_return}{$rid} = $cb; + $ws->{ns}{widget_cb}{$rid} = sub { + delete $ws->{ns}{widget_cb}{$rid}; + $ws->{ns}->free_wid ($rid); + &$cb + }; + + $self->msg ($type, $rid, @arg); } else { # synchronous case my $wait = new Coro::Signal; my @res; - $ws->{ns}{widget_return}{$rid} = sub { + $ws->{ns}{widget_cb}{$rid} = sub { + delete $ws->{ns}{widget_cb}{$rid}; + $ws->{ns}->free_wid ($rid); + @res = @_; $wait->send; }; + $self->msg ($type, $rid, @arg); $wait->wait; return @res; @@ -299,11 +329,11 @@ sub get { my ($self, $member, $cb) = @_; - $self->msg_cb ($cb, w_g => [$member]); + $self->msg_cb ($cb, w_g => ref $member ? @$member : $member); } sub TO_JSON { - { __w_ => $_[0]{id} } + { "\fw" => $_[0]{id} } } our $AUTOLOAD; @@ -320,3 +350,18 @@ () } +package ext::widget::callback; + +sub DESTROY { + my ($self) = @_; + + if (my $ns = $self->{ns}) { + delete $ns->{widget_cb}{$self->{id}}; + $ns->free_wid ($self->{id}); + } +} + +sub TO_JSON { + { "\fc" => $_[0]{id} } +} +