… | |
… | |
21 | |
21 | |
22 | my $self = $class->SUPER::new (%arg, |
22 | my $self = $class->SUPER::new (%arg, |
23 | setup_req => { |
23 | setup_req => { |
24 | extmap => 1, |
24 | extmap => 1, |
25 | excmd => 1, |
25 | excmd => 1, |
26 | xwidget1 => 1,#d# |
26 | xwidget2 => 1,#d# |
27 | %{$arg{setup_req} || {}}, |
27 | %{$arg{setup_req} || {}}, |
28 | }, |
28 | }, |
29 | ); |
29 | ); |
30 | |
30 | |
31 | $self->{map_widget}->clr_commands; |
31 | $self->{map_widget}->clr_commands; |
… | |
… | |
50 | } sort { $a->{par} <=> $b->{par} } |
50 | } sort { $a->{par} <=> $b->{par} } |
51 | CFPlus::Pod::find command => "*"; |
51 | CFPlus::Pod::find command => "*"; |
52 | |
52 | |
53 | $self->{json_coder} |
53 | $self->{json_coder} |
54 | ->convert_blessed |
54 | ->convert_blessed |
55 | ->filter_json_single_key_object (__w_ => sub { |
55 | ->filter_json_single_key_object ("\fw" => sub { |
56 | $self->{widget}{$_[0]} |
56 | $self->{widget}{$_[0]} |
|
|
57 | }) |
|
|
58 | ->filter_json_single_key_object ("\fc" => sub { |
|
|
59 | my ($id) = @_; |
|
|
60 | sub { |
|
|
61 | $self->send_exti_msg (w_e => $id, @_); |
|
|
62 | } |
57 | }); |
63 | }); |
58 | |
64 | |
59 | # destroy widgets on logout |
65 | # destroy widgets on logout |
60 | $self->{on_stop_game_guard} = $self->{map_widget}{root}->connect (stop_game => sub { |
66 | $self->{on_stop_game_guard} = $self->{map_widget}{root}->connect (stop_game => sub { |
61 | for my $ws (values %{delete $self->{widgetset} || {}}) { |
67 | for my $ws (values %{delete $self->{widgetset} || {}}) { |
… | |
… | |
138 | ############################################################################# |
144 | ############################################################################# |
139 | |
145 | |
140 | sub widget_associate { |
146 | sub widget_associate { |
141 | my ($self, $ws, $id, $widget) = @_; |
147 | my ($self, $ws, $id, $widget) = @_; |
142 | |
148 | |
143 | if ($widget) { |
149 | $widget ||= new CFPlus::UI::Bin; |
|
|
150 | |
144 | $widget->{s_id} = $id; |
151 | $widget->{s_id} = $id; |
145 | $self->{widget}{$id} = $widget; |
152 | $self->{widget}{$id} = $widget; |
146 | |
153 | |
147 | if ($ws) { |
154 | if ($ws) { |
148 | $widget->{s_ws} = $ws; |
155 | $widget->{s_ws} = $ws; |
149 | $self->{widgetset}{$ws}{w}{$id} = $widget; |
156 | $self->{widgetset}{$ws}{w}{$id} = $widget; |
150 | } |
157 | } |
151 | |
158 | |
152 | $widget->connect (on_destroy => sub { |
159 | $widget->connect (on_destroy => sub { |
153 | my ($widget) = @_; |
160 | my ($widget) = @_; |
154 | |
161 | |
155 | delete $self->{widget}{$widget->{s_id}}; |
162 | delete $self->{widget}{$widget->{s_id}}; |
156 | delete $self->{widgetset}{$widget->{s_ws}}{$widget->{s_id}} |
163 | delete $self->{widgetset}{$widget->{s_ws}}{$widget->{s_id}} |
157 | if exists $widget->{s_ws}; |
164 | if exists $widget->{s_ws}; |
158 | }); |
165 | }); |
159 | |
|
|
160 | 1 |
|
|
161 | } else { |
|
|
162 | $self->send_exti_msg (w_e => $id, undef); |
|
|
163 | |
|
|
164 | 0 |
|
|
165 | } |
|
|
166 | } |
166 | } |
167 | |
167 | |
168 | # widgetset new |
168 | # widgetset new |
169 | sub ext_ws_n { |
169 | sub ext_ws_n { |
170 | my ($self, $id) = @_; |
170 | my ($self, $id) = @_; |
… | |
… | |
186 | } |
186 | } |
187 | |
187 | |
188 | # widgetset create |
188 | # widgetset create |
189 | sub ext_ws_c { |
189 | sub ext_ws_c { |
190 | my ($self, $ws, $id, $class, $args) = @_; |
190 | my ($self, $ws, $id, $class, $args) = @_; |
191 | |
|
|
192 | for my $ev (grep /^on_/, keys %$args) { |
|
|
193 | my $rid = $args->{$ev}; |
|
|
194 | $args->{$ev} = sub { |
|
|
195 | my $id = shift->{s_id}; |
|
|
196 | $self->send_exti_msg (w_e => $id, $rid, @_); |
|
|
197 | |
|
|
198 | 1 |
|
|
199 | }; |
|
|
200 | } |
|
|
201 | |
191 | |
202 | $self->widget_associate ( |
192 | $self->widget_associate ( |
203 | $ws, $id => scalar eval { |
193 | $ws, $id => scalar eval { |
204 | local $SIG{__DIE__}; |
194 | local $SIG{__DIE__}; |
205 | "CFPlus::UI::$class"->new (%$args) |
195 | "CFPlus::UI::$class"->new (%$args) |
206 | } |
196 | } |
207 | ) or warn "server failed creating client-side widget " . (CFPlus::to_json $class) . ": $@\n"; |
197 | ); |
208 | } |
198 | } |
209 | |
199 | |
210 | # widgetset associate |
200 | # widgetset associate |
211 | sub ext_ws_a { |
201 | sub ext_ws_a { |
212 | my ($self, %ass) = @_; |
202 | my ($self, %ass) = @_; |
… | |
… | |
248 | invr => $::INVR, |
238 | invr => $::INVR, |
249 | invr_hb => $::INVR_HB, |
239 | invr_hb => $::INVR_HB, |
250 | ); |
240 | ); |
251 | |
241 | |
252 | while (my ($id, $name) = each %ass) { |
242 | while (my ($id, $name) = each %ass) { |
253 | $self->widget_associate (undef, $id => $wkw{$name}) |
243 | $self->widget_associate (undef, $id => $wkw{$name}); |
254 | or warn "server failed to associate non-existent well-known widget $name\n"; |
|
|
255 | } |
244 | } |
256 | } |
245 | } |
257 | |
246 | |
258 | # widget call |
247 | # widget call |
259 | sub ext_w_c { |
248 | sub ext_w_c { |
260 | my ($self, $id, $rid, $method, @args) = @_; |
249 | my ($self, $id, $rcb, $method, @args) = @_; |
261 | |
250 | |
262 | my $w = $self->{widget}{$id} |
251 | my $w = $self->{widget}{$id} |
263 | or return; |
252 | or return; |
264 | |
253 | |
265 | if ($rid) { |
254 | if ($rcb) { |
266 | $self->send_exti_msg (w_r => $rid, $w->$method (@args)); |
255 | $rcb->($w->$method (@args)); |
267 | } else { |
256 | } else { |
268 | $w->$method (@args); |
257 | $w->$method (@args); |
269 | } |
258 | } |
270 | } |
259 | } |
271 | |
260 | |
… | |
… | |
287 | } |
276 | } |
288 | } |
277 | } |
289 | |
278 | |
290 | # widget get |
279 | # widget get |
291 | sub ext_w_g { |
280 | sub ext_w_g { |
292 | my ($self, $id, $rid, $attr) = @_; |
281 | my ($self, $id, $rid, @attr) = @_; |
293 | |
282 | |
294 | my $w = $self->{widget}{$id} |
283 | my $w = $self->{widget}{$id} |
295 | or return; |
284 | or return; |
296 | |
285 | |
297 | $self->send_exti_msg (w_r => $rid, [map $w->{$_}, @$attr]); |
286 | $self->send_exti_msg (w_e => $rid, map $w->{$_}, @attr); |
298 | } |
287 | } |
299 | |
288 | |
300 | # message window |
289 | # message window |
301 | sub ext_channel_info { |
290 | sub ext_channel_info { |
302 | my ($self, $info) = @_; |
291 | my ($self, $info) = @_; |