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.2 by root, Mon Jun 25 07:40:53 2007 UTC vs.
Revision 1.29 by root, Mon Oct 29 23:56:43 2012 UTC

1#! perl # mandatory depends=login 1#! perl # mandatory depends=login
2 2
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_n id # widgetset new 5# ws_n ws # widgetset new
5# ws_d id # widgetset destroy 6# ws_d ws # widgetset destroy
6# ws_c ws id class args # widgetset create 7# ws_c ws id class @args # widgetset create
8# ws_ct ws ttype ttext done_cb \%cfg # widgetset create from template
7# w_c id [rid] name args # widget method call 9# w_c id rid name @args # widget method call
8# w_s id name value # widget member set 10# w_s id @attr # widget member set
9# w_g id rid name # widget member get 11# w_g id rid @attr # widget member get
10# 12#
11# and expects the following exti message types 13# and expects the following exti message types
12# w_r rid res # widget call return
13# w_e id name args # widget_event 14# w_e id @args # widget_call
14 15
15cf::client->attach ( 16cf::client->attach (
16 on_connect => sub { 17 on_connect => sub {
17 my ($ns) = @_; 18 my ($ns) = @_;
18 19
19 $ns->{id} = "a"; 20 $ns->{id} = "a";
21 $ns->{json_coder}->filter_json_single_key_object ("\fw" => sub {
22 $ns->{widget}{$_[0]}
23 });
24
25 cf::weaken $ns;
20 }, 26 },
21); 27);
22 28
23sub csc_update_stats { 29sub csc_update_stats {
24 my ($ns) = @_; 30 my ($ns) = @_;
25 31
26 while (my ($k, $v) = each %{ $ns->{csc}{stat} }) { 32 while (my ($k, $v) = each %{ $ns->{csc}{stat} }) {
27 $v->set_text ($ns->pl->ob->stats->$k); 33 $v->set_text ($ns->pl->ob->stats->$k);
28 } 34 }
29} 35}
36
37my $cg_template = eval <<EOF;
38[
39 Toplevel => {
40 s_id => "toplevel",
41 title => "Character Creation",
42 x => "center",
43 y => "center",
44 z => 5,
45 force_w => 760,
46 force_h => 440,
47 s_cl => [VBox => { s_cl => [
48 Label => {
49 text => "Character Creation",
50 fontsize => 1,
51 align => 0,
52 },
53 Label => {
54 markup => "View or Edit your character attributes below, then press <b>Finish</b> to create your character",
55 fontsize => 0.8,
56 align => 0,
57 },
58 HBox => { s_cl => [
59 Face => {
60 s_id => "face",
61 face => 0,
62 bg => [.2, .2, .2, 1],
63 min_w => 64,
64 min_h => 64,
65 },
66 Label => {
67 s_id => "desc",
68 fontsize => 0.8,
69 ellipsize => 0,
70 },
71 ]},
72 Notebook => {
73 expand => 1,
74 s_cl => [
75 Table => {
76 c_tab => ["Basics", "Title, background and other information of your character."],
77 },
78 Table => {
79 c_tab => ["Stats", "Your character's primary stats such as strength, dexterity and so on."],
80 },
81 Table => {
82 c_tab => ["Race", "Your character's race."],
83 },
84 Table => {
85 c_tab => ["Class", "Your character's initial class."],
86 },
87 ],
88 },
89 Button => {
90 s_id => "finish",
91 text => "Finish",
92 },
93 ]}],
94 },
95]
96EOF
97die if $@;
30 98
31sub csc_start { 99sub csc_start {
32 my ($ns) = @_; 100 my ($ns) = @_;
33 101
34 my $ws = $ns->{csc} = $ns->new_widgetset; 102 my $ws = $ns->{csc} = $ns->new_widgetset;
… …
37 min_w => 600, 105 min_w => 600,
38 min_h => 400, 106 min_h => 400,
39 x => "center", 107 x => "center",
40 y => "center", 108 y => "center",
41 title => "Character Creation", 109 title => "Character Creation",
110 has_close_button => 1,
111 on_delete => sub {
112 $ws->destroy;
113 },
42 ); 114 );
43 115
44 $w->add (my $ntb = $ws->new (Notebook => expand => 1)); 116 $w->add (my $ntb = $ws->new (Notebook => expand => 1));
45 117
46 $ntb->add (Statistics => (my $stats = $ws->new (Table => expand => 1)), "Basic statistics of your new character"); 118 $ntb->add_tab (Statistics => (my $stats = $ws->new (Table => expand => 1)), "Basic statistics of your new character");
47 119
48 $stats->add (0, 0, (my $statstable = $ws->new ("Table"))); 120 $stats->add_at (0, 0, (my $statstable = $ws->new ("Table")));
49 121
50 for ( 122 for (
51 [0, "Str", "Strength"], 123 [0, "Str"],
52 [1, "Dex", "Dexterity"], 124 [1, "Dex"],
53 [2, "Con", "Constitution"], 125 [2, "Con"],
54 [3, "Int", "Intelligence"], 126 [3, "Int"],
55 [4, "Wis", "Wisdom"], 127 [4, "Wis"],
56 [5, "Pow", "Power"], 128 [5, "Pow"],
57 [6, "Cha", "Charisma"], 129 [6, "Cha"],
58 ) { 130 ) {
59 my ($x, $label, $description) = @$_; 131 my ($x, $label) = @$_;
60 132
61 $statstable->add ($x, 0, $ws->new (Label => 133 $statstable->add_at ($x, 0, $ws->new (Label =>
62 can_hover => 1, can_events => 1, 134 can_hover => 1, can_events => 1,
63 align => +1, text => $label, tooltip => "#stat_$label", 135 align => +1, text => $label, tooltip => "#stat_$label",
64 )); 136 ));
65 $statstable->add ($x, 1, $ws->{stat}{$label} = $ws->new (Label => 137 $statstable->add_at ($x, 1, $ws->{stat}{$label} = $ws->new (Label =>
66 can_hover => 1, can_events => 1, 138 can_hover => 1, can_events => 1,
67 align => +1, template => "88", tooltip => "#stat_$label", 139 align => +1, template => "88", tooltip => "#stat_$label",
68 )); 140 ));
69 } 141 }
70 142
71 csc_update_stats $ns; 143 csc_update_stats $ns;
72 144
145 $ws->{tl} = $w;
73 $w->show; 146 $w->show;
147
148# my ($tl, $entry) = $ws->template (inline => $cg_template,
149# [
150# toplevel => {},
151# entry => {
152# text => "xyz",
153# on_changed => sub {
154# warn "changed<@_>\n";#d#
155# },
156# },
157# ],
158# );
159#
160# $tl->show;
161#
162# $ns->{xxxw} = [$tl, $entry];#d#
163#
164# $ws->find ("setup_notebook")->add ($ws->{tab});
165# $ws->find ("setup_dialog")->toggle_visibility;
74} 166}
75 167
76cf::player->attach ( 168cf::player->attach (
77 on_login => sub { 169 on_login => sub {
78 my ($pl) = @_; 170 my ($pl) = @_;
79 171
172 my $ns = $pl->ns;
173 return unless $ns->{can_widget};
174
80 return unless $cf::CFG{devel}; 175 return unless $cf::CFG{devel};
81 176
82 my $ns = $pl->ns;
83
84 return unless $ns->{can_widget};
85
86 csc_start $ns; 177 #csc_start $ns;
87 }, 178 },
88); 179);
89 180
90cf::register_exticmd w_e => sub { 181cf::register_exticmd w_e => sub {
91 my ($ns, $pkt) = @_; 182 my ($ns, $id, @args) = @_;
92 183
93 if (my $w = $ns->{widget}{$pkt->{id}}) { 184 if (my $cb = $ns->{widget_cb}{$id}) {
94 if (my $cb = $w->{ev}{$pkt->{name}}) { 185 $cb->(@args);
95 $_->($w, @{ $pkt->{args} || [] })
96 for @$cb;
97 }
98 }
99
100 ()
101};
102
103cf::register_exticmd w_r => sub {
104 my ($ns, $pkt) = @_;
105
106 if (my $cb = delete $ns->{widget_return}{$pkt->{rid}}) {
107 $cb->(@{$pkt->{res} || [] });
108 } 186 }
109 187
110 () 188 ()
111}; 189};
112 190
… …
116 my $id = ++$self->{id}; 194 my $id = ++$self->{id};
117 195
118 my $ws = bless { 196 my $ws = bless {
119 id => $id, 197 id => $id,
120 ns => $self, 198 ns => $self,
121 w => {}, 199 _w => {},
122 }, "ext::widget::set"; 200 }, "ext::widget::set";
123 201
202 cf::weaken $ws->{ns};
203
124 $ws->msg (ws_n => id => $id); 204 $ws->msg (ws_n => $id);
125 205
126 $ws 206 $ws
207}
208
209sub cf::client::alloc_wid {
210 pop @{ $_[0]{ids} }
211 or ++$_[0]{id}
212}
213
214sub cf::client::free_wid {
215 push @{ $_[0]{ids} }, $_[1];
127} 216}
128 217
129############################################################################# 218#############################################################################
130 219
131package ext::widget::set; 220package ext::widget::set;
… …
135} 224}
136 225
137sub destroy { 226sub destroy {
138 my ($self) = @_; 227 my ($self) = @_;
139 228
140 $self->msg (ws_d => id => $self->{id}); 229 $self->msg (ws_d => $self->{id});
141 delete $self->{ns}; 230 delete $self->{ns};
142 $_->destroy 231 $_->destroy
143 for values %{ $self->{w} }; 232 for values %{ $self->{w} };
144} 233}
145 234
146sub msg { 235sub msg {
147 my ($self, $type, %msg) = @_; 236 my ($self, @msg) = @_;
148 237
149 if (my $ns = shift->{ns}) { 238 if (my $ns = shift->{ns}) {
150 $msg{msgtype} = $type; 239 return unless $ns->{json_coder};#d# might be gone at destroy time(??)
151 $ns->send_packet ("ext " . cf::to_json \%msg); 240 $ns->send_packet ("ext " . $ns->{json_coder}->encode (\@msg));
152 } 241 }
242}
243
244sub alloc {
245 my ($self) = @_;
246
247 my $id = $self->{ns}->alloc_wid;
248
249 my $proxy = bless {
250 id => $id,
251 }, "ext::widget::proxy";
252
253 cf::weaken ($proxy->{ns} = $self->{ns});
254 cf::weaken ($self->{ns}{widget}{$id} = $proxy);
255
256 $proxy
153} 257}
154 258
155sub new { 259sub new {
156 my ($self, $class, %args) = @_; 260 my ($self, $class, %args) = @_;
157 261
158 my $id = ++$self->{ns}{id}; 262 my $proxy = $self->alloc;
159 263
160 my $proxy = $self->{w}{$id} = bless { 264 cf::weaken
161 id => $id, 265 +($self->{_w}{$proxy->{id}} = $proxy),
162 }, "ext::widget::proxy"; 266 +($proxy->{ws} = $self);
163
164 Scalar::Util::weaken ($proxy->{ws} = $self);
165 Scalar::Util::weaken ($proxy->{ns} = $self->{ns});
166 Scalar::Util::weaken ($self->{ns}{widget}{$id} = $proxy);
167 267
168 for my $ev (grep /^on_/, keys %args) { 268 for my $ev (grep /^on_/, keys %args) {
169 push @{$proxy->{ev}{$ev}}, $args{$ev}; 269 $args{$ev} = $proxy->{"_$ev"} = $proxy->cb ($args{$ev});
170 $args{$ev} = 0;
171 } 270 }
172 271
173 $self->msg (ws_c => 272 $self->msg (ws_c =>
174 ws => $self->{w}{id}, 273 $self->{id},
175 id => $id, 274 $proxy->{id},
176 class => $class, 275 $class,
177 args => \%args, 276 \%args,
178 ); 277 );
179 278
180 $proxy 279 $proxy
181} 280}
182 281
282sub template {
283 my ($self, $type, $template, $args, $done_cb) = @_;
284
285 my %cfg;
286
287 while (@$args) {
288 my ($name, $args) = splice @$args, 0, 2, ();
289
290 my $proxy = $self->alloc;
291
292 $self->{delete $args->{alias} or $name} = $proxy;
293
294 cf::weaken
295 +($self->{_w}{$proxy->{id}} = $proxy),
296 +($proxy->{ws} = $self);
297
298 for my $ev (grep /^on_/, keys %$args) {
299 $args->{$ev} = $proxy->{"_$ev"} = $proxy->cb ($args->{$ev});
300 }
301
302 $cfg{$name} = {
303 %$args,
304 id => $proxy->{id},
305 };
306 }
307
308 if ($done_cb) {
309 my $proxy = $self->alloc;
310 my $ocb = $done_cb;
311 $done_cb = $proxy->cb (sub {
312 undef $proxy;
313 undef $done_cb;
314 &$ocb
315 });
316 }
317
318 if ($type eq "face") {
319 $self->{ns}->send_face ($template, 100);
320 $self->{ns}->flush_fx;
321 }
322
323 $self->msg (ws_ct =>
324 $self->{id},
325 $type => $template,
326 $done_cb,
327 \%cfg,
328 );
329}
330
331sub find {
332 my ($self, @names) = @_;
333
334 my @res;
335 my @alloc;
336
337 for my $name (@names) {
338 push @res, $self->{ns}{widget_wkw}{$name} ||= do {
339 my $proxy = $self->alloc;
340
341 push @alloc, $proxy->{id} => $name;
342
343 $proxy
344 };
345 }
346
347 $self->msg (ws_a => @alloc)
348 if @alloc;
349
350 wantarray ? @res : $res[0]
351}
352
183############################################################################# 353#############################################################################
184 354
185package ext::widget::proxy; 355package ext::widget::proxy;
186 356
187sub DESTROY { 357sub msg {
188 my ($self) = @_; 358 my ($self, $type, @arg) = @_;
189 359
190 delete $self->{ns}{widget}{$self->{id}}; 360 if (my $ns = $self->{ns}) {
361 my @msg = ($type, $self->{id}, @arg);
362 $ns->send_packet ("ext " . $ns->{json_coder}->encode (\@msg));
363 }
364}
365
366sub msg_cb {
367 my ($self, $cb, $type, @arg) = @_;
191 368
192 if (my $ws = $self->{ws}) { 369 if (my $ws = $self->{ws}) {
193 delete $ws->{w}{$self->{id}};
194 $self->msg (w_c => name => "destroy");
195 }
196}
197
198sub msg {
199 my ($self, $type, %msg) = @_;
200
201 if (my $ws = $self->{ws}) {
202 $ws->msg ($type,
203 %msg,
204 id => $self->{id},
205 );
206 }
207}
208
209sub msg_cb {
210 my ($self, $cb, $type, %msg) = @_;
211
212 if (my $ws = $self->{ws}) {
213
214 my $rid = ++$ws->{ns}{id}; 370 my $rid = $ws->{ns}->alloc_wid;
215
216 $self->msg ($type, %msg, rid => $rid);
217 371
218 if ($cb) { 372 if ($cb) {
219 $ws->{ns}{widget_return}{$rid} = $cb; 373 $ws->{ns}{widget_cb}{$rid} = sub {
374 delete $ws->{ns}{widget_cb}{$rid};
375 $ws->{ns}->free_wid ($rid);
376 &$cb
377 };
378
379 $self->msg ($type, $rid, @arg);
220 } else { 380 } else {
221 # synchronous case 381 # synchronous case
222 my $wait = new Coro::Signal; 382 my $wait = new Coro::Signal;
223 my @res; 383 my @res;
224 384
225 $ws->{ns}{widget_return}{$rid} = sub { 385 $ws->{ns}{widget_cb}{$rid} = sub {
386 delete $ws->{ns}{widget_cb}{$rid};
387 $ws->{ns}->free_wid ($rid);
388
226 @res = @_; 389 @res = @_;
227 $wait->send; 390 $wait->send;
228 }; 391 };
392 $self->msg ($type, $rid, @arg);
229 $wait->wait; 393 $wait->wait;
230 394
231 return @res; 395 return @res;
232 } 396 }
233 } 397 }
234 398
235 () 399 ()
236} 400}
237 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
238sub set { 442sub set {
239 my ($self, $member, $value) = @_; 443 my ($self, @kv) = @_;
240 444
241 $self->msg (w_s => name => $member, value => $value); 445 $self->msg (w_s => \@kv);
242} 446}
243 447
244sub get { 448sub get {
245 my ($self, $member, $cb) = @_; 449 my ($self, $member, $cb) = @_;
246 450
247 $self->msg_cb ($cb, w_g => name => $member); 451 $self->msg_cb ($cb, w_g => ref $member ? @$member : $member);
248} 452}
249 453
250sub TO_JSON { 454sub TO_JSON {
251 { __widget_ref__ => $_[0]{id} } 455 { "\fw" => $_[0]{id} }
252} 456}
253 457
254our $AUTOLOAD; 458our $AUTOLOAD;
255 459
256sub AUTOLOAD { 460sub AUTOLOAD {
257 $AUTOLOAD =~ s/^.*:// 461 $AUTOLOAD =~ s/^.*://
258 or return; 462 or return;
259 463
260 my $self = shift; 464 my $self = shift;
261 465
466 #TODO: handle non-void context
262 $self->msg (w_c => name => $AUTOLOAD, args => \@_); 467 $self->msg (w_c => 0, $AUTOLOAD, @_);
263 468
264 () 469 ()
265} 470}
266 471
472package ext::widget::callback;
473
474sub DESTROY {
475 my ($self) = @_;
476
477 if (my $ns = $self->{ns}) {
478 delete $ns->{widget_cb}{$self->{id}};
479 $ns->free_wid ($self->{id});
480 }
481}
482
483sub TO_JSON {
484 { "\fc" => $_[0]{id} }
485}
486

Diff Legend

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