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.17 by root, Fri Aug 17 21:18:01 2007 UTC vs.
Revision 1.20 by root, Thu Dec 27 18:35:48 2007 UTC

… …
3# sends the following ext message types 3# sends the following ext message types
4# ws_a id name... # associate well-known widget with given id 4# ws_a id name... # associate well-known widget with given id
5# ws_n ws # widgetset new 5# ws_n ws # widgetset new
6# ws_d ws # widgetset destroy 6# ws_d ws # widgetset destroy
7# ws_c ws id class @args # widgetset create 7# ws_c ws id class @args # widgetset create
8# ws_ct ws templateface \%cfg # widgetset create from template
8# w_c id rid name @args # widget method call 9# w_c id rid name @args # widget method call
9# w_s id @attr # widget member set 10# w_s id @attr # widget member set
10# w_g id rid @attr # widget member get 11# w_g id rid @attr # widget member get
11# 12#
12# and expects the following exti message types 13# and expects the following exti message types
13# w_r rid res # widget call return
14# w_e id rid @args # widget_event 14# w_e id @args # widget_call
15 15
16our $DEBUG = 1; 16our $DEBUG = 1;
17 17
18cf::client->attach ( 18cf::client->attach (
19 on_connect => sub { 19 on_connect => sub {
20 my ($ns) = @_; 20 my ($ns) = @_;
21 21
22 Scalar::Util::weaken (my $weakns = $ns); 22 Scalar::Util::weaken (my $weakns = $ns);
23 23
24 $ns->{id} = "a"; 24 $ns->{id} = "a";
25 $ns->{json_coder}->filter_json_single_key_object (__w_ => sub { 25 $ns->{json_coder}->filter_json_single_key_object ("\fw" => sub {
26 # cannot deserialise ATM 26 $weakns->{widget}{$_[0]}
27 undef
28 }); 27 });
29 }, 28 },
30); 29);
31 30
32sub csc_update_stats { 31sub csc_update_stats {
… …
40sub demo_start { 39sub demo_start {
41 my ($ns) = @_; 40 my ($ns) = @_;
42 41
43 my $ws = $ns->{csc} = $ns->new_widgetset; 42 my $ws = $ns->{csc} = $ns->new_widgetset;
44 43
45 $ws->{tab} = $ws->new (Label => text => "dumb tst", c_tab => ["hull"]); 44 my ($tl, $entry) = $ws->template (undef,
45 toplevel => {},
46 entry => {
47 text => "xyz",
48 on_changed => sub {
49 warn "changed<@_>\n";#d#
50 },
51 },
52 );
53
54 $tl->show;
55
56 $ns->{xxxw} = [$tl, $entry];#d#
46 57
47 $ws->find ("setup_notebook")->add ($ws->{tab}); 58# $ws->find ("setup_notebook")->add ($ws->{tab});
48 $ws->find ("setup_dialog")->toggle_visibility; 59# $ws->find ("setup_dialog")->toggle_visibility;
49} 60}
50 61
51sub csc_start { 62sub csc_start {
52 my ($ns) = @_; 63 my ($ns) = @_;
53 64
… …
111 demo_start $ns; 122 demo_start $ns;
112 }, 123 },
113); 124);
114 125
115cf::register_exticmd w_e => sub { 126cf::register_exticmd w_e => sub {
116 my ($ns, $id, $rid, @args) = @_; 127 my ($ns, $id, @args) = @_;
117 128
118 if (my $w = $ns->{widget}{$id}) { 129 if (my $cb = $ns->{widget_cb}{$id}) {
119 if (my $cb = $w->{ev}{$rid}) {
120 $cb->($w, @args);
121 }
122 }
123
124 ()
125};
126
127cf::register_exticmd w_r => sub {
128 my ($ns, $rid, $res) = @_;
129
130 if (my $cb = delete $ns->{widget_return}{$rid}) {
131 $cb->(@$res); 130 $cb->(@args);
132 } 131 }
133 132
134 () 133 ()
135}; 134};
136 135
… …
148 $ws->msg (ws_n => $id); 147 $ws->msg (ws_n => $id);
149 148
150 $ws 149 $ws
151} 150}
152 151
152sub cf::client::alloc_wid {
153 pop @{ $_[0]{ids} }
154 or ++$_[0]{id}
155}
156
157sub cf::client::free_wid {
158 push @{ $_[0]{ids} }, $_[1];
159}
160
153############################################################################# 161#############################################################################
154 162
155package ext::widget::set; 163package ext::widget::set;
156 164
157sub DESTROY { 165sub DESTROY {
… …
177} 185}
178 186
179sub alloc { 187sub alloc {
180 my ($self) = @_; 188 my ($self) = @_;
181 189
182 my $id = ++$self->{ns}{id}; 190 my $id = $self->{ns}->alloc_wid;
183 191
184 my $proxy = bless { 192 my $proxy = bless {
185 id => $id, 193 id => $id,
186 }, "ext::widget::proxy"; 194 }, "ext::widget::proxy";
187 195
… …
198 206
199 Scalar::Util::weaken ($self->{_w}{$proxy->{id}} = $proxy); 207 Scalar::Util::weaken ($self->{_w}{$proxy->{id}} = $proxy);
200 Scalar::Util::weaken ($proxy->{ws} = $self); 208 Scalar::Util::weaken ($proxy->{ws} = $self);
201 209
202 for my $ev (grep /^on_/, keys %args) { 210 for my $ev (grep /^on_/, keys %args) {
203 my $rid = ++$self->{ns}{id}; 211 $args{$ev} = $proxy->{"_$ev"} = $proxy->cb ($args{$ev});
204 $proxy->{ev}{$rid} = $args{$ev};
205 $args{$ev} = $rid;
206 } 212 }
207 213
208 $self->msg (ws_c => 214 $self->msg (ws_c =>
209 $self->{id}, 215 $self->{id},
210 $proxy->{id}, 216 $proxy->{id},
… …
213 ); 219 );
214 220
215 $proxy 221 $proxy
216} 222}
217 223
224sub template {
225 my ($self, $template, @args) = @_;
226
227 my %cfg;
228 my @res;
229
230 while (@args) {
231 my ($name, $args) = splice @args, 0, 2, ();
232
233 my $proxy = $self->alloc;
234
235 Scalar::Util::weaken ($self->{_w}{$proxy->{id}} = $proxy);
236 Scalar::Util::weaken ($proxy->{ws} = $self);
237
238 for my $ev (grep /^on_/, keys %$args) {
239 $args->{$ev} = $proxy->{"_$ev"} = $proxy->cb ($args->{$ev});
240 }
241
242 $cfg{$name} = {
243 %$args,
244 id => $proxy->{id},
245 };
246
247 push @res, $proxy;
248 }
249
250 $self->msg (ws_ct =>
251 $self->{id},
252 $template,
253 \%cfg,
254 );
255
256 @res
257}
258
218sub find { 259sub find {
219 my ($self, @names) = @_; 260 my ($self, @names) = @_;
220 261
221 my @res; 262 my @res;
222 my @alloc; 263 my @alloc;
… …
248 289
249 if (my $ws = $self->{ws}) { 290 if (my $ws = $self->{ws}) {
250 $self->msg (w_c => 0, "destroy"); 291 $self->msg (w_c => 0, "destroy");
251 delete $ws->{_w}{$self->{id}}; 292 delete $ws->{_w}{$self->{id}};
252 } 293 }
294}
295
296sub cb {
297 my ($self, $cb) = @_;
298
299 my $proxy = bless {
300 ns => $self->{ns},
301 id => $self->{ns}->alloc_wid,
302 }, "ext::widget::callback";
303
304 Scalar::Util::weaken $proxy->{ns};
305
306 $self->{ns}{widget_cb}{$proxy->{id}} = $cb;
307
308 $proxy
309}
310
311sub oneshot_cb {
312 my ($self, $cb) = @_;
313
314 if ("CODE" eq ref $cb) {
315 my $ocb = $cb;
316 $cb = $self->cb (sub {
317 undef $cb;
318 &$ocb
319 });
320 }
321
322 $cb
253} 323}
254 324
255sub msg { 325sub msg {
256 my ($self, $type, @arg) = @_; 326 my ($self, $type, @arg) = @_;
257 327
… …
264 334
265sub msg_cb { 335sub msg_cb {
266 my ($self, $cb, $type, @arg) = @_; 336 my ($self, $cb, $type, @arg) = @_;
267 337
268 if (my $ws = $self->{ws}) { 338 if (my $ws = $self->{ws}) {
269 my $rid = ++$ws->{ns}{id}; 339 my $rid = $ws->{ns}->alloc_wid;
270
271 $self->msg ($type, $rid, @arg);
272 340
273 if ($cb) { 341 if ($cb) {
274 $ws->{ns}{widget_return}{$rid} = $cb; 342 $ws->{ns}{widget_cb}{$rid} = sub {
343 delete $ws->{ns}{widget_cb}{$rid};
344 $ws->{ns}->free_wid ($rid);
345 &$cb
346 };
347
348 $self->msg ($type, $rid, @arg);
275 } else { 349 } else {
276 # synchronous case 350 # synchronous case
277 my $wait = new Coro::Signal; 351 my $wait = new Coro::Signal;
278 my @res; 352 my @res;
279 353
280 $ws->{ns}{widget_return}{$rid} = sub { 354 $ws->{ns}{widget_cb}{$rid} = sub {
355 delete $ws->{ns}{widget_cb}{$rid};
356 $ws->{ns}->free_wid ($rid);
357
281 @res = @_; 358 @res = @_;
282 $wait->send; 359 $wait->send;
283 }; 360 };
361 $self->msg ($type, $rid, @arg);
284 $wait->wait; 362 $wait->wait;
285 363
286 return @res; 364 return @res;
287 } 365 }
288 } 366 }
… …
297} 375}
298 376
299sub get { 377sub get {
300 my ($self, $member, $cb) = @_; 378 my ($self, $member, $cb) = @_;
301 379
302 $self->msg_cb ($cb, w_g => [$member]); 380 $self->msg_cb ($cb, w_g => ref $member ? @$member : $member);
303} 381}
304 382
305sub TO_JSON { 383sub TO_JSON {
306 { __w_ => $_[0]{id} } 384 { "\fw" => $_[0]{id} }
307} 385}
308 386
309our $AUTOLOAD; 387our $AUTOLOAD;
310 388
311sub AUTOLOAD { 389sub AUTOLOAD {
… …
318 $self->msg (w_c => 0, $AUTOLOAD, @_); 396 $self->msg (w_c => 0, $AUTOLOAD, @_);
319 397
320 () 398 ()
321} 399}
322 400
401package ext::widget::callback;
402
403sub DESTROY {
404 my ($self) = @_;
405
406 if (my $ns = $self->{ns}) {
407 delete $ns->{widget_cb}{$self->{id}};
408 $ns->free_wid ($self->{id});
409 }
410}
411
412sub TO_JSON {
413 { "\fc" => $_[0]{id} }
414}
415

Diff Legend

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