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.309 by elmex, Wed Jun 21 12:59:23 2006 UTC vs.
Revision 1.339 by root, Sun Jul 30 12:15:19 2006 UTC

… …
79sub feed_sdl_key_up_event { 79sub feed_sdl_key_up_event {
80 $FOCUS->emit (key_up => $_[0]) 80 $FOCUS->emit (key_up => $_[0])
81 if $FOCUS; 81 if $FOCUS;
82} 82}
83 83
84sub check_hover {
85 my ($widget) = @_;
86
87 if ($widget != $HOVER) {
88 my $hover = $HOVER; $HOVER = $widget;
89
90 $hover->update if $hover && $hover->{can_hover};
91 $HOVER->update if $HOVER && $HOVER->{can_hover};
92
93 $TOOLTIP_WATCHER->start;
94 }
95}
96
84sub feed_sdl_button_down_event { 97sub feed_sdl_button_down_event {
85 my ($ev) = @_; 98 my ($ev) = @_;
86 my ($x, $y) = ($ev->{x}, $ev->{y}); 99 my ($x, $y) = ($ev->{x}, $ev->{y});
87 100
88 if (!$BUTTON_STATE) { 101 $BUTTON_STATE |= 1 << ($ev->{button} - 1);
102
103 unless ($GRAB) {
89 my $widget = $ROOT->find_widget ($x, $y); 104 my $widget = $ROOT->find_widget ($x, $y);
90 105
91 $GRAB = $widget; 106 $GRAB = $widget;
92 $GRAB->update if $GRAB; 107 $GRAB->update if $GRAB;
93 108
94 $TOOLTIP_WATCHER->cb->(); 109 $TOOLTIP_WATCHER->cb->();
95 } 110 }
96 111
97 $BUTTON_STATE |= 1 << ($ev->{button} - 1); 112 if ($GRAB) {
98 113 if ($ev->{button} == 4 || $ev->{button} == 5) {
99 $GRAB->emit (button_down => $ev, $GRAB->coord2local ($x, $y)) 114 # mousewheel
100 if $GRAB; 115 $ev->{dx} = 0;
116 $ev->{dy} = $ev->{button} * 2 - 9;
117 $GRAB->emit (mouse_wheel => $ev);
118 } else {
119 $GRAB->emit (button_down => $ev)
120 }
121 }
101} 122}
102 123
103sub feed_sdl_button_up_event { 124sub feed_sdl_button_up_event {
104 my ($ev) = @_; 125 my ($ev) = @_;
105 my ($x, $y) = ($ev->{x}, $ev->{y});
106 126
107 my $widget = $GRAB || $ROOT->find_widget ($x, $y); 127 my $widget = $GRAB || $ROOT->find_widget ($ev->{x}, $ev->{y});
108 128
109 $BUTTON_STATE &= ~(1 << ($ev->{button} - 1)); 129 $BUTTON_STATE &= ~(1 << ($ev->{button} - 1));
110 130
111 $GRAB->emit (button_up => $ev, $GRAB->coord2local ($x, $y)) 131 $GRAB->emit (button_up => $ev)
112 if $GRAB; 132 if $GRAB && $ev->{button} != 4 && $ev->{button} != 5;
113 133
114 if (!$BUTTON_STATE) { 134 unless ($BUTTON_STATE) {
115 my $grab = $GRAB; undef $GRAB; 135 my $grab = $GRAB; undef $GRAB;
116 $grab->update if $grab; 136 $grab->update if $grab;
117 $GRAB->update if $GRAB; 137 $GRAB->update if $GRAB;
118 138
139 check_hover $widget;
119 $TOOLTIP_WATCHER->cb->(); 140 $TOOLTIP_WATCHER->cb->();
120 } 141 }
121} 142}
122 143
123sub feed_sdl_motion_event { 144sub feed_sdl_motion_event {
124 my ($ev) = @_; 145 my ($ev) = @_;
125 my ($x, $y) = ($ev->{x}, $ev->{y}); 146 my ($x, $y) = ($ev->{x}, $ev->{y});
126 147
127 my $widget = $GRAB || $ROOT->find_widget ($x, $y); 148 my $widget = $GRAB || $ROOT->find_widget ($x, $y);
128 149
129 if ($widget != $HOVER) { 150 check_hover $widget;
130 my $hover = $HOVER; $HOVER = $widget;
131 151
132 $hover->update if $hover && $hover->{can_hover}; 152 $HOVER->emit (mouse_motion => $ev)
133 $HOVER->update if $HOVER && $HOVER->{can_hover};
134
135 $TOOLTIP_WATCHER->start;
136 }
137
138 $HOVER->emit (mouse_motion => $ev, $HOVER->coord2local ($x, $y))
139 if $HOVER; 153 if $HOVER;
140} 154}
141 155
142# convert position array to integers 156# convert position array to integers
143sub harmonize { 157sub harmonize {
… …
189 203
190 } 204 }
191 } 205 }
192 206
193 reconfigure_widgets; 207 reconfigure_widgets;
208}
209
210#############################################################################
211
212package CFClient::UI::Event;
213
214sub xy {
215 $_[1]->coord2local ($_[0]{x}, $_[0]{y})
194} 216}
195 217
196############################################################################# 218#############################################################################
197 219
198package CFClient::UI::Base; 220package CFClient::UI::Base;
… …
335sub size_request { 357sub size_request {
336 require Carp; 358 require Carp;
337 Carp::confess "size_request is abstract"; 359 Carp::confess "size_request is abstract";
338} 360}
339 361
362sub baseline_shift {
363 0
364}
365
340sub configure { 366sub configure {
341 my ($self, $x, $y, $w, $h) = @_; 367 my ($self, $x, $y, $w, $h) = @_;
342 368
343 if ($self->{aspect}) { 369 if ($self->{aspect}) {
344 my ($ow, $oh) = ($w, $h); 370 my ($ow, $oh) = ($w, $h);
345 371
346 $w = List::Util::min $w, int $h * $self->{aspect}; 372 $w = List::Util::min $w, CFClient::ceil $h * $self->{aspect};
347 $h = List::Util::min $h, int $w / $self->{aspect}; 373 $h = List::Util::min $h, CFClient::ceil $w / $self->{aspect};
348 374
349 # use alignment to adjust x, y 375 # use alignment to adjust x, y
350 376
351 $x += int 0.5 * ($ow - $w); 377 $x += int 0.5 * ($ow - $w);
352 $y += int 0.5 * ($oh - $h); 378 $y += int 0.5 * ($oh - $h);
… …
403 429
404# translate global coordinates to local coordinate system 430# translate global coordinates to local coordinate system
405sub coord2local { 431sub coord2local {
406 my ($self, $x, $y) = @_; 432 my ($self, $x, $y) = @_;
407 433
434 Carp::confess unless $self->{parent};#d#
435
408 $self->{parent}->coord2local ($x - $self->{x}, $y - $self->{y}) 436 $self->{parent}->coord2local ($x - $self->{x}, $y - $self->{y})
409} 437}
410 438
411# translate local coordinates to global coordinate system 439# translate local coordinates to global coordinate system
412sub coord2global { 440sub coord2global {
413 my ($self, $x, $y) = @_; 441 my ($self, $x, $y) = @_;
414 442
443 Carp::confess unless $self->{parent};#d#
444
415 $self->{parent}->coord2global ($x + $self->{x}, $y + $self->{y}) 445 $self->{parent}->coord2global ($x + $self->{x}, $y + $self->{y})
416} 446}
417 447
418sub invoke_focus_in { 448sub invoke_focus_in {
419 my ($self) = @_; 449 my ($self) = @_;
420 450
421 return if $FOCUS == $self; 451 return if $FOCUS == $self;
422 return unless $self->{can_focus}; 452 return unless $self->{can_focus};
423 453
424 my $focus = $FOCUS; $FOCUS = $self; 454 $FOCUS = $self;
425 455
426 $focus->update if $focus; 456 $self->update;
427 $FOCUS->update;
428 457
429 0 458 0
430} 459}
431 460
432sub invoke_focus_out { 461sub invoke_focus_out {
433 my ($self) = @_; 462 my ($self) = @_;
434 463
435 return unless $FOCUS == $self; 464 return unless $FOCUS == $self;
436 465
437 my $focus = $FOCUS; undef $FOCUS; 466 undef $FOCUS;
438 467
439 $focus->update if $focus; #? 468 $self->update;
440 469
441 $::MAPWIDGET->grab_focus #d# focus mapwidget if no other widget has focus 470 $::MAPWIDGET->grab_focus #d# focus mapwidget if no other widget has focus
442 unless $FOCUS; 471 unless $FOCUS;
443 472
444 0 473 0
445} 474}
446 475
447sub grab_focus { 476sub grab_focus {
448 my ($self) = @_; 477 my ($self) = @_;
449 478
479 $FOCUS->emit ("focus_out") if $FOCUS;
450 $self->emit ("focus_in"); 480 $self->emit ("focus_in");
451} 481}
452 482
453sub invoke_mouse_motion { 1 } 483sub invoke_mouse_motion { 0 }
454sub invoke_button_up { 1 } 484sub invoke_button_up { 0 }
455sub invoke_key_down { 1 } 485sub invoke_key_down { 0 }
456sub invoke_key_up { 1 } 486sub invoke_key_up { 0 }
487sub invoke_mouse_wheel { 0 }
457 488
458sub invoke_button_down { 489sub invoke_button_down {
459 my ($self, $ev, $x, $y) = @_; 490 my ($self, $ev, $x, $y) = @_;
460 491
461 $self->grab_focus; 492 $self->grab_focus;
462 493
463 1 494 0
464} 495}
465 496
466sub connect { 497sub connect {
467 my ($self, $signal, $cb) = @_; 498 my ($self, $signal, $cb) = @_;
468 499
469 push @{ $self->{signal_cb}{$signal} }, $cb; 500 push @{ $self->{signal_cb}{$signal} }, $cb;
501
502 defined wantarray and CFClient::guard {
503 @{ $self->{signal_cb}{$signal} } = grep $_ != $cb,
504 @{ $self->{signal_cb}{$signal} };
505 }
470} 506}
507
508my %has_coords = (
509 button_down => 1,
510 button_up => 1,
511 mouse_motion => 1,
512 mouse_wheel => 1,
513);
471 514
472sub emit { 515sub emit {
473 my ($self, $signal, @args) = @_; 516 my ($self, $signal, @args) = @_;
474 517
518 # I do not really like this solution, but I dislike duplication
519 # and needlessly verbose code, too.
520 my @append
521 = $has_coords{$signal}
522 ? $args[0]->xy ($self)
523 : ();
524
525 #warn +(caller(1))[3] . "emit $signal on $self (parent $self->{parent})\n";#d#
526
475 #d##TODO# stop propagating at first true, do not use sum 527 #d##TODO# stop propagating at first true, do not use sum
476 (List::Util::sum map $_->($self, @args), @{$self->{signal_cb}{$signal} || []}) # before 528 (List::Util::sum map $_->($self, @args, @append), @{$self->{signal_cb}{$signal} || []}) # before
477 || ($self->can ("invoke_$signal") || sub { 1 })->($self, @args) # closure 529 || ($self->can ("invoke_$signal") || sub { 1 })->($self, @args, @append) # closure
478 || ($self->{parent} && $self->{parent}->emit ($signal, @args)) # parent 530 || ($self->{parent} && $self->{parent}->emit ($signal, @args)) # parent
479} 531}
480 532
481sub find_widget { 533sub find_widget {
482 my ($self, $x, $y) = @_; 534 my ($self, $x, $y) = @_;
483 535
… …
535 return unless $self->{h} && $self->{w}; 587 return unless $self->{h} && $self->{w};
536 588
537 # update screen rectangle 589 # update screen rectangle
538 local $draw_x = $draw_x + $self->{x}; 590 local $draw_x = $draw_x + $self->{x};
539 local $draw_y = $draw_y + $self->{y}; 591 local $draw_y = $draw_y + $self->{y};
540 local $draw_w = $draw_x + $self->{w};
541 local $draw_h = $draw_y + $self->{h};
542 592
543 # skip widgets that are entirely outside the drawing area 593 # skip widgets that are entirely outside the drawing area
544 return if ($draw_x + $self->{w} < 0) || ($draw_x >= $draw_w) 594 return if ($draw_x + $self->{w} < 0) || ($draw_x >= $draw_w)
545 || ($draw_y + $self->{h} < 0) || ($draw_y >= $draw_h); 595 || ($draw_y + $self->{h} < 0) || ($draw_y >= $draw_h);
546 596
… …
585} 635}
586 636
587sub DESTROY { 637sub DESTROY {
588 my ($self) = @_; 638 my ($self) = @_;
589 639
640 return if CFClient::in_destruct;
641
590 delete $WIDGET{$self+0}; 642 delete $WIDGET{$self+0};
591 643
592 eval { $self->destroy }; 644 eval { $self->destroy };
593 warn "exception during widget destruction: $@" if $@ & $@ != /during global destruction/; 645 warn "exception during widget destruction: $@" if $@ & $@ != /during global destruction/;
594} 646}
… …
677 729
678 $self->add (@$children) 730 $self->add (@$children)
679 if $children; 731 if $children;
680 732
681 $self 733 $self
734}
735
736sub realloc {
737 my ($self) = @_;
738
739 $self->{force_realloc} = 1;
740 $self->{force_size_alloc} = 1;
741 $self->SUPER::realloc;
682} 742}
683 743
684sub add { 744sub add {
685 my ($self, @widgets) = @_; 745 my ($self, @widgets) = @_;
686 746
… …
973 $self->{vp}->set_offset (0, $_[1]); 1033 $self->{vp}->set_offset (0, $_[1]);
974 }, 1034 },
975 ; 1035 ;
976 1036
977 $self = $class->SUPER::new ( 1037 $self = $class->SUPER::new (
978 vp => (new CFClient::UI::ViewPort expand => 1), 1038 vp => (new CFClient::UI::ViewPort expand => 1),
1039 can_events => 1,
979 slider => $slider, 1040 slider => $slider,
980 %arg, 1041 %arg,
981 ); 1042 );
982 1043
983 $self->SUPER::add ($self->{vp}, $self->{slider}); 1044 $self->SUPER::add ($self->{vp}, $self->{slider});
984 $self->add ($child) if $child; 1045 $self->add ($child) if $child;
985 1046
986 $self 1047 $self
987} 1048}
988 1049
1050#TODO# update range on size_allocate depending on child
1051
989sub add { 1052sub add {
990 my ($self, $widget) = @_; 1053 my ($self, $widget) = @_;
991 1054
992 $self->{vp}->add ($self->{child} = $widget); 1055 $self->{vp}->add ($self->{child} = $widget);
993} 1056}
994 1057
1058sub invoke_mouse_wheel {
1059 my ($self, $ev) = @_;
1060
1061 return 0 unless $ev->{dy}; # only vertical movements
1062
1063 $self->{slider}->emit (mouse_wheel => $ev);
1064
1065 1
1066}
1067
1068sub update_slider {
1069 my ($self) = @_;
1070
1071 $self->{slider}->set_range ([$self->{slider}{range}[0], 0, $self->{vp}->child->{h}, $self->{vp}{h}, 1]);
1072}
1073
995sub update { 1074sub update {
996 my ($self) = @_; 1075 my ($self) = @_;
997 1076
998 $self->SUPER::update; 1077 $self->SUPER::update;
999 1078
1000 # todo: overwrite size_allocate of child 1079 $self->update_slider;
1001 my $child = $self->{vp}->child;
1002 $self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);
1003} 1080}
1004 1081
1005sub invoke_size_allocate { 1082sub invoke_size_allocate {
1006 my ($self, $w, $h) = @_; 1083 my ($self, $w, $h) = @_;
1007 1084
1008 my $child = $self->{vp}->child; 1085 $self->update_slider;
1009 $self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);
1010 1086
1011 $self->SUPER::invoke_size_allocate ($w, $h) 1087 $self->SUPER::invoke_size_allocate ($w, $h)
1012} 1088}
1013
1014#TODO# update range on size_allocate depending on child
1015# update viewport offset on scroll
1016 1089
1017############################################################################# 1090#############################################################################
1018 1091
1019package CFClient::UI::Frame; 1092package CFClient::UI::Frame;
1020 1093
… …
1076 my $self = $class->SUPER::new ( 1149 my $self = $class->SUPER::new (
1077 bg => [1, 1, 1, 1], 1150 bg => [1, 1, 1, 1],
1078 border_bg => [1, 1, 1, 1], 1151 border_bg => [1, 1, 1, 1],
1079 border => 0.6, 1152 border => 0.6,
1080 can_events => 1, 1153 can_events => 1,
1081 min_w => 16, 1154 min_w => 64,
1082 min_h => 16, 1155 min_h => 32,
1083 %arg, 1156 %arg,
1084 ); 1157 );
1085 1158
1086 $self->{title_widget} = new CFClient::UI::Label 1159 $self->{title_widget} = new CFClient::UI::Label
1087 align => 0, 1160 align => 0,
… …
1091 if exists $self->{title}; 1164 if exists $self->{title};
1092 1165
1093 if ($self->{has_close_button}) { 1166 if ($self->{has_close_button}) {
1094 $self->{close_button} = 1167 $self->{close_button} =
1095 new CFClient::UI::ImageButton 1168 new CFClient::UI::ImageButton
1096 image => 'x1_close.png', 1169 path => 'x1_close.png',
1097 on_activate => sub { $self->hide }; 1170 on_activate => sub { $self->emit ("delete") };
1098 1171
1099 $self->CFClient::UI::Container::add ($self->{close_button}); 1172 $self->CFClient::UI::Container::add ($self->{close_button});
1100 } 1173 }
1101 1174
1102 $self 1175 $self
… …
1148 $self->child->configure ($border, $border, $w, $h); 1221 $self->child->configure ($border, $border, $w, $h);
1149 1222
1150 $self->{close_button}->configure ($self->{w} - $border, 0, $border, $border) 1223 $self->{close_button}->configure ($self->{w} - $border, 0, $border, $border)
1151 if $self->{close_button}; 1224 if $self->{close_button};
1152 1225
1226 1
1227}
1228
1229sub invoke_delete {
1230 my ($self) = @_;
1231
1232 $self->hide;
1233
1153 1 1234 1
1154} 1235}
1155 1236
1156sub invoke_button_down { 1237sub invoke_button_down {
1157 my ($self, $ev, $x, $y) = @_; 1238 my ($self, $ev, $x, $y) = @_;
… …
1215 $self->{motion}->($ev, $x, $y) if $self->{motion}; 1296 $self->{motion}->($ev, $x, $y) if $self->{motion};
1216 1297
1217 ! ! $self->{motion} 1298 ! ! $self->{motion}
1218} 1299}
1219 1300
1301sub invoke_visibility_change {
1302 my ($self, $visible) = @_;
1303
1304 delete $self->{motion} unless $visible;
1305
1306 0
1307}
1308
1220sub _draw { 1309sub _draw {
1221 my ($self) = @_; 1310 my ($self) = @_;
1222 1311
1223 my $child = $self->{children}[0]; 1312 my $child = $self->{children}[0];
1224 1313
… …
1283sub children { 1372sub children {
1284 grep $_, map @$_, grep $_, @{ $_[0]{children} } 1373 grep $_, map @$_, grep $_, @{ $_[0]{children} }
1285} 1374}
1286 1375
1287sub add { 1376sub add {
1288 my ($self, $x, $y, $child) = @_; 1377 my ($self) = shift;
1289 1378
1379 while (@_) {
1380 my ($x, $y, $child) = splice @_, 0, 3, ();
1290 $child->set_parent ($self); 1381 $child->set_parent ($self);
1291 $self->{children}[$y][$x] = $child; 1382 $self->{children}[$y][$x] = $child;
1383 }
1292 1384
1385 $self->{force_realloc} = 1;
1386 $self->{force_size_alloc} = 1;
1293 $self->realloc; 1387 $self->realloc;
1294} 1388}
1295 1389
1296sub remove { 1390sub remove {
1297 my ($self, $child) = @_; 1391 my ($self, $child) = @_;
… …
1438 1532
1439sub invoke_size_allocate { 1533sub invoke_size_allocate {
1440 my ($self, $w, $h) = @_; 1534 my ($self, $w, $h) = @_;
1441 1535
1442 my $space = $self->{vertical} ? $h : $w; 1536 my $space = $self->{vertical} ? $h : $w;
1443 my $children = $self->{children}; 1537 my @children = $self->visible_children;
1444 1538
1445 my @req; 1539 my @req;
1446 1540
1447 if ($self->{homogeneous}) { 1541 if ($self->{homogeneous}) {
1448 @req = ($space / (@$children || 1)) x @$children; 1542 @req = ($space / (@children || 1)) x @children;
1449 } else { 1543 } else {
1450 @req = map $_->{$self->{vertical} ? "req_h" : "req_w"}, @$children; 1544 @req = map $_->{$self->{vertical} ? "req_h" : "req_w"}, @children;
1451 my $req = List::Util::sum @req; 1545 my $req = List::Util::sum @req;
1452 1546
1453 if ($req > $space) { 1547 if ($req > $space) {
1454 # ah well, not enough space 1548 # ah well, not enough space
1455 $_ *= $space / $req for @req; 1549 $_ *= $space / $req for @req;
1456 } else { 1550 } else {
1457 my $expand = (List::Util::sum map $_->{expand}, @$children) || 1; 1551 my $expand = (List::Util::sum map $_->{expand}, @children) || 1;
1458 1552
1459 $space = ($space - $req) / $expand; # remaining space to give away 1553 $space = ($space - $req) / $expand; # remaining space to give away
1460 1554
1461 $req[$_] += $space * $children->[$_]{expand} 1555 $req[$_] += $space * $children[$_]{expand}
1462 for 0 .. $#$children; 1556 for 0 .. $#children;
1463 } 1557 }
1464 } 1558 }
1465 1559
1466 CFClient::UI::harmonize \@req; 1560 CFClient::UI::harmonize \@req;
1467 1561
1468 my $pos = 0; 1562 my $pos = 0;
1469 for (0 .. $#$children) { 1563 for (0 .. $#children) {
1470 my $alloc = $req[$_]; 1564 my $alloc = $req[$_];
1471 $children->[$_]->configure ($self->{vertical} ? (0, $pos, $w, $alloc) : ($pos, 0, $alloc, $h)); 1565 $children[$_]->configure ($self->{vertical} ? (0, $pos, $w, $alloc) : ($pos, 0, $alloc, $h));
1472 1566
1473 $pos += $alloc; 1567 $pos += $alloc;
1474 } 1568 }
1475 1569
1476 1 1570 1
… …
1549 } 1643 }
1550 1644
1551 $self 1645 $self
1552} 1646}
1553 1647
1554sub escape($) {
1555 local $_ = $_[0];
1556
1557 s/&/&amp;/g;
1558 s/>/&gt;/g;
1559 s/</&lt;/g;
1560
1561 $_
1562}
1563
1564sub update { 1648sub update {
1565 my ($self) = @_; 1649 my ($self) = @_;
1566 1650
1567 delete $self->{texture}; 1651 delete $self->{texture};
1568 $self->SUPER::update; 1652 $self->SUPER::update;
… …
1579 my ($self, $text) = @_; 1663 my ($self, $text) = @_;
1580 1664
1581 return if $self->{text} eq "T$text"; 1665 return if $self->{text} eq "T$text";
1582 $self->{text} = "T$text"; 1666 $self->{text} = "T$text";
1583 1667
1584 $self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;
1585 $self->{layout}->set_text ($text); 1668 $self->{layout}->set_text ($text);
1586 1669
1587 delete $self->{size_req}; 1670 delete $self->{size_req};
1588 $self->realloc; 1671 $self->realloc;
1589 $self->update; 1672 $self->update;
… …
1595 return if $self->{text} eq "M$markup"; 1678 return if $self->{text} eq "M$markup";
1596 $self->{text} = "M$markup"; 1679 $self->{text} = "M$markup";
1597 1680
1598 my $rgba = $markup =~ /span.*(?:foreground|background)/; 1681 my $rgba = $markup =~ /span.*(?:foreground|background)/;
1599 1682
1600 $self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba;
1601 $self->{layout}->set_markup ($markup); 1683 $self->{layout}->set_markup ($markup);
1602 1684
1603 delete $self->{size_req}; 1685 delete $self->{size_req};
1604 $self->realloc; 1686 $self->realloc;
1605 $self->update; 1687 $self->update;
… …
1617 1699
1618 my ($w, $h) = $self->{layout}->size; 1700 my ($w, $h) = $self->{layout}->size;
1619 1701
1620 if (exists $self->{template}) { 1702 if (exists $self->{template}) {
1621 $self->{template}->set_font ($self->{font}) if $self->{font}; 1703 $self->{template}->set_font ($self->{font}) if $self->{font};
1704 $self->{template}->set_width ($self->{max_w} || -1);
1622 $self->{template}->set_height ($self->{fontsize} * $::FONTSIZE); 1705 $self->{template}->set_height ($self->{fontsize} * $::FONTSIZE);
1623 1706
1624 my ($w2, $h2) = $self->{template}->size; 1707 my ($w2, $h2) = $self->{template}->size;
1625 1708
1626 $w = List::Util::max $w, $w2; 1709 $w = List::Util::max $w, $w2;
… …
1631 }; 1714 };
1632 1715
1633 @{ $self->{size_req} } 1716 @{ $self->{size_req} }
1634} 1717}
1635 1718
1719sub baseline_shift {
1720 $_[0]{layout}->descent
1721}
1722
1636sub invoke_size_allocate { 1723sub invoke_size_allocate {
1637 my ($self, $w, $h) = @_; 1724 my ($self, $w, $h) = @_;
1638 1725
1639 delete $self->{ox}; 1726 delete $self->{ox};
1640 1727
… …
1646 1733
1647sub set_fontsize { 1734sub set_fontsize {
1648 my ($self, $fontsize) = @_; 1735 my ($self, $fontsize) = @_;
1649 1736
1650 $self->{fontsize} = $fontsize; 1737 $self->{fontsize} = $fontsize;
1738 delete $self->{size_req};
1651 delete $self->{texture}; 1739 delete $self->{texture};
1652 1740
1653 $self->realloc; 1741 $self->realloc;
1654} 1742}
1655 1743
1656sub reconfigure { 1744sub reconfigure {
1657 my ($self) = @_; 1745 my ($self) = @_;
1658 1746
1659 delete $self->{size_req}; 1747 delete $self->{size_req};
1748 delete $self->{texture};
1660 1749
1661 $self->SUPER::reconfigure; 1750 $self->SUPER::reconfigure;
1662} 1751}
1663 1752
1664sub _draw { 1753sub _draw {
1665 my ($self) = @_; 1754 my ($self) = @_;
1666 1755
1667 $self->SUPER::_draw; # draw background, if applicable 1756 $self->SUPER::_draw; # draw background, if applicable
1668 1757
1669 my $tex = $self->{texture} ||= do { 1758 my $size = $self->{texture} ||= do {
1670 $self->{layout}->set_foreground (@{$self->{fg}}); 1759 $self->{layout}->set_foreground (@{$self->{fg}});
1671 $self->{layout}->set_font ($self->{font}) if $self->{font}; 1760 $self->{layout}->set_font ($self->{font}) if $self->{font};
1672 $self->{layout}->set_width ($self->{w}); 1761 $self->{layout}->set_width ($self->{w});
1673 $self->{layout}->set_ellipsise ($self->{ellipsise}); 1762 $self->{layout}->set_ellipsise ($self->{ellipsise});
1674 $self->{layout}->set_single_paragraph_mode ($self->{ellipsise}); 1763 $self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1675 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE); 1764 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1676 1765
1677 new_from_layout CFClient::Texture $self->{layout} 1766 [$self->{layout}->size]
1678 }; 1767 };
1679 1768
1680 unless (exists $self->{ox}) { 1769 unless (exists $self->{ox}) {
1681 $self->{ox} = int ($self->{align} < 0 ? $self->{padding_x} 1770 $self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}
1682 : $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x} 1771 : $self->{align} > 0 ? $self->{w} - $size->[0] - $self->{padding_x}
1683 : ($self->{w} - $tex->{w}) * 0.5); 1772 : ($self->{w} - $size->[0]) * 0.5);
1684 1773
1685 $self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y} 1774 $self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}
1686 : $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y} 1775 : $self->{valign} > 0 ? $self->{h} - $size->[1] - $self->{padding_y}
1687 : ($self->{h} - $tex->{h}) * 0.5); 1776 : ($self->{h} - $size->[1]) * 0.5);
1688 }; 1777 };
1689 1778
1690 glEnable GL_TEXTURE_2D;
1691
1692 my $w = List::Util::min $self->{w} + 4, $tex->{w}; 1779 my $w = List::Util::min $self->{w} + 4, $size->[0];
1693 my $h = List::Util::min $self->{h} + 2, $tex->{h}; 1780 my $h = List::Util::min $self->{h} + 2, $size->[1];
1694 1781
1695 if ($tex->{format} == GL_ALPHA) { 1782 $self->{layout}->render ($self->{ox}, $self->{oy});
1696 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
1697 glColor @{$self->{fg}};
1698 $tex->draw_quad_alpha ($self->{ox}, $self->{oy}, $w, $h);
1699 } else {
1700 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1701 $tex->draw_quad_alpha_premultiplied ($self->{ox}, $self->{oy}, $w, $h);
1702 }
1703
1704 glDisable GL_TEXTURE_2D;
1705} 1783}
1706 1784
1707############################################################################# 1785#############################################################################
1708 1786
1709package CFClient::UI::EntryBase; 1787package CFClient::UI::EntryBase;
… …
1820 1898
1821 my $idx = $self->{layout}->xy_to_index ($x, $y); 1899 my $idx = $self->{layout}->xy_to_index ($x, $y);
1822 1900
1823 # byte-index to char-index 1901 # byte-index to char-index
1824 my $text = $self->{text}; 1902 my $text = $self->{text};
1825 utf8::encode $text; 1903 utf8::encode $text; $text = substr $text, 0, $idx; utf8::decode $text;
1826 $self->{cursor} = length substr $text, 0, $idx; 1904 $self->{cursor} = length $text;
1827 1905
1828 $self->_set_text ($self->{text}); 1906 $self->_set_text ($self->{text});
1829 $self->update; 1907 $self->update;
1830 1908
1831 1 1909 1
… …
1983 $self->SUPER::_draw; 2061 $self->SUPER::_draw;
1984} 2062}
1985 2063
1986############################################################################# 2064#############################################################################
1987 2065
2066package CFClient::UI::CheckBox;
2067
2068our @ISA = CFClient::UI::DrawBG::;
2069
2070my @tex =
2071 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
2072 qw(c1_checkbox_bg.png c1_checkbox_active.png);
2073
2074use CFClient::OpenGL;
2075
2076sub new {
2077 my $class = shift;
2078
2079 $class->SUPER::new (
2080 padding_x => 2,
2081 padding_y => 2,
2082 fg => [1, 1, 1],
2083 active_fg => [1, 1, 0],
2084 bg => [0, 0, 0, 0.2],
2085 active_bg => [1, 1, 1, 0.5],
2086 state => 0,
2087 can_hover => 1,
2088 @_
2089 )
2090}
2091
2092sub size_request {
2093 my ($self) = @_;
2094
2095 (6) x 2
2096}
2097
2098sub toggle {
2099 my ($self) = @_;
2100
2101 $self->{state} = !$self->{state};
2102 $self->emit (changed => $self->{state});
2103 $self->update;
2104}
2105
2106sub invoke_button_down {
2107 my ($self, $ev, $x, $y) = @_;
2108
2109 if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
2110 && $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
2111 $self->toggle;
2112 } else {
2113 return 0
2114 }
2115
2116 1
2117}
2118
2119sub _draw {
2120 my ($self) = @_;
2121
2122 $self->SUPER::_draw;
2123
2124 glTranslate $self->{padding_x} + 0.375, $self->{padding_y} + 0.375, 0;
2125
2126 my ($w, $h) = @$self{qw(w h)};
2127
2128 my $s = List::Util::min $w - $self->{padding_x} * 2, $h - $self->{padding_y} * 2;
2129
2130 glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };
2131
2132 my $tex = $self->{state} ? $tex[1] : $tex[0];
2133
2134 glEnable GL_TEXTURE_2D;
2135 $tex->draw_quad_alpha (0, 0, $s, $s);
2136 glDisable GL_TEXTURE_2D;
2137}
2138
2139#############################################################################
2140
2141package CFClient::UI::Image;
2142
2143our @ISA = CFClient::UI::Base::;
2144
2145use CFClient::OpenGL;
2146
2147our %texture_cache;
2148
2149sub new {
2150 my $class = shift;
2151
2152 my $self = $class->SUPER::new (
2153 can_events => 0,
2154 @_,
2155 );
2156
2157 $self->{path} || $self->{tex}
2158 or Carp::croak "'path' or 'tex' attributes required";
2159
2160 $self->{tex} ||= $texture_cache{$self->{path}} ||=
2161 new_from_file CFClient::Texture CFClient::find_rcfile $self->{path}, mipmap => 1;
2162
2163 Scalar::Util::weaken $texture_cache{$self->{path}};
2164
2165 $self->{aspect} ||= $self->{tex}{w} / $self->{tex}{h};
2166
2167 $self
2168}
2169
2170sub STORABLE_freeze {
2171 my ($self, $cloning) = @_;
2172
2173 $self->{path}
2174 or die "cannot serialise CFClient::UI::Image on non-loadable images\n";
2175
2176 $self->{path}
2177}
2178
2179sub STORABLE_attach {
2180 my ($self, $cloning, $path) = @_;
2181
2182 $self->new (path => $path)
2183}
2184
2185sub size_request {
2186 my ($self) = @_;
2187
2188 ($self->{tex}{w}, $self->{tex}{h})
2189}
2190
2191sub _draw {
2192 my ($self) = @_;
2193
2194 my $tex = $self->{tex};
2195
2196 my ($w, $h) = ($self->{w}, $self->{h});
2197
2198 if ($self->{rot90}) {
2199 glRotate 90, 0, 0, 1;
2200 glTranslate 0, -$self->{w}, 0;
2201
2202 ($w, $h) = ($h, $w);
2203 }
2204
2205 glEnable GL_TEXTURE_2D;
2206 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2207
2208 $tex->draw_quad (0, 0, $w, $h);
2209
2210 glDisable GL_TEXTURE_2D;
2211}
2212
2213#############################################################################
2214
1988package CFClient::UI::ImageButton; 2215package CFClient::UI::ImageButton;
1989 2216
1990our @ISA = CFClient::UI::Image::; 2217our @ISA = CFClient::UI::Image::;
1991 2218
1992use CFClient::OpenGL; 2219use CFClient::OpenGL;
… …
2015 $self->emit ("activate") 2242 $self->emit ("activate")
2016 if $x >= 0 && $x < $self->{w} 2243 if $x >= 0 && $x < $self->{w}
2017 && $y >= 0 && $y < $self->{h}; 2244 && $y >= 0 && $y < $self->{h};
2018 2245
2019 1 2246 1
2020}
2021
2022#############################################################################
2023
2024package CFClient::UI::CheckBox;
2025
2026our @ISA = CFClient::UI::DrawBG::;
2027
2028my @tex =
2029 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
2030 qw(c1_checkbox_bg.png c1_checkbox_active.png);
2031
2032use CFClient::OpenGL;
2033
2034sub new {
2035 my $class = shift;
2036
2037 $class->SUPER::new (
2038 padding_x => 2,
2039 padding_y => 2,
2040 fg => [1, 1, 1],
2041 active_fg => [1, 1, 0],
2042 bg => [0, 0, 0, 0.2],
2043 active_bg => [1, 1, 1, 0.5],
2044 state => 0,
2045 can_hover => 1,
2046 @_
2047 )
2048}
2049
2050sub size_request {
2051 my ($self) = @_;
2052
2053 (6) x 2
2054}
2055
2056sub invoke_button_down {
2057 my ($self, $ev, $x, $y) = @_;
2058
2059 if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
2060 && $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
2061 $self->{state} = !$self->{state};
2062 $self->emit (changed => $self->{state});
2063 } else {
2064 return 0
2065 }
2066
2067 1
2068}
2069
2070sub _draw {
2071 my ($self) = @_;
2072
2073 $self->SUPER::_draw;
2074
2075 glTranslate $self->{padding_x} + 0.375, $self->{padding_y} + 0.375, 0;
2076
2077 my ($w, $h) = @$self{qw(w h)};
2078
2079 my $s = List::Util::min $w - $self->{padding_x} * 2, $h - $self->{padding_y} * 2;
2080
2081 glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };
2082
2083 my $tex = $self->{state} ? $tex[1] : $tex[0];
2084
2085 glEnable GL_TEXTURE_2D;
2086 $tex->draw_quad_alpha (0, 0, $s, $s);
2087 glDisable GL_TEXTURE_2D;
2088}
2089
2090#############################################################################
2091
2092package CFClient::UI::Image;
2093
2094our @ISA = CFClient::UI::Base::;
2095
2096use CFClient::OpenGL;
2097use Carp qw/confess/;
2098
2099our %loaded_images;
2100
2101sub new {
2102 my $class = shift;
2103
2104 my $self = $class->SUPER::new (can_events => 0, @_);
2105
2106 $self->{image} or confess "Image has 'image' not set. This is a fatal error!";
2107
2108 $loaded_images{$self->{image}} ||=
2109 new_from_file CFClient::Texture CFClient::find_rcfile $self->{image}, mipmap => 1;
2110
2111 my $tex = $self->{tex} = $loaded_images{$self->{image}};
2112
2113 Scalar::Util::weaken $loaded_images{$self->{image}};
2114
2115 $self->{aspect} = $tex->{w} / $tex->{h};
2116
2117 $self
2118}
2119
2120sub size_request {
2121 my ($self) = @_;
2122
2123 ($self->{tex}->{w}, $self->{tex}->{h})
2124}
2125
2126sub _draw {
2127 my ($self) = @_;
2128
2129 my $tex = $self->{tex};
2130
2131 my ($w, $h) = ($self->{w}, $self->{h});
2132
2133 if ($self->{rot90}) {
2134 glRotate 90, 0, 0, 1;
2135 glTranslate 0, -$self->{w}, 0;
2136
2137 ($w, $h) = ($h, $w);
2138 }
2139
2140 glEnable GL_TEXTURE_2D;
2141 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2142
2143 $tex->draw_quad_alpha (0, 0, $w, $h);
2144
2145 glDisable GL_TEXTURE_2D;
2146} 2247}
2147 2248
2148############################################################################# 2249#############################################################################
2149 2250
2150package CFClient::UI::VGauge; 2251package CFClient::UI::VGauge;
… …
2237 my $ycut1 = max 0, min 1, $ycut; 2338 my $ycut1 = max 0, min 1, $ycut;
2238 my $ycut2 = max 0, min 1, $ycut - 1; 2339 my $ycut2 = max 0, min 1, $ycut - 1;
2239 2340
2240 my $h1 = $self->{h} * (1 - $ycut1); 2341 my $h1 = $self->{h} * (1 - $ycut1);
2241 my $h2 = $self->{h} * (1 - $ycut2); 2342 my $h2 = $self->{h} * (1 - $ycut2);
2343 my $h3 = $self->{h};
2344
2345 $_ = $_ * (284-4)/288 + 4/288 for ($h1, $h2, $h3);
2242 2346
2243 glEnable GL_BLEND; 2347 glEnable GL_BLEND;
2244 glBlendFuncSeparate GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA, 2348 glBlendFuncSeparate GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA,
2245 GL_ONE, GL_ONE_MINUS_SRC_ALPHA; 2349 GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2246 glEnable GL_TEXTURE_2D; 2350 glEnable GL_TEXTURE_2D;
… …
2265 2369
2266 if ($t3) { 2370 if ($t3) {
2267 glBindTexture GL_TEXTURE_2D, $t3->{name}; 2371 glBindTexture GL_TEXTURE_2D, $t3->{name};
2268 glBegin GL_QUADS; 2372 glBegin GL_QUADS;
2269 glTexCoord 0 , $t3->{t} * (1 - $ycut2); glVertex 0 , $h2; 2373 glTexCoord 0 , $t3->{t} * (1 - $ycut2); glVertex 0 , $h2;
2270 glTexCoord 0 , $t3->{t}; glVertex 0 , $self->{h}; 2374 glTexCoord 0 , $t3->{t}; glVertex 0 , $h3;
2271 glTexCoord $t3->{s}, $t3->{t}; glVertex $w, $self->{h}; 2375 glTexCoord $t3->{s}, $t3->{t}; glVertex $w, $h3;
2272 glTexCoord $t3->{s}, $t3->{t} * (1 - $ycut2); glVertex $w, $h2; 2376 glTexCoord $t3->{s}, $t3->{t} * (1 - $ycut2); glVertex $w, $h2;
2273 glEnd; 2377 glEnd;
2274 } 2378 }
2275 2379
2276 glDisable GL_BLEND; 2380 glDisable GL_BLEND;
… …
2432 } 2536 }
2433 2537
2434 1 2538 1
2435} 2539}
2436 2540
2541sub invoke_mouse_wheel {
2542 my ($self, $ev) = @_;
2543
2544 my $delta = $self->{vertical} ? $ev->{dy} : $ev->{dx};
2545
2546 $self->set_value ($self->{range}[0] + $delta * $self->{range}[3] * 0.2);
2547
2548 ! ! $delta
2549}
2550
2437sub update { 2551sub update {
2438 my ($self) = @_; 2552 my ($self) = @_;
2439 2553
2440 delete $self->{knob_w}; 2554 delete $self->{knob_w};
2441 $self->SUPER::update; 2555 $self->SUPER::update;
… …
2540sub new { 2654sub new {
2541 my $class = shift; 2655 my $class = shift;
2542 2656
2543 my $self = $class->SUPER::new ( 2657 my $self = $class->SUPER::new (
2544 fontsize => 1, 2658 fontsize => 1,
2545 can_events => 0, 2659 can_events => 1,
2546 indent => 0, 2660 indent => 0,
2547 #font => default_font 2661 #font => default_font
2548 @_, 2662 @_,
2549 2663
2550 layout => (new CFClient::Layout 1), 2664 layout => (new CFClient::Layout),
2551 par => [], 2665 par => [],
2552 height => 0, 2666 height => 0,
2553 children => [ 2667 children => [
2554 (new CFClient::UI::Empty expand => 1), 2668 (new CFClient::UI::Empty expand => 1),
2555 (new CFClient::UI::Slider vertical => 1), 2669 (new CFClient::UI::Slider vertical => 1),
… …
2566 2680
2567 $self->{fontsize} = $fontsize; 2681 $self->{fontsize} = $fontsize;
2568 $self->reflow; 2682 $self->reflow;
2569} 2683}
2570 2684
2685sub size_request {
2686 my ($self) = @_;
2687
2688 my ($empty, $slider) = @{ $self->{children} };
2689
2690 local $self->{children} = [$empty, $slider];
2691 $self->SUPER::size_request
2692}
2693
2571sub invoke_size_allocate { 2694sub invoke_size_allocate {
2572 my ($self, $w, $h) = @_; 2695 my ($self, $w, $h) = @_;
2573 2696
2697 my ($empty, $slider, @other) = @{ $self->{children} };
2698 $_->configure (@$_{qw(x y req_w req_h)}) for @other;
2699
2574 $self->{layout}->set_font ($self->{font}) if $self->{font}; 2700 $self->{layout}->set_font ($self->{font}) if $self->{font};
2575 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE); 2701 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
2576 $self->{layout}->set_width ($self->{children}[0]{w}); 2702 $self->{layout}->set_width ($empty->{w});
2577 $self->{layout}->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent}); 2703 $self->{layout}->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2578 2704
2579 $self->reflow; 2705 $self->reflow;
2580 2706
2707 local $self->{children} = [$empty, $slider];
2581 $self->SUPER::invoke_size_allocate ($w, $h) 2708 $self->SUPER::invoke_size_allocate ($w, $h)
2582} 2709}
2583 2710
2584sub text_size { 2711sub invoke_mouse_wheel {
2585 my ($self, $text, $indent) = @_; 2712 my ($self, $ev) = @_;
2713
2714 return 0 unless $ev->{dy}; # only vertical movements
2715
2716 $self->{children}[1]->emit (mouse_wheel => $ev);
2717
2718 1
2719}
2720
2721sub get_layout {
2722 my ($self, $para) = @_;
2586 2723
2587 my $layout = $self->{layout}; 2724 my $layout = $self->{layout};
2588 2725
2726 $layout->set_font ($self->{font}) if $self->{font};
2727 $layout->set_foreground (@{$para->{fg}});
2589 $layout->set_height ($self->{fontsize} * $::FONTSIZE); 2728 $layout->set_height ($self->{fontsize} * $::FONTSIZE);
2590 $layout->set_width ($self->{children}[0]{w} - $indent); 2729 $layout->set_width ($self->{children}[0]{w} - $para->{indent});
2591 $layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent}); 2730 $layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2592 $layout->set_markup ($text); 2731 $layout->set_markup ($para->{markup});
2732
2733 $layout->set_shapes (
2734 map
2735 +(0, $_->baseline_shift +$_->{padding_y} - $_->{h}, $_->{w}, $_->{h}),
2736 @{$para->{widget}}
2593 2737 );
2738
2594 $layout->size 2739 $layout
2595} 2740}
2596 2741
2597sub reflow { 2742sub reflow {
2598 my ($self) = @_; 2743 my ($self) = @_;
2599 2744
… …
2608 $self->{children}[1]->set_value ($offset); 2753 $self->{children}[1]->set_value ($offset);
2609} 2754}
2610 2755
2611sub clear { 2756sub clear {
2612 my ($self) = @_; 2757 my ($self) = @_;
2758
2759 my (undef, undef, @other) = @{ $self->{children} };
2760 $self->remove ($_) for @other;
2613 2761
2614 $self->{par} = []; 2762 $self->{par} = [];
2615 $self->{height} = 0; 2763 $self->{height} = 0;
2616 $self->{children}[1]->set_range ([0, 0, 0, 1, 1]); 2764 $self->{children}[1]->set_range ([0, 0, 0, 1, 1]);
2617} 2765}
2618 2766
2619sub add_paragraph { 2767sub add_paragraph {
2620 my ($self, $color, $text, $indent) = @_; 2768 my $self = shift;
2621 2769
2622 for my $line (split /\n/, $text) { 2770 for my $para (@_) {
2623 my ($w, $h) = $self->text_size ($line); 2771 $para = {
2624 $self->{height} += $h; 2772 fg => [1, 1, 1, 1],
2625 push @{$self->{par}}, [$w + $indent, $h, $color, $indent, $line]; 2773 indent => 0,
2626 } 2774 markup => "",
2775 widget => [],
2776 ref $para ? %$para : (markup => $para),
2777 w => 1e10,
2778 wrapped => 1,
2779 };
2627 2780
2628 $self->{children}[1]->set_range ([$self->{height}, 0, $self->{height}, $self->{h}, 1]); 2781 $self->add (@{ $para->{widget} }) if @{ $para->{widget} };
2782 push @{$self->{par}}, $para;
2783 }
2784
2785 $self->{need_reflow}++;
2786 $self->update;
2787}
2788
2789sub scroll_to_bottom {
2790 my ($self) = @_;
2791
2792 $self->{scroll_to_bottom} = 1;
2793 $self->update;
2629} 2794}
2630 2795
2631sub update { 2796sub update {
2632 my ($self) = @_; 2797 my ($self) = @_;
2633 2798
… …
2641 my ($W, $H) = @{$self->{children}[0]}{qw(w h)}; 2806 my ($W, $H) = @{$self->{children}[0]}{qw(w h)};
2642 2807
2643 if (delete $self->{need_reflow}) { 2808 if (delete $self->{need_reflow}) {
2644 my $height = 0; 2809 my $height = 0;
2645 2810
2646 my $layout = $self->{layout};
2647
2648 $layout->set_height ($self->{fontsize} * $::FONTSIZE);
2649
2650 for (@{$self->{par}}) { 2811 for my $para (@{$self->{par}}) {
2651 if (1 || $_->[0] >= $W) { # TODO: works,but needs reconfigure etc. support 2812 if ($para->{w} != $W && ($para->{wrapped} || $para->{w} > $W)) {
2652 $layout->set_width ($W - $_->[3]); 2813 my $layout = $self->get_layout ($para);
2653 $layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2654 $layout->set_markup ($_->[4]);
2655 my ($w, $h) = $layout->size; 2814 my ($w, $h) = $layout->size;
2656 $_->[0] = $w + $_->[3]; 2815
2657 $_->[1] = $h; 2816 $para->{w} = $w + $para->{indent};
2817 $para->{h} = $h;
2818 $para->{wrapped} = $layout->has_wrapped;
2658 } 2819 }
2659 2820
2660 $height += $_->[1]; 2821 $height += $para->{h};
2661 } 2822 }
2662 2823
2663 $self->{height} = $height; 2824 $self->{height} = $height;
2664 2825
2665 $self->{children}[1]->set_range ([$height, 0, $height, $H, 1]); 2826 $self->{children}[1]->set_range ([$self->{children}[1]{range}[0], 0, $height, $H, 1]);
2666 2827
2667 delete $self->{texture}; 2828 delete $self->{texture};
2829 }
2830
2831 if (delete $self->{scroll_to_bottom}) {
2832 $self->{children}[1]->set_value (1e10);
2668 } 2833 }
2669 2834
2670 $self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub { 2835 $self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub {
2671 glClearColor 0, 0, 0, 0; 2836 glClearColor 0, 0, 0, 0;
2672 glClear GL_COLOR_BUFFER_BIT; 2837 glClear GL_COLOR_BUFFER_BIT;
… …
2676 my $y0 = $top; 2841 my $y0 = $top;
2677 my $y1 = $top + $H; 2842 my $y1 = $top + $H;
2678 2843
2679 my $y = 0; 2844 my $y = 0;
2680 2845
2681 my $layout = $self->{layout};
2682
2683 $layout->set_font ($self->{font}) if $self->{font};
2684
2685 glEnable GL_BLEND;
2686 #TODO# not correct in windows where rgba is forced off
2687 glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2688
2689 for my $par (@{$self->{par}}) { 2846 for my $para (@{$self->{par}}) {
2690 my $h = $par->[1]; 2847 my $h = $para->{h};
2691 2848
2692 if ($y0 < $y + $h && $y < $y1) { 2849 if ($y0 < $y + $h && $y < $y1) {
2693 $layout->set_foreground (@{ $par->[2] });
2694 $layout->set_width ($W - $par->[3]);
2695 $layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2696 $layout->set_markup ($par->[4]);
2697 2850
2698 my ($w, $h, $data, $format, $internalformat) = $layout->render; 2851 my $layout = $self->get_layout ($para);
2699 2852
2700 glRasterPos $par->[3], $y - $y0; 2853 $layout->render ($para->{indent}, $y - $y0);
2701 glDrawPixels $w, $h, $format, GL_UNSIGNED_BYTE, $data; 2854
2855 if (my @w = @{ $para->{widget} }) {
2856 my @s = $layout->get_shapes;
2857
2858 for (@w) {
2859 my ($dx, $dy) = splice @s, 0, 2, ();
2860
2861 $_->{x} = $dx + $para->{indent};
2862 $_->{y} = $dy + $y - $y0;
2863
2864 $_->draw;
2865 }
2866 }
2702 } 2867 }
2703 2868
2704 $y += $h; 2869 $y += $h;
2705 } 2870 }
2706
2707 glDisable GL_BLEND;
2708 }; 2871 };
2709 }); 2872 });
2873}
2874
2875sub reconfigure {
2876 my ($self) = @_;
2877
2878 $self->SUPER::reconfigure;
2879
2880 $_->{w} = 1e10 for @{ $self->{par} };
2881 $self->reflow;
2710} 2882}
2711 2883
2712sub _draw { 2884sub _draw {
2713 my ($self) = @_; 2885 my ($self) = @_;
2714 2886
… …
2717 glColor 0, 0, 0, 1; 2889 glColor 0, 0, 0, 1;
2718 $self->{texture}->draw_quad_alpha_premultiplied (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h}); 2890 $self->{texture}->draw_quad_alpha_premultiplied (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});
2719 glDisable GL_TEXTURE_2D; 2891 glDisable GL_TEXTURE_2D;
2720 2892
2721 $self->{children}[1]->draw; 2893 $self->{children}[1]->draw;
2722
2723} 2894}
2724 2895
2725############################################################################# 2896#############################################################################
2726 2897
2727package CFClient::UI::Animator; 2898package CFClient::UI::Animator;
… …
2851 3022
2852 $self->{root}->on_post_alloc ("move_$self" => sub { 3023 $self->{root}->on_post_alloc ("move_$self" => sub {
2853 my $widget = $self->{owner} 3024 my $widget = $self->{owner}
2854 or return; 3025 or return;
2855 3026
3027 if ($widget->{visible}) {
2856 my ($x, $y) = $widget->coord2global ($widget->{w}, 0); 3028 my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
2857 3029
2858 ($x, $y) = $widget->coord2global (-$self->{w}, 0) 3030 ($x, $y) = $widget->coord2global (-$self->{w}, 0)
2859 if $x + $self->{w} > $self->{root}{w}; 3031 if $x + $self->{w} > $self->{root}{w};
2860 3032
2861 $self->move_abs ($x, $y); 3033 $self->move_abs ($x, $y);
3034 } else {
3035 $self->hide;
3036 }
2862 }); 3037 });
2863} 3038}
2864 3039
2865sub _draw { 3040sub _draw {
2866 my ($self) = @_; 3041 my ($self) = @_;
… …
2892 3067
2893############################################################################# 3068#############################################################################
2894 3069
2895package CFClient::UI::Face; 3070package CFClient::UI::Face;
2896 3071
2897our @ISA = CFClient::UI::Base::; 3072our @ISA = CFClient::UI::DrawBG::;
2898 3073
2899use CFClient::OpenGL; 3074use CFClient::OpenGL;
2900 3075
2901sub new { 3076sub new {
2902 my $class = shift; 3077 my $class = shift;
… …
2939sub _draw { 3114sub _draw {
2940 my ($self) = @_; 3115 my ($self) = @_;
2941 3116
2942 return unless $::CONN; 3117 return unless $::CONN;
2943 3118
3119 $self->SUPER::_draw;
3120
2944 my $face; 3121 my $face;
2945 3122
2946 if ($self->{frame}) { 3123 if ($self->{frame}) {
2947 my $anim = $::CONN->{anim}[$self->{anim}]; 3124 my $anim = $::CONN->{anim}[$self->{anim}];
2948 3125
… …
3000 for my $item (@{ $self->{items} }) { 3177 for my $item (@{ $self->{items} }) {
3001 my ($widget, $cb, $tooltip) = @$item; 3178 my ($widget, $cb, $tooltip) = @$item;
3002 3179
3003 # handle various types of items, only text for now 3180 # handle various types of items, only text for now
3004 if (!ref $widget) { 3181 if (!ref $widget) {
3182 if ($widget =~ /\t/) {
3183 my ($left, $right) = split /\t/, $widget, 2;
3184
3185 $widget = new CFClient::UI::HBox
3186 can_hover => 1,
3187 can_events => 1,
3188 tooltip => $tooltip,
3189 children => [
3190 (new CFClient::UI::Label markup => $left, expand => 1),
3191 (new CFClient::UI::Label markup => $right, align => +1),
3192 ],
3193 ;
3194
3195 } else {
3005 $widget = new CFClient::UI::Label 3196 $widget = new CFClient::UI::Label
3006 can_hover => 1, 3197 can_hover => 1,
3007 can_events => 1, 3198 can_events => 1,
3008 markup => $widget, 3199 markup => $widget,
3009 tooltip => $tooltip 3200 tooltip => $tooltip;
3201 }
3010 } 3202 }
3011 3203
3012 $self->{item}{$widget} = $item; 3204 $self->{item}{$widget} = $item;
3013 3205
3014 $self->{vbox}->add ($widget); 3206 $self->{vbox}->add ($widget);
… …
3081 3273
3082 $self->SUPER::add (@widgets); 3274 $self->SUPER::add (@widgets);
3083 3275
3084 $self->{current} = $self->{children}[0] 3276 $self->{current} = $self->{children}[0]
3085 if @{ $self->{children} }; 3277 if @{ $self->{children} };
3278}
3279
3280sub get_current_page {
3281 my ($self) = @_;
3282
3283 $self->{current}
3086} 3284}
3087 3285
3088sub set_current_page { 3286sub set_current_page {
3089 my ($self, $page_or_widget) = @_; 3287 my ($self, $page_or_widget) = @_;
3090 3288
… …
3158 ); 3356 );
3159 3357
3160 $self->{multiplexer}->add ($widget); 3358 $self->{multiplexer}->add ($widget);
3161} 3359}
3162 3360
3361sub get_current_page {
3362 my ($self) = @_;
3363
3364 $self->{multiplexer}->get_current_page
3365}
3366
3163sub set_current_page { 3367sub set_current_page {
3164 my ($self, $page) = @_; 3368 my ($self, $page) = @_;
3165 3369
3166 $self->{multiplexer}->set_current_page ($page); 3370 $self->{multiplexer}->set_current_page ($page);
3167 $self->emit (page_changed => $self->{multiplexer}{current}); 3371 $self->emit (page_changed => $self->{multiplexer}{current});
3168} 3372}
3169 3373
3170############################################################################# 3374#############################################################################
3171 3375
3172package CFClient::UI::Combobox; 3376package CFClient::UI::Selector;
3173 3377
3174use utf8; 3378use utf8;
3175 3379
3176our @ISA = CFClient::UI::Button::; 3380our @ISA = CFClient::UI::Button::;
3177 3381
… …
3343 count => 1, 3547 count => 1,
3344 %arg, 3548 %arg,
3345 }; 3549 };
3346 } 3550 }
3347 3551
3552 $ROOT->on_refresh (reorder => sub {
3348 $self->reorder; 3553 $self->reorder;
3554 });
3349} 3555}
3350 3556
3351sub reconfigure { 3557sub reconfigure {
3352 my ($self) = @_; 3558 my ($self) = @_;
3353 3559
… …
3368 3574
3369############################################################################# 3575#############################################################################
3370 3576
3371package CFClient::UI::Inventory; 3577package CFClient::UI::Inventory;
3372 3578
3373our @ISA = CFClient::UI::ScrolledWindow::; 3579our @ISA = CFClient::UI::Table::;
3374 3580
3375sub new { 3581sub new {
3376 my $class = shift; 3582 my $class = shift;
3377 3583
3378 my $self = $class->SUPER::new ( 3584 my $self = $class->SUPER::new (
3379 child => (new CFClient::UI::Table col_expand => [0, 1, 0]), 3585 col_expand => [0, 1, 0],
3586 items => [],
3380 @_, 3587 @_,
3381 ); 3588 );
3382 3589
3590 $self->set_sort_order (undef);
3591
3383 $self 3592 $self
3593}
3594
3595sub update_items {
3596 my ($self) = @_;
3597
3598 $self->clear;
3599
3600 my @item = $self->{sort}->(@{ $self->{items} });
3601
3602 my @adds;
3603 my $row = 0;
3604 for my $item ($self->{sort}->(@{ $self->{items} })) {
3605 CFClient::Item::update_widgets $item;
3606
3607 push @adds, 0, $row, $item->{face_widget};
3608 push @adds, 1, $row, $item->{desc_widget};
3609 push @adds, 2, $row, $item->{weight_widget};
3610
3611 $row++;
3612 }
3613
3614 $self->add (@adds);
3615}
3616
3617sub set_sort_order {
3618 my ($self, $order) = @_;
3619
3620 $self->{sort} = $order ||= sub {
3621 sort {
3622 $a->{type} <=> $b->{type}
3623 or $a->{name} cmp $b->{name}
3624 } @_
3625 };
3626
3627 $self->update_items;
3384} 3628}
3385 3629
3386sub set_items { 3630sub set_items {
3387 my ($self, $items) = @_; 3631 my ($self, $items) = @_;
3388 3632
3389 $self->{child}->clear; 3633 $self->{items} = [$items ? values %$items : ()];
3390 return unless $items;
3391
3392 my @items = sort {
3393 ($a->{type} <=> $b->{type})
3394 or ($a->{name} cmp $b->{name})
3395 } @$items;
3396
3397 $self->{real_items} = \@items;
3398
3399 my $row = 0;
3400 for my $item (@items) {
3401 CFClient::Item::update_widgets $item;
3402
3403 $self->{child}->add (0, $row, $item->{face_widget});
3404 $self->{child}->add (1, $row, $item->{desc_widget});
3405 $self->{child}->add (2, $row, $item->{weight_widget});
3406
3407 $row++;
3408 }
3409}
3410
3411#############################################################################
3412
3413package CFClient::UI::BindEditor;
3414
3415our @ISA = CFClient::UI::FancyFrame::;
3416
3417sub new {
3418 my $class = shift;
3419
3420 my $self = $class->SUPER::new (binding => [], commands => [], @_);
3421
3422 $self->add (my $vb = new CFClient::UI::VBox);
3423
3424
3425 $vb->add ($self->{rec_btn} = new CFClient::UI::Button
3426 text => "start recording",
3427 tooltip => "Start/Stops recording of actions."
3428 ."All subsequent actions after the recording started will be captured."
3429 ."The actions are displayed after the record was stopped."
3430 ."To bind the action you have to click on the 'Bind' button",
3431 on_activate => sub {
3432 unless ($self->{recording}) {
3433 $self->start;
3434 } else {
3435 $self->stop;
3436 }
3437 });
3438
3439 $vb->add (new CFClient::UI::Label text => "Actions:");
3440 $vb->add ($self->{cmdbox} = new CFClient::UI::VBox);
3441
3442 $vb->add (new CFClient::UI::Label text => "Bound to: ");
3443 $vb->add (my $hb = new CFClient::UI::HBox);
3444 $hb->add ($self->{keylbl} = new CFClient::UI::Label expand => 1);
3445 $hb->add (new CFClient::UI::Button
3446 text => "bind",
3447 tooltip => "This opens a query where you have to press the key combination to bind the recorded actions",
3448 on_activate => sub {
3449 $self->ask_for_bind;
3450 });
3451
3452 $vb->add (my $hb = new CFClient::UI::HBox);
3453 $hb->add (new CFClient::UI::Button
3454 text => "ok",
3455 expand => 1,
3456 tooltip => "This closes the binding editor and saves the binding",
3457 on_activate => sub {
3458 $self->hide;
3459 $self->commit;
3460 });
3461
3462 $hb->add (new CFClient::UI::Button
3463 text => "cancel",
3464 expand => 1,
3465 tooltip => "This closes the binding editor without saving",
3466 on_activate => sub {
3467 $self->hide;
3468 $self->{binding_cancel}->()
3469 if $self->{binding_cancel};
3470 });
3471
3472 $self->update_binding_widgets; 3634 $self->update_items;
3473
3474 $self
3475}
3476
3477sub cfg_bind {
3478 my ($self, $mod, $sym, $cmds) = @_;
3479 $::CFG->{profile}{default}{bindings}{$mod}{$sym} = $cmds;
3480 ::update_bindings ();
3481}
3482
3483sub cfg_unbind {
3484 my ($self, $mod, $sym, $cmds) = @_;
3485 delete $::CFG->{profile}{default}{bindings}{$mod}{$sym};
3486 ::update_bindings ();
3487}
3488
3489sub commit {
3490 my ($self) = @_;
3491 my ($mod, $sym, $cmds) = $self->get_binding;
3492 if ($sym != 0 && @$cmds > 0) {
3493 $::STATUSBOX->add ("Bound actions to '".CFClient::Binder::keycombo_to_name ($mod, $sym)
3494 ."'. Don't forget 'Save Config'!");
3495 $self->{binding_change}->($mod, $sym, $cmds)
3496 if $self->{binding_change};
3497 } else {
3498 $::STATUSBOX->add ("No action bound, no key or action specified!");
3499 $self->{binding_cancel}->()
3500 if $self->{binding_cancel};
3501 }
3502}
3503
3504sub start {
3505 my ($self) = @_;
3506
3507 $self->{rec_btn}->set_text ("stop recording");
3508 $self->{recording} = 1;
3509 $self->clear_command_list;
3510 $::CONN->start_record if $::CONN;
3511}
3512
3513sub stop {
3514 my ($self) = @_;
3515
3516 $self->{rec_btn}->set_text ("start recording");
3517 $self->{recording} = 0;
3518
3519 my $rec;
3520 $rec = $::CONN->stop_record if $::CONN;
3521 return unless ref $rec eq 'ARRAY';
3522 $self->set_command_list ($rec);
3523}
3524
3525
3526sub ask_for_bind_and_commit {
3527 my ($self) = @_;
3528 $self->ask_for_bind (1);
3529}
3530
3531sub ask_for_bind {
3532 my ($self, $commit, $end_cb) = @_;
3533
3534 CFClient::Binder::open_binding_dialog (sub {
3535 my ($mod, $sym) = @_;
3536 $self->{binding} = [$mod, $sym]; # XXX: how to stop that memleak?
3537 $self->update_binding_widgets;
3538 $self->commit if $commit;
3539 $end_cb->() if $end_cb;
3540 });
3541}
3542
3543# $mod and $sym are the modifiers and key symbol
3544# $cmds is a array ref of strings (the commands)
3545# $cb is the callback that is executed on OK
3546# $ccb is the callback that is executed on CANCEL and
3547# when the binding was unsuccessful on OK
3548sub set_binding {
3549 my ($self, $mod, $sym, $cmds, $cb, $ccb) = @_;
3550
3551 $self->clear_command_list;
3552 $self->{recording} = 0;
3553 $self->{rec_btn}->set_text ("start recording");
3554
3555 $self->{binding} = [$mod, $sym];
3556 $self->{commands} = $cmds;
3557
3558 $self->{binding_change} = $cb;
3559 $self->{binding_cancel} = $ccb;
3560
3561 $self->update_binding_widgets;
3562}
3563
3564# this is a shortcut method that asks for a binding
3565# and then just binds it.
3566sub do_quick_binding {
3567 my ($self, $cmds, $end_cb) = @_;
3568 $self->set_binding (undef, undef, $cmds, sub { $self->cfg_bind (@_) });
3569 $self->ask_for_bind (1, $end_cb);
3570}
3571
3572sub update_binding_widgets {
3573 my ($self) = @_;
3574 my ($mod, $sym, $cmds) = $self->get_binding;
3575 $self->{keylbl}->set_text (CFClient::Binder::keycombo_to_name ($mod, $sym));
3576 $self->set_command_list ($cmds);
3577}
3578
3579sub get_binding {
3580 my ($self) = @_;
3581 return (
3582 $self->{binding}->[0],
3583 $self->{binding}->[1],
3584 [ grep { defined $_ } @{$self->{commands}} ]
3585 );
3586}
3587
3588sub clear_command_list {
3589 my ($self) = @_;
3590 $self->{cmdbox}->clear ();
3591}
3592
3593sub set_command_list {
3594 my ($self, $cmds) = @_;
3595
3596 $self->{cmdbox}->clear ();
3597 $self->{commands} = $cmds;
3598
3599 my $idx = 0;
3600
3601 for (@$cmds) {
3602 $self->{cmdbox}->add (my $hb = new CFClient::UI::HBox);
3603
3604 my $i = $idx;
3605 $hb->add (new CFClient::UI::Label text => $_);
3606 $hb->add (new CFClient::UI::Button
3607 text => "delete",
3608 tooltip => "Deletes the action from the record",
3609 on_activate => sub {
3610 $self->{cmdbox}->remove ($hb);
3611 $cmds->[$i] = undef;
3612 });
3613
3614
3615 $idx++
3616 }
3617} 3635}
3618 3636
3619############################################################################# 3637#############################################################################
3620 3638
3621package CFClient::UI::SpellList; 3639package CFClient::UI::SpellList;
… …
3674 } elsif ($ev->{button} == 2) { 3692 } elsif ($ev->{button} == 2) {
3675 $::CONN->user_send ("invoke $spell->{name}"); 3693 $::CONN->user_send ("invoke $spell->{name}");
3676 } elsif ($ev->{button} == 3) { 3694 } elsif ($ev->{button} == 3) {
3677 (new CFClient::UI::Menu 3695 (new CFClient::UI::Menu
3678 items => [ 3696 items => [
3679 ["bind <i>cast $spell->{name}</i> to a key" => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) }], 3697 ["bind <i>cast $spell->{name}</i> to a key" => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) }],
3680 ["bind <i>invoke $spell->{name}</i> to a key" => sub { $::BIND_EDITOR->do_quick_binding (["invoke $spell->{name}"]) }], 3698 ["bind <i>invoke $spell->{name}</i> to a key" => sub { $::BIND_EDITOR->do_quick_binding (["invoke $spell->{name}"]) }],
3681 ], 3699 ],
3682 )->popup ($ev); 3700 )->popup ($ev);
3683 } else { 3701 } else {
3684 return 0; 3702 return 0;
… …
3930 my ($w, $h) = @$widget{qw(alloc_w alloc_h)}; 3948 my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
3931 3949
3932 $w = 0 if $w < 0; 3950 $w = 0 if $w < 0;
3933 $h = 0 if $h < 0; 3951 $h = 0 if $h < 0;
3934 3952
3953 $w = max $widget->{min_w}, $w;
3954 $h = max $widget->{min_h}, $h;
3955
3956# $w = min $self->{w} - $widget->{x}, $w if $self->{w};
3957# $h = min $self->{h} - $widget->{y}, $h if $self->{h};
3958
3959 $w = min $widget->{max_w}, $w if exists $widget->{max_w};
3960 $h = min $widget->{max_h}, $h if exists $widget->{max_h};
3961
3935 $w = int $w + 0.5; 3962 $w = int $w + 0.5;
3936 $h = int $h + 0.5; 3963 $h = int $h + 0.5;
3937 3964
3938 if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) { 3965 if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {
3939 $widget->{old_w} = $widget->{w}; 3966 $widget->{old_w} = $widget->{w};

Diff Legend

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