ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/DC/UI.pm
(Generate patch)

Comparing deliantra/Deliantra-Client/DC/UI.pm (file contents):
Revision 1.299 by root, Wed Jun 7 07:17:37 2006 UTC vs.
Revision 1.314 by root, Mon Jun 26 21:59:04 2006 UTC

… …
272 272
273 return unless $self->{visible}; 273 return unless $self->{visible};
274 274
275 $_->set_invisible for $self->children; 275 $_->set_invisible for $self->children;
276 276
277 delete $self->{visible};
277 delete $self->{root}; 278 delete $self->{root};
278 delete $self->{visible};
279 279
280 undef $GRAB if $GRAB == $self; 280 undef $GRAB if $GRAB == $self;
281 undef $HOVER if $HOVER == $self; 281 undef $HOVER if $HOVER == $self;
282 282
283 $CFClient::UI::TOOLTIP_WATCHER->cb->() 283 $CFClient::UI::TOOLTIP_WATCHER->cb->()
284 if $TOOLTIP->{owner} == $self; 284 if $TOOLTIP->{owner} == $self;
285 285
286 $self->focus_out; 286 $self->emit ("focus_out");
287
288 $self->emit (visibility_change => 0); 287 $self->emit (visibility_change => 0);
289} 288}
290 289
291sub set_visibility { 290sub set_visibility {
292 my ($self, $visible) = @_; 291 my ($self, $visible) = @_;
… …
334} 333}
335 334
336sub size_request { 335sub size_request {
337 require Carp; 336 require Carp;
338 Carp::confess "size_request is abstract"; 337 Carp::confess "size_request is abstract";
338}
339
340sub baseline_shift {
341 0
339} 342}
340 343
341sub configure { 344sub configure {
342 my ($self, $x, $y, $w, $h) = @_; 345 my ($self, $x, $y, $w, $h) = @_;
343 346
… …
367 370
368 $self->{root}{size_alloc}{$self+0} = $self; 371 $self->{root}{size_alloc}{$self+0} = $self;
369 } 372 }
370} 373}
371 374
372sub size_allocate {
373 # nothing to be done
374}
375
376sub children { 375sub children {
377 # nop 376 # nop
378} 377}
379 378
380sub visible_children { 379sub visible_children {
… …
418 my ($self, $x, $y) = @_; 417 my ($self, $x, $y) = @_;
419 418
420 $self->{parent}->coord2global ($x + $self->{x}, $y + $self->{y}) 419 $self->{parent}->coord2global ($x + $self->{x}, $y + $self->{y})
421} 420}
422 421
423sub focus_in { 422sub invoke_focus_in {
424 my ($self) = @_; 423 my ($self) = @_;
425 424
426 return if $FOCUS == $self; 425 return if $FOCUS == $self;
427 return unless $self->{can_focus}; 426 return unless $self->{can_focus};
428 427
429 my $focus = $FOCUS; $FOCUS = $self; 428 my $focus = $FOCUS; $FOCUS = $self;
430 429
431 $self->_emit (focus_in => $focus);
432
433 $focus->update if $focus; 430 $focus->update if $focus;
434 $FOCUS->update; 431 $FOCUS->update;
435}
436 432
433 0
434}
435
437sub focus_out { 436sub invoke_focus_out {
438 my ($self) = @_; 437 my ($self) = @_;
439 438
440 return unless $FOCUS == $self; 439 return unless $FOCUS == $self;
441 440
442 my $focus = $FOCUS; undef $FOCUS; 441 my $focus = $FOCUS; undef $FOCUS;
443 442
444 $self->_emit (focus_out => $focus);
445
446 $focus->update if $focus; #? 443 $focus->update if $focus; #?
447 444
448 $::MAPWIDGET->focus_in #d# focus mapwidget if no other widget has focus 445 $::MAPWIDGET->grab_focus #d# focus mapwidget if no other widget has focus
449 unless $FOCUS; 446 unless $FOCUS;
450}
451 447
448 0
449}
450
451sub grab_focus {
452 my ($self) = @_;
453
454 $self->emit ("focus_in");
455}
456
452sub mouse_motion { 0 } 457sub invoke_mouse_motion { 1 }
453sub button_up { 0 } 458sub invoke_button_up { 1 }
454sub key_down { 0 } 459sub invoke_key_down { 1 }
455sub key_up { 0 } 460sub invoke_key_up { 1 }
456 461
457sub button_down { 462sub invoke_button_down {
458 my ($self, $ev, $x, $y) = @_; 463 my ($self, $ev, $x, $y) = @_;
459 464
460 $self->focus_in; 465 $self->grab_focus;
461 466
462 0 467 1
468}
469
470sub connect {
471 my ($self, $signal, $cb) = @_;
472
473 push @{ $self->{signal_cb}{$signal} }, $cb;
474}
475
476sub emit {
477 my ($self, $signal, @args) = @_;
478
479 #d##TODO# stop propagating at first true, do not use sum
480 (List::Util::sum map $_->($self, @args), @{$self->{signal_cb}{$signal} || []}) # before
481 || ($self->can ("invoke_$signal") || sub { 1 })->($self, @args) # closure
482 || ($self->{parent} && $self->{parent}->emit ($signal, @args)) # parent
463} 483}
464 484
465sub find_widget { 485sub find_widget {
466 my ($self, $x, $y) = @_; 486 my ($self, $x, $y) = @_;
467 487
… …
477sub set_parent { 497sub set_parent {
478 my ($self, $parent) = @_; 498 my ($self, $parent) = @_;
479 499
480 Scalar::Util::weaken ($self->{parent} = $parent); 500 Scalar::Util::weaken ($self->{parent} = $parent);
481 $self->set_visible if $parent->{visible}; 501 $self->set_visible if $parent->{visible};
482}
483
484sub connect {
485 my ($self, $signal, $cb) = @_;
486
487 push @{ $self->{signal_cb}{$signal} }, $cb;
488}
489
490sub _emit {
491 my ($self, $signal, @args) = @_;
492
493 List::Util::sum map $_->($self, @args), @{$self->{signal_cb}{$signal} || []}
494}
495
496sub emit {
497 my ($self, $signal, @args) = @_;
498
499 $self->_emit ($signal, @args)
500 || $self->$signal (@args);
501}
502
503sub visibility_change {
504 #my ($self, $visible) = @_;
505} 502}
506 503
507sub realloc { 504sub realloc {
508 my ($self) = @_; 505 my ($self) = @_;
509 506
… …
542 return unless $self->{h} && $self->{w}; 539 return unless $self->{h} && $self->{w};
543 540
544 # update screen rectangle 541 # update screen rectangle
545 local $draw_x = $draw_x + $self->{x}; 542 local $draw_x = $draw_x + $self->{x};
546 local $draw_y = $draw_y + $self->{y}; 543 local $draw_y = $draw_y + $self->{y};
547 local $draw_w = $draw_x + $self->{w};
548 local $draw_h = $draw_y + $self->{h};
549 544
550 # skip widgets that are entirely outside the drawing area 545 # skip widgets that are entirely outside the drawing area
551 return if ($draw_x + $self->{w} < 0) || ($draw_x >= $draw_w) 546 return if ($draw_x + $self->{w} < 0) || ($draw_x >= $draw_w)
552 || ($draw_y + $self->{h} < 0) || ($draw_y >= $draw_h); 547 || ($draw_y + $self->{h} < 0) || ($draw_y >= $draw_h);
553 548
… …
593 588
594sub DESTROY { 589sub DESTROY {
595 my ($self) = @_; 590 my ($self) = @_;
596 591
597 delete $WIDGET{$self+0}; 592 delete $WIDGET{$self+0};
598 #$self->deactivate; 593
594 eval { $self->destroy };
595 warn "exception during widget destruction: $@" if $@ & $@ != /during global destruction/;
599} 596}
600 597
601############################################################################# 598#############################################################################
602 599
603package CFClient::UI::DrawBG; 600package CFClient::UI::DrawBG;
… …
768} 765}
769 766
770sub add { 767sub add {
771 my ($self, $child) = @_; 768 my ($self, $child) = @_;
772 769
773 $self->{children} = []; 770 $self->SUPER::remove ($_) for @{ $self->{children} };
774
775 $self->SUPER::add ($child); 771 $self->SUPER::add ($child);
776} 772}
777 773
778sub remove { 774sub remove {
779 my ($self, $widget) = @_; 775 my ($self, $widget) = @_;
… …
788 784
789sub size_request { 785sub size_request {
790 $_[0]{children}[0]->size_request 786 $_[0]{children}[0]->size_request
791} 787}
792 788
793sub size_allocate { 789sub invoke_size_allocate {
794 my ($self, $w, $h) = @_; 790 my ($self, $w, $h) = @_;
795 791
796 $self->{children}[0]->configure (0, 0, $w, $h); 792 $self->{children}[0]->configure (0, 0, $w, $h);
793
794 1
797} 795}
798 796
799############################################################################# 797#############################################################################
800 798
801# back-buffered drawing area 799# back-buffered drawing area
… …
817 815
818 $ROOT->on_post_alloc ($self => sub { $self->render_child }); 816 $ROOT->on_post_alloc ($self => sub { $self->render_child });
819 $self->SUPER::update; 817 $self->SUPER::update;
820} 818}
821 819
822sub size_allocate { 820sub invoke_size_allocate {
823 my ($self, $w, $h) = @_; 821 my ($self, $w, $h) = @_;
824 822
825 $self->SUPER::size_allocate ($w, $h);
826 $self->update; 823 $self->update;
824
825 $self->SUPER::invoke_size_allocate ($w, $h)
827} 826}
828 827
829sub _render { 828sub _render {
830 my ($self) = @_; 829 my ($self) = @_;
831 830
… …
892 $h = 10 if $self->{scroll_y}; 891 $h = 10 if $self->{scroll_y};
893 892
894 ($w, $h) 893 ($w, $h)
895} 894}
896 895
897sub size_allocate { 896sub invoke_size_allocate {
898 my ($self, $w, $h) = @_; 897 my ($self, $w, $h) = @_;
899 898
900 my $child = $self->child; 899 my $child = $self->child;
901 900
902 $w = $child->{req_w} if $self->{scroll_x} && $child->{req_w}; 901 $w = $child->{req_w} if $self->{scroll_x} && $child->{req_w};
903 $h = $child->{req_h} if $self->{scroll_y} && $child->{req_h}; 902 $h = $child->{req_h} if $self->{scroll_y} && $child->{req_h};
904 903
905 $self->child->configure (0, 0, $w, $h); 904 $self->child->configure (0, 0, $w, $h);
906 $self->update; 905 $self->update;
906
907 1
907} 908}
908 909
909sub set_offset { 910sub set_offset {
910 my ($self, $x, $y) = @_; 911 my ($self, $x, $y) = @_;
911 912
… …
985 $self->add ($child) if $child; 986 $self->add ($child) if $child;
986 987
987 $self 988 $self
988} 989}
989 990
991#TODO# update range on size_allocate depending on child
992
990sub add { 993sub add {
991 my ($self, $widget) = @_; 994 my ($self, $widget) = @_;
992 995
993 $self->{vp}->add ($self->{child} = $widget); 996 $self->{vp}->add ($self->{child} = $widget);
994} 997}
995 998
999sub update_slider {
1000 my ($self) = @_;
1001
1002 $self->{slider}->set_range ([$self->{slider}{range}[0], 0, $self->{vp}->child->{h}, $self->{vp}{h}, 1]);
1003}
1004
996sub update { 1005sub update {
997 my ($self) = @_; 1006 my ($self) = @_;
998 1007
999 $self->SUPER::update; 1008 $self->SUPER::update;
1000 1009
1001 # todo: overwrite size_allocate of child 1010 $self->update_slider;
1002 my $child = $self->{vp}->child;
1003 $self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);
1004} 1011}
1005 1012
1006sub size_allocate { 1013sub invoke_size_allocate {
1007 my ($self, $w, $h) = @_; 1014 my ($self, $w, $h) = @_;
1008 1015
1016 $self->update_slider;
1017
1009 $self->SUPER::size_allocate ($w, $h); 1018 $self->SUPER::invoke_size_allocate ($w, $h)
1010
1011 my $child = $self->{vp}->child;
1012 $self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);
1013} 1019}
1014
1015#TODO# update range on size_allocate depending on child
1016# update viewport offset on scroll
1017 1020
1018############################################################################# 1021#############################################################################
1019 1022
1020package CFClient::UI::Frame; 1023package CFClient::UI::Frame;
1021 1024
… …
1071 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 } 1074 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
1072 qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png); 1075 qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);
1073 1076
1074sub new { 1077sub new {
1075 my ($class, %arg) = @_; 1078 my ($class, %arg) = @_;
1076
1077 my $title = delete $arg{title};
1078 1079
1079 my $self = $class->SUPER::new ( 1080 my $self = $class->SUPER::new (
1080 bg => [1, 1, 1, 1], 1081 bg => [1, 1, 1, 1],
1081 border_bg => [1, 1, 1, 1], 1082 border_bg => [1, 1, 1, 1],
1082 border => 0.6, 1083 border => 0.6,
… …
1084 min_w => 16, 1085 min_w => 16,
1085 min_h => 16, 1086 min_h => 16,
1086 %arg, 1087 %arg,
1087 ); 1088 );
1088 1089
1089 $self->{title} = new CFClient::UI::Label 1090 $self->{title_widget} = new CFClient::UI::Label
1090 align => 0, 1091 align => 0,
1091 valign => 1, 1092 valign => 1,
1092 text => $title, 1093 text => $self->{title},
1093 fontsize => $self->{border} 1094 fontsize => $self->{border},
1094 if defined $title; 1095 if exists $self->{title};
1096
1097 if ($self->{has_close_button}) {
1098 $self->{close_button} =
1099 new CFClient::UI::ImageButton
1100 path => 'x1_close.png',
1101 on_activate => sub { $self->hide };
1102
1103 $self->CFClient::UI::Container::add ($self->{close_button});
1104 }
1095 1105
1096 $self 1106 $self
1097} 1107}
1098 1108
1099sub add { 1109sub add {
1100 my ($self, @widgets) = @_; 1110 my ($self, @widgets) = @_;
1101 1111
1102 $self->SUPER::add (@widgets); 1112 $self->SUPER::add (@widgets);
1113 $self->CFClient::UI::Container::add ($self->{close_button}) if $self->{close_button};
1103 $self->CFClient::UI::Container::add ($self->{title}) if $self->{title}; 1114 $self->CFClient::UI::Container::add ($self->{title_widget}) if $self->{title_widget};
1104} 1115}
1105 1116
1106sub border { 1117sub border {
1107 int $_[0]{border} * $::FONTSIZE 1118 int $_[0]{border} * $::FONTSIZE
1108} 1119}
1109 1120
1110sub size_request { 1121sub size_request {
1111 my ($self) = @_; 1122 my ($self) = @_;
1112 1123
1113 $self->{title}->size_request 1124 $self->{title_widget}->size_request
1114 if $self->{title}; 1125 if $self->{title_widget};
1126
1127 $self->{close_button}->size_request
1128 if $self->{close_button};
1115 1129
1116 my ($w, $h) = $self->SUPER::size_request; 1130 my ($w, $h) = $self->SUPER::size_request;
1117 1131
1118 ( 1132 (
1119 $w + $self->border * 2, 1133 $w + $self->border * 2,
1120 $h + $self->border * 2, 1134 $h + $self->border * 2,
1121 ) 1135 )
1122} 1136}
1123 1137
1124sub size_allocate { 1138sub invoke_size_allocate {
1125 my ($self, $w, $h) = @_; 1139 my ($self, $w, $h) = @_;
1126 1140
1127 if ($self->{title}) { 1141 if ($self->{title_widget}) {
1128 $self->{title}{w} = $w; 1142 $self->{title_widget}{w} = $w;
1129 $self->{title}{h} = $h; 1143 $self->{title_widget}{h} = $h;
1130 $self->{title}->size_allocate ($w, $h); 1144 $self->{title_widget}->invoke_size_allocate ($w, $h);
1131 } 1145 }
1132 1146
1133 my $border = $self->border; 1147 my $border = $self->border;
1134 1148
1135 $h -= List::Util::max 0, $border * 2; 1149 $h -= List::Util::max 0, $border * 2;
1136 $w -= List::Util::max 0, $border * 2; 1150 $w -= List::Util::max 0, $border * 2;
1137 1151
1138 $self->child->configure ($border, $border, $w, $h); 1152 $self->child->configure ($border, $border, $w, $h);
1139}
1140 1153
1154 $self->{close_button}->configure ($self->{w} - $border, 0, $border, $border)
1155 if $self->{close_button};
1156
1157 1
1158}
1159
1141sub button_down { 1160sub invoke_button_down {
1142 my ($self, $ev, $x, $y) = @_; 1161 my ($self, $ev, $x, $y) = @_;
1143 1162
1144 my ($w, $h) = @$self{qw(w h)}; 1163 my ($w, $h) = @$self{qw(w h)};
1145 my $border = $self->border; 1164 my $border = $self->border;
1146 1165
… …
1177 1196
1178 ($x, $y) = ($ev->{x}, $ev->{y}); 1197 ($x, $y) = ($ev->{x}, $ev->{y});
1179 1198
1180 $self->move_abs ($bx + $x - $ox, $by + $y - $oy); 1199 $self->move_abs ($bx + $x - $ox, $by + $y - $oy);
1181 # HACK: the next line is required to enforce placement 1200 # HACK: the next line is required to enforce placement
1182 $self->{parent}->size_allocate ($self->{parent}{w}, $self->{parent}{h}); 1201 $self->{parent}->invoke_size_allocate ($self->{parent}{w}, $self->{parent}{h});
1183 }; 1202 };
1184 } else { 1203 } else {
1185 return 0; 1204 return 0;
1186 } 1205 }
1187 1206
1188 1 1207 1
1189} 1208}
1190 1209
1191sub button_up { 1210sub invoke_button_up {
1192 my ($self, $ev, $x, $y) = @_; 1211 my ($self, $ev, $x, $y) = @_;
1193 1212
1194 !!delete $self->{motion} 1213 ! ! delete $self->{motion}
1195} 1214}
1196 1215
1197sub mouse_motion { 1216sub invoke_mouse_motion {
1198 my ($self, $ev, $x, $y) = @_; 1217 my ($self, $ev, $x, $y) = @_;
1199 1218
1200 $self->{motion}->($ev, $x, $y) if $self->{motion}; 1219 $self->{motion}->($ev, $x, $y) if $self->{motion};
1201 1220
1202 !!$self->{motion} 1221 ! ! $self->{motion}
1203} 1222}
1204 1223
1205sub _draw { 1224sub _draw {
1206 my ($self) = @_; 1225 my ($self) = @_;
1207 1226
… …
1233 1252
1234 glDisable GL_TEXTURE_2D; 1253 glDisable GL_TEXTURE_2D;
1235 1254
1236 $child->draw; 1255 $child->draw;
1237 1256
1238 if ($self->{title}) { 1257 if ($self->{title_widget}) {
1239 glTranslate 0, $border - $self->{h}; 1258 glTranslate 0, $border - $self->{h};
1240 $self->{title}->_draw; 1259 $self->{title_widget}->_draw;
1260
1261 glTranslate 0, - ($border - $self->{h});
1241 } 1262 }
1263
1264 $self->{close_button}->draw
1265 if $self->{close_button};
1242} 1266}
1243 1267
1244############################################################################# 1268#############################################################################
1245 1269
1246package CFClient::UI::Table; 1270package CFClient::UI::Table;
… …
1269 1293
1270 $child->set_parent ($self); 1294 $child->set_parent ($self);
1271 $self->{children}[$y][$x] = $child; 1295 $self->{children}[$y][$x] = $child;
1272 1296
1273 $self->realloc; 1297 $self->realloc;
1298}
1299
1300sub remove {
1301 my ($self, $child) = @_;
1302
1303 # TODO: not yet implemented
1274} 1304}
1275 1305
1276# TODO: move to container class maybe? send children a signal on removal? 1306# TODO: move to container class maybe? send children a signal on removal?
1277sub clear { 1307sub clear {
1278 my ($self) = @_; 1308 my ($self) = @_;
… …
1319 (sum @$ws), 1349 (sum @$ws),
1320 (sum @$hs), 1350 (sum @$hs),
1321 ) 1351 )
1322} 1352}
1323 1353
1324sub size_allocate { 1354sub invoke_size_allocate {
1325 my ($self, $w, $h) = @_; 1355 my ($self, $w, $h) = @_;
1326 1356
1327 my ($ws, $hs) = $self->get_wh; 1357 my ($ws, $hs) = $self->get_wh;
1328 1358
1329 my $req_w = (sum @$ws) || 1; 1359 my $req_w = (sum @$ws) || 1;
… …
1361 } 1391 }
1362 1392
1363 $y += $row_h; 1393 $y += $row_h;
1364 } 1394 }
1365 1395
1396 1
1366} 1397}
1367 1398
1368sub find_widget { 1399sub find_widget {
1369 my ($self, $x, $y) = @_; 1400 my ($self, $x, $y) = @_;
1370 1401
… …
1407 (List::Util::sum map $_->{req_w}, @{$self->{children}}), 1438 (List::Util::sum map $_->{req_w}, @{$self->{children}}),
1408 (List::Util::max map $_->{req_h}, @{$self->{children}}), 1439 (List::Util::max map $_->{req_h}, @{$self->{children}}),
1409 ) 1440 )
1410} 1441}
1411 1442
1412sub size_allocate { 1443sub invoke_size_allocate {
1413 my ($self, $w, $h) = @_; 1444 my ($self, $w, $h) = @_;
1414 1445
1415 my $space = $self->{vertical} ? $h : $w; 1446 my $space = $self->{vertical} ? $h : $w;
1416 my $children = $self->{children}; 1447 my @children = $self->visible_children;
1417 1448
1418 my @req; 1449 my @req;
1419 1450
1420 if ($self->{homogeneous}) { 1451 if ($self->{homogeneous}) {
1421 @req = ($space / (@$children || 1)) x @$children; 1452 @req = ($space / (@children || 1)) x @children;
1422 } else { 1453 } else {
1423 @req = map $_->{$self->{vertical} ? "req_h" : "req_w"}, @$children; 1454 @req = map $_->{$self->{vertical} ? "req_h" : "req_w"}, @children;
1424 my $req = List::Util::sum @req; 1455 my $req = List::Util::sum @req;
1425 1456
1426 if ($req > $space) { 1457 if ($req > $space) {
1427 # ah well, not enough space 1458 # ah well, not enough space
1428 $_ *= $space / $req for @req; 1459 $_ *= $space / $req for @req;
1429 } else { 1460 } else {
1430 my $expand = (List::Util::sum map $_->{expand}, @$children) || 1; 1461 my $expand = (List::Util::sum map $_->{expand}, @children) || 1;
1431 1462
1432 $space = ($space - $req) / $expand; # remaining space to give away 1463 $space = ($space - $req) / $expand; # remaining space to give away
1433 1464
1434 $req[$_] += $space * $children->[$_]{expand} 1465 $req[$_] += $space * $children[$_]{expand}
1435 for 0 .. $#$children; 1466 for 0 .. $#children;
1436 } 1467 }
1437 } 1468 }
1438 1469
1439 CFClient::UI::harmonize \@req; 1470 CFClient::UI::harmonize \@req;
1440 1471
1441 my $pos = 0; 1472 my $pos = 0;
1442 for (0 .. $#$children) { 1473 for (0 .. $#children) {
1443 my $alloc = $req[$_]; 1474 my $alloc = $req[$_];
1444 $children->[$_]->configure ($self->{vertical} ? (0, $pos, $w, $alloc) : ($pos, 0, $alloc, $h)); 1475 $children[$_]->configure ($self->{vertical} ? (0, $pos, $w, $alloc) : ($pos, 0, $alloc, $h));
1445 1476
1446 $pos += $alloc; 1477 $pos += $alloc;
1447 } 1478 }
1448 1479
1449 1 1480 1
… …
1604 }; 1635 };
1605 1636
1606 @{ $self->{size_req} } 1637 @{ $self->{size_req} }
1607} 1638}
1608 1639
1640sub baseline_shift {
1641 $_[0]{layout}->descent
1642}
1643
1609sub size_allocate { 1644sub invoke_size_allocate {
1610 my ($self, $w, $h) = @_; 1645 my ($self, $w, $h) = @_;
1611 1646
1612 delete $self->{ox}; 1647 delete $self->{ox};
1613 1648
1614 delete $self->{texture} 1649 delete $self->{texture}
1615 unless $w >= $self->{req_w} && $self->{old_w} >= $self->{req_w}; 1650 unless $w >= $self->{req_w} && $self->{old_w} >= $self->{req_w};
1651
1652 1
1616} 1653}
1617 1654
1618sub set_fontsize { 1655sub set_fontsize {
1619 my ($self, $fontsize) = @_; 1656 my ($self, $fontsize) = @_;
1620 1657
… …
1713 1750
1714 $text =~ s/./*/g if $self->{hidden}; 1751 $text =~ s/./*/g if $self->{hidden};
1715 $self->{layout}->set_text ("$text "); 1752 $self->{layout}->set_text ("$text ");
1716 delete $self->{size_req}; 1753 delete $self->{size_req};
1717 1754
1718 $self->_emit (changed => $self->{text}); 1755 $self->emit (changed => $self->{text});
1719 1756
1720 $self->realloc; 1757 $self->realloc;
1721 $self->update; 1758 $self->update;
1722} 1759}
1723 1760
… …
1738 my ($w, $h) = $self->SUPER::size_request; 1775 my ($w, $h) = $self->SUPER::size_request;
1739 1776
1740 ($w + 1, $h) # add 1 for cursor 1777 ($w + 1, $h) # add 1 for cursor
1741} 1778}
1742 1779
1743sub key_down { 1780sub invoke_key_down {
1744 my ($self, $ev) = @_; 1781 my ($self, $ev) = @_;
1745 1782
1746 my $mod = $ev->{mod}; 1783 my $mod = $ev->{mod};
1747 my $sym = $ev->{sym}; 1784 my $sym = $ev->{sym};
1748 my $uni = $ev->{unicode}; 1785 my $uni = $ev->{unicode};
… …
1760 } elsif ($sym == CFClient::SDLK_HOME) { 1797 } elsif ($sym == CFClient::SDLK_HOME) {
1761 $self->{cursor} = 0; 1798 $self->{cursor} = 0;
1762 } elsif ($sym == CFClient::SDLK_END) { 1799 } elsif ($sym == CFClient::SDLK_END) {
1763 $self->{cursor} = length $text; 1800 $self->{cursor} = length $text;
1764 } elsif ($uni == 27) { 1801 } elsif ($uni == 27) {
1765 $self->_emit ('escape'); 1802 $self->emit ('escape');
1766 } elsif ($uni) { 1803 } elsif ($uni) {
1767 substr $text, $self->{cursor}++, 0, chr $uni; 1804 substr $text, $self->{cursor}++, 0, chr $uni;
1768 } else { 1805 } else {
1769 return 0; 1806 return 0;
1770 } 1807 }
… …
1774 $self->realloc; 1811 $self->realloc;
1775 1812
1776 1 1813 1
1777} 1814}
1778 1815
1779sub focus_in { 1816sub invoke_focus_in {
1780 my ($self) = @_; 1817 my ($self) = @_;
1781 1818
1782 $self->{last_activity} = $::NOW; 1819 $self->{last_activity} = $::NOW;
1783 1820
1784 $self->SUPER::focus_in; 1821 $self->SUPER::invoke_focus_in
1785} 1822}
1786 1823
1787sub button_down { 1824sub invoke_button_down {
1788 my ($self, $ev, $x, $y) = @_; 1825 my ($self, $ev, $x, $y) = @_;
1789 1826
1790 $self->SUPER::button_down ($ev, $x, $y); 1827 $self->SUPER::invoke_button_down ($ev, $x, $y);
1791 1828
1792 my $idx = $self->{layout}->xy_to_index ($x, $y); 1829 my $idx = $self->{layout}->xy_to_index ($x, $y);
1793 1830
1794 # byte-index to char-index 1831 # byte-index to char-index
1795 my $text = $self->{text}; 1832 my $text = $self->{text};
… …
1800 $self->update; 1837 $self->update;
1801 1838
1802 1 1839 1
1803} 1840}
1804 1841
1805sub mouse_motion { 1842sub invoke_mouse_motion {
1806 my ($self, $ev, $x, $y) = @_; 1843 my ($self, $ev, $x, $y) = @_;
1807# printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d# 1844# printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d#
1808 1845
1809 0 1846 1
1810} 1847}
1811 1848
1812sub _draw { 1849sub _draw {
1813 my ($self) = @_; 1850 my ($self) = @_;
1814 1851
… …
1855 1892
1856our @ISA = CFClient::UI::EntryBase::; 1893our @ISA = CFClient::UI::EntryBase::;
1857 1894
1858use CFClient::OpenGL; 1895use CFClient::OpenGL;
1859 1896
1860sub key_down { 1897sub invoke_key_down {
1861 my ($self, $ev) = @_; 1898 my ($self, $ev) = @_;
1862 1899
1863 my $sym = $ev->{sym}; 1900 my $sym = $ev->{sym};
1864 1901
1865 if ($sym == 13) { 1902 if ($sym == 13) {
1866 unshift @{$self->{history}}, 1903 unshift @{$self->{history}},
1867 my $txt = $self->get_text; 1904 my $txt = $self->get_text;
1905
1868 $self->{history_pointer} = -1; 1906 $self->{history_pointer} = -1;
1869 $self->{history_saveback} = ''; 1907 $self->{history_saveback} = '';
1870 $self->_emit (activate => $txt); 1908 $self->emit (activate => $txt);
1871 $self->update; 1909 $self->update;
1872 1910
1873 } elsif ($sym == CFClient::SDLK_UP) { 1911 } elsif ($sym == CFClient::SDLK_UP) {
1874 if ($self->{history_pointer} < 0) { 1912 if ($self->{history_pointer} < 0) {
1875 $self->{history_saveback} = $self->get_text; 1913 $self->{history_saveback} = $self->get_text;
… …
1891 } else { 1929 } else {
1892 $self->set_text ($self->{history_saveback}); 1930 $self->set_text ($self->{history_saveback});
1893 } 1931 }
1894 1932
1895 } else { 1933 } else {
1896 return $self->SUPER::key_down ($ev) 1934 return $self->SUPER::invoke_key_down ($ev)
1897 } 1935 }
1898 1936
1899 1 1937 1
1900} 1938}
1901 1939
… …
1925 can_events => 1, 1963 can_events => 1,
1926 @_ 1964 @_
1927 ) 1965 )
1928} 1966}
1929 1967
1930sub activate { }
1931
1932sub button_up { 1968sub invoke_button_up {
1933 my ($self, $ev, $x, $y) = @_; 1969 my ($self, $ev, $x, $y) = @_;
1934 1970
1935 $self->emit ("activate") 1971 $self->emit ("activate")
1936 if $x >= 0 && $x < $self->{w} 1972 if $x >= 0 && $x < $self->{w}
1937 && $y >= 0 && $y < $self->{h}; 1973 && $y >= 0 && $y < $self->{h};
… …
1951 $tex[0]->draw_quad_alpha (0, 0, $self->{w}, $self->{h}); 1987 $tex[0]->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
1952 1988
1953 glDisable GL_TEXTURE_2D; 1989 glDisable GL_TEXTURE_2D;
1954 1990
1955 $self->SUPER::_draw; 1991 $self->SUPER::_draw;
1992}
1993
1994#############################################################################
1995
1996package CFClient::UI::ImageButton;
1997
1998our @ISA = CFClient::UI::Image::;
1999
2000use CFClient::OpenGL;
2001
2002my %textures;
2003
2004sub new {
2005 my $class = shift;
2006
2007 my $self = $class->SUPER::new (
2008 padding_x => 4,
2009 padding_y => 4,
2010 fg => [1, 1, 1],
2011 active_fg => [0, 0, 1],
2012 can_hover => 1,
2013 align => 0,
2014 valign => 0,
2015 can_events => 1,
2016 @_
2017 );
2018}
2019
2020sub invoke_button_up {
2021 my ($self, $ev, $x, $y) = @_;
2022
2023 $self->emit ("activate")
2024 if $x >= 0 && $x < $self->{w}
2025 && $y >= 0 && $y < $self->{h};
2026
2027 1
1956} 2028}
1957 2029
1958############################################################################# 2030#############################################################################
1959 2031
1960package CFClient::UI::CheckBox; 2032package CFClient::UI::CheckBox;
… …
1987 my ($self) = @_; 2059 my ($self) = @_;
1988 2060
1989 (6) x 2 2061 (6) x 2
1990} 2062}
1991 2063
1992sub button_down { 2064sub invoke_button_down {
1993 my ($self, $ev, $x, $y) = @_; 2065 my ($self, $ev, $x, $y) = @_;
1994 2066
1995 if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x} 2067 if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
1996 && $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) { 2068 && $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
1997 $self->{state} = !$self->{state}; 2069 $self->{state} = !$self->{state};
1998 $self->_emit (changed => $self->{state}); 2070 $self->emit (changed => $self->{state});
1999 } else { 2071 } else {
2000 return 0 2072 return 0
2001 } 2073 }
2002 2074
2003 1 2075 1
… …
2028package CFClient::UI::Image; 2100package CFClient::UI::Image;
2029 2101
2030our @ISA = CFClient::UI::Base::; 2102our @ISA = CFClient::UI::Base::;
2031 2103
2032use CFClient::OpenGL; 2104use CFClient::OpenGL;
2033use Carp qw/confess/;
2034 2105
2035our %loaded_images; 2106our %texture_cache;
2036 2107
2037sub new { 2108sub new {
2038 my $class = shift; 2109 my $class = shift;
2039 2110
2040 my $self = $class->SUPER::new (can_events => 0, @_); 2111 my $self = $class->SUPER::new (
2112 can_events => 0,
2113 @_,
2114 );
2041 2115
2042 $self->{image} or confess "Image has 'image' not set. This is a fatal error!"; 2116 $self->{path}
2117 or Carp::croak "required attribute 'path' not set";
2043 2118
2044 $loaded_images{$self->{image}} ||= 2119 $self->{tex} = $texture_cache{$self->{path}} ||=
2045 new_from_file CFClient::Texture CFClient::find_rcfile $self->{image}, mipmap => 1; 2120 new_from_file CFClient::Texture CFClient::find_rcfile $self->{path}, mipmap => 1;
2046 2121
2047 my $tex = $self->{tex} = $loaded_images{$self->{image}}; 2122 Scalar::Util::weaken $texture_cache{$self->{path}};
2048 2123
2049 Scalar::Util::weaken $loaded_images{$self->{image}}; 2124 $self->{aspect} ||= $self->{tex}{w} / $self->{tex}{h};
2050
2051 $self->{aspect} = $tex->{w} / $tex->{h};
2052 2125
2053 $self 2126 $self
2054} 2127}
2055 2128
2056sub size_request { 2129sub size_request {
2057 my ($self) = @_; 2130 my ($self) = @_;
2058 2131
2059 ($self->{tex}->{w}, $self->{tex}->{h}) 2132 ($self->{tex}{w}, $self->{tex}{h})
2060} 2133}
2061 2134
2062sub _draw { 2135sub _draw {
2063 my ($self) = @_; 2136 my ($self) = @_;
2064 2137
… …
2300 $self->update; 2373 $self->update;
2301 2374
2302 $self 2375 $self
2303} 2376}
2304 2377
2305sub changed { }
2306
2307sub set_range { 2378sub set_range {
2308 my ($self, $range) = @_; 2379 my ($self, $range) = @_;
2309 2380
2310 ($range, $self->{range}) = ($self->{range}, $range); 2381 ($range, $self->{range}) = ($self->{range}, $range);
2311 2382
… …
2331 if $unit; 2402 if $unit;
2332 2403
2333 @{$self->{range}} = ($value, $lo, $hi, $page, $unit); 2404 @{$self->{range}} = ($value, $lo, $hi, $page, $unit);
2334 2405
2335 if ($value != $old_value) { 2406 if ($value != $old_value) {
2336 $self->_emit (changed => $value); 2407 $self->emit (changed => $value);
2337 $self->update; 2408 $self->update;
2338 } 2409 }
2339} 2410}
2340 2411
2341sub size_request { 2412sub size_request {
2342 my ($self) = @_; 2413 my ($self) = @_;
2343 2414
2344 ($self->{req_w}, $self->{req_h}) 2415 ($self->{req_w}, $self->{req_h})
2345} 2416}
2346 2417
2347sub button_down { 2418sub invoke_button_down {
2348 my ($self, $ev, $x, $y) = @_; 2419 my ($self, $ev, $x, $y) = @_;
2349 2420
2350 $self->SUPER::button_down ($ev, $x, $y); 2421 $self->SUPER::invoke_button_down ($ev, $x, $y);
2351 2422
2352 $self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x]; 2423 $self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];
2353 2424
2354 $self->mouse_motion ($ev, $x, $y) 2425 $self->invoke_mouse_motion ($ev, $x, $y)
2355} 2426}
2356 2427
2357sub mouse_motion { 2428sub invoke_mouse_motion {
2358 my ($self, $ev, $x, $y) = @_; 2429 my ($self, $ev, $x, $y) = @_;
2359 2430
2360 if ($GRAB == $self) { 2431 if ($GRAB == $self) {
2361 my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w}); 2432 my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w});
2362 2433
… …
2504 2575
2505 $self->{fontsize} = $fontsize; 2576 $self->{fontsize} = $fontsize;
2506 $self->reflow; 2577 $self->reflow;
2507} 2578}
2508 2579
2580sub size_request {
2581 my ($self) = @_;
2582
2583 my ($empty, $slider) = @{ $self->{children} };
2584
2585 local $self->{children} = [$empty, $slider];
2586 $self->SUPER::size_request
2587}
2588
2509sub size_allocate { 2589sub invoke_size_allocate {
2510 my ($self, $w, $h) = @_; 2590 my ($self, $w, $h) = @_;
2511 2591
2512 $self->SUPER::size_allocate ($w, $h); 2592 my ($empty, $slider, @other) = @{ $self->{children} };
2593 $_->configure (@$_{qw(x y req_w req_h)}) for @other;
2513 2594
2514 $self->{layout}->set_font ($self->{font}) if $self->{font}; 2595 $self->{layout}->set_font ($self->{font}) if $self->{font};
2515 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE); 2596 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
2516 $self->{layout}->set_width ($self->{children}[0]{w}); 2597 $self->{layout}->set_width ($empty->{w});
2517 $self->{layout}->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent}); 2598 $self->{layout}->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2518 2599
2519 $self->reflow; 2600 $self->reflow;
2520}
2521 2601
2522sub text_size { 2602 local $self->{children} = [$empty, $slider];
2523 my ($self, $text, $indent) = @_; 2603 $self->SUPER::invoke_size_allocate ($w, $h)
2604}
2605
2606sub get_layout {
2607 my ($self, $para) = @_;
2524 2608
2525 my $layout = $self->{layout}; 2609 my $layout = $self->{layout};
2526 2610
2611 $layout->set_font ($self->{font}) if $self->{font};
2612 $layout->set_foreground (@{$para->{fg}});
2527 $layout->set_height ($self->{fontsize} * $::FONTSIZE); 2613 $layout->set_height ($self->{fontsize} * $::FONTSIZE);
2528 $layout->set_width ($self->{children}[0]{w} - $indent); 2614 $layout->set_width ($self->{children}[0]{w} - $para->{indent});
2529 $layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent}); 2615 $layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2530 $layout->set_markup ($text); 2616 $layout->set_markup ($para->{markup});
2617
2618 $layout->set_shapes (
2619 map
2620 +(0, $_->baseline_shift +$_->{padding_y} - $_->{h}, $_->{w}, $_->{h}),
2621 @{$para->{widget}}
2531 2622 );
2623
2532 $layout->size 2624 $layout
2533} 2625}
2534 2626
2535sub reflow { 2627sub reflow {
2536 my ($self) = @_; 2628 my ($self) = @_;
2537 2629
… …
2546 $self->{children}[1]->set_value ($offset); 2638 $self->{children}[1]->set_value ($offset);
2547} 2639}
2548 2640
2549sub clear { 2641sub clear {
2550 my ($self) = @_; 2642 my ($self) = @_;
2643
2644 my (undef, undef, @other) = @{ $self->{children} };
2645 $self->remove ($_) for @other;
2551 2646
2552 $self->{par} = []; 2647 $self->{par} = [];
2553 $self->{height} = 0; 2648 $self->{height} = 0;
2554 $self->{children}[1]->set_range ([0, 0, 0, 1, 1]); 2649 $self->{children}[1]->set_range ([0, 0, 0, 1, 1]);
2555} 2650}
2556 2651
2557sub add_paragraph { 2652sub add_paragraph {
2558 my ($self, $color, $text, $indent) = @_; 2653 my ($self, $color, $para, $indent) = @_;
2559 2654
2560 for my $line (split /\n/, $text) { 2655 my ($text, @w) = ref $para ? @$para : $para;
2561 my ($w, $h) = $self->text_size ($line); 2656
2562 $self->{height} += $h; 2657 $para = {
2563 push @{$self->{par}}, [$w + $indent, $h, $color, $indent, $line]; 2658 w => 1e10,
2659 wrapped => 1,
2660 fg => $color,
2661 indent => $indent,
2662 markup => $text,
2663 widget => \@w,
2564 } 2664 };
2565 2665
2566 $self->{children}[1]->set_range ([$self->{height}, 0, $self->{height}, $self->{h}, 1]); 2666 $self->add (@w) if @w;
2667 push @{$self->{par}}, $para;
2668
2669 $self->{need_reflow}++;
2670 $self->update;
2671}
2672
2673sub scroll_to_bottom {
2674 my ($self) = @_;
2675
2676 $self->{scroll_to_bottom} = 1;
2677 $self->update;
2567} 2678}
2568 2679
2569sub update { 2680sub update {
2570 my ($self) = @_; 2681 my ($self) = @_;
2571 2682
… …
2579 my ($W, $H) = @{$self->{children}[0]}{qw(w h)}; 2690 my ($W, $H) = @{$self->{children}[0]}{qw(w h)};
2580 2691
2581 if (delete $self->{need_reflow}) { 2692 if (delete $self->{need_reflow}) {
2582 my $height = 0; 2693 my $height = 0;
2583 2694
2584 my $layout = $self->{layout};
2585
2586 $layout->set_height ($self->{fontsize} * $::FONTSIZE);
2587
2588 for (@{$self->{par}}) { 2695 for my $para (@{$self->{par}}) {
2589 if (1 || $_->[0] >= $W) { # TODO: works,but needs reconfigure etc. support 2696 if ($para->{w} != $W && ($para->{wrapped} || $para->{w} > $W)) {
2590 $layout->set_width ($W - $_->[3]); 2697 my $layout = $self->get_layout ($para);
2591 $layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2592 $layout->set_markup ($_->[4]);
2593 my ($w, $h) = $layout->size; 2698 my ($w, $h) = $layout->size;
2594 $_->[0] = $w + $_->[3]; 2699
2595 $_->[1] = $h; 2700 $para->{w} = $w + $para->{indent};
2701 $para->{h} = $h;
2702 $para->{wrapped} = $layout->has_wrapped;
2596 } 2703 }
2597 2704
2598 $height += $_->[1]; 2705 $height += $para->{h};
2599 } 2706 }
2600 2707
2601 $self->{height} = $height; 2708 $self->{height} = $height;
2602 2709
2603 $self->{children}[1]->set_range ([$height, 0, $height, $H, 1]); 2710 $self->{children}[1]->set_range ([$self->{children}[1]{range}[0], 0, $height, $H, 1]);
2604 2711
2605 delete $self->{texture}; 2712 delete $self->{texture};
2713 }
2714
2715 if (delete $self->{scroll_to_bottom}) {
2716 $self->{children}[1]->set_value (1e10);
2606 } 2717 }
2607 2718
2608 $self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub { 2719 $self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub {
2609 glClearColor 0, 0, 0, 0; 2720 glClearColor 0, 0, 0, 0;
2610 glClear GL_COLOR_BUFFER_BIT; 2721 glClear GL_COLOR_BUFFER_BIT;
… …
2614 my $y0 = $top; 2725 my $y0 = $top;
2615 my $y1 = $top + $H; 2726 my $y1 = $top + $H;
2616 2727
2617 my $y = 0; 2728 my $y = 0;
2618 2729
2619 my $layout = $self->{layout};
2620
2621 $layout->set_font ($self->{font}) if $self->{font};
2622
2623 glEnable GL_BLEND; 2730 glEnable GL_BLEND;
2624 #TODO# not correct in windows where rgba is forced off 2731 #TODO# not correct in windows where rgba is forced off
2625 glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA; 2732 glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2626 2733
2627 for my $par (@{$self->{par}}) { 2734 for my $para (@{$self->{par}}) {
2628 my $h = $par->[1]; 2735 my $h = $para->{h};
2629 2736
2630 if ($y0 < $y + $h && $y < $y1) { 2737 if ($y0 < $y + $h && $y < $y1) {
2631 $layout->set_foreground (@{ $par->[2] }); 2738
2632 $layout->set_width ($W - $par->[3]); 2739 my $layout = $self->get_layout ($para);
2633 $layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2634 $layout->set_markup ($par->[4]);
2635 2740
2636 my ($w, $h, $data, $format, $internalformat) = $layout->render; 2741 my ($w, $h, $data, $format, $internalformat) = $layout->render;
2637 2742
2638 glRasterPos $par->[3], $y - $y0; 2743 glRasterPos $para->{indent}, $y - $y0;
2639 glDrawPixels $w, $h, $format, GL_UNSIGNED_BYTE, $data; 2744 glDrawPixels $w, $h, $format, GL_UNSIGNED_BYTE, $data;
2745
2746 if (my @w = @{ $para->{widget} }) {
2747 my @s = $layout->get_shapes;
2748
2749 glDisable GL_BLEND;
2750 for (@w) {
2751 my ($dx, $dy) = splice @s, 0, 2, ();
2752
2753 $_->{x} = $dx + $para->{indent};
2754 $_->{y} = $dy + $y - $y0;
2755
2756 $_->draw;
2757 }
2758 glEnable GL_BLEND;
2759 glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2760 }
2640 } 2761 }
2641 2762
2642 $y += $h; 2763 $y += $h;
2643 } 2764 }
2644 2765
2645 glDisable GL_BLEND; 2766 glDisable GL_BLEND;
2646 }; 2767 };
2647 }); 2768 });
2769}
2770
2771sub reconfigure {
2772 my ($self) = @_;
2773
2774 $self->SUPER::reconfigure;
2775
2776 $_->{w} = 1e10 for @{ $self->{par} };
2777 $self->reflow;
2648} 2778}
2649 2779
2650sub _draw { 2780sub _draw {
2651 my ($self) = @_; 2781 my ($self) = @_;
2652 2782
… …
2655 glColor 0, 0, 0, 1; 2785 glColor 0, 0, 0, 1;
2656 $self->{texture}->draw_quad_alpha_premultiplied (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h}); 2786 $self->{texture}->draw_quad_alpha_premultiplied (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});
2657 glDisable GL_TEXTURE_2D; 2787 glDisable GL_TEXTURE_2D;
2658 2788
2659 $self->{children}[1]->draw; 2789 $self->{children}[1]->draw;
2660
2661} 2790}
2662 2791
2663############################################################################# 2792#############################################################################
2664 2793
2665package CFClient::UI::Animator; 2794package CFClient::UI::Animator;
… …
2774 my ($w, $h) = @{$self->child}{qw(req_w req_h)}; 2903 my ($w, $h) = @{$self->child}{qw(req_w req_h)};
2775 2904
2776 ($w + 4, $h + 4) 2905 ($w + 4, $h + 4)
2777} 2906}
2778 2907
2779sub size_allocate { 2908sub invoke_size_allocate {
2780 my ($self, $w, $h) = @_; 2909 my ($self, $w, $h) = @_;
2781 2910
2782 $self->SUPER::size_allocate ($w - 4, $h - 4); 2911 $self->SUPER::invoke_size_allocate ($w - 4, $h - 4)
2783} 2912}
2784 2913
2785sub visibility_change { 2914sub invoke_visibility_change {
2786 my ($self, $visible) = @_; 2915 my ($self, $visible) = @_;
2787 2916
2788 return unless $visible; 2917 return unless $visible;
2789 2918
2790 $self->{root}->on_post_alloc ("move_$self" => sub { 2919 $self->{root}->on_post_alloc ("move_$self" => sub {
… …
2897 $tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h}); 3026 $tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
2898 glDisable GL_TEXTURE_2D; 3027 glDisable GL_TEXTURE_2D;
2899 } 3028 }
2900} 3029}
2901 3030
2902sub DESTROY { 3031sub destroy {
2903 my ($self) = @_; 3032 my ($self) = @_;
2904 3033
2905 $self->{timer}->cancel 3034 $self->{timer}->cancel
2906 if $self->{timer}; 3035 if $self->{timer};
2907 3036
2908 $self->SUPER::DESTROY; 3037 $self->SUPER::destroy;
2909} 3038}
2910 3039
2911############################################################################# 3040#############################################################################
2912 3041
2913package CFClient::UI::Buttonbar; 3042package CFClient::UI::Buttonbar;
… …
2957 3086
2958# popup given the event (must be a mouse button down event currently) 3087# popup given the event (must be a mouse button down event currently)
2959sub popup { 3088sub popup {
2960 my ($self, $ev) = @_; 3089 my ($self, $ev) = @_;
2961 3090
2962 $self->_emit ("popdown"); 3091 $self->emit ("popdown");
2963 3092
2964 # maybe save $GRAB? must be careful about events... 3093 # maybe save $GRAB? must be careful about events...
2965 $GRAB = $self; 3094 $GRAB = $self;
2966 $self->{button} = $ev->{button}; 3095 $self->{button} = $ev->{button};
2967 3096
2968 $self->show; 3097 $self->show;
2969 $self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5); 3098 $self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);
2970} 3099}
2971 3100
2972sub mouse_motion { 3101sub invoke_mouse_motion {
2973 my ($self, $ev, $x, $y) = @_; 3102 my ($self, $ev, $x, $y) = @_;
2974 3103
2975 # TODO: should use vbox->find_widget or so 3104 # TODO: should use vbox->find_widget or so
2976 $HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y}); 3105 $HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});
2977 $self->{hover} = $self->{item}{$HOVER}; 3106 $self->{hover} = $self->{item}{$HOVER};
2978 3107
2979 0 3108 0
2980} 3109}
2981 3110
2982sub button_up { 3111sub invoke_button_up {
2983 my ($self, $ev, $x, $y) = @_; 3112 my ($self, $ev, $x, $y) = @_;
2984 3113
2985 if ($ev->{button} == $self->{button}) { 3114 if ($ev->{button} == $self->{button}) {
2986 undef $GRAB; 3115 undef $GRAB;
2987 $self->hide; 3116 $self->hide;
2988 3117
2989 $self->_emit ("popdown"); 3118 $self->emit ("popdown");
2990 $self->{hover}[1]->() if $self->{hover}; 3119 $self->{hover}[1]->() if $self->{hover};
2991 } else { 3120 } else {
2992 return 0 3121 return 0
2993 } 3122 }
2994 3123
… …
3031 : $self->{children}[$page_or_widget]; 3160 : $self->{children}[$page_or_widget];
3032 3161
3033 $self->{current} = $widget; 3162 $self->{current} = $widget;
3034 $self->{current}->configure (0, 0, $self->{w}, $self->{h}); 3163 $self->{current}->configure (0, 0, $self->{w}, $self->{h});
3035 3164
3036 $self->_emit (page_changed => $self->{current}); 3165 $self->emit (page_changed => $self->{current});
3037 3166
3038 $self->realloc; 3167 $self->realloc;
3039} 3168}
3040 3169
3041sub visible_children { 3170sub visible_children {
… …
3046 my ($self) = @_; 3175 my ($self) = @_;
3047 3176
3048 $self->{current}->size_request 3177 $self->{current}->size_request
3049} 3178}
3050 3179
3051sub size_allocate { 3180sub invoke_size_allocate {
3052 my ($self, $w, $h) = @_; 3181 my ($self, $w, $h) = @_;
3053 3182
3054 $self->{current}->configure (0, 0, $w, $h); 3183 $self->{current}->configure (0, 0, $w, $h);
3184
3185 1
3055} 3186}
3056 3187
3057sub _draw { 3188sub _draw {
3058 my ($self) = @_; 3189 my ($self) = @_;
3059 3190
… …
3098 3229
3099sub set_current_page { 3230sub set_current_page {
3100 my ($self, $page) = @_; 3231 my ($self, $page) = @_;
3101 3232
3102 $self->{multiplexer}->set_current_page ($page); 3233 $self->{multiplexer}->set_current_page ($page);
3103 $self->_emit (page_changed => $self->{multiplexer}{current}); 3234 $self->emit (page_changed => $self->{multiplexer}{current});
3104} 3235}
3105 3236
3106############################################################################# 3237#############################################################################
3107 3238
3108package CFClient::UI::Combobox; 3239package CFClient::UI::Combobox;
… …
3123 $self->_set_value ($self->{value}); 3254 $self->_set_value ($self->{value});
3124 3255
3125 $self 3256 $self
3126} 3257}
3127 3258
3128sub button_down { 3259sub invoke_button_down {
3129 my ($self, $ev) = @_; 3260 my ($self, $ev) = @_;
3130 3261
3131 my @menu_items; 3262 my @menu_items;
3132 3263
3133 for (@{ $self->{options} }) { 3264 for (@{ $self->{options} }) {
… …
3154 my ($self, $value) = @_; 3285 my ($self, $value) = @_;
3155 3286
3156 return unless $self->{value} ne $value; 3287 return unless $self->{value} ne $value;
3157 3288
3158 $self->_set_value ($value); 3289 $self->_set_value ($value);
3159 $self->_emit (changed => $value); 3290 $self->emit (changed => $value);
3160} 3291}
3161 3292
3162############################################################################# 3293#############################################################################
3163 3294
3164package CFClient::UI::Statusbox; 3295package CFClient::UI::Statusbox;
… …
3263 $item->{count}++; 3394 $item->{count}++;
3264 } else { 3395 } else {
3265 $item->{count} = 1; 3396 $item->{count} = 1;
3266 $item->{text} = $item->{tooltip} = $text; 3397 $item->{text} = $item->{tooltip} = $text;
3267 } 3398 }
3268 $item->{id} = ++$self->{id}; 3399 $item->{id} += 0.2;#d#
3269 $item->{timeout} = $timeout; 3400 $item->{timeout} = $timeout;
3270 delete $item->{label}; 3401 delete $item->{label};
3271 } else { 3402 } else {
3272 $self->{item}{$group} = { 3403 $self->{item}{$group} = {
3273 id => ++$self->{id}, 3404 id => ++$self->{id},
… …
3292 3423
3293 $self->reorder; 3424 $self->reorder;
3294 $self->SUPER::reconfigure; 3425 $self->SUPER::reconfigure;
3295} 3426}
3296 3427
3297sub DESTROY { 3428sub destroy {
3298 my ($self) = @_; 3429 my ($self) = @_;
3299 3430
3300 $self->{timer}->cancel; 3431 $self->{timer}->cancel;
3301 3432
3302 $self->SUPER::DESTROY; 3433 $self->SUPER::destroy;
3303} 3434}
3304 3435
3305############################################################################# 3436#############################################################################
3306 3437
3307package CFClient::UI::Inventory; 3438package CFClient::UI::Inventory;
… …
3339 $self->{child}->add (0, $row, $item->{face_widget}); 3470 $self->{child}->add (0, $row, $item->{face_widget});
3340 $self->{child}->add (1, $row, $item->{desc_widget}); 3471 $self->{child}->add (1, $row, $item->{desc_widget});
3341 $self->{child}->add (2, $row, $item->{weight_widget}); 3472 $self->{child}->add (2, $row, $item->{weight_widget});
3342 3473
3343 $row++; 3474 $row++;
3344 }
3345}
3346
3347#############################################################################
3348
3349package CFClient::UI::BindEditor;
3350
3351our @ISA = CFClient::UI::FancyFrame::;
3352
3353sub new {
3354 my $class = shift;
3355
3356 my $self = $class->SUPER::new (binding => [], commands => [], @_);
3357
3358 $self->add (my $vb = new CFClient::UI::VBox);
3359
3360
3361 $vb->add ($self->{rec_btn} = new CFClient::UI::Button
3362 text => "start recording",
3363 tooltip => "Start/Stops recording of actions."
3364 ."All subsequent actions after the recording started will be captured."
3365 ."The actions are displayed after the record was stopped."
3366 ."To bind the action you have to click on the 'Bind' button",
3367 on_activate => sub {
3368 unless ($self->{recording}) {
3369 $self->start;
3370 } else {
3371 $self->stop;
3372 }
3373 });
3374
3375 $vb->add (new CFClient::UI::Label text => "Actions:");
3376 $vb->add ($self->{cmdbox} = new CFClient::UI::VBox);
3377
3378 $vb->add (new CFClient::UI::Label text => "Bound to: ");
3379 $vb->add (my $hb = new CFClient::UI::HBox);
3380 $hb->add ($self->{keylbl} = new CFClient::UI::Label expand => 1);
3381 $hb->add (new CFClient::UI::Button
3382 text => "bind",
3383 tooltip => "This opens a query where you have to press the key combination to bind the recorded actions",
3384 on_activate => sub {
3385 $self->ask_for_bind;
3386 });
3387
3388 $vb->add (my $hb = new CFClient::UI::HBox);
3389 $hb->add (new CFClient::UI::Button
3390 text => "ok",
3391 expand => 1,
3392 tooltip => "This closes the binding editor and saves the binding",
3393 on_activate => sub {
3394 $self->hide;
3395 $self->commit;
3396 });
3397
3398 $hb->add (new CFClient::UI::Button
3399 text => "cancel",
3400 expand => 1,
3401 tooltip => "This closes the binding editor without saving",
3402 on_activate => sub {
3403 $self->hide;
3404 $self->{binding_cancel}->()
3405 if $self->{binding_cancel};
3406 });
3407
3408 $self->update_binding_widgets;
3409
3410 $self
3411}
3412
3413sub commit {
3414 my ($self) = @_;
3415 my ($mod, $sym, $cmds) = $self->get_binding;
3416 if ($sym != 0 && @$cmds > 0) {
3417 $::STATUSBOX->add ("Bound actions to '".CFClient::Binder::keycombo_to_name ($mod, $sym)
3418 ."'. Don't forget 'Save Config'!");
3419 $self->{binding_change}->($mod, $sym, $cmds)
3420 if $self->{binding_change};
3421 } else {
3422 $::STATUSBOX->add ("No action bound, no key or action specified!");
3423 $self->{binding_cancel}->()
3424 if $self->{binding_cancel};
3425 }
3426}
3427
3428sub start {
3429 my ($self) = @_;
3430
3431 $self->{rec_btn}->set_text ("stop recording");
3432 $self->{recording} = 1;
3433 $self->clear_command_list;
3434 $::CONN->start_record if $::CONN;
3435}
3436
3437sub stop {
3438 my ($self) = @_;
3439
3440 $self->{rec_btn}->set_text ("start recording");
3441 $self->{recording} = 0;
3442
3443 my $rec;
3444 $rec = $::CONN->stop_record if $::CONN;
3445 return unless ref $rec eq 'ARRAY';
3446 $self->set_command_list ($rec);
3447}
3448
3449
3450sub ask_for_bind_and_commit {
3451 my ($self) = @_;
3452 $self->ask_for_bind (1);
3453}
3454
3455sub ask_for_bind {
3456 my ($self, $commit) = @_;
3457
3458 CFClient::Binder::open_binding_dialog (sub {
3459 my ($mod, $sym) = @_;
3460 $self->{binding} = [$mod, $sym]; # XXX: how to stop that memleak?
3461 $self->update_binding_widgets;
3462 $self->commit if $commit;
3463 });
3464}
3465
3466# $mod and $sym are the modifiers and key symbol
3467# $cmds is a array ref of strings (the commands)
3468# $cb is the callback that is executed on OK
3469# $ccb is the callback that is executed on CANCEL and
3470# when the binding was unsuccessful on OK
3471sub set_binding {
3472 my ($self, $mod, $sym, $cmds, $cb, $ccb) = @_;
3473
3474 $self->clear_command_list;
3475 $self->{recording} = 0;
3476 $self->{rec_btn}->set_text ("start recording");
3477
3478 $self->{binding} = [$mod, $sym];
3479 $self->{commands} = $cmds;
3480
3481 $self->{binding_change} = $cb;
3482 $self->{binding_cancel} = $ccb;
3483
3484 $self->update_binding_widgets;
3485}
3486
3487# this is a shortcut method that asks for a binding
3488# and then just binds it.
3489sub do_quick_binding {
3490 my ($self, $cmds) = @_;
3491 $self->set_binding (undef, undef, $cmds, sub {
3492 $::CFG->{bindings}->{$_[0]}->{$_[1]} = $_[2];
3493 });
3494 $self->ask_for_bind (1);
3495}
3496
3497sub update_binding_widgets {
3498 my ($self) = @_;
3499 my ($mod, $sym, $cmds) = $self->get_binding;
3500 $self->{keylbl}->set_text (CFClient::Binder::keycombo_to_name ($mod, $sym));
3501 $self->set_command_list ($cmds);
3502}
3503
3504sub get_binding {
3505 my ($self) = @_;
3506 return (
3507 $self->{binding}->[0],
3508 $self->{binding}->[1],
3509 [ grep { defined $_ } @{$self->{commands}} ]
3510 );
3511}
3512
3513sub clear_command_list {
3514 my ($self) = @_;
3515 $self->{cmdbox}->clear ();
3516}
3517
3518sub set_command_list {
3519 my ($self, $cmds) = @_;
3520
3521 $self->{cmdbox}->clear ();
3522 $self->{commands} = $cmds;
3523
3524 my $idx = 0;
3525
3526 for (@$cmds) {
3527 $self->{cmdbox}->add (my $hb = new CFClient::UI::HBox);
3528
3529 my $i = $idx;
3530 $hb->add (new CFClient::UI::Label text => $_);
3531 $hb->add (new CFClient::UI::Button
3532 text => "delete",
3533 tooltip => "Deletes the action from the record",
3534 on_activate => sub {
3535 $self->{cmdbox}->remove ($hb);
3536 $cmds->[$i] = undef;
3537 });
3538
3539
3540 $idx++
3541 } 3475 }
3542} 3476}
3543 3477
3544############################################################################# 3478#############################################################################
3545 3479
… …
3574 my ($self) = @_; 3508 my ($self) = @_;
3575 3509
3576 $CFClient::UI::ROOT->on_refresh ($self => sub { 3510 $CFClient::UI::ROOT->on_refresh ($self => sub {
3577 $self->clear; 3511 $self->clear;
3578 3512
3513 return unless $::CONN;
3514
3579 $self->add (1, 0, new CFClient::UI::Label text => "Spell Name", @TOOLTIP_NAME); 3515 $self->add (1, 0, new CFClient::UI::Label text => "Spell Name", @TOOLTIP_NAME);
3580 $self->add (2, 0, new CFClient::UI::Label text => "Skill", @TOOLTIP_SKILL); 3516 $self->add (2, 0, new CFClient::UI::Label text => "Skill", @TOOLTIP_SKILL);
3581 $self->add (3, 0, new CFClient::UI::Label text => "Lvl" , @TOOLTIP_LVL); 3517 $self->add (3, 0, new CFClient::UI::Label text => "Lvl" , @TOOLTIP_LVL);
3582 $self->add (4, 0, new CFClient::UI::Label text => "Sp/Gp", @TOOLTIP_SP); 3518 $self->add (4, 0, new CFClient::UI::Label text => "Sp/Gp", @TOOLTIP_SP);
3583 $self->add (5, 0, new CFClient::UI::Label text => "Dmg" , @TOOLTIP_DMG); 3519 $self->add (5, 0, new CFClient::UI::Label text => "Dmg" , @TOOLTIP_DMG);
… …
3597 } elsif ($ev->{button} == 2) { 3533 } elsif ($ev->{button} == 2) {
3598 $::CONN->user_send ("invoke $spell->{name}"); 3534 $::CONN->user_send ("invoke $spell->{name}");
3599 } elsif ($ev->{button} == 3) { 3535 } elsif ($ev->{button} == 3) {
3600 (new CFClient::UI::Menu 3536 (new CFClient::UI::Menu
3601 items => [ 3537 items => [
3602 ["bind <i>cast $spell->{name}</i> to a key" => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) }], 3538 ["bind <i>cast $spell->{name}</i> to a key" => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) }],
3603 ["bind <i>invoke $spell->{name}</i> to a key" => sub { $::BIND_EDITOR->do_quick_binding (["invoke $spell->{name}"]) }], 3539 ["bind <i>invoke $spell->{name}</i> to a key" => sub { $::BIND_EDITOR->do_quick_binding (["invoke $spell->{name}"]) }],
3604 ], 3540 ],
3605 )->popup ($ev); 3541 )->popup ($ev);
3606 } else { 3542 } else {
3607 return 0; 3543 return 0;
… …
3652 3588
3653 delete $self->{spell}->{$spell->{name}}; 3589 delete $self->{spell}->{$spell->{name}};
3654 $self->rebuild_spell_list; 3590 $self->rebuild_spell_list;
3655} 3591}
3656 3592
3593sub clear_spells {
3594 my ($self) = @_;
3595
3596 $self->{spell} = {};
3597 $self->rebuild_spell_list;
3598}
3599
3657############################################################################# 3600#############################################################################
3658 3601
3659package CFClient::UI::Root; 3602package CFClient::UI::Root;
3660 3603
3661our @ISA = CFClient::UI::Container::; 3604our @ISA = CFClient::UI::Container::;
… …
3695 $coord = $max - $size if $coord > $max - $size; 3638 $coord = $max - $size if $coord > $max - $size;
3696 3639
3697 int $coord + 0.5 3640 int $coord + 0.5
3698} 3641}
3699 3642
3700sub size_allocate { 3643sub invoke_size_allocate {
3701 my ($self, $w, $h) = @_; 3644 my ($self, $w, $h) = @_;
3702 3645
3703 for my $child ($self->children) { 3646 for my $child ($self->children) {
3704 my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)}; 3647 my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};
3705 3648
… …
3709 $X = _to_pixel $X, $W, $self->{w}; 3652 $X = _to_pixel $X, $W, $self->{w};
3710 $Y = _to_pixel $Y, $H, $self->{h}; 3653 $Y = _to_pixel $Y, $H, $self->{h};
3711 3654
3712 $child->configure ($X, $Y, $W, $H); 3655 $child->configure ($X, $Y, $W, $H);
3713 } 3656 }
3657
3658 1
3714} 3659}
3715 3660
3716sub coord2local { 3661sub coord2local {
3717 my ($self, $x, $y) = @_; 3662 my ($self, $x, $y) = @_;
3718 3663

Diff Legend

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