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.300 by root, Wed Jun 7 22:06:43 2006 UTC vs.
Revision 1.316 by root, Sun Jul 2 13:57:58 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
1621 $self->{fontsize} = $fontsize; 1658 $self->{fontsize} = $fontsize;
1659 delete $self->{size_req};
1622 delete $self->{texture}; 1660 delete $self->{texture};
1623 1661
1624 $self->realloc; 1662 $self->realloc;
1625} 1663}
1626 1664
… …
1713 1751
1714 $text =~ s/./*/g if $self->{hidden}; 1752 $text =~ s/./*/g if $self->{hidden};
1715 $self->{layout}->set_text ("$text "); 1753 $self->{layout}->set_text ("$text ");
1716 delete $self->{size_req}; 1754 delete $self->{size_req};
1717 1755
1718 $self->_emit (changed => $self->{text}); 1756 $self->emit (changed => $self->{text});
1719 1757
1720 $self->realloc; 1758 $self->realloc;
1721 $self->update; 1759 $self->update;
1722} 1760}
1723 1761
… …
1738 my ($w, $h) = $self->SUPER::size_request; 1776 my ($w, $h) = $self->SUPER::size_request;
1739 1777
1740 ($w + 1, $h) # add 1 for cursor 1778 ($w + 1, $h) # add 1 for cursor
1741} 1779}
1742 1780
1743sub key_down { 1781sub invoke_key_down {
1744 my ($self, $ev) = @_; 1782 my ($self, $ev) = @_;
1745 1783
1746 my $mod = $ev->{mod}; 1784 my $mod = $ev->{mod};
1747 my $sym = $ev->{sym}; 1785 my $sym = $ev->{sym};
1748 my $uni = $ev->{unicode}; 1786 my $uni = $ev->{unicode};
… …
1760 } elsif ($sym == CFClient::SDLK_HOME) { 1798 } elsif ($sym == CFClient::SDLK_HOME) {
1761 $self->{cursor} = 0; 1799 $self->{cursor} = 0;
1762 } elsif ($sym == CFClient::SDLK_END) { 1800 } elsif ($sym == CFClient::SDLK_END) {
1763 $self->{cursor} = length $text; 1801 $self->{cursor} = length $text;
1764 } elsif ($uni == 27) { 1802 } elsif ($uni == 27) {
1765 $self->_emit ('escape'); 1803 $self->emit ('escape');
1766 } elsif ($uni) { 1804 } elsif ($uni) {
1767 substr $text, $self->{cursor}++, 0, chr $uni; 1805 substr $text, $self->{cursor}++, 0, chr $uni;
1768 } else { 1806 } else {
1769 return 0; 1807 return 0;
1770 } 1808 }
… …
1774 $self->realloc; 1812 $self->realloc;
1775 1813
1776 1 1814 1
1777} 1815}
1778 1816
1779sub focus_in { 1817sub invoke_focus_in {
1780 my ($self) = @_; 1818 my ($self) = @_;
1781 1819
1782 $self->{last_activity} = $::NOW; 1820 $self->{last_activity} = $::NOW;
1783 1821
1784 $self->SUPER::focus_in; 1822 $self->SUPER::invoke_focus_in
1785} 1823}
1786 1824
1787sub button_down { 1825sub invoke_button_down {
1788 my ($self, $ev, $x, $y) = @_; 1826 my ($self, $ev, $x, $y) = @_;
1789 1827
1790 $self->SUPER::button_down ($ev, $x, $y); 1828 $self->SUPER::invoke_button_down ($ev, $x, $y);
1791 1829
1792 my $idx = $self->{layout}->xy_to_index ($x, $y); 1830 my $idx = $self->{layout}->xy_to_index ($x, $y);
1793 1831
1794 # byte-index to char-index 1832 # byte-index to char-index
1795 my $text = $self->{text}; 1833 my $text = $self->{text};
… …
1800 $self->update; 1838 $self->update;
1801 1839
1802 1 1840 1
1803} 1841}
1804 1842
1805sub mouse_motion { 1843sub invoke_mouse_motion {
1806 my ($self, $ev, $x, $y) = @_; 1844 my ($self, $ev, $x, $y) = @_;
1807# printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d# 1845# printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d#
1808 1846
1809 0 1847 1
1810} 1848}
1811 1849
1812sub _draw { 1850sub _draw {
1813 my ($self) = @_; 1851 my ($self) = @_;
1814 1852
… …
1855 1893
1856our @ISA = CFClient::UI::EntryBase::; 1894our @ISA = CFClient::UI::EntryBase::;
1857 1895
1858use CFClient::OpenGL; 1896use CFClient::OpenGL;
1859 1897
1860sub key_down { 1898sub invoke_key_down {
1861 my ($self, $ev) = @_; 1899 my ($self, $ev) = @_;
1862 1900
1863 my $sym = $ev->{sym}; 1901 my $sym = $ev->{sym};
1864 1902
1865 if ($sym == 13) { 1903 if ($sym == 13) {
1866 unshift @{$self->{history}}, 1904 unshift @{$self->{history}},
1867 my $txt = $self->get_text; 1905 my $txt = $self->get_text;
1906
1868 $self->{history_pointer} = -1; 1907 $self->{history_pointer} = -1;
1869 $self->{history_saveback} = ''; 1908 $self->{history_saveback} = '';
1870 $self->_emit (activate => $txt); 1909 $self->emit (activate => $txt);
1871 $self->update; 1910 $self->update;
1872 1911
1873 } elsif ($sym == CFClient::SDLK_UP) { 1912 } elsif ($sym == CFClient::SDLK_UP) {
1874 if ($self->{history_pointer} < 0) { 1913 if ($self->{history_pointer} < 0) {
1875 $self->{history_saveback} = $self->get_text; 1914 $self->{history_saveback} = $self->get_text;
… …
1891 } else { 1930 } else {
1892 $self->set_text ($self->{history_saveback}); 1931 $self->set_text ($self->{history_saveback});
1893 } 1932 }
1894 1933
1895 } else { 1934 } else {
1896 return $self->SUPER::key_down ($ev) 1935 return $self->SUPER::invoke_key_down ($ev)
1897 } 1936 }
1898 1937
1899 1 1938 1
1900} 1939}
1901 1940
… …
1925 can_events => 1, 1964 can_events => 1,
1926 @_ 1965 @_
1927 ) 1966 )
1928} 1967}
1929 1968
1930sub activate { }
1931
1932sub button_up { 1969sub invoke_button_up {
1933 my ($self, $ev, $x, $y) = @_; 1970 my ($self, $ev, $x, $y) = @_;
1934 1971
1935 $self->emit ("activate") 1972 $self->emit ("activate")
1936 if $x >= 0 && $x < $self->{w} 1973 if $x >= 0 && $x < $self->{w}
1937 && $y >= 0 && $y < $self->{h}; 1974 && $y >= 0 && $y < $self->{h};
… …
1951 $tex[0]->draw_quad_alpha (0, 0, $self->{w}, $self->{h}); 1988 $tex[0]->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
1952 1989
1953 glDisable GL_TEXTURE_2D; 1990 glDisable GL_TEXTURE_2D;
1954 1991
1955 $self->SUPER::_draw; 1992 $self->SUPER::_draw;
1993}
1994
1995#############################################################################
1996
1997package CFClient::UI::ImageButton;
1998
1999our @ISA = CFClient::UI::Image::;
2000
2001use CFClient::OpenGL;
2002
2003my %textures;
2004
2005sub new {
2006 my $class = shift;
2007
2008 my $self = $class->SUPER::new (
2009 padding_x => 4,
2010 padding_y => 4,
2011 fg => [1, 1, 1],
2012 active_fg => [0, 0, 1],
2013 can_hover => 1,
2014 align => 0,
2015 valign => 0,
2016 can_events => 1,
2017 @_
2018 );
2019}
2020
2021sub invoke_button_up {
2022 my ($self, $ev, $x, $y) = @_;
2023
2024 $self->emit ("activate")
2025 if $x >= 0 && $x < $self->{w}
2026 && $y >= 0 && $y < $self->{h};
2027
2028 1
1956} 2029}
1957 2030
1958############################################################################# 2031#############################################################################
1959 2032
1960package CFClient::UI::CheckBox; 2033package CFClient::UI::CheckBox;
… …
1987 my ($self) = @_; 2060 my ($self) = @_;
1988 2061
1989 (6) x 2 2062 (6) x 2
1990} 2063}
1991 2064
1992sub button_down { 2065sub invoke_button_down {
1993 my ($self, $ev, $x, $y) = @_; 2066 my ($self, $ev, $x, $y) = @_;
1994 2067
1995 if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x} 2068 if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
1996 && $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) { 2069 && $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
1997 $self->{state} = !$self->{state}; 2070 $self->{state} = !$self->{state};
1998 $self->_emit (changed => $self->{state}); 2071 $self->emit (changed => $self->{state});
1999 } else { 2072 } else {
2000 return 0 2073 return 0
2001 } 2074 }
2002 2075
2003 1 2076 1
… …
2028package CFClient::UI::Image; 2101package CFClient::UI::Image;
2029 2102
2030our @ISA = CFClient::UI::Base::; 2103our @ISA = CFClient::UI::Base::;
2031 2104
2032use CFClient::OpenGL; 2105use CFClient::OpenGL;
2033use Carp qw/confess/;
2034 2106
2035our %loaded_images; 2107our %texture_cache;
2036 2108
2037sub new { 2109sub new {
2038 my $class = shift; 2110 my $class = shift;
2039 2111
2040 my $self = $class->SUPER::new (can_events => 0, @_); 2112 my $self = $class->SUPER::new (
2113 can_events => 0,
2114 @_,
2115 );
2041 2116
2042 $self->{image} or confess "Image has 'image' not set. This is a fatal error!"; 2117 $self->{path}
2118 or Carp::croak "required attribute 'path' not set";
2043 2119
2044 $loaded_images{$self->{image}} ||= 2120 $self->{tex} = $texture_cache{$self->{path}} ||=
2045 new_from_file CFClient::Texture CFClient::find_rcfile $self->{image}, mipmap => 1; 2121 new_from_file CFClient::Texture CFClient::find_rcfile $self->{path}, mipmap => 1;
2046 2122
2047 my $tex = $self->{tex} = $loaded_images{$self->{image}}; 2123 Scalar::Util::weaken $texture_cache{$self->{path}};
2048 2124
2049 Scalar::Util::weaken $loaded_images{$self->{image}}; 2125 $self->{aspect} ||= $self->{tex}{w} / $self->{tex}{h};
2050
2051 $self->{aspect} = $tex->{w} / $tex->{h};
2052 2126
2053 $self 2127 $self
2054} 2128}
2055 2129
2056sub size_request { 2130sub size_request {
2057 my ($self) = @_; 2131 my ($self) = @_;
2058 2132
2059 ($self->{tex}->{w}, $self->{tex}->{h}) 2133 ($self->{tex}{w}, $self->{tex}{h})
2060} 2134}
2061 2135
2062sub _draw { 2136sub _draw {
2063 my ($self) = @_; 2137 my ($self) = @_;
2064 2138
… …
2300 $self->update; 2374 $self->update;
2301 2375
2302 $self 2376 $self
2303} 2377}
2304 2378
2305sub changed { }
2306
2307sub set_range { 2379sub set_range {
2308 my ($self, $range) = @_; 2380 my ($self, $range) = @_;
2309 2381
2310 ($range, $self->{range}) = ($self->{range}, $range); 2382 ($range, $self->{range}) = ($self->{range}, $range);
2311 2383
… …
2331 if $unit; 2403 if $unit;
2332 2404
2333 @{$self->{range}} = ($value, $lo, $hi, $page, $unit); 2405 @{$self->{range}} = ($value, $lo, $hi, $page, $unit);
2334 2406
2335 if ($value != $old_value) { 2407 if ($value != $old_value) {
2336 $self->_emit (changed => $value); 2408 $self->emit (changed => $value);
2337 $self->update; 2409 $self->update;
2338 } 2410 }
2339} 2411}
2340 2412
2341sub size_request { 2413sub size_request {
2342 my ($self) = @_; 2414 my ($self) = @_;
2343 2415
2344 ($self->{req_w}, $self->{req_h}) 2416 ($self->{req_w}, $self->{req_h})
2345} 2417}
2346 2418
2347sub button_down { 2419sub invoke_button_down {
2348 my ($self, $ev, $x, $y) = @_; 2420 my ($self, $ev, $x, $y) = @_;
2349 2421
2350 $self->SUPER::button_down ($ev, $x, $y); 2422 $self->SUPER::invoke_button_down ($ev, $x, $y);
2351 2423
2352 $self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x]; 2424 $self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];
2353 2425
2354 $self->mouse_motion ($ev, $x, $y) 2426 $self->invoke_mouse_motion ($ev, $x, $y)
2355} 2427}
2356 2428
2357sub mouse_motion { 2429sub invoke_mouse_motion {
2358 my ($self, $ev, $x, $y) = @_; 2430 my ($self, $ev, $x, $y) = @_;
2359 2431
2360 if ($GRAB == $self) { 2432 if ($GRAB == $self) {
2361 my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w}); 2433 my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w});
2362 2434
… …
2504 2576
2505 $self->{fontsize} = $fontsize; 2577 $self->{fontsize} = $fontsize;
2506 $self->reflow; 2578 $self->reflow;
2507} 2579}
2508 2580
2581sub size_request {
2582 my ($self) = @_;
2583
2584 my ($empty, $slider) = @{ $self->{children} };
2585
2586 local $self->{children} = [$empty, $slider];
2587 $self->SUPER::size_request
2588}
2589
2509sub size_allocate { 2590sub invoke_size_allocate {
2510 my ($self, $w, $h) = @_; 2591 my ($self, $w, $h) = @_;
2511 2592
2512 $self->SUPER::size_allocate ($w, $h); 2593 my ($empty, $slider, @other) = @{ $self->{children} };
2594 $_->configure (@$_{qw(x y req_w req_h)}) for @other;
2513 2595
2514 $self->{layout}->set_font ($self->{font}) if $self->{font}; 2596 $self->{layout}->set_font ($self->{font}) if $self->{font};
2515 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE); 2597 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
2516 $self->{layout}->set_width ($self->{children}[0]{w}); 2598 $self->{layout}->set_width ($empty->{w});
2517 $self->{layout}->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent}); 2599 $self->{layout}->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2518 2600
2519 $self->reflow; 2601 $self->reflow;
2520}
2521 2602
2522sub text_size { 2603 local $self->{children} = [$empty, $slider];
2523 my ($self, $text, $indent) = @_; 2604 $self->SUPER::invoke_size_allocate ($w, $h)
2605}
2606
2607sub get_layout {
2608 my ($self, $para) = @_;
2524 2609
2525 my $layout = $self->{layout}; 2610 my $layout = $self->{layout};
2526 2611
2612 $layout->set_font ($self->{font}) if $self->{font};
2613 $layout->set_foreground (@{$para->{fg}});
2527 $layout->set_height ($self->{fontsize} * $::FONTSIZE); 2614 $layout->set_height ($self->{fontsize} * $::FONTSIZE);
2528 $layout->set_width ($self->{children}[0]{w} - $indent); 2615 $layout->set_width ($self->{children}[0]{w} - $para->{indent});
2529 $layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent}); 2616 $layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2530 $layout->set_markup ($text); 2617 $layout->set_markup ($para->{markup});
2618
2619 $layout->set_shapes (
2620 map
2621 +(0, $_->baseline_shift +$_->{padding_y} - $_->{h}, $_->{w}, $_->{h}),
2622 @{$para->{widget}}
2531 2623 );
2624
2532 $layout->size 2625 $layout
2533} 2626}
2534 2627
2535sub reflow { 2628sub reflow {
2536 my ($self) = @_; 2629 my ($self) = @_;
2537 2630
… …
2546 $self->{children}[1]->set_value ($offset); 2639 $self->{children}[1]->set_value ($offset);
2547} 2640}
2548 2641
2549sub clear { 2642sub clear {
2550 my ($self) = @_; 2643 my ($self) = @_;
2644
2645 my (undef, undef, @other) = @{ $self->{children} };
2646 $self->remove ($_) for @other;
2551 2647
2552 $self->{par} = []; 2648 $self->{par} = [];
2553 $self->{height} = 0; 2649 $self->{height} = 0;
2554 $self->{children}[1]->set_range ([0, 0, 0, 1, 1]); 2650 $self->{children}[1]->set_range ([0, 0, 0, 1, 1]);
2555} 2651}
2556 2652
2557sub add_paragraph { 2653sub add_paragraph {
2558 my ($self, $color, $text, $indent) = @_; 2654 my ($self, $color, $para, $indent) = @_;
2559 2655
2560 for my $line (split /\n/, $text) { 2656 my ($text, @w) = ref $para ? @$para : $para;
2561 my ($w, $h) = $self->text_size ($line); 2657
2562 $self->{height} += $h; 2658 $para = {
2563 push @{$self->{par}}, [$w + $indent, $h, $color, $indent, $line]; 2659 w => 1e10,
2660 wrapped => 1,
2661 fg => $color,
2662 indent => $indent,
2663 markup => $text,
2664 widget => \@w,
2564 } 2665 };
2565 2666
2566 $self->{children}[1]->set_range ([$self->{height}, 0, $self->{height}, $self->{h}, 1]); 2667 $self->add (@w) if @w;
2668 push @{$self->{par}}, $para;
2669
2670 $self->{need_reflow}++;
2671 $self->update;
2672}
2673
2674sub scroll_to_bottom {
2675 my ($self) = @_;
2676
2677 $self->{scroll_to_bottom} = 1;
2678 $self->update;
2567} 2679}
2568 2680
2569sub update { 2681sub update {
2570 my ($self) = @_; 2682 my ($self) = @_;
2571 2683
… …
2579 my ($W, $H) = @{$self->{children}[0]}{qw(w h)}; 2691 my ($W, $H) = @{$self->{children}[0]}{qw(w h)};
2580 2692
2581 if (delete $self->{need_reflow}) { 2693 if (delete $self->{need_reflow}) {
2582 my $height = 0; 2694 my $height = 0;
2583 2695
2584 my $layout = $self->{layout};
2585
2586 $layout->set_height ($self->{fontsize} * $::FONTSIZE);
2587
2588 for (@{$self->{par}}) { 2696 for my $para (@{$self->{par}}) {
2589 if (1 || $_->[0] >= $W) { # TODO: works,but needs reconfigure etc. support 2697 if ($para->{w} != $W && ($para->{wrapped} || $para->{w} > $W)) {
2590 $layout->set_width ($W - $_->[3]); 2698 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; 2699 my ($w, $h) = $layout->size;
2594 $_->[0] = $w + $_->[3]; 2700
2595 $_->[1] = $h; 2701 $para->{w} = $w + $para->{indent};
2702 $para->{h} = $h;
2703 $para->{wrapped} = $layout->has_wrapped;
2596 } 2704 }
2597 2705
2598 $height += $_->[1]; 2706 $height += $para->{h};
2599 } 2707 }
2600 2708
2601 $self->{height} = $height; 2709 $self->{height} = $height;
2602 2710
2603 $self->{children}[1]->set_range ([$height, 0, $height, $H, 1]); 2711 $self->{children}[1]->set_range ([$self->{children}[1]{range}[0], 0, $height, $H, 1]);
2604 2712
2605 delete $self->{texture}; 2713 delete $self->{texture};
2714 }
2715
2716 if (delete $self->{scroll_to_bottom}) {
2717 $self->{children}[1]->set_value (1e10);
2606 } 2718 }
2607 2719
2608 $self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub { 2720 $self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub {
2609 glClearColor 0, 0, 0, 0; 2721 glClearColor 0, 0, 0, 0;
2610 glClear GL_COLOR_BUFFER_BIT; 2722 glClear GL_COLOR_BUFFER_BIT;
… …
2614 my $y0 = $top; 2726 my $y0 = $top;
2615 my $y1 = $top + $H; 2727 my $y1 = $top + $H;
2616 2728
2617 my $y = 0; 2729 my $y = 0;
2618 2730
2619 my $layout = $self->{layout};
2620
2621 $layout->set_font ($self->{font}) if $self->{font};
2622
2623 glEnable GL_BLEND; 2731 glEnable GL_BLEND;
2624 #TODO# not correct in windows where rgba is forced off 2732 #TODO# not correct in windows where rgba is forced off
2625 glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA; 2733 glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2626 2734
2627 for my $par (@{$self->{par}}) { 2735 for my $para (@{$self->{par}}) {
2628 my $h = $par->[1]; 2736 my $h = $para->{h};
2629 2737
2630 if ($y0 < $y + $h && $y < $y1) { 2738 if ($y0 < $y + $h && $y < $y1) {
2631 $layout->set_foreground (@{ $par->[2] }); 2739
2632 $layout->set_width ($W - $par->[3]); 2740 my $layout = $self->get_layout ($para);
2633 $layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2634 $layout->set_markup ($par->[4]);
2635 2741
2636 my ($w, $h, $data, $format, $internalformat) = $layout->render; 2742 my ($w, $h, $data, $format, $internalformat) = $layout->render;
2637 2743
2638 glRasterPos $par->[3], $y - $y0; 2744 glRasterPos $para->{indent}, $y - $y0;
2639 glDrawPixels $w, $h, $format, GL_UNSIGNED_BYTE, $data; 2745 glDrawPixels $w, $h, $format, GL_UNSIGNED_BYTE, $data;
2746
2747 if (my @w = @{ $para->{widget} }) {
2748 my @s = $layout->get_shapes;
2749
2750 glDisable GL_BLEND;
2751 for (@w) {
2752 my ($dx, $dy) = splice @s, 0, 2, ();
2753
2754 $_->{x} = $dx + $para->{indent};
2755 $_->{y} = $dy + $y - $y0;
2756
2757 $_->draw;
2758 }
2759 glEnable GL_BLEND;
2760 glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2761 }
2640 } 2762 }
2641 2763
2642 $y += $h; 2764 $y += $h;
2643 } 2765 }
2644 2766
2645 glDisable GL_BLEND; 2767 glDisable GL_BLEND;
2646 }; 2768 };
2647 }); 2769 });
2770}
2771
2772sub reconfigure {
2773 my ($self) = @_;
2774
2775 $self->SUPER::reconfigure;
2776
2777 $_->{w} = 1e10 for @{ $self->{par} };
2778 $self->reflow;
2648} 2779}
2649 2780
2650sub _draw { 2781sub _draw {
2651 my ($self) = @_; 2782 my ($self) = @_;
2652 2783
… …
2655 glColor 0, 0, 0, 1; 2786 glColor 0, 0, 0, 1;
2656 $self->{texture}->draw_quad_alpha_premultiplied (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h}); 2787 $self->{texture}->draw_quad_alpha_premultiplied (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});
2657 glDisable GL_TEXTURE_2D; 2788 glDisable GL_TEXTURE_2D;
2658 2789
2659 $self->{children}[1]->draw; 2790 $self->{children}[1]->draw;
2660
2661} 2791}
2662 2792
2663############################################################################# 2793#############################################################################
2664 2794
2665package CFClient::UI::Animator; 2795package CFClient::UI::Animator;
… …
2774 my ($w, $h) = @{$self->child}{qw(req_w req_h)}; 2904 my ($w, $h) = @{$self->child}{qw(req_w req_h)};
2775 2905
2776 ($w + 4, $h + 4) 2906 ($w + 4, $h + 4)
2777} 2907}
2778 2908
2779sub size_allocate { 2909sub invoke_size_allocate {
2780 my ($self, $w, $h) = @_; 2910 my ($self, $w, $h) = @_;
2781 2911
2782 $self->SUPER::size_allocate ($w - 4, $h - 4); 2912 $self->SUPER::invoke_size_allocate ($w - 4, $h - 4)
2783} 2913}
2784 2914
2785sub visibility_change { 2915sub invoke_visibility_change {
2786 my ($self, $visible) = @_; 2916 my ($self, $visible) = @_;
2787 2917
2788 return unless $visible; 2918 return unless $visible;
2789 2919
2790 $self->{root}->on_post_alloc ("move_$self" => sub { 2920 $self->{root}->on_post_alloc ("move_$self" => sub {
… …
2897 $tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h}); 3027 $tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
2898 glDisable GL_TEXTURE_2D; 3028 glDisable GL_TEXTURE_2D;
2899 } 3029 }
2900} 3030}
2901 3031
2902sub DESTROY { 3032sub destroy {
2903 my ($self) = @_; 3033 my ($self) = @_;
2904 3034
2905 $self->{timer}->cancel 3035 $self->{timer}->cancel
2906 if $self->{timer}; 3036 if $self->{timer};
2907 3037
2908 $self->SUPER::DESTROY; 3038 $self->SUPER::destroy;
2909} 3039}
2910 3040
2911############################################################################# 3041#############################################################################
2912 3042
2913package CFClient::UI::Buttonbar; 3043package CFClient::UI::Buttonbar;
… …
2957 3087
2958# popup given the event (must be a mouse button down event currently) 3088# popup given the event (must be a mouse button down event currently)
2959sub popup { 3089sub popup {
2960 my ($self, $ev) = @_; 3090 my ($self, $ev) = @_;
2961 3091
2962 $self->_emit ("popdown"); 3092 $self->emit ("popdown");
2963 3093
2964 # maybe save $GRAB? must be careful about events... 3094 # maybe save $GRAB? must be careful about events...
2965 $GRAB = $self; 3095 $GRAB = $self;
2966 $self->{button} = $ev->{button}; 3096 $self->{button} = $ev->{button};
2967 3097
2968 $self->show; 3098 $self->show;
2969 $self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5); 3099 $self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);
2970} 3100}
2971 3101
2972sub mouse_motion { 3102sub invoke_mouse_motion {
2973 my ($self, $ev, $x, $y) = @_; 3103 my ($self, $ev, $x, $y) = @_;
2974 3104
2975 # TODO: should use vbox->find_widget or so 3105 # TODO: should use vbox->find_widget or so
2976 $HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y}); 3106 $HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});
2977 $self->{hover} = $self->{item}{$HOVER}; 3107 $self->{hover} = $self->{item}{$HOVER};
2978 3108
2979 0 3109 0
2980} 3110}
2981 3111
2982sub button_up { 3112sub invoke_button_up {
2983 my ($self, $ev, $x, $y) = @_; 3113 my ($self, $ev, $x, $y) = @_;
2984 3114
2985 if ($ev->{button} == $self->{button}) { 3115 if ($ev->{button} == $self->{button}) {
2986 undef $GRAB; 3116 undef $GRAB;
2987 $self->hide; 3117 $self->hide;
2988 3118
2989 $self->_emit ("popdown"); 3119 $self->emit ("popdown");
2990 $self->{hover}[1]->() if $self->{hover}; 3120 $self->{hover}[1]->() if $self->{hover};
2991 } else { 3121 } else {
2992 return 0 3122 return 0
2993 } 3123 }
2994 3124
… …
3031 : $self->{children}[$page_or_widget]; 3161 : $self->{children}[$page_or_widget];
3032 3162
3033 $self->{current} = $widget; 3163 $self->{current} = $widget;
3034 $self->{current}->configure (0, 0, $self->{w}, $self->{h}); 3164 $self->{current}->configure (0, 0, $self->{w}, $self->{h});
3035 3165
3036 $self->_emit (page_changed => $self->{current}); 3166 $self->emit (page_changed => $self->{current});
3037 3167
3038 $self->realloc; 3168 $self->realloc;
3039} 3169}
3040 3170
3041sub visible_children { 3171sub visible_children {
… …
3046 my ($self) = @_; 3176 my ($self) = @_;
3047 3177
3048 $self->{current}->size_request 3178 $self->{current}->size_request
3049} 3179}
3050 3180
3051sub size_allocate { 3181sub invoke_size_allocate {
3052 my ($self, $w, $h) = @_; 3182 my ($self, $w, $h) = @_;
3053 3183
3054 $self->{current}->configure (0, 0, $w, $h); 3184 $self->{current}->configure (0, 0, $w, $h);
3185
3186 1
3055} 3187}
3056 3188
3057sub _draw { 3189sub _draw {
3058 my ($self) = @_; 3190 my ($self) = @_;
3059 3191
… …
3098 3230
3099sub set_current_page { 3231sub set_current_page {
3100 my ($self, $page) = @_; 3232 my ($self, $page) = @_;
3101 3233
3102 $self->{multiplexer}->set_current_page ($page); 3234 $self->{multiplexer}->set_current_page ($page);
3103 $self->_emit (page_changed => $self->{multiplexer}{current}); 3235 $self->emit (page_changed => $self->{multiplexer}{current});
3104} 3236}
3105 3237
3106############################################################################# 3238#############################################################################
3107 3239
3108package CFClient::UI::Combobox; 3240package CFClient::UI::Combobox;
… …
3123 $self->_set_value ($self->{value}); 3255 $self->_set_value ($self->{value});
3124 3256
3125 $self 3257 $self
3126} 3258}
3127 3259
3128sub button_down { 3260sub invoke_button_down {
3129 my ($self, $ev) = @_; 3261 my ($self, $ev) = @_;
3130 3262
3131 my @menu_items; 3263 my @menu_items;
3132 3264
3133 for (@{ $self->{options} }) { 3265 for (@{ $self->{options} }) {
… …
3154 my ($self, $value) = @_; 3286 my ($self, $value) = @_;
3155 3287
3156 return unless $self->{value} ne $value; 3288 return unless $self->{value} ne $value;
3157 3289
3158 $self->_set_value ($value); 3290 $self->_set_value ($value);
3159 $self->_emit (changed => $value); 3291 $self->emit (changed => $value);
3160} 3292}
3161 3293
3162############################################################################# 3294#############################################################################
3163 3295
3164package CFClient::UI::Statusbox; 3296package CFClient::UI::Statusbox;
… …
3279 count => 1, 3411 count => 1,
3280 %arg, 3412 %arg,
3281 }; 3413 };
3282 } 3414 }
3283 3415
3416 $ROOT->on_refresh (reorder => sub {
3284 $self->reorder; 3417 $self->reorder;
3418 });
3285} 3419}
3286 3420
3287sub reconfigure { 3421sub reconfigure {
3288 my ($self) = @_; 3422 my ($self) = @_;
3289 3423
… …
3292 3426
3293 $self->reorder; 3427 $self->reorder;
3294 $self->SUPER::reconfigure; 3428 $self->SUPER::reconfigure;
3295} 3429}
3296 3430
3297sub DESTROY { 3431sub destroy {
3298 my ($self) = @_; 3432 my ($self) = @_;
3299 3433
3300 $self->{timer}->cancel; 3434 $self->{timer}->cancel;
3301 3435
3302 $self->SUPER::DESTROY; 3436 $self->SUPER::destroy;
3303} 3437}
3304 3438
3305############################################################################# 3439#############################################################################
3306 3440
3307package CFClient::UI::Inventory; 3441package CFClient::UI::Inventory;
… …
3326 return unless $items; 3460 return unless $items;
3327 3461
3328 my @items = sort { 3462 my @items = sort {
3329 ($a->{type} <=> $b->{type}) 3463 ($a->{type} <=> $b->{type})
3330 or ($a->{name} cmp $b->{name}) 3464 or ($a->{name} cmp $b->{name})
3331 } @$items; 3465 } values %$items;
3332 3466
3333 $self->{real_items} = \@items; 3467 $self->{real_items} = \@items;
3334 3468
3335 my $row = 0; 3469 my $row = 0;
3336 for my $item (@items) { 3470 for my $item (@items) {
… …
3339 $self->{child}->add (0, $row, $item->{face_widget}); 3473 $self->{child}->add (0, $row, $item->{face_widget});
3340 $self->{child}->add (1, $row, $item->{desc_widget}); 3474 $self->{child}->add (1, $row, $item->{desc_widget});
3341 $self->{child}->add (2, $row, $item->{weight_widget}); 3475 $self->{child}->add (2, $row, $item->{weight_widget});
3342 3476
3343 $row++; 3477 $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 } 3478 }
3542} 3479}
3543 3480
3544############################################################################# 3481#############################################################################
3545 3482
… …
3574 my ($self) = @_; 3511 my ($self) = @_;
3575 3512
3576 $CFClient::UI::ROOT->on_refresh ($self => sub { 3513 $CFClient::UI::ROOT->on_refresh ($self => sub {
3577 $self->clear; 3514 $self->clear;
3578 3515
3516 return unless $::CONN;
3517
3579 $self->add (1, 0, new CFClient::UI::Label text => "Spell Name", @TOOLTIP_NAME); 3518 $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); 3519 $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); 3520 $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); 3521 $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); 3522 $self->add (5, 0, new CFClient::UI::Label text => "Dmg" , @TOOLTIP_DMG);
… …
3597 } elsif ($ev->{button} == 2) { 3536 } elsif ($ev->{button} == 2) {
3598 $::CONN->user_send ("invoke $spell->{name}"); 3537 $::CONN->user_send ("invoke $spell->{name}");
3599 } elsif ($ev->{button} == 3) { 3538 } elsif ($ev->{button} == 3) {
3600 (new CFClient::UI::Menu 3539 (new CFClient::UI::Menu
3601 items => [ 3540 items => [
3602 ["bind <i>cast $spell->{name}</i> to a key" => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) }], 3541 ["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}"]) }], 3542 ["bind <i>invoke $spell->{name}</i> to a key" => sub { $::BIND_EDITOR->do_quick_binding (["invoke $spell->{name}"]) }],
3604 ], 3543 ],
3605 )->popup ($ev); 3544 )->popup ($ev);
3606 } else { 3545 } else {
3607 return 0; 3546 return 0;
… …
3652 3591
3653 delete $self->{spell}->{$spell->{name}}; 3592 delete $self->{spell}->{$spell->{name}};
3654 $self->rebuild_spell_list; 3593 $self->rebuild_spell_list;
3655} 3594}
3656 3595
3596sub clear_spells {
3597 my ($self) = @_;
3598
3599 $self->{spell} = {};
3600 $self->rebuild_spell_list;
3601}
3602
3657############################################################################# 3603#############################################################################
3658 3604
3659package CFClient::UI::Root; 3605package CFClient::UI::Root;
3660 3606
3661our @ISA = CFClient::UI::Container::; 3607our @ISA = CFClient::UI::Container::;
… …
3695 $coord = $max - $size if $coord > $max - $size; 3641 $coord = $max - $size if $coord > $max - $size;
3696 3642
3697 int $coord + 0.5 3643 int $coord + 0.5
3698} 3644}
3699 3645
3700sub size_allocate { 3646sub invoke_size_allocate {
3701 my ($self, $w, $h) = @_; 3647 my ($self, $w, $h) = @_;
3702 3648
3703 for my $child ($self->children) { 3649 for my $child ($self->children) {
3704 my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)}; 3650 my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};
3705 3651
… …
3709 $X = _to_pixel $X, $W, $self->{w}; 3655 $X = _to_pixel $X, $W, $self->{w};
3710 $Y = _to_pixel $Y, $H, $self->{h}; 3656 $Y = _to_pixel $Y, $H, $self->{h};
3711 3657
3712 $child->configure ($X, $Y, $W, $H); 3658 $child->configure ($X, $Y, $W, $H);
3713 } 3659 }
3660
3661 1
3714} 3662}
3715 3663
3716sub coord2local { 3664sub coord2local {
3717 my ($self, $x, $y) = @_; 3665 my ($self, $x, $y) = @_;
3718 3666

Diff Legend

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