1 | package DC::UI; |
1 | package DC::UI; |
2 | |
2 | |
3 | use utf8; |
3 | use common::sense; |
4 | use strict; |
|
|
5 | |
4 | |
6 | use List::Util (); |
5 | use List::Util (); |
|
|
6 | |
|
|
7 | use AnyEvent (); |
|
|
8 | use Guard (); |
7 | |
9 | |
8 | use DC; |
10 | use DC; |
9 | use DC::Pod; |
11 | use DC::Pod; |
10 | use DC::Texture; |
12 | use DC::Texture; |
11 | |
13 | |
… | |
… | |
189 | # call when resolution changes etc. |
191 | # call when resolution changes etc. |
190 | sub rescale_widgets { |
192 | sub rescale_widgets { |
191 | my ($sx, $sy) = @_; |
193 | my ($sx, $sy) = @_; |
192 | |
194 | |
193 | for my $widget (values %WIDGET) { |
195 | for my $widget (values %WIDGET) { |
194 | if ($widget->{is_toplevel}) { |
196 | if ($widget->{is_toplevel} || $widget->{c_rescale}) { |
195 | $widget->{x} += int $widget->{w} * 0.5 if $widget->{x} =~ /^[0-9.]+$/; |
197 | $widget->{x} += int $widget->{w} * 0.5 if $widget->{x} =~ /^[0-9.]+$/; |
196 | $widget->{y} += int $widget->{h} * 0.5 if $widget->{y} =~ /^[0-9.]+$/; |
198 | $widget->{y} += int $widget->{h} * 0.5 if $widget->{y} =~ /^[0-9.]+$/; |
197 | |
199 | |
198 | $widget->{x} = int 0.5 + $widget->{x} * $sx if $widget->{x} =~ /^[0-9.]+$/; |
200 | $widget->{x} = int 0.5 + $widget->{x} * $sx if $widget->{x} =~ /^[0-9.]+$/; |
199 | $widget->{w} = int 0.5 + $widget->{w} * $sx if exists $widget->{w}; |
201 | $widget->{w} = int 0.5 + $widget->{w} * $sx if exists $widget->{w}; |
… | |
… | |
221 | |
223 | |
222 | ############################################################################# |
224 | ############################################################################# |
223 | |
225 | |
224 | package DC::UI::Base; |
226 | package DC::UI::Base; |
225 | |
227 | |
226 | use strict; |
228 | use common::sense; |
227 | |
229 | |
228 | use DC::OpenGL; |
230 | use DC::OpenGL; |
229 | |
231 | |
230 | sub new { |
232 | sub new { |
231 | my $class = shift; |
233 | my $class = shift; |
… | |
… | |
286 | sub set_visible { |
288 | sub set_visible { |
287 | my ($self) = @_; |
289 | my ($self) = @_; |
288 | |
290 | |
289 | return if $self->{visible}; |
291 | return if $self->{visible}; |
290 | |
292 | |
|
|
293 | $self->{parent} && $self->{parent}{root}#d# |
|
|
294 | or return ::clienterror ("set_visible called without parent ($self->{parent}) or root\n" => 1); |
|
|
295 | |
291 | $self->{root} = $self->{parent}{root}; |
296 | $self->{root} = $self->{parent}{root}; |
292 | $self->{visible} = $self->{parent}{visible} + 1; |
297 | $self->{visible} = $self->{parent}{visible} + 1; |
293 | |
298 | |
294 | $self->emit (visibility_change => 1); |
299 | $self->emit (visibility_change => 1); |
295 | |
300 | |
296 | $self->realloc if !exists $self->{req_w}; |
301 | $self->realloc if !exists $self->{req_w}; |
297 | |
302 | |
298 | $_->set_visible for $self->children; |
303 | $_->set_visible for $self->visible_children; |
299 | } |
304 | } |
300 | |
305 | |
301 | sub set_invisible { |
306 | sub set_invisible { |
302 | my ($self) = @_; |
307 | my ($self) = @_; |
303 | |
308 | |
… | |
… | |
527 | sub connect { |
532 | sub connect { |
528 | my ($self, $signal, $cb) = @_; |
533 | my ($self, $signal, $cb) = @_; |
529 | |
534 | |
530 | push @{ $self->{signal_cb}{$signal} }, $cb; |
535 | push @{ $self->{signal_cb}{$signal} }, $cb; |
531 | |
536 | |
532 | defined wantarray and DC::guard { |
537 | defined wantarray and Guard::guard { |
533 | @{ $self->{signal_cb}{$signal} } = grep $_ != $cb, |
538 | @{ $self->{signal_cb}{$signal} } = grep $_ != $cb, |
534 | @{ $self->{signal_cb}{$signal} }; |
539 | @{ $self->{signal_cb}{$signal} }; |
535 | } |
540 | } |
536 | } |
541 | } |
537 | |
542 | |
… | |
… | |
638 | |
643 | |
639 | package DC::UI::DrawBG; |
644 | package DC::UI::DrawBG; |
640 | |
645 | |
641 | our @ISA = DC::UI::Base::; |
646 | our @ISA = DC::UI::Base::; |
642 | |
647 | |
643 | use strict; |
648 | use common::sense; |
|
|
649 | |
644 | use DC::OpenGL; |
650 | use DC::OpenGL; |
645 | |
651 | |
646 | sub new { |
652 | sub new { |
647 | my $class = shift; |
653 | my $class = shift; |
648 | |
654 | |
… | |
… | |
651 | #active_bg => [1, 1, 1, 0.5], |
657 | #active_bg => [1, 1, 1, 0.5], |
652 | @_ |
658 | @_ |
653 | ) |
659 | ) |
654 | } |
660 | } |
655 | |
661 | |
|
|
662 | sub set_bg { |
|
|
663 | my ($self, $bg) = @_; |
|
|
664 | |
|
|
665 | $self->{bg} = $bg; |
|
|
666 | $self->update; |
|
|
667 | } |
|
|
668 | |
656 | sub _draw { |
669 | sub _draw { |
657 | my ($self) = @_; |
670 | my ($self) = @_; |
658 | |
671 | |
659 | my $color = $FOCUS == $self && $self->{active_bg} |
672 | my $color = $FOCUS == $self |
660 | ? $self->{active_bg} |
673 | ? $self->{active_bg} || $self->{bg} |
661 | : $self->{bg}; |
674 | : $self->{bg}; |
662 | |
675 | |
663 | if ($color && (@$color < 4 || $color->[3])) { |
676 | if ($color && (@$color < 4 || $color->[3])) { |
664 | my ($w, $h) = @$self{qw(w h)}; |
677 | my ($w, $h) = @$self{qw(w h)}; |
665 | |
678 | |
… | |
… | |
1256 | fontsize => ($arg{border} || 0.8) * 0.75; |
1269 | fontsize => ($arg{border} || 0.8) * 0.75; |
1257 | } |
1270 | } |
1258 | |
1271 | |
1259 | my $self = $class->SUPER::new ( |
1272 | my $self = $class->SUPER::new ( |
1260 | # label => "", |
1273 | # label => "", |
1261 | fg => [0.6, 0.3, 0.1], |
1274 | fg => undef, |
1262 | border => 0.8, |
1275 | border => 0.8, |
1263 | style => 'single', |
1276 | style => 'single', |
1264 | %arg, |
1277 | %arg, |
1265 | ); |
1278 | ); |
1266 | |
1279 | |
… | |
… | |
1319 | my $border = $self->border; |
1332 | my $border = $self->border; |
1320 | my ($w, $h) = ($self->{w}, $self->{h}); |
1333 | my ($w, $h) = ($self->{w}, $self->{h}); |
1321 | |
1334 | |
1322 | $child->draw; |
1335 | $child->draw; |
1323 | |
1336 | |
1324 | glColor @{$self->{fg}}; |
1337 | glColor @{$self->{fg} || $DC::THEME{fancyframe}}; |
1325 | glBegin GL_LINE_STRIP; |
1338 | glBegin GL_LINE_STRIP; |
1326 | glVertex $border * 1.5 , $border * 0.5 + 0.5; |
1339 | glVertex $border * 1.5 , $border * 0.5 + 0.5; |
1327 | glVertex $border * 0.5 + 0.5, $border * 0.5 + 0.5; |
1340 | glVertex $border * 0.5 + 0.5, $border * 0.5 + 0.5; |
1328 | glVertex $border * 0.5 + 0.5, $h - $border * 0.5 + 0.5; |
1341 | glVertex $border * 0.5 + 0.5, $h - $border * 0.5 + 0.5; |
1329 | glVertex $w - $border * 0.5 + 0.5, $h - $border * 0.5 + 0.5; |
1342 | glVertex $w - $border * 0.5 + 0.5, $h - $border * 0.5 + 0.5; |
… | |
… | |
1344 | our @ISA = DC::UI::Bin::; |
1357 | our @ISA = DC::UI::Bin::; |
1345 | |
1358 | |
1346 | use DC::OpenGL; |
1359 | use DC::OpenGL; |
1347 | |
1360 | |
1348 | my $bg = |
1361 | my $bg = |
1349 | new_from_file DC::Texture DC::find_rcfile "d1_bg.png", |
1362 | new_from_resource DC::Texture "d1_bg.png", |
1350 | mipmap => 1, wrap => 1; |
1363 | mipmap => 1, wrap => 1; |
1351 | |
1364 | |
1352 | my @border = |
1365 | my @border = |
1353 | map { new_from_file DC::Texture DC::find_rcfile $_, mipmap => 1 } |
1366 | map { new_from_resource DC::Texture $_, mipmap => 1 } |
1354 | qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png); |
1367 | qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png); |
1355 | |
1368 | |
1356 | my @icon = |
1369 | my @icon = |
1357 | map { new_from_file DC::Texture DC::find_rcfile $_, mipmap => 1 } |
1370 | map { new_from_resource DC::Texture $_, mipmap => 1 } |
1358 | qw(x1_move.png x1_resize.png); |
1371 | qw(x1_move.png x1_resize.png); |
1359 | |
1372 | |
1360 | sub new { |
1373 | sub new { |
1361 | my ($class, %arg) = @_; |
1374 | my ($class, %arg) = @_; |
1362 | |
1375 | |
1363 | my $self = $class->SUPER::new ( |
1376 | my $self = $class->SUPER::new ( |
1364 | bg => [1, 1, 1, 1], |
1377 | bg => [1, 1, 1, 1], |
1365 | border_bg => [1, 1, 1, 1], |
1378 | border_bg => [1, 1, 1, 1], |
1366 | border => 0.6, |
1379 | border => 0.8, |
1367 | can_events => 1, |
1380 | can_events => 1, |
1368 | min_w => 64, |
1381 | min_w => 64, |
1369 | min_h => 32, |
1382 | min_h => 32, |
1370 | %arg, |
1383 | %arg, |
1371 | ); |
1384 | ); |
… | |
… | |
1540 | glEnable GL_TEXTURE_2D; |
1553 | glEnable GL_TEXTURE_2D; |
1541 | glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE; |
1554 | glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE; |
1542 | |
1555 | |
1543 | my $border = $self->border; |
1556 | my $border = $self->border; |
1544 | |
1557 | |
|
|
1558 | if ($border) { |
1545 | glColor @{ $self->{border_bg} }; |
1559 | glColor @{ $self->{border_bg} }; |
1546 | $border[0]->draw_quad_alpha ( 0, 0, $w, $border); |
1560 | $border[0]->draw_quad_alpha ( 0, 0, $w, $border); |
1547 | $border[1]->draw_quad_alpha ( 0, $border, $border, $ch); |
1561 | $border[1]->draw_quad_alpha ( 0, $border, $border, $ch); |
1548 | $border[2]->draw_quad_alpha ($w - $border, $border, $border, $ch); |
1562 | $border[2]->draw_quad_alpha ($w - $border, $border, $border, $ch); |
1549 | $border[3]->draw_quad_alpha ( 0, $h - $border, $w, $border); |
1563 | $border[3]->draw_quad_alpha ( 0, $h - $border, $w, $border); |
1550 | |
1564 | |
1551 | # move |
1565 | # move |
1552 | my $w2 = ($w - $border) * .5; |
1566 | my $w2 = ($w - $border) * .5; |
1553 | my $h2 = ($h - $border) * .5; |
1567 | my $h2 = ($h - $border) * .5; |
1554 | $icon[0]->draw_quad_alpha ( 0, $h2, $border, $border); |
1568 | $icon[0]->draw_quad_alpha ( 0, $h2, $border, $border); |
1555 | $icon[0]->draw_quad_alpha ($w - $border, $h2, $border, $border); |
1569 | $icon[0]->draw_quad_alpha ($w - $border, $h2, $border, $border); |
1556 | $icon[0]->draw_quad_alpha ($w2 , $h - $border, $border, $border); |
1570 | $icon[0]->draw_quad_alpha ($w2 , $h - $border, $border, $border); |
1557 | |
1571 | |
1558 | # resize |
1572 | # resize |
1559 | $icon[1]->draw_quad_alpha ( 0, 0, $border, $border); |
1573 | $icon[1]->draw_quad_alpha ( 0, 0, $border, $border); |
1560 | $icon[1]->draw_quad_alpha ($w - $border, 0, $border, $border) |
1574 | $icon[1]->draw_quad_alpha ($w - $border, 0, $border, $border) |
1561 | unless $self->{has_close_button}; |
1575 | unless $self->{has_close_button}; |
1562 | $icon[1]->draw_quad_alpha ( 0, $h - $border, $border, $border); |
1576 | $icon[1]->draw_quad_alpha ( 0, $h - $border, $border, $border); |
1563 | $icon[1]->draw_quad_alpha ($w - $border, $h - $border, $border, $border); |
1577 | $icon[1]->draw_quad_alpha ($w - $border, $h - $border, $border, $border); |
|
|
1578 | } |
1564 | |
1579 | |
1565 | if (@{$self->{bg}} < 4 || $self->{bg}[3]) { |
1580 | if (@{$self->{bg}} < 4 || $self->{bg}[3]) { |
1566 | glColor @{ $self->{bg} }; |
1581 | glColor @{ $self->{bg} }; |
1567 | |
1582 | |
1568 | # TODO: repeat texture not scale |
1583 | # TODO: repeat texture not scale |
… | |
… | |
2090 | my $class = shift; |
2105 | my $class = shift; |
2091 | |
2106 | |
2092 | $class->SUPER::new ( |
2107 | $class->SUPER::new ( |
2093 | fg => [1, 1, 1], |
2108 | fg => [1, 1, 1], |
2094 | bg => [0, 0, 0, 0.2], |
2109 | bg => [0, 0, 0, 0.2], |
2095 | outline => [0.6, 0.3, 0.1], |
2110 | outline => undef, |
2096 | active_bg => [0, 0, 1, .2], |
2111 | active_bg => [0, 0, 1, .2], |
2097 | active_fg => [1, 1, 1], |
2112 | active_fg => [1, 1, 1], |
2098 | active_outline => [1, 1, 0], |
2113 | active_outline => [1, 1, 0], |
2099 | can_hover => 1, |
2114 | can_hover => 1, |
2100 | can_focus => 1, |
2115 | can_focus => 1, |
… | |
… | |
2158 | |
2173 | |
2159 | my $text = $self->get_text; |
2174 | my $text = $self->get_text; |
2160 | |
2175 | |
2161 | $self->{cursor} = List::Util::max 0, List::Util::min $self->{cursor}, length $text; |
2176 | $self->{cursor} = List::Util::max 0, List::Util::min $self->{cursor}, length $text; |
2162 | |
2177 | |
2163 | if ($uni == 8) { |
2178 | if ($sym == DC::SDLK_BACKSPACE) { |
2164 | substr $text, --$self->{cursor}, 1, "" if $self->{cursor}; |
2179 | substr $text, --$self->{cursor}, 1, "" if $self->{cursor}; |
2165 | } elsif ($uni == 127) { |
2180 | } elsif ($sym == DC::SDLK_DELETE) { |
2166 | substr $text, $self->{cursor}, 1, ""; |
2181 | substr $text, $self->{cursor}, 1, ""; |
2167 | } elsif ($sym == DC::SDLK_LEFT) { |
2182 | } elsif ($sym == DC::SDLK_LEFT) { |
2168 | --$self->{cursor} if $self->{cursor}; |
2183 | --$self->{cursor} if $self->{cursor}; |
2169 | } elsif ($sym == DC::SDLK_RIGHT) { |
2184 | } elsif ($sym == DC::SDLK_RIGHT) { |
2170 | ++$self->{cursor} if $self->{cursor} < length $self->{text}; |
2185 | ++$self->{cursor} if $self->{cursor} < length $self->{text}; |
… | |
… | |
2273 | glColor @{$self->{active_outline}}; |
2288 | glColor @{$self->{active_outline}}; |
2274 | glRect_lineloop 1.5, 1.5, $self->{w} - 1.5, $self->{h} - 1.5; |
2289 | glRect_lineloop 1.5, 1.5, $self->{w} - 1.5, $self->{h} - 1.5; |
2275 | glLineWidth 1; |
2290 | glLineWidth 1; |
2276 | |
2291 | |
2277 | } else { |
2292 | } else { |
2278 | glColor @{$self->{outline}}; |
2293 | glColor @{$self->{outline} || $DC::THEME{entry_outline}}; |
2279 | glBegin GL_LINE_STRIP; |
2294 | glBegin GL_LINE_STRIP; |
2280 | glVertex .5, $self->{h} * .5; |
2295 | glVertex .5, $self->{h} * .5; |
2281 | glVertex .5, $self->{h} - 2.5; |
2296 | glVertex .5, $self->{h} - 2.5; |
2282 | glVertex $self->{w} - .5, $self->{h} - 2.5; |
2297 | glVertex $self->{w} - .5, $self->{h} - 2.5; |
2283 | glVertex $self->{w} - .5, $self->{h} * .5; |
2298 | glVertex $self->{w} - .5, $self->{h} * .5; |
… | |
… | |
2405 | our @ISA = DC::UI::Bin::; |
2420 | our @ISA = DC::UI::Bin::; |
2406 | |
2421 | |
2407 | use DC::OpenGL; |
2422 | use DC::OpenGL; |
2408 | |
2423 | |
2409 | my @tex = |
2424 | my @tex = |
2410 | map { new_from_file DC::Texture DC::find_rcfile $_, mipmap => 1 } |
2425 | map { new_from_resource DC::Texture $_, mipmap => 1 } |
2411 | qw(b1_button_inactive.png b1_button_active.png); |
2426 | qw(b1_button_inactive.png b1_button_active.png); |
2412 | |
2427 | |
2413 | sub new { |
2428 | sub new { |
2414 | my $class = shift; |
2429 | my $class = shift; |
2415 | |
2430 | |
… | |
… | |
2454 | our @ISA = DC::UI::Label::; |
2469 | our @ISA = DC::UI::Label::; |
2455 | |
2470 | |
2456 | use DC::OpenGL; |
2471 | use DC::OpenGL; |
2457 | |
2472 | |
2458 | my @tex = |
2473 | my @tex = |
2459 | map { new_from_file DC::Texture DC::find_rcfile $_, mipmap => 1 } |
2474 | map { new_from_resource DC::Texture $_, mipmap => 1 } |
2460 | qw(b1_button_inactive.png b1_button_active.png); |
2475 | qw(b1_button_inactive.png b1_button_active.png); |
2461 | |
2476 | |
2462 | sub new { |
2477 | sub new { |
2463 | my $class = shift; |
2478 | my $class = shift; |
2464 | |
2479 | |
… | |
… | |
2507 | package DC::UI::CheckBox; |
2522 | package DC::UI::CheckBox; |
2508 | |
2523 | |
2509 | our @ISA = DC::UI::DrawBG::; |
2524 | our @ISA = DC::UI::DrawBG::; |
2510 | |
2525 | |
2511 | my @tex = |
2526 | my @tex = |
2512 | map { new_from_file DC::Texture DC::find_rcfile $_, mipmap => 1 } |
2527 | map { new_from_resource DC::Texture $_, mipmap => 1 } |
2513 | qw(c1_checkbox_bg.png c1_checkbox_active.png); |
2528 | qw(c1_checkbox_bg.png c1_checkbox_active.png); |
2514 | |
2529 | |
2515 | use DC::OpenGL; |
2530 | use DC::OpenGL; |
2516 | |
2531 | |
2517 | sub new { |
2532 | sub new { |
2518 | my $class = shift; |
2533 | my $class = shift; |
2519 | |
2534 | |
2520 | $class->SUPER::new ( |
2535 | $class->SUPER::new ( |
|
|
2536 | fontsize => 1, |
2521 | padding_x => 2, |
2537 | padding_x => 2, |
2522 | padding_y => 2, |
2538 | padding_y => 2, |
2523 | fg => [1, 1, 1], |
2539 | fg => [1, 1, 1], |
2524 | active_fg => [1, 1, 0], |
2540 | active_fg => [1, 1, 0], |
2525 | bg => [0, 0, 0, 0.2], |
2541 | bg => [0, 0, 0, 0.2], |
… | |
… | |
2531 | } |
2547 | } |
2532 | |
2548 | |
2533 | sub size_request { |
2549 | sub size_request { |
2534 | my ($self) = @_; |
2550 | my ($self) = @_; |
2535 | |
2551 | |
2536 | (6) x 2 |
2552 | ($self->{fontsize} * $::FONTSIZE) x 2 |
2537 | } |
2553 | } |
2538 | |
2554 | |
2539 | sub toggle { |
2555 | sub toggle { |
2540 | my ($self) = @_; |
2556 | my ($self) = @_; |
2541 | |
2557 | |
… | |
… | |
2579 | |
2595 | |
2580 | ############################################################################# |
2596 | ############################################################################# |
2581 | |
2597 | |
2582 | package DC::UI::Image; |
2598 | package DC::UI::Image; |
2583 | |
2599 | |
2584 | our @ISA = DC::UI::Base::; |
2600 | our @ISA = DC::UI::DrawBG::; |
2585 | |
2601 | |
2586 | use DC::OpenGL; |
2602 | use DC::OpenGL; |
2587 | |
2603 | |
2588 | our %texture_cache; |
2604 | our %texture_cache; |
2589 | |
2605 | |
… | |
… | |
2598 | |
2614 | |
2599 | $self->{path} || $self->{tex} |
2615 | $self->{path} || $self->{tex} |
2600 | or Carp::croak "'path' or 'tex' attributes required"; |
2616 | or Carp::croak "'path' or 'tex' attributes required"; |
2601 | |
2617 | |
2602 | $self->{tex} ||= $texture_cache{$self->{path}} ||= |
2618 | $self->{tex} ||= $texture_cache{$self->{path}} ||= |
2603 | new_from_file DC::Texture DC::find_rcfile $self->{path}, mipmap => 1; |
2619 | new_from_resource DC::Texture $self->{path}, mipmap => 1; |
2604 | |
2620 | |
2605 | DC::weaken $texture_cache{$self->{path}}; |
2621 | DC::weaken $texture_cache{$self->{path}}; |
2606 | |
2622 | |
2607 | $self->{aspect} ||= $self->{tex}{w} / $self->{tex}{h}; |
2623 | $self->{aspect} ||= $self->{tex}{w} / $self->{tex}{h}; |
2608 | |
2624 | |
… | |
… | |
2622 | my ($self, $cloning, $path) = @_; |
2638 | my ($self, $cloning, $path) = @_; |
2623 | |
2639 | |
2624 | $self->new (path => $path) |
2640 | $self->new (path => $path) |
2625 | } |
2641 | } |
2626 | |
2642 | |
|
|
2643 | sub set_texture { |
|
|
2644 | my ($self, $tex) = @_; |
|
|
2645 | |
|
|
2646 | $self->{tex} = $tex; |
|
|
2647 | $self->update; |
|
|
2648 | } |
|
|
2649 | |
2627 | sub size_request { |
2650 | sub size_request { |
2628 | my ($self) = @_; |
2651 | my ($self) = @_; |
2629 | |
2652 | |
2630 | (int $self->{tex}{w} * $self->{scale}, int $self->{tex}{h} * $self->{scale}) |
2653 | (int $self->{tex}{w} * $self->{scale}, int $self->{tex}{h} * $self->{scale}) |
2631 | } |
2654 | } |
2632 | |
2655 | |
2633 | sub _draw { |
2656 | sub _draw { |
2634 | my ($self) = @_; |
2657 | my ($self) = @_; |
|
|
2658 | |
|
|
2659 | $self->SUPER::_draw; |
2635 | |
2660 | |
2636 | my $tex = $self->{tex}; |
2661 | my $tex = $self->{tex}; |
2637 | |
2662 | |
2638 | my ($w, $h) = ($self->{w}, $self->{h}); |
2663 | my ($w, $h) = ($self->{w}, $self->{h}); |
2639 | |
2664 | |
… | |
… | |
2657 | package DC::UI::ImageButton; |
2682 | package DC::UI::ImageButton; |
2658 | |
2683 | |
2659 | our @ISA = DC::UI::Image::; |
2684 | our @ISA = DC::UI::Image::; |
2660 | |
2685 | |
2661 | use DC::OpenGL; |
2686 | use DC::OpenGL; |
2662 | |
|
|
2663 | my %textures; |
|
|
2664 | |
2687 | |
2665 | sub new { |
2688 | sub new { |
2666 | my $class = shift; |
2689 | my $class = shift; |
2667 | |
2690 | |
2668 | my $self = $class->SUPER::new ( |
2691 | my $self = $class->SUPER::new ( |
… | |
… | |
2704 | |
2727 | |
2705 | use DC::OpenGL; |
2728 | use DC::OpenGL; |
2706 | |
2729 | |
2707 | my %tex = ( |
2730 | my %tex = ( |
2708 | food => [ |
2731 | food => [ |
2709 | map { new_from_file DC::Texture DC::find_rcfile $_, mipmap => 1 } |
2732 | map { new_from_resource DC::Texture $_, mipmap => 1 } |
2710 | qw/g1_food_gauge_empty.png g1_food_gauge_full.png/ |
2733 | qw/g1_food_gauge_empty.png g1_food_gauge_full.png/ |
2711 | ], |
2734 | ], |
2712 | grace => [ |
2735 | grace => [ |
2713 | map { new_from_file DC::Texture DC::find_rcfile $_, mipmap => 1 } |
2736 | map { new_from_resource DC::Texture $_, mipmap => 1 } |
2714 | qw/g1_grace_gauge_empty.png g1_grace_gauge_full.png g1_grace_gauge_overflow.png/ |
2737 | qw/g1_grace_gauge_empty.png g1_grace_gauge_full.png g1_grace_gauge_overflow.png/ |
2715 | ], |
2738 | ], |
2716 | hp => [ |
2739 | hp => [ |
2717 | map { new_from_file DC::Texture DC::find_rcfile $_, mipmap => 1 } |
2740 | map { new_from_resource DC::Texture $_, mipmap => 1 } |
2718 | qw/g1_hp_gauge_empty.png g1_hp_gauge_full.png/ |
2741 | qw/g1_hp_gauge_empty.png g1_hp_gauge_full.png/ |
2719 | ], |
2742 | ], |
2720 | mana => [ |
2743 | mana => [ |
2721 | map { new_from_file DC::Texture DC::find_rcfile $_, mipmap => 1 } |
2744 | map { new_from_resource DC::Texture $_, mipmap => 1 } |
2722 | qw/g1_mana_gauge_empty.png g1_mana_gauge_full.png g1_mana_gauge_overflow.png/ |
2745 | qw/g1_mana_gauge_empty.png g1_mana_gauge_full.png g1_mana_gauge_overflow.png/ |
2723 | ], |
2746 | ], |
2724 | ); |
2747 | ); |
2725 | |
2748 | |
2726 | # eg. VGauge->new (gauge => 'food'), default gauge: food |
2749 | # eg. VGauge->new (gauge => 'food'), default gauge: food |
… | |
… | |
2839 | |
2862 | |
2840 | sub new { |
2863 | sub new { |
2841 | my ($class, %arg) = @_; |
2864 | my ($class, %arg) = @_; |
2842 | |
2865 | |
2843 | my $self = $class->SUPER::new ( |
2866 | my $self = $class->SUPER::new ( |
|
|
2867 | padding_x => 2, |
|
|
2868 | padding_y => 2, |
2844 | fg => [1, 1, 1], |
2869 | fg => [1, 1, 1], |
2845 | bg => [0, 0, 1, 0.2], |
2870 | bg => [0, 0, 1, 0.2], |
2846 | bar => [0.7, 0.5, 0.1, 0.8], |
2871 | bar => [0.7, 0.5, 0.1, 0.8], |
2847 | outline => [0.4, 0.3, 0], |
2872 | outline => [0.4, 0.3, 0], |
2848 | fontsize => 0.9, |
2873 | fontsize => 0.9, |
… | |
… | |
2888 | my ($self) = @_; |
2913 | my ($self) = @_; |
2889 | |
2914 | |
2890 | glEnable GL_BLEND; |
2915 | glEnable GL_BLEND; |
2891 | glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA; |
2916 | glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA; |
2892 | |
2917 | |
|
|
2918 | my $px = $self->{padding_x}; |
|
|
2919 | my $py = $self->{padding_y}; |
|
|
2920 | |
2893 | if ($self->{value} >= 0) { |
2921 | if ($self->{value} >= 0) { |
2894 | my $s = int 2 + ($self->{w} - 4) * $self->{value}; |
2922 | my $s = int $px + ($self->{w} - $px * 2) * $self->{value}; |
2895 | |
2923 | |
2896 | glColor_premultiply @{$self->{bar}}; |
2924 | glColor_premultiply @{$self->{bar}}; |
2897 | glRect 2, 2, $s, $self->{h} - 2; |
2925 | glRect $px, $py, $s, $self->{h} - $py; |
2898 | glColor_premultiply @{$self->{bg}}; |
2926 | glColor_premultiply @{$self->{bg}}; |
2899 | glRect $s, 2, $self->{w} - 2, $self->{h} - 2; |
2927 | glRect $s , $py, $self->{w} - $px, $self->{h} - $py; |
2900 | } |
2928 | } |
2901 | |
2929 | |
2902 | glColor_premultiply @{$self->{outline}}; |
2930 | glColor_premultiply @{$self->{outline}}; |
|
|
2931 | |
|
|
2932 | $px -= .5; |
|
|
2933 | $py -= .5; |
|
|
2934 | |
2903 | glRect_lineloop 1.5, 1.5, $self->{w} - 1.5, $self->{h} - 1.5; |
2935 | glRect_lineloop $px, $py, $self->{w} - $px, $self->{h} - $py; |
2904 | |
2936 | |
2905 | glDisable GL_BLEND; |
2937 | glDisable GL_BLEND; |
2906 | |
2938 | |
2907 | { |
2939 | { |
2908 | local $self->{bg}; # do not draw background |
2940 | local $self->{bg}; # do not draw background |
… | |
… | |
2917 | our @ISA = DC::UI::Progress::; |
2949 | our @ISA = DC::UI::Progress::; |
2918 | |
2950 | |
2919 | sub new { |
2951 | sub new { |
2920 | my ($class, %arg) = @_; |
2952 | my ($class, %arg) = @_; |
2921 | |
2953 | |
|
|
2954 | my $tt = exists $arg{tooltip} ? "$arg{tooltip}\n\n" : ""; |
|
|
2955 | |
2922 | my $self = $class->SUPER::new ( |
2956 | my $self = $class->SUPER::new ( |
|
|
2957 | %arg, |
2923 | tooltip => sub { |
2958 | tooltip => sub { |
2924 | my ($self) = @_; |
2959 | my ($self) = @_; |
2925 | |
2960 | |
2926 | sprintf "level %d\n%s points\n%s next level\n%s to go", |
2961 | sprintf "%slevel %d\n%s points\n%s next level\n%s to go, %d%% done", |
|
|
2962 | $tt, |
2927 | $self->{lvl}, |
2963 | $self->{lvl}, |
2928 | ::formsep ($self->{exp}), |
2964 | ::formsep ($self->{exp}), |
2929 | ::formsep ($self->{nxt}), |
2965 | ::formsep ($self->{nxt}), |
2930 | ::formsep ($self->{nxt} - $self->{exp}), |
2966 | ::formsep ($self->{nxt} - $self->{exp}), |
|
|
2967 | $self->_percent * 100, |
2931 | }, |
2968 | }, |
2932 | %arg |
|
|
2933 | ); |
2969 | ); |
2934 | |
2970 | |
2935 | $::CONN->{on_exp_update}{$self+0} = sub { $self->set_value ($self->{value}) } |
2971 | $::CONN->{on_exp_update}{$self+0} = sub { $self->set_value ($self->{value}) } |
2936 | if $::CONN; |
2972 | if $::CONN; |
2937 | |
2973 | |
… | |
… | |
2945 | if $::CONN; |
2981 | if $::CONN; |
2946 | |
2982 | |
2947 | $self->SUPER::DESTROY; |
2983 | $self->SUPER::DESTROY; |
2948 | } |
2984 | } |
2949 | |
2985 | |
|
|
2986 | sub _percent { |
|
|
2987 | my ($self) = @_; |
|
|
2988 | |
|
|
2989 | my $table = $::CONN && $::CONN->{exp_table} |
|
|
2990 | or return -1; |
|
|
2991 | |
|
|
2992 | my $l0 = $table->[$self->{lvl} - 1]; |
|
|
2993 | my $l1 = $table->[$self->{lvl}]; |
|
|
2994 | |
|
|
2995 | $self->{nxt} = $l1; |
|
|
2996 | |
|
|
2997 | ($self->{exp} - $l0) / ($l1 - $l0) |
|
|
2998 | } |
|
|
2999 | |
2950 | sub set_value { |
3000 | sub set_value { |
2951 | my ($self, $lvl, $exp) = @_; |
3001 | my ($self, $lvl, $exp) = @_; |
2952 | |
3002 | |
2953 | $self->{lvl} = $lvl; |
3003 | $self->{lvl} = $lvl; |
2954 | $self->{exp} = $exp; |
3004 | $self->{exp} = $exp; |
2955 | |
3005 | |
2956 | my $v = -1; |
|
|
2957 | |
|
|
2958 | if ($::CONN && (my $table = $::CONN->{exp_table})) { |
|
|
2959 | my $l0 = $table->[$lvl - 1]; |
|
|
2960 | my $l1 = $table->[$lvl]; |
|
|
2961 | |
|
|
2962 | $self->{nxt} = $l1; |
|
|
2963 | |
|
|
2964 | $v = ($exp - $l0) / ($l1 - $l0); |
|
|
2965 | } |
|
|
2966 | |
|
|
2967 | $self->SUPER::set_value ($v); |
3006 | $self->SUPER::set_value ($self->_percent); |
2968 | } |
3007 | } |
2969 | |
3008 | |
2970 | ############################################################################# |
3009 | ############################################################################# |
2971 | |
3010 | |
2972 | package DC::UI::Gauge; |
3011 | package DC::UI::Gauge; |
… | |
… | |
3016 | |
3055 | |
3017 | ############################################################################# |
3056 | ############################################################################# |
3018 | |
3057 | |
3019 | package DC::UI::Slider; |
3058 | package DC::UI::Slider; |
3020 | |
3059 | |
3021 | use strict; |
3060 | use common::sense; |
3022 | |
3061 | |
3023 | use DC::OpenGL; |
3062 | use DC::OpenGL; |
3024 | |
3063 | |
3025 | our @ISA = DC::UI::DrawBG::; |
3064 | our @ISA = DC::UI::DrawBG::; |
3026 | |
3065 | |
3027 | my @tex = |
3066 | my @tex = |
3028 | map { new_from_file DC::Texture DC::find_rcfile $_ } |
3067 | map { new_from_resource DC::Texture $_ } |
3029 | qw(s1_slider.png s1_slider_bg.png); |
3068 | qw(s1_slider.png s1_slider_bg.png); |
3030 | |
3069 | |
3031 | sub new { |
3070 | sub new { |
3032 | my $class = shift; |
3071 | my $class = shift; |
3033 | |
3072 | |
… | |
… | |
3070 | sub set_value { |
3109 | sub set_value { |
3071 | my ($self, $value) = @_; |
3110 | my ($self, $value) = @_; |
3072 | |
3111 | |
3073 | my ($old_value, $lo, $hi, $page, $unit) = @{$self->{range}}; |
3112 | my ($old_value, $lo, $hi, $page, $unit) = @{$self->{range}}; |
3074 | |
3113 | |
3075 | $hi = $lo + 1 if $hi <= $lo; |
3114 | $hi = $lo if $hi < $lo; |
3076 | |
3115 | |
3077 | $page = $hi - $lo if $page > $hi - $lo; |
3116 | $value = $hi - $page if $value > $hi - $page; |
3078 | |
|
|
3079 | $value = $lo if $value < $lo; |
3117 | $value = $lo if $value < $lo; |
3080 | $value = $hi - $page if $value > $hi - $page; |
|
|
3081 | |
3118 | |
3082 | $value = $lo + $unit * int +($value - $lo + $unit * 0.5) / $unit |
3119 | $value = $lo + $unit * int +($value - $lo + $unit * 0.5) / $unit |
3083 | if $unit; |
3120 | if $unit; |
3084 | |
3121 | |
3085 | @{$self->{range}} = ($value, $lo, $hi, $page, $unit); |
3122 | @{$self->{range}} = ($value, $lo, $hi, $page, $unit); |
… | |
… | |
3114 | if ($GRAB == $self) { |
3151 | if ($GRAB == $self) { |
3115 | my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w}); |
3152 | my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w}); |
3116 | |
3153 | |
3117 | my (undef, $lo, $hi, $page) = @{$self->{range}}; |
3154 | my (undef, $lo, $hi, $page) = @{$self->{range}}; |
3118 | |
3155 | |
3119 | $x = ($x - $self->{click}[1]) / ($w * $self->{scale}); |
3156 | $x = ($x - $self->{click}[1]) / ($w * $self->{scale} || 1e999); |
3120 | |
3157 | |
3121 | $self->set_value ($self->{click}[0] + $x * ($hi - $page - $lo)); |
3158 | $self->set_value ($self->{click}[0] + $x * ($hi - $page - $lo)); |
3122 | } else { |
3159 | } else { |
3123 | return 0; |
3160 | return 0; |
3124 | } |
3161 | } |
… | |
… | |
3149 | my ($self) = @_; |
3186 | my ($self) = @_; |
3150 | |
3187 | |
3151 | unless ($self->{knob_w}) { |
3188 | unless ($self->{knob_w}) { |
3152 | $self->set_value ($self->{range}[0]); |
3189 | $self->set_value ($self->{range}[0]); |
3153 | |
3190 | |
3154 | my ($value, $lo, $hi, $page) = @{$self->{range}}; |
3191 | my ($value, $lo, $hi, $page, $unit) = @{$self->{range}}; |
3155 | my $range = ($hi - $page - $lo) || 1e-100; |
3192 | my $range = ($hi - $page - $lo) || 1e-10; |
3156 | |
3193 | |
3157 | my $knob_w = List::Util::min 1, $page / ($hi - $lo) || 0.1; |
3194 | my $knob_w = List::Util::min 1, $page / (($hi - $lo) || 1e-10) || 24 / $self->{w}; |
3158 | |
3195 | |
3159 | $self->{offset} = List::Util::max $self->{inner_pad}, $knob_w * 0.5; |
3196 | $self->{offset} = List::Util::max $self->{inner_pad}, $knob_w * 0.5; |
3160 | $self->{scale} = 1 - 2 * $self->{offset} || 1e-100; |
3197 | $self->{scale} = 1 - 2 * $self->{offset} || 1e-100; |
3161 | |
3198 | |
3162 | $value = ($value - $lo) / $range; |
3199 | $value = ($value - $lo) / $range; |
… | |
… | |
3622 | |
3659 | |
3623 | $tip =~ s/^\n+//; |
3660 | $tip =~ s/^\n+//; |
3624 | $tip =~ s/\n+$//; |
3661 | $tip =~ s/\n+$//; |
3625 | |
3662 | |
3626 | $self->add (new DC::UI::Label |
3663 | $self->add (new DC::UI::Label |
|
|
3664 | fg => $DC::THEME{tooltip_fg}, |
3627 | markup => $tip, |
3665 | markup => $tip, |
3628 | max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH, |
3666 | max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH, |
3629 | align => 0, |
3667 | align => 0, |
3630 | fontsize => 0.8, |
3668 | fontsize => 0.8, |
3631 | style => 1, # FLAG_INVERSE |
3669 | style => $DC::THEME{tooltip_style}, # FLAG_INVERSE |
3632 | ellipsise => 0, |
3670 | ellipsise => 0, |
3633 | font => ($widget->{tooltip_font} || $::FONT_PROP), |
3671 | font => ($widget->{tooltip_font} || $::FONT_PROP), |
3634 | ); |
3672 | ); |
3635 | } |
3673 | } |
3636 | |
3674 | |
… | |
… | |
3673 | sub _draw { |
3711 | sub _draw { |
3674 | my ($self) = @_; |
3712 | my ($self) = @_; |
3675 | |
3713 | |
3676 | my ($w, $h) = @$self{qw(w h)}; |
3714 | my ($w, $h) = @$self{qw(w h)}; |
3677 | |
3715 | |
3678 | glColor 1, 0.8, 0.4; |
3716 | glColor @{ $DC::THEME{tooltip_bg} }; |
3679 | glRect 0, 0, $w, $h; |
3717 | glRect 0, 0, $w, $h; |
3680 | |
3718 | |
3681 | glColor 0, 0, 0; |
3719 | glColor @{ $DC::THEME{tooltip_border} }; |
3682 | glRect_lineloop .5, .5, $w + .5, $h + .5; |
3720 | glRect_lineloop .5, .5, $w + .5, $h + .5; |
3683 | |
3721 | |
3684 | glTranslate 2, 2; |
3722 | glTranslate 2, 2; |
3685 | |
3723 | |
3686 | $self->SUPER::_draw; |
3724 | $self->SUPER::_draw; |
… | |
… | |
3703 | aspect => 1, |
3741 | aspect => 1, |
3704 | can_events => 0, |
3742 | can_events => 0, |
3705 | @_, |
3743 | @_, |
3706 | ); |
3744 | ); |
3707 | |
3745 | |
3708 | if ($self->{anim} && $self->{animspeed}) { |
|
|
3709 | DC::weaken (my $widget = $self); |
|
|
3710 | |
|
|
3711 | $self->{animspeed} = List::Util::max 0.05, $self->{animspeed}; |
|
|
3712 | $self->{timer} = EV::periodic_ns 0, $self->{animspeed}, undef, sub { |
|
|
3713 | return unless $::CONN; |
|
|
3714 | |
|
|
3715 | my $w = $widget |
|
|
3716 | or return; |
|
|
3717 | |
|
|
3718 | ++$w->{frame}; |
|
|
3719 | $w->update_face; |
|
|
3720 | |
|
|
3721 | # somehow, $widget can go away |
|
|
3722 | $w->update; |
|
|
3723 | $w->update_timer; |
|
|
3724 | }; |
|
|
3725 | |
|
|
3726 | $self->update_face; |
|
|
3727 | $self->update_timer; |
3746 | $self->update_anim; |
3728 | } |
|
|
3729 | |
3747 | |
3730 | $self |
3748 | $self |
3731 | } |
3749 | } |
3732 | |
3750 | |
3733 | sub update_timer { |
3751 | sub update_timer { |
… | |
… | |
3756 | $tex->upload (sub { $self->reconfigure }); |
3774 | $tex->upload (sub { $self->reconfigure }); |
3757 | } |
3775 | } |
3758 | } |
3776 | } |
3759 | } |
3777 | } |
3760 | } |
3778 | } |
|
|
3779 | } |
|
|
3780 | } |
|
|
3781 | |
|
|
3782 | sub update_anim { |
|
|
3783 | my ($self) = @_; |
|
|
3784 | |
|
|
3785 | if ($self->{anim} && $self->{animspeed}) { |
|
|
3786 | DC::weaken (my $widget = $self); |
|
|
3787 | |
|
|
3788 | $self->{animspeed} = List::Util::max 0.05, $self->{animspeed}; |
|
|
3789 | $self->{timer} = EV::periodic_ns 0, $self->{animspeed}, undef, sub { |
|
|
3790 | return unless $::CONN; |
|
|
3791 | |
|
|
3792 | my $w = $widget |
|
|
3793 | or return; |
|
|
3794 | |
|
|
3795 | ++$w->{frame}; |
|
|
3796 | $w->update_face; |
|
|
3797 | |
|
|
3798 | # somehow, $widget can go away |
|
|
3799 | $w->update; |
|
|
3800 | $w->update_timer; |
|
|
3801 | }; |
|
|
3802 | |
|
|
3803 | $self->update_face; |
|
|
3804 | $self->update_timer; |
|
|
3805 | } else { |
|
|
3806 | delete $self->{timer}; |
3761 | } |
3807 | } |
3762 | } |
3808 | } |
3763 | |
3809 | |
3764 | sub size_request { |
3810 | sub size_request { |
3765 | my ($self) = @_; |
3811 | my ($self) = @_; |
… | |
… | |
3787 | return unless $self->{visible}; |
3833 | return unless $self->{visible}; |
3788 | |
3834 | |
3789 | $self->SUPER::update; |
3835 | $self->SUPER::update; |
3790 | } |
3836 | } |
3791 | |
3837 | |
|
|
3838 | sub set_face { |
|
|
3839 | my ($self, $face) = @_; |
|
|
3840 | |
|
|
3841 | $self->{face} = $face; |
|
|
3842 | $self->reconfigure; |
|
|
3843 | } |
|
|
3844 | |
|
|
3845 | sub set_anim { |
|
|
3846 | my ($self, $anim) = @_; |
|
|
3847 | |
|
|
3848 | $self->{anim} = $anim; |
|
|
3849 | $self->update_anim; |
|
|
3850 | } |
|
|
3851 | |
|
|
3852 | sub set_animspeed { |
|
|
3853 | my ($self, $animspeed) = @_; |
|
|
3854 | |
|
|
3855 | $self->{animspeed} = $animspeed; |
|
|
3856 | $self->update_anim; |
|
|
3857 | } |
|
|
3858 | |
3792 | sub invoke_visibility_change { |
3859 | sub invoke_visibility_change { |
3793 | my ($self) = @_; |
3860 | my ($self) = @_; |
3794 | |
3861 | |
3795 | $self->update_timer; |
3862 | $self->update_timer; |
3796 | |
3863 | |
… | |
… | |
3858 | $widget = new DC::UI::HBox |
3925 | $widget = new DC::UI::HBox |
3859 | can_hover => 1, |
3926 | can_hover => 1, |
3860 | can_events => 1, |
3927 | can_events => 1, |
3861 | tooltip => $tooltip, |
3928 | tooltip => $tooltip, |
3862 | children => [ |
3929 | children => [ |
3863 | (new DC::UI::Label markup => $left, expand => 1), |
3930 | (new DC::UI::Label markup => $left , align => 0, expand => 1), |
3864 | (new DC::UI::Label markup => $right, align => 1), |
3931 | (new DC::UI::Label markup => $right, align => 1), |
3865 | ], |
3932 | ], |
3866 | ; |
3933 | ; |
3867 | |
3934 | |
3868 | } else { |
3935 | } else { |
… | |
… | |
3892 | # maybe save $GRAB? must be careful about events... |
3959 | # maybe save $GRAB? must be careful about events... |
3893 | $GRAB = $self; |
3960 | $GRAB = $self; |
3894 | $self->{button} = $ev->{button}; |
3961 | $self->{button} = $ev->{button}; |
3895 | |
3962 | |
3896 | $self->show; |
3963 | $self->show; |
3897 | $self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5); |
3964 | |
|
|
3965 | my $x = $ev->{x}; |
|
|
3966 | my $y = $ev->{y}; |
|
|
3967 | |
|
|
3968 | $self->{root}->on_post_alloc ($self => sub { |
|
|
3969 | $self->move_abs ($x - $self->{w} * 0.25, $y - $self->{border} * $::FONTSIZE * .5); |
|
|
3970 | }); |
|
|
3971 | |
|
|
3972 | 1 # so it can be used inside event handlers |
3898 | } |
3973 | } |
3899 | |
3974 | |
3900 | sub invoke_mouse_motion { |
3975 | sub invoke_mouse_motion { |
3901 | my ($self, $ev, $x, $y) = @_; |
3976 | my ($self, $ev, $x, $y) = @_; |
3902 | |
3977 | |
… | |
… | |
3934 | |
4009 | |
3935 | my $self = $class->SUPER::new ( |
4010 | my $self = $class->SUPER::new ( |
3936 | @_, |
4011 | @_, |
3937 | ); |
4012 | ); |
3938 | |
4013 | |
3939 | $self->{current} = $self->{children}[0] |
4014 | $self->set_current_page (0); |
3940 | if @{ $self->{children} }; |
|
|
3941 | |
4015 | |
3942 | $self |
4016 | $self |
3943 | } |
4017 | } |
3944 | |
4018 | |
3945 | sub add { |
4019 | sub add { |
3946 | my ($self, @widgets) = @_; |
4020 | my ($self, @widgets) = @_; |
3947 | |
4021 | |
3948 | $self->SUPER::add (@widgets); |
4022 | $self->SUPER::add (@widgets); |
3949 | |
4023 | |
3950 | $self->{current} = $self->{children}[0] |
4024 | $self->set_current_page (0) |
3951 | if @{ $self->{children} }; |
4025 | if @widgets == @{ $self->{children} }; |
3952 | } |
4026 | } |
3953 | |
4027 | |
3954 | sub get_current_page { |
4028 | sub get_current_page { |
3955 | my ($self) = @_; |
4029 | my ($self) = @_; |
3956 | |
4030 | |
… | |
… | |
3962 | |
4036 | |
3963 | my $widget = ref $page_or_widget |
4037 | my $widget = ref $page_or_widget |
3964 | ? $page_or_widget |
4038 | ? $page_or_widget |
3965 | : $self->{children}[$page_or_widget]; |
4039 | : $self->{children}[$page_or_widget]; |
3966 | |
4040 | |
|
|
4041 | $self->{current}->set_invisible if $self->{current} && $self->{visible}; |
|
|
4042 | |
3967 | $self->{current} = $widget; |
4043 | if (($self->{current} = $widget)) { |
|
|
4044 | $self->{current}->set_visible if $self->{current} && $self->{visible}; |
3968 | $self->{current}->configure (0, 0, $self->{w}, $self->{h}); |
4045 | $self->{current}->configure (0, 0, $self->{w}, $self->{h}); |
3969 | |
4046 | |
3970 | $self->emit (page_changed => $self->{current}); |
4047 | $self->emit (page_changed => $self->{current}); |
|
|
4048 | } |
3971 | |
4049 | |
3972 | $self->realloc; |
4050 | $self->realloc; |
3973 | } |
4051 | } |
3974 | |
4052 | |
3975 | sub visible_children { |
4053 | sub visible_children { |
3976 | $_[0]{current} |
4054 | $_[0]{current} || () |
3977 | } |
4055 | } |
3978 | |
4056 | |
3979 | sub size_request { |
4057 | sub size_request { |
3980 | my ($self) = @_; |
4058 | my ($self) = @_; |
3981 | |
4059 | |
|
|
4060 | $self->{current} |
3982 | $self->{current}->size_request |
4061 | ? $self->{current}->size_request |
|
|
4062 | : (0, 0) |
3983 | } |
4063 | } |
3984 | |
4064 | |
3985 | sub invoke_size_allocate { |
4065 | sub invoke_size_allocate { |
3986 | my ($self, $w, $h) = @_; |
4066 | my ($self, $w, $h) = @_; |
3987 | |
4067 | |
3988 | $self->{current}->configure (0, 0, $w, $h); |
4068 | $self->{current}->configure (0, 0, $w, $h) |
|
|
4069 | if $self->{current}; |
3989 | |
4070 | |
3990 | 1 |
4071 | 1 |
3991 | } |
4072 | } |
3992 | |
4073 | |
3993 | sub _draw { |
4074 | sub _draw { |
3994 | my ($self) = @_; |
4075 | my ($self) = @_; |
3995 | |
4076 | |
3996 | $self->{current}->draw; |
4077 | $self->{current}->draw |
|
|
4078 | if $self->{current}; |
3997 | } |
4079 | } |
3998 | |
4080 | |
3999 | ############################################################################# |
4081 | ############################################################################# |
4000 | |
4082 | |
4001 | package DC::UI::Notebook; |
4083 | package DC::UI::Notebook; |
… | |
… | |
4211 | $self |
4293 | $self |
4212 | } |
4294 | } |
4213 | |
4295 | |
4214 | sub reorder { |
4296 | sub reorder { |
4215 | my ($self) = @_; |
4297 | my ($self) = @_; |
4216 | my $NOW = Time::HiRes::time; |
4298 | my $NOW = AE::time; |
4217 | |
4299 | |
4218 | # freeze display when hovering over any label |
4300 | # freeze display when hovering over any label |
4219 | return if $DC::UI::TOOLTIP->{owner} |
4301 | return if $DC::UI::TOOLTIP->{owner} |
4220 | && grep $DC::UI::TOOLTIP->{owner} == $_->{label}, |
4302 | && grep $DC::UI::TOOLTIP->{owner} == $_->{label}, |
4221 | values %{ $self->{item} }; |
4303 | values %{ $self->{item} }; |
… | |
… | |
4271 | $label->{fg}[3] = $item->{fg}[3] || 1; |
4353 | $label->{fg}[3] = $item->{fg}[3] || 1; |
4272 | } |
4354 | } |
4273 | |
4355 | |
4274 | push @widgets, $label; |
4356 | push @widgets, $label; |
4275 | } |
4357 | } |
|
|
4358 | |
|
|
4359 | my $hash = join ",", @widgets; |
|
|
4360 | return if $hash eq $self->{last_widget_hash}; |
|
|
4361 | $self->{last_widget_hash} = $hash; |
4276 | |
4362 | |
4277 | $self->clear; |
4363 | $self->clear; |
4278 | $self->SUPER::add (reverse @widgets); |
4364 | $self->SUPER::add (reverse @widgets); |
4279 | } |
4365 | } |
4280 | |
4366 | |
… | |
… | |
4585 | |
4671 | |
4586 | $ROOT = new DC::UI::Root; |
4672 | $ROOT = new DC::UI::Root; |
4587 | $TOOLTIP = new DC::UI::Tooltip z => 900; |
4673 | $TOOLTIP = new DC::UI::Tooltip z => 900; |
4588 | |
4674 | |
4589 | 1 |
4675 | 1 |
4590 | |
|
|