ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/server/ext/widget.ext
(Generate patch)

Comparing deliantra/server/ext/widget.ext (file contents):
Revision 1.22 by root, Fri Dec 28 12:44:45 2007 UTC vs.
Revision 1.29 by root, Mon Oct 29 23:56:43 2012 UTC

… …
11# w_g id rid @attr # widget member get 11# w_g id rid @attr # widget member get
12# 12#
13# and expects the following exti message types 13# and expects the following exti message types
14# w_e id @args # widget_call 14# w_e id @args # widget_call
15 15
16our $DEBUG = 1;
17
18cf::client->attach ( 16cf::client->attach (
19 on_connect => sub { 17 on_connect => sub {
20 my ($ns) = @_; 18 my ($ns) = @_;
21 19
22 Scalar::Util::weaken (my $weakns = $ns);
23
24 $ns->{id} = "a"; 20 $ns->{id} = "a";
25 $ns->{json_coder}->filter_json_single_key_object ("\fw" => sub { 21 $ns->{json_coder}->filter_json_single_key_object ("\fw" => sub {
26 $weakns->{widget}{$_[0]} 22 $ns->{widget}{$_[0]}
27 }); 23 });
24
25 cf::weaken $ns;
28 }, 26 },
29); 27);
30 28
31sub csc_update_stats { 29sub csc_update_stats {
32 my ($ns) = @_; 30 my ($ns) = @_;
… …
160# ); 158# );
161# 159#
162# $tl->show; 160# $tl->show;
163# 161#
164# $ns->{xxxw} = [$tl, $entry];#d# 162# $ns->{xxxw} = [$tl, $entry];#d#
165# 163#
166# $ws->find ("setup_notebook")->add ($ws->{tab}); 164# $ws->find ("setup_notebook")->add ($ws->{tab});
167# $ws->find ("setup_dialog")->toggle_visibility; 165# $ws->find ("setup_dialog")->toggle_visibility;
168} 166}
169 167
170cf::player->attach ( 168cf::player->attach (
… …
199 id => $id, 197 id => $id,
200 ns => $self, 198 ns => $self,
201 _w => {}, 199 _w => {},
202 }, "ext::widget::set"; 200 }, "ext::widget::set";
203 201
202 cf::weaken $ws->{ns};
203
204 $ws->msg (ws_n => $id); 204 $ws->msg (ws_n => $id);
205 205
206 $ws 206 $ws
207} 207}
208 208
… …
234 234
235sub msg { 235sub msg {
236 my ($self, @msg) = @_; 236 my ($self, @msg) = @_;
237 237
238 if (my $ns = shift->{ns}) { 238 if (my $ns = shift->{ns}) {
239 warn "msg " . $ns->{json_coder}->encode (\@msg) if $DEBUG;#d# 239 return unless $ns->{json_coder};#d# might be gone at destroy time(??)
240 $ns->send_packet ("ext " . $ns->{json_coder}->encode (\@msg)); 240 $ns->send_packet ("ext " . $ns->{json_coder}->encode (\@msg));
241 } 241 }
242} 242}
243 243
244sub alloc { 244sub alloc {
… …
248 248
249 my $proxy = bless { 249 my $proxy = bless {
250 id => $id, 250 id => $id,
251 }, "ext::widget::proxy"; 251 }, "ext::widget::proxy";
252 252
253 Scalar::Util::weaken ($proxy->{ns} = $self->{ns}); 253 cf::weaken ($proxy->{ns} = $self->{ns});
254 Scalar::Util::weaken ($self->{ns}{widget}{$id} = $proxy); 254 cf::weaken ($self->{ns}{widget}{$id} = $proxy);
255 255
256 $proxy 256 $proxy
257} 257}
258 258
259sub new { 259sub new {
260 my ($self, $class, %args) = @_; 260 my ($self, $class, %args) = @_;
261 261
262 my $proxy = $self->alloc; 262 my $proxy = $self->alloc;
263 263
264 Scalar::Util::weaken ($self->{_w}{$proxy->{id}} = $proxy); 264 cf::weaken
265 Scalar::Util::weaken ($proxy->{ws} = $self); 265 +($self->{_w}{$proxy->{id}} = $proxy),
266 +($proxy->{ws} = $self);
266 267
267 for my $ev (grep /^on_/, keys %args) { 268 for my $ev (grep /^on_/, keys %args) {
268 $args{$ev} = $proxy->{"_$ev"} = $proxy->cb ($args{$ev}); 269 $args{$ev} = $proxy->{"_$ev"} = $proxy->cb ($args{$ev});
269 } 270 }
270 271
… …
288 289
289 my $proxy = $self->alloc; 290 my $proxy = $self->alloc;
290 291
291 $self->{delete $args->{alias} or $name} = $proxy; 292 $self->{delete $args->{alias} or $name} = $proxy;
292 293
294 cf::weaken
293 Scalar::Util::weaken ($self->{_w}{$proxy->{id}} = $proxy); 295 +($self->{_w}{$proxy->{id}} = $proxy),
294 Scalar::Util::weaken ($proxy->{ws} = $self); 296 +($proxy->{ws} = $self);
295 297
296 for my $ev (grep /^on_/, keys %$args) { 298 for my $ev (grep /^on_/, keys %$args) {
297 $args->{$ev} = $proxy->{"_$ev"} = $proxy->cb ($args->{$ev}); 299 $args->{$ev} = $proxy->{"_$ev"} = $proxy->cb ($args->{$ev});
298 } 300 }
299 301
… …
350 352
351############################################################################# 353#############################################################################
352 354
353package ext::widget::proxy; 355package ext::widget::proxy;
354 356
355sub DESTROY {
356 my ($self) = @_;
357
358 delete $self->{ns}{widget}{$self->{id}};
359
360 if (my $ws = $self->{ws}) {
361 $self->msg (w_c => 0, "destroy");
362 delete $ws->{_w}{$self->{id}};
363 }
364}
365
366sub cb {
367 my ($self, $cb) = @_;
368
369 my $proxy = bless {
370 ns => $self->{ns},
371 id => $self->{ns}->alloc_wid,
372 }, "ext::widget::callback";
373
374 Scalar::Util::weaken $proxy->{ns};
375
376 $self->{ns}{widget_cb}{$proxy->{id}} = $cb;
377
378 $proxy
379}
380
381sub oneshot_cb {
382 my ($self, $cb) = @_;
383
384 if ("CODE" eq ref $cb) {
385 my $ocb = $cb;
386 $cb = $self->cb (sub {
387 undef $cb;
388 &$ocb
389 });
390 }
391
392 $cb
393}
394
395sub msg { 357sub msg {
396 my ($self, $type, @arg) = @_; 358 my ($self, $type, @arg) = @_;
397 359
398 if (my $ns = $self->{ns}) { 360 if (my $ns = $self->{ns}) {
399 my @msg = ($type, $self->{id}, @arg); 361 my @msg = ($type, $self->{id}, @arg);
400 warn "MSG " . $ns->{json_coder}->encode (\@msg) if $DEBUG;#d#
401 $ns->send_packet ("ext " . $ns->{json_coder}->encode (\@msg)); 362 $ns->send_packet ("ext " . $ns->{json_coder}->encode (\@msg));
402 } 363 }
403} 364}
404 365
405sub msg_cb { 366sub msg_cb {
… …
436 } 397 }
437 398
438 () 399 ()
439} 400}
440 401
402sub DESTROY {
403 my ($self) = @_;
404
405 delete $self->{ns}{widget}{$self->{id}};
406
407 if (my $ws = $self->{ws}) {
408 $self->msg (w_c => 0, "destroy");
409 delete $ws->{_w}{$self->{id}};
410 }
411}
412
413sub cb {
414 my ($self, $cb) = @_;
415
416 my $proxy = bless {
417 ns => $self->{ns},
418 id => $self->{ns}->alloc_wid,
419 }, "ext::widget::callback";
420
421 cf::weaken $proxy->{ns};
422
423 $self->{ns}{widget_cb}{$proxy->{id}} = $cb;
424
425 $proxy
426}
427
428sub oneshot_cb {
429 my ($self, $cb) = @_;
430
431 if ("CODE" eq ref $cb) {
432 my $ocb = $cb;
433 $cb = cb $self, sub {
434 undef $cb;
435 &$ocb
436 };
437 }
438
439 $cb
440}
441
441sub set { 442sub set {
442 my ($self, @kv) = @_; 443 my ($self, @kv) = @_;
443 444
444 $self->msg (w_s => \@kv); 445 $self->msg (w_s => \@kv);
445} 446}

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines