… | |
… | |
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) = @_; |
… | |
… | |
401 | |
390 | |
402 | if ( |
391 | if ( |
403 | my @diffs = map $_->[1]->($self, $_->[2], $prev->{$_->[0]}, $stats->{$_->[0]}), @statchange |
392 | my @diffs = map $_->[1]->($self, $_->[2], $prev->{$_->[0]}, $stats->{$_->[0]}), @statchange |
404 | ) { |
393 | ) { |
405 | my $msg = "<b>stat change</b>: " . (join " ", @diffs); |
394 | my $msg = "<b>stat change</b>: " . (join " ", @diffs); |
406 | $self->{statusbox}->add ($msg, group => "stat $msg", fg => [0.8, 1, 0.2, 1], timeout => 10); |
395 | $self->{statusbox}->add ($msg, group => "stat $msg", fg => [0.8, 1, 0.2, 1], timeout => 20); |
407 | } |
396 | } |
408 | |
397 | |
409 | $self->update_stats_window ($stats, $prev); |
398 | $self->update_stats_window ($stats, $prev); |
410 | |
399 | |
411 | $self->{prev_stats} = { %$stats }; |
400 | $self->{prev_stats} = { %$stats }; |
… | |
… | |
566 | |
555 | |
567 | for (@order) { |
556 | for (@order) { |
568 | my ($idx, $name) = @$_; |
557 | my ($idx, $name) = @$_; |
569 | my $val = $stats->{$idx}; |
558 | my $val = $stats->{$idx}; |
570 | |
559 | |
571 | next if $prev->{$idx}[1] == $val->[1]; |
560 | next if $prev->{$idx}[1] eq $val->[1]; |
572 | |
561 | |
573 | my $sw = $self->{skillwid}{$idx}; |
562 | my $sw = $self->{skillwid}{$idx}; |
574 | $sw->[0]->set_text (::formsep ($val->[1])); |
563 | $sw->[0]->set_text (::formsep ($val->[1])); |
575 | $sw->[1]->set_text ($val->[0] * 1); |
564 | $sw->[1]->set_text ($val->[0] * 1); |
576 | $sw->[2]->set_value (@$val); |
565 | $sw->[2]->set_value (@$val); |
577 | |
566 | |
578 | #$::GAUGES->{sklprg}->set_label ($name); |
567 | $::GAUGES->{sklprg}->set_label ("$name %d%%"); |
579 | $::GAUGES->{sklprg}->set_value (@$val); |
568 | $::GAUGES->{sklprg}->set_value (@$val); |
580 | } |
|
|
581 | } |
|
|
582 | |
|
|
583 | sub macro_send { |
|
|
584 | my ($self, $macro) = @_; |
|
|
585 | |
|
|
586 | for my $cmd (@{ $macro->{action} }) { |
|
|
587 | $self->send_command ($cmd); |
|
|
588 | } |
569 | } |
589 | } |
570 | } |
590 | |
571 | |
591 | sub user_send { |
572 | sub user_send { |
592 | my ($self, $command) = @_; |
573 | my ($self, $command) = @_; |
… | |
… | |
594 | $self->{record}->($command) |
575 | $self->{record}->($command) |
595 | if $self->{record}; |
576 | if $self->{record}; |
596 | |
577 | |
597 | $self->logprint ("send: ", $command); |
578 | $self->logprint ("send: ", $command); |
598 | $self->send_command ($command); |
579 | $self->send_command ($command); |
599 | ::status ($command); |
|
|
600 | } |
580 | } |
601 | |
581 | |
602 | sub record { |
582 | sub record { |
603 | my ($self, $cb) = @_; |
583 | my ($self, $cb) = @_; |
604 | |
584 | |
… | |
… | |
887 | # split metadata case, FT_MUSIC, FT_SOUND |
867 | # split metadata case, FT_MUSIC, FT_SOUND |
888 | if ($changed) { # new data |
868 | if ($changed) { # new data |
889 | my ($meta, $data) = unpack "(w/a*)*", $face->{data}; |
869 | my ($meta, $data) = unpack "(w/a*)*", $face->{data}; |
890 | $face->{data} = $meta; |
870 | $face->{data} = $meta; |
891 | |
871 | |
|
|
872 | # rely on strict ordering here and also on later fetch |
892 | CFPlus::DB::put res_data => $face->{name} => $data, sub { }; |
873 | CFPlus::DB::put res_data => $face->{name} => $data, sub { }; |
893 | CFPlus::DB::put res_meta => $face->{name} => $meta, sub { }; |
874 | CFPlus::DB::put res_meta => $face->{name} => $meta, sub { }; |
894 | } |
875 | } |
895 | |
876 | |
896 | $face->{data} = $self->{json_coder}->decode ($face->{data}); |
877 | $face->{data} = $self->{json_coder}->decode ($face->{data}); |
897 | |
|
|
898 | ::add_license ($face); |
878 | ::add_license ($face); |
|
|
879 | ::message ({ markup => CFPlus::asxml "downloaded resource '$face->{data}{name}', type $face->{type}." }) |
|
|
880 | if $changed; |
899 | |
881 | |
900 | if ($face->{type} == 3) { # FT_MUSIC |
882 | if ($face->{type} == 3) { # FT_MUSIC |
901 | ::message ({ markup => "downloaded song #$facenum" }) |
|
|
902 | if $changed; |
|
|
903 | |
|
|
904 | &::audio_music_push ($facenum); |
883 | &::audio_music_push ($facenum); |
905 | } elsif ($face->{type} == 5) { # FT_SOUND |
884 | } elsif ($face->{type} == 5) { # FT_SOUND |
906 | ::message ({ markup => "downloaded sound #$facenum" }) |
|
|
907 | if $changed; |
|
|
908 | |
|
|
909 | &::audio_sound_push ($facenum); |
885 | &::audio_sound_push ($facenum); |
910 | } |
886 | } |
911 | |
887 | |
912 | } else { |
888 | } else { |
913 | # flat resource case, FT_RSRC |
889 | # flat resource case, FT_RSRC |
… | |
… | |
1056 | |
1032 | |
1057 | ## try to create single paragraphs of multiple lines sent by the server |
1033 | ## try to create single paragraphs of multiple lines sent by the server |
1058 | # no longer neecssary with TRT servers |
1034 | # no longer neecssary with TRT servers |
1059 | #$text =~ s/(?<=\S)\n(?=\w)/ /g; |
1035 | #$text =~ s/(?<=\S)\n(?=\w)/ /g; |
1060 | |
1036 | |
|
|
1037 | for (split /\n/, $text) { |
1061 | ::message ({ |
1038 | ::message ({ |
1062 | fg => $fg, |
1039 | fg => $fg, |
1063 | markup => $_, |
1040 | markup => $_, |
1064 | type => $type, |
1041 | type => $type, |
1065 | extra => [@extra], |
1042 | extra => [@extra], |
1066 | color_flags => $color |
1043 | color_flags => $color, #d# ugly, kill |
1067 | }) for split /\n/, $text; |
1044 | }); |
|
|
1045 | |
|
|
1046 | $color &= ~NDI_CLEAR; # only clear once for multiline messages |
|
|
1047 | # actually, this is an ugly design. _we_ should control the channels, |
|
|
1048 | # not some random other widget, as the channels are clearly protocol-specific. |
|
|
1049 | # then we could also react to flags such as CLEAR without resorting to |
|
|
1050 | # hacks such as color_flags, above. |
|
|
1051 | } |
1068 | |
1052 | |
1069 | $self->{statusbox}->add ($text, |
1053 | $self->{statusbox}->add ($text, |
1070 | group => $text, |
1054 | group => $text, |
1071 | fg => $fg, |
1055 | fg => $fg, |
1072 | timeout => $color >= 2 ? 180 : 10, |
1056 | timeout => $color >= 2 ? 180 : 10, |