… | |
… | |
2 | |
2 | |
3 | use utf8; |
3 | use utf8; |
4 | use strict; |
4 | use strict; |
5 | |
5 | |
6 | use List::Util (); |
6 | use List::Util (); |
|
|
7 | |
|
|
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}; |
… | |
… | |
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 | |
… | |
… | |
1256 | fontsize => ($arg{border} || 0.8) * 0.75; |
1261 | fontsize => ($arg{border} || 0.8) * 0.75; |
1257 | } |
1262 | } |
1258 | |
1263 | |
1259 | my $self = $class->SUPER::new ( |
1264 | my $self = $class->SUPER::new ( |
1260 | # label => "", |
1265 | # label => "", |
1261 | fg => [0.6, 0.3, 0.1], |
1266 | fg => undef, |
1262 | border => 0.8, |
1267 | border => 0.8, |
1263 | style => 'single', |
1268 | style => 'single', |
1264 | %arg, |
1269 | %arg, |
1265 | ); |
1270 | ); |
1266 | |
1271 | |
… | |
… | |
1319 | my $border = $self->border; |
1324 | my $border = $self->border; |
1320 | my ($w, $h) = ($self->{w}, $self->{h}); |
1325 | my ($w, $h) = ($self->{w}, $self->{h}); |
1321 | |
1326 | |
1322 | $child->draw; |
1327 | $child->draw; |
1323 | |
1328 | |
1324 | glColor @{$self->{fg}}; |
1329 | glColor @{$self->{fg} || $DC::THEME{fancyframe}}; |
1325 | glBegin GL_LINE_STRIP; |
1330 | glBegin GL_LINE_STRIP; |
1326 | glVertex $border * 1.5 , $border * 0.5 + 0.5; |
1331 | glVertex $border * 1.5 , $border * 0.5 + 0.5; |
1327 | glVertex $border * 0.5 + 0.5, $border * 0.5 + 0.5; |
1332 | glVertex $border * 0.5 + 0.5, $border * 0.5 + 0.5; |
1328 | glVertex $border * 0.5 + 0.5, $h - $border * 0.5 + 0.5; |
1333 | 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; |
1334 | glVertex $w - $border * 0.5 + 0.5, $h - $border * 0.5 + 0.5; |
… | |
… | |
1344 | our @ISA = DC::UI::Bin::; |
1349 | our @ISA = DC::UI::Bin::; |
1345 | |
1350 | |
1346 | use DC::OpenGL; |
1351 | use DC::OpenGL; |
1347 | |
1352 | |
1348 | my $bg = |
1353 | my $bg = |
1349 | new_from_file DC::Texture DC::find_rcfile "d1_bg.png", |
1354 | new_from_resource DC::Texture "d1_bg.png", |
1350 | mipmap => 1, wrap => 1; |
1355 | mipmap => 1, wrap => 1; |
1351 | |
1356 | |
1352 | my @border = |
1357 | my @border = |
1353 | map { new_from_file DC::Texture DC::find_rcfile $_, mipmap => 1 } |
1358 | 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); |
1359 | qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png); |
1355 | |
1360 | |
1356 | my @icon = |
1361 | my @icon = |
1357 | map { new_from_file DC::Texture DC::find_rcfile $_, mipmap => 1 } |
1362 | map { new_from_resource DC::Texture $_, mipmap => 1 } |
1358 | qw(x1_move.png x1_resize.png); |
1363 | qw(x1_move.png x1_resize.png); |
1359 | |
1364 | |
1360 | sub new { |
1365 | sub new { |
1361 | my ($class, %arg) = @_; |
1366 | my ($class, %arg) = @_; |
1362 | |
1367 | |
1363 | my $self = $class->SUPER::new ( |
1368 | my $self = $class->SUPER::new ( |
1364 | bg => [1, 1, 1, 1], |
1369 | bg => [1, 1, 1, 1], |
1365 | border_bg => [1, 1, 1, 1], |
1370 | border_bg => [1, 1, 1, 1], |
1366 | border => 0.6, |
1371 | border => 0.8, |
1367 | can_events => 1, |
1372 | can_events => 1, |
1368 | min_w => 64, |
1373 | min_w => 64, |
1369 | min_h => 32, |
1374 | min_h => 32, |
1370 | %arg, |
1375 | %arg, |
1371 | ); |
1376 | ); |
… | |
… | |
1540 | glEnable GL_TEXTURE_2D; |
1545 | glEnable GL_TEXTURE_2D; |
1541 | glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE; |
1546 | glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE; |
1542 | |
1547 | |
1543 | my $border = $self->border; |
1548 | my $border = $self->border; |
1544 | |
1549 | |
|
|
1550 | if ($border) { |
1545 | glColor @{ $self->{border_bg} }; |
1551 | glColor @{ $self->{border_bg} }; |
1546 | $border[0]->draw_quad_alpha ( 0, 0, $w, $border); |
1552 | $border[0]->draw_quad_alpha ( 0, 0, $w, $border); |
1547 | $border[1]->draw_quad_alpha ( 0, $border, $border, $ch); |
1553 | $border[1]->draw_quad_alpha ( 0, $border, $border, $ch); |
1548 | $border[2]->draw_quad_alpha ($w - $border, $border, $border, $ch); |
1554 | $border[2]->draw_quad_alpha ($w - $border, $border, $border, $ch); |
1549 | $border[3]->draw_quad_alpha ( 0, $h - $border, $w, $border); |
1555 | $border[3]->draw_quad_alpha ( 0, $h - $border, $w, $border); |
1550 | |
1556 | |
1551 | # move |
1557 | # move |
1552 | my $w2 = ($w - $border) * .5; |
1558 | my $w2 = ($w - $border) * .5; |
1553 | my $h2 = ($h - $border) * .5; |
1559 | my $h2 = ($h - $border) * .5; |
1554 | $icon[0]->draw_quad_alpha ( 0, $h2, $border, $border); |
1560 | $icon[0]->draw_quad_alpha ( 0, $h2, $border, $border); |
1555 | $icon[0]->draw_quad_alpha ($w - $border, $h2, $border, $border); |
1561 | $icon[0]->draw_quad_alpha ($w - $border, $h2, $border, $border); |
1556 | $icon[0]->draw_quad_alpha ($w2 , $h - $border, $border, $border); |
1562 | $icon[0]->draw_quad_alpha ($w2 , $h - $border, $border, $border); |
1557 | |
1563 | |
1558 | # resize |
1564 | # resize |
1559 | $icon[1]->draw_quad_alpha ( 0, 0, $border, $border); |
1565 | $icon[1]->draw_quad_alpha ( 0, 0, $border, $border); |
1560 | $icon[1]->draw_quad_alpha ($w - $border, 0, $border, $border) |
1566 | $icon[1]->draw_quad_alpha ($w - $border, 0, $border, $border) |
1561 | unless $self->{has_close_button}; |
1567 | unless $self->{has_close_button}; |
1562 | $icon[1]->draw_quad_alpha ( 0, $h - $border, $border, $border); |
1568 | $icon[1]->draw_quad_alpha ( 0, $h - $border, $border, $border); |
1563 | $icon[1]->draw_quad_alpha ($w - $border, $h - $border, $border, $border); |
1569 | $icon[1]->draw_quad_alpha ($w - $border, $h - $border, $border, $border); |
|
|
1570 | } |
1564 | |
1571 | |
1565 | if (@{$self->{bg}} < 4 || $self->{bg}[3]) { |
1572 | if (@{$self->{bg}} < 4 || $self->{bg}[3]) { |
1566 | glColor @{ $self->{bg} }; |
1573 | glColor @{ $self->{bg} }; |
1567 | |
1574 | |
1568 | # TODO: repeat texture not scale |
1575 | # TODO: repeat texture not scale |
… | |
… | |
2090 | my $class = shift; |
2097 | my $class = shift; |
2091 | |
2098 | |
2092 | $class->SUPER::new ( |
2099 | $class->SUPER::new ( |
2093 | fg => [1, 1, 1], |
2100 | fg => [1, 1, 1], |
2094 | bg => [0, 0, 0, 0.2], |
2101 | bg => [0, 0, 0, 0.2], |
2095 | outline => [0.6, 0.3, 0.1], |
2102 | outline => undef, |
2096 | active_bg => [0, 0, 1, .2], |
2103 | active_bg => [0, 0, 1, .2], |
2097 | active_fg => [1, 1, 1], |
2104 | active_fg => [1, 1, 1], |
2098 | active_outline => [1, 1, 0], |
2105 | active_outline => [1, 1, 0], |
2099 | can_hover => 1, |
2106 | can_hover => 1, |
2100 | can_focus => 1, |
2107 | can_focus => 1, |
… | |
… | |
2158 | |
2165 | |
2159 | my $text = $self->get_text; |
2166 | my $text = $self->get_text; |
2160 | |
2167 | |
2161 | $self->{cursor} = List::Util::max 0, List::Util::min $self->{cursor}, length $text; |
2168 | $self->{cursor} = List::Util::max 0, List::Util::min $self->{cursor}, length $text; |
2162 | |
2169 | |
2163 | if ($uni == 8) { |
2170 | if ($sym == DC::SDLK_BACKSPACE) { |
2164 | substr $text, --$self->{cursor}, 1, "" if $self->{cursor}; |
2171 | substr $text, --$self->{cursor}, 1, "" if $self->{cursor}; |
2165 | } elsif ($uni == 127) { |
2172 | } elsif ($sym == DC::SDLK_DELETE) { |
2166 | substr $text, $self->{cursor}, 1, ""; |
2173 | substr $text, $self->{cursor}, 1, ""; |
2167 | } elsif ($sym == DC::SDLK_LEFT) { |
2174 | } elsif ($sym == DC::SDLK_LEFT) { |
2168 | --$self->{cursor} if $self->{cursor}; |
2175 | --$self->{cursor} if $self->{cursor}; |
2169 | } elsif ($sym == DC::SDLK_RIGHT) { |
2176 | } elsif ($sym == DC::SDLK_RIGHT) { |
2170 | ++$self->{cursor} if $self->{cursor} < length $self->{text}; |
2177 | ++$self->{cursor} if $self->{cursor} < length $self->{text}; |
… | |
… | |
2273 | glColor @{$self->{active_outline}}; |
2280 | glColor @{$self->{active_outline}}; |
2274 | glRect_lineloop 1.5, 1.5, $self->{w} - 1.5, $self->{h} - 1.5; |
2281 | glRect_lineloop 1.5, 1.5, $self->{w} - 1.5, $self->{h} - 1.5; |
2275 | glLineWidth 1; |
2282 | glLineWidth 1; |
2276 | |
2283 | |
2277 | } else { |
2284 | } else { |
2278 | glColor @{$self->{outline}}; |
2285 | glColor @{$self->{outline} || $DC::THEME{entry_outline}}; |
2279 | glBegin GL_LINE_STRIP; |
2286 | glBegin GL_LINE_STRIP; |
2280 | glVertex .5, $self->{h} * .5; |
2287 | glVertex .5, $self->{h} * .5; |
2281 | glVertex .5, $self->{h} - 2.5; |
2288 | glVertex .5, $self->{h} - 2.5; |
2282 | glVertex $self->{w} - .5, $self->{h} - 2.5; |
2289 | glVertex $self->{w} - .5, $self->{h} - 2.5; |
2283 | glVertex $self->{w} - .5, $self->{h} * .5; |
2290 | glVertex $self->{w} - .5, $self->{h} * .5; |
… | |
… | |
2290 | package DC::UI::Entry; |
2297 | package DC::UI::Entry; |
2291 | |
2298 | |
2292 | our @ISA = DC::UI::EntryBase::; |
2299 | our @ISA = DC::UI::EntryBase::; |
2293 | |
2300 | |
2294 | use DC::OpenGL; |
2301 | use DC::OpenGL; |
|
|
2302 | |
|
|
2303 | sub new { |
|
|
2304 | my $class = shift; |
|
|
2305 | |
|
|
2306 | $class->SUPER::new ( |
|
|
2307 | history_pointer => -1, |
|
|
2308 | @_ |
|
|
2309 | ) |
|
|
2310 | } |
|
|
2311 | |
2295 | |
2312 | |
2296 | sub invoke_key_down { |
2313 | sub invoke_key_down { |
2297 | my ($self, $ev) = @_; |
2314 | my ($self, $ev) = @_; |
2298 | |
2315 | |
2299 | my $sym = $ev->{sym}; |
2316 | my $sym = $ev->{sym}; |
… | |
… | |
2324 | $self->{history_pointer} = -1 if $self->{history_pointer} < 0; |
2341 | $self->{history_pointer} = -1 if $self->{history_pointer} < 0; |
2325 | |
2342 | |
2326 | if ($self->{history_pointer} >= 0) { |
2343 | if ($self->{history_pointer} >= 0) { |
2327 | $self->set_text ($self->{history}->[$self->{history_pointer}]); |
2344 | $self->set_text ($self->{history}->[$self->{history_pointer}]); |
2328 | } else { |
2345 | } else { |
|
|
2346 | if (defined $self->{history_saveback}) { |
2329 | $self->set_text ($self->{history_saveback}); |
2347 | $self->set_text ($self->{history_saveback}); |
|
|
2348 | $self->{history_saveback} = undef; |
|
|
2349 | } |
2330 | } |
2350 | } |
2331 | |
2351 | |
2332 | } else { |
2352 | } else { |
2333 | return $self->SUPER::invoke_key_down ($ev) |
2353 | return $self->SUPER::invoke_key_down ($ev) |
2334 | } |
2354 | } |
… | |
… | |
2392 | our @ISA = DC::UI::Bin::; |
2412 | our @ISA = DC::UI::Bin::; |
2393 | |
2413 | |
2394 | use DC::OpenGL; |
2414 | use DC::OpenGL; |
2395 | |
2415 | |
2396 | my @tex = |
2416 | my @tex = |
2397 | map { new_from_file DC::Texture DC::find_rcfile $_, mipmap => 1 } |
2417 | map { new_from_resource DC::Texture $_, mipmap => 1 } |
2398 | qw(b1_button_inactive.png b1_button_active.png); |
2418 | qw(b1_button_inactive.png b1_button_active.png); |
2399 | |
2419 | |
2400 | sub new { |
2420 | sub new { |
2401 | my $class = shift; |
2421 | my $class = shift; |
2402 | |
2422 | |
… | |
… | |
2441 | our @ISA = DC::UI::Label::; |
2461 | our @ISA = DC::UI::Label::; |
2442 | |
2462 | |
2443 | use DC::OpenGL; |
2463 | use DC::OpenGL; |
2444 | |
2464 | |
2445 | my @tex = |
2465 | my @tex = |
2446 | map { new_from_file DC::Texture DC::find_rcfile $_, mipmap => 1 } |
2466 | map { new_from_resource DC::Texture $_, mipmap => 1 } |
2447 | qw(b1_button_inactive.png b1_button_active.png); |
2467 | qw(b1_button_inactive.png b1_button_active.png); |
2448 | |
2468 | |
2449 | sub new { |
2469 | sub new { |
2450 | my $class = shift; |
2470 | my $class = shift; |
2451 | |
2471 | |
… | |
… | |
2494 | package DC::UI::CheckBox; |
2514 | package DC::UI::CheckBox; |
2495 | |
2515 | |
2496 | our @ISA = DC::UI::DrawBG::; |
2516 | our @ISA = DC::UI::DrawBG::; |
2497 | |
2517 | |
2498 | my @tex = |
2518 | my @tex = |
2499 | map { new_from_file DC::Texture DC::find_rcfile $_, mipmap => 1 } |
2519 | map { new_from_resource DC::Texture $_, mipmap => 1 } |
2500 | qw(c1_checkbox_bg.png c1_checkbox_active.png); |
2520 | qw(c1_checkbox_bg.png c1_checkbox_active.png); |
2501 | |
2521 | |
2502 | use DC::OpenGL; |
2522 | use DC::OpenGL; |
2503 | |
2523 | |
2504 | sub new { |
2524 | sub new { |
2505 | my $class = shift; |
2525 | my $class = shift; |
2506 | |
2526 | |
2507 | $class->SUPER::new ( |
2527 | $class->SUPER::new ( |
|
|
2528 | fontsize => 1, |
2508 | padding_x => 2, |
2529 | padding_x => 2, |
2509 | padding_y => 2, |
2530 | padding_y => 2, |
2510 | fg => [1, 1, 1], |
2531 | fg => [1, 1, 1], |
2511 | active_fg => [1, 1, 0], |
2532 | active_fg => [1, 1, 0], |
2512 | bg => [0, 0, 0, 0.2], |
2533 | bg => [0, 0, 0, 0.2], |
… | |
… | |
2518 | } |
2539 | } |
2519 | |
2540 | |
2520 | sub size_request { |
2541 | sub size_request { |
2521 | my ($self) = @_; |
2542 | my ($self) = @_; |
2522 | |
2543 | |
2523 | (6) x 2 |
2544 | ($self->{fontsize} * $::FONTSIZE) x 2 |
2524 | } |
2545 | } |
2525 | |
2546 | |
2526 | sub toggle { |
2547 | sub toggle { |
2527 | my ($self) = @_; |
2548 | my ($self) = @_; |
2528 | |
2549 | |
… | |
… | |
2585 | |
2606 | |
2586 | $self->{path} || $self->{tex} |
2607 | $self->{path} || $self->{tex} |
2587 | or Carp::croak "'path' or 'tex' attributes required"; |
2608 | or Carp::croak "'path' or 'tex' attributes required"; |
2588 | |
2609 | |
2589 | $self->{tex} ||= $texture_cache{$self->{path}} ||= |
2610 | $self->{tex} ||= $texture_cache{$self->{path}} ||= |
2590 | new_from_file DC::Texture DC::find_rcfile $self->{path}, mipmap => 1; |
2611 | new_from_resource DC::Texture $self->{path}, mipmap => 1; |
2591 | |
2612 | |
2592 | DC::weaken $texture_cache{$self->{path}}; |
2613 | DC::weaken $texture_cache{$self->{path}}; |
2593 | |
2614 | |
2594 | $self->{aspect} ||= $self->{tex}{w} / $self->{tex}{h}; |
2615 | $self->{aspect} ||= $self->{tex}{w} / $self->{tex}{h}; |
2595 | |
2616 | |
… | |
… | |
2691 | |
2712 | |
2692 | use DC::OpenGL; |
2713 | use DC::OpenGL; |
2693 | |
2714 | |
2694 | my %tex = ( |
2715 | my %tex = ( |
2695 | food => [ |
2716 | food => [ |
2696 | map { new_from_file DC::Texture DC::find_rcfile $_, mipmap => 1 } |
2717 | map { new_from_resource DC::Texture $_, mipmap => 1 } |
2697 | qw/g1_food_gauge_empty.png g1_food_gauge_full.png/ |
2718 | qw/g1_food_gauge_empty.png g1_food_gauge_full.png/ |
2698 | ], |
2719 | ], |
2699 | grace => [ |
2720 | grace => [ |
2700 | map { new_from_file DC::Texture DC::find_rcfile $_, mipmap => 1 } |
2721 | map { new_from_resource DC::Texture $_, mipmap => 1 } |
2701 | qw/g1_grace_gauge_empty.png g1_grace_gauge_full.png g1_grace_gauge_overflow.png/ |
2722 | qw/g1_grace_gauge_empty.png g1_grace_gauge_full.png g1_grace_gauge_overflow.png/ |
2702 | ], |
2723 | ], |
2703 | hp => [ |
2724 | hp => [ |
2704 | map { new_from_file DC::Texture DC::find_rcfile $_, mipmap => 1 } |
2725 | map { new_from_resource DC::Texture $_, mipmap => 1 } |
2705 | qw/g1_hp_gauge_empty.png g1_hp_gauge_full.png/ |
2726 | qw/g1_hp_gauge_empty.png g1_hp_gauge_full.png/ |
2706 | ], |
2727 | ], |
2707 | mana => [ |
2728 | mana => [ |
2708 | map { new_from_file DC::Texture DC::find_rcfile $_, mipmap => 1 } |
2729 | map { new_from_resource DC::Texture $_, mipmap => 1 } |
2709 | qw/g1_mana_gauge_empty.png g1_mana_gauge_full.png g1_mana_gauge_overflow.png/ |
2730 | qw/g1_mana_gauge_empty.png g1_mana_gauge_full.png g1_mana_gauge_overflow.png/ |
2710 | ], |
2731 | ], |
2711 | ); |
2732 | ); |
2712 | |
2733 | |
2713 | # eg. VGauge->new (gauge => 'food'), default gauge: food |
2734 | # eg. VGauge->new (gauge => 'food'), default gauge: food |
… | |
… | |
2826 | |
2847 | |
2827 | sub new { |
2848 | sub new { |
2828 | my ($class, %arg) = @_; |
2849 | my ($class, %arg) = @_; |
2829 | |
2850 | |
2830 | my $self = $class->SUPER::new ( |
2851 | my $self = $class->SUPER::new ( |
|
|
2852 | padding_x => 2, |
|
|
2853 | padding_y => 2, |
2831 | fg => [1, 1, 1], |
2854 | fg => [1, 1, 1], |
2832 | bg => [0, 0, 1, 0.2], |
2855 | bg => [0, 0, 1, 0.2], |
2833 | bar => [0.7, 0.5, 0.1, 0.8], |
2856 | bar => [0.7, 0.5, 0.1, 0.8], |
2834 | outline => [0.4, 0.3, 0], |
2857 | outline => [0.4, 0.3, 0], |
2835 | fontsize => 0.9, |
2858 | fontsize => 0.9, |
… | |
… | |
2875 | my ($self) = @_; |
2898 | my ($self) = @_; |
2876 | |
2899 | |
2877 | glEnable GL_BLEND; |
2900 | glEnable GL_BLEND; |
2878 | glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA; |
2901 | glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA; |
2879 | |
2902 | |
|
|
2903 | my $px = $self->{padding_x}; |
|
|
2904 | my $py = $self->{padding_y}; |
|
|
2905 | |
2880 | if ($self->{value} >= 0) { |
2906 | if ($self->{value} >= 0) { |
2881 | my $s = int 2 + ($self->{w} - 4) * $self->{value}; |
2907 | my $s = int $px + ($self->{w} - $px * 2) * $self->{value}; |
2882 | |
2908 | |
2883 | glColor_premultiply @{$self->{bar}}; |
2909 | glColor_premultiply @{$self->{bar}}; |
2884 | glRect 2, 2, $s, $self->{h} - 2; |
2910 | glRect $px, $py, $s, $self->{h} - $py; |
2885 | glColor_premultiply @{$self->{bg}}; |
2911 | glColor_premultiply @{$self->{bg}}; |
2886 | glRect $s, 2, $self->{w} - 2, $self->{h} - 2; |
2912 | glRect $s , $py, $self->{w} - $px, $self->{h} - $py; |
2887 | } |
2913 | } |
2888 | |
2914 | |
2889 | glColor_premultiply @{$self->{outline}}; |
2915 | glColor_premultiply @{$self->{outline}}; |
|
|
2916 | |
|
|
2917 | $px -= .5; |
|
|
2918 | $py -= .5; |
|
|
2919 | |
2890 | glRect_lineloop 1.5, 1.5, $self->{w} - 1.5, $self->{h} - 1.5; |
2920 | glRect_lineloop $px, $py, $self->{w} - $px, $self->{h} - $py; |
2891 | |
2921 | |
2892 | glDisable GL_BLEND; |
2922 | glDisable GL_BLEND; |
2893 | |
2923 | |
2894 | { |
2924 | { |
2895 | local $self->{bg}; # do not draw background |
2925 | local $self->{bg}; # do not draw background |
… | |
… | |
2904 | our @ISA = DC::UI::Progress::; |
2934 | our @ISA = DC::UI::Progress::; |
2905 | |
2935 | |
2906 | sub new { |
2936 | sub new { |
2907 | my ($class, %arg) = @_; |
2937 | my ($class, %arg) = @_; |
2908 | |
2938 | |
|
|
2939 | my $tt = exists $arg{tooltip} ? "$arg{tooltip}\n\n" : ""; |
|
|
2940 | |
2909 | my $self = $class->SUPER::new ( |
2941 | my $self = $class->SUPER::new ( |
|
|
2942 | %arg, |
2910 | tooltip => sub { |
2943 | tooltip => sub { |
2911 | my ($self) = @_; |
2944 | my ($self) = @_; |
2912 | |
2945 | |
2913 | sprintf "level %d\n%s points\n%s next level\n%s to go", |
2946 | sprintf "%slevel %d\n%s points\n%s next level\n%s to go, %d%% done", |
|
|
2947 | $tt, |
2914 | $self->{lvl}, |
2948 | $self->{lvl}, |
2915 | ::formsep ($self->{exp}), |
2949 | ::formsep ($self->{exp}), |
2916 | ::formsep ($self->{nxt}), |
2950 | ::formsep ($self->{nxt}), |
2917 | ::formsep ($self->{nxt} - $self->{exp}), |
2951 | ::formsep ($self->{nxt} - $self->{exp}), |
|
|
2952 | $self->_percent * 100, |
2918 | }, |
2953 | }, |
2919 | %arg |
|
|
2920 | ); |
2954 | ); |
2921 | |
2955 | |
2922 | $::CONN->{on_exp_update}{$self+0} = sub { $self->set_value ($self->{value}) } |
2956 | $::CONN->{on_exp_update}{$self+0} = sub { $self->set_value ($self->{value}) } |
2923 | if $::CONN; |
2957 | if $::CONN; |
2924 | |
2958 | |
… | |
… | |
2932 | if $::CONN; |
2966 | if $::CONN; |
2933 | |
2967 | |
2934 | $self->SUPER::DESTROY; |
2968 | $self->SUPER::DESTROY; |
2935 | } |
2969 | } |
2936 | |
2970 | |
|
|
2971 | sub _percent { |
|
|
2972 | my ($self) = @_; |
|
|
2973 | |
|
|
2974 | my $table = $::CONN && $::CONN->{exp_table} |
|
|
2975 | or return -1; |
|
|
2976 | |
|
|
2977 | my $l0 = $table->[$self->{lvl} - 1]; |
|
|
2978 | my $l1 = $table->[$self->{lvl}]; |
|
|
2979 | |
|
|
2980 | $self->{nxt} = $l1; |
|
|
2981 | |
|
|
2982 | ($self->{exp} - $l0) / ($l1 - $l0) |
|
|
2983 | } |
|
|
2984 | |
2937 | sub set_value { |
2985 | sub set_value { |
2938 | my ($self, $lvl, $exp) = @_; |
2986 | my ($self, $lvl, $exp) = @_; |
2939 | |
2987 | |
2940 | $self->{lvl} = $lvl; |
2988 | $self->{lvl} = $lvl; |
2941 | $self->{exp} = $exp; |
2989 | $self->{exp} = $exp; |
2942 | |
2990 | |
2943 | my $v = -1; |
|
|
2944 | |
|
|
2945 | if ($::CONN && (my $table = $::CONN->{exp_table})) { |
|
|
2946 | my $l0 = $table->[$lvl - 1]; |
|
|
2947 | my $l1 = $table->[$lvl]; |
|
|
2948 | |
|
|
2949 | $self->{nxt} = $l1; |
|
|
2950 | |
|
|
2951 | $v = ($exp - $l0) / ($l1 - $l0); |
|
|
2952 | } |
|
|
2953 | |
|
|
2954 | $self->SUPER::set_value ($v); |
2991 | $self->SUPER::set_value ($self->_percent); |
2955 | } |
2992 | } |
2956 | |
2993 | |
2957 | ############################################################################# |
2994 | ############################################################################# |
2958 | |
2995 | |
2959 | package DC::UI::Gauge; |
2996 | package DC::UI::Gauge; |
… | |
… | |
3010 | use DC::OpenGL; |
3047 | use DC::OpenGL; |
3011 | |
3048 | |
3012 | our @ISA = DC::UI::DrawBG::; |
3049 | our @ISA = DC::UI::DrawBG::; |
3013 | |
3050 | |
3014 | my @tex = |
3051 | my @tex = |
3015 | map { new_from_file DC::Texture DC::find_rcfile $_ } |
3052 | map { new_from_resource DC::Texture $_ } |
3016 | qw(s1_slider.png s1_slider_bg.png); |
3053 | qw(s1_slider.png s1_slider_bg.png); |
3017 | |
3054 | |
3018 | sub new { |
3055 | sub new { |
3019 | my $class = shift; |
3056 | my $class = shift; |
3020 | |
3057 | |
… | |
… | |
3057 | sub set_value { |
3094 | sub set_value { |
3058 | my ($self, $value) = @_; |
3095 | my ($self, $value) = @_; |
3059 | |
3096 | |
3060 | my ($old_value, $lo, $hi, $page, $unit) = @{$self->{range}}; |
3097 | my ($old_value, $lo, $hi, $page, $unit) = @{$self->{range}}; |
3061 | |
3098 | |
3062 | $hi = $lo + 1 if $hi <= $lo; |
3099 | $hi = $lo if $hi < $lo; |
3063 | |
3100 | |
3064 | $page = $hi - $lo if $page > $hi - $lo; |
3101 | $value = $hi - $page if $value > $hi - $page; |
3065 | |
|
|
3066 | $value = $lo if $value < $lo; |
3102 | $value = $lo if $value < $lo; |
3067 | $value = $hi - $page if $value > $hi - $page; |
|
|
3068 | |
3103 | |
3069 | $value = $lo + $unit * int +($value - $lo + $unit * 0.5) / $unit |
3104 | $value = $lo + $unit * int +($value - $lo + $unit * 0.5) / $unit |
3070 | if $unit; |
3105 | if $unit; |
3071 | |
3106 | |
3072 | @{$self->{range}} = ($value, $lo, $hi, $page, $unit); |
3107 | @{$self->{range}} = ($value, $lo, $hi, $page, $unit); |
… | |
… | |
3136 | my ($self) = @_; |
3171 | my ($self) = @_; |
3137 | |
3172 | |
3138 | unless ($self->{knob_w}) { |
3173 | unless ($self->{knob_w}) { |
3139 | $self->set_value ($self->{range}[0]); |
3174 | $self->set_value ($self->{range}[0]); |
3140 | |
3175 | |
3141 | my ($value, $lo, $hi, $page) = @{$self->{range}}; |
3176 | my ($value, $lo, $hi, $page, $unit) = @{$self->{range}}; |
3142 | my $range = ($hi - $page - $lo) || 1e-100; |
3177 | my $range = ($hi - $page - $lo) || 1e-10; |
3143 | |
3178 | |
3144 | my $knob_w = List::Util::min 1, $page / ($hi - $lo) || 0.1; |
3179 | my $knob_w = List::Util::min 1, $page / (($hi - $lo) || 1e-10) || 24 / $self->{w}; |
3145 | |
3180 | |
3146 | $self->{offset} = List::Util::max $self->{inner_pad}, $knob_w * 0.5; |
3181 | $self->{offset} = List::Util::max $self->{inner_pad}, $knob_w * 0.5; |
3147 | $self->{scale} = 1 - 2 * $self->{offset} || 1e-100; |
3182 | $self->{scale} = 1 - 2 * $self->{offset} || 1e-100; |
3148 | |
3183 | |
3149 | $value = ($value - $lo) / $range; |
3184 | $value = ($value - $lo) / $range; |
… | |
… | |
3609 | |
3644 | |
3610 | $tip =~ s/^\n+//; |
3645 | $tip =~ s/^\n+//; |
3611 | $tip =~ s/\n+$//; |
3646 | $tip =~ s/\n+$//; |
3612 | |
3647 | |
3613 | $self->add (new DC::UI::Label |
3648 | $self->add (new DC::UI::Label |
|
|
3649 | fg => $DC::THEME{tooltip_fg}, |
3614 | markup => $tip, |
3650 | markup => $tip, |
3615 | max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH, |
3651 | max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH, |
3616 | align => 0, |
3652 | align => 0, |
3617 | fontsize => 0.8, |
3653 | fontsize => 0.8, |
3618 | style => 1, # FLAG_INVERSE |
3654 | style => $DC::THEME{tooltip_style}, # FLAG_INVERSE |
3619 | ellipsise => 0, |
3655 | ellipsise => 0, |
3620 | font => ($widget->{tooltip_font} || $::FONT_PROP), |
3656 | font => ($widget->{tooltip_font} || $::FONT_PROP), |
3621 | ); |
3657 | ); |
3622 | } |
3658 | } |
3623 | |
3659 | |
… | |
… | |
3660 | sub _draw { |
3696 | sub _draw { |
3661 | my ($self) = @_; |
3697 | my ($self) = @_; |
3662 | |
3698 | |
3663 | my ($w, $h) = @$self{qw(w h)}; |
3699 | my ($w, $h) = @$self{qw(w h)}; |
3664 | |
3700 | |
3665 | glColor 1, 0.8, 0.4; |
3701 | glColor @{ $DC::THEME{tooltip_bg} }; |
3666 | glRect 0, 0, $w, $h; |
3702 | glRect 0, 0, $w, $h; |
3667 | |
3703 | |
3668 | glColor 0, 0, 0; |
3704 | glColor @{ $DC::THEME{tooltip_border} }; |
3669 | glRect_lineloop .5, .5, $w + .5, $h + .5; |
3705 | glRect_lineloop .5, .5, $w + .5, $h + .5; |
3670 | |
3706 | |
3671 | glTranslate 2, 2; |
3707 | glTranslate 2, 2; |
3672 | |
3708 | |
3673 | $self->SUPER::_draw; |
3709 | $self->SUPER::_draw; |
… | |
… | |
3845 | $widget = new DC::UI::HBox |
3881 | $widget = new DC::UI::HBox |
3846 | can_hover => 1, |
3882 | can_hover => 1, |
3847 | can_events => 1, |
3883 | can_events => 1, |
3848 | tooltip => $tooltip, |
3884 | tooltip => $tooltip, |
3849 | children => [ |
3885 | children => [ |
3850 | (new DC::UI::Label markup => $left, expand => 1), |
3886 | (new DC::UI::Label markup => $left , align => 0, expand => 1), |
3851 | (new DC::UI::Label markup => $right, align => 1), |
3887 | (new DC::UI::Label markup => $right, align => 1), |
3852 | ], |
3888 | ], |
3853 | ; |
3889 | ; |
3854 | |
3890 | |
3855 | } else { |
3891 | } else { |
… | |
… | |
3879 | # maybe save $GRAB? must be careful about events... |
3915 | # maybe save $GRAB? must be careful about events... |
3880 | $GRAB = $self; |
3916 | $GRAB = $self; |
3881 | $self->{button} = $ev->{button}; |
3917 | $self->{button} = $ev->{button}; |
3882 | |
3918 | |
3883 | $self->show; |
3919 | $self->show; |
3884 | $self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5); |
3920 | |
|
|
3921 | my $x = $ev->{x}; |
|
|
3922 | my $y = $ev->{y}; |
|
|
3923 | |
|
|
3924 | $self->{root}->on_post_alloc ($self => sub { |
|
|
3925 | $self->move_abs ($x - $self->{w} * 0.25, $y - $self->{border} * $::FONTSIZE * .5); |
|
|
3926 | }); |
|
|
3927 | |
|
|
3928 | 1 # so it can be used inside event handlers |
3885 | } |
3929 | } |
3886 | |
3930 | |
3887 | sub invoke_mouse_motion { |
3931 | sub invoke_mouse_motion { |
3888 | my ($self, $ev, $x, $y) = @_; |
3932 | my ($self, $ev, $x, $y) = @_; |
3889 | |
3933 | |
… | |
… | |
3921 | |
3965 | |
3922 | my $self = $class->SUPER::new ( |
3966 | my $self = $class->SUPER::new ( |
3923 | @_, |
3967 | @_, |
3924 | ); |
3968 | ); |
3925 | |
3969 | |
3926 | $self->{current} = $self->{children}[0] |
3970 | $self->set_current_page (0); |
3927 | if @{ $self->{children} }; |
|
|
3928 | |
3971 | |
3929 | $self |
3972 | $self |
3930 | } |
3973 | } |
3931 | |
3974 | |
3932 | sub add { |
3975 | sub add { |
3933 | my ($self, @widgets) = @_; |
3976 | my ($self, @widgets) = @_; |
3934 | |
3977 | |
3935 | $self->SUPER::add (@widgets); |
3978 | $self->SUPER::add (@widgets); |
3936 | |
3979 | |
3937 | $self->{current} = $self->{children}[0] |
3980 | $self->set_current_page (0) |
3938 | if @{ $self->{children} }; |
3981 | if @widgets == @{ $self->{children} }; |
3939 | } |
3982 | } |
3940 | |
3983 | |
3941 | sub get_current_page { |
3984 | sub get_current_page { |
3942 | my ($self) = @_; |
3985 | my ($self) = @_; |
3943 | |
3986 | |
… | |
… | |
3949 | |
3992 | |
3950 | my $widget = ref $page_or_widget |
3993 | my $widget = ref $page_or_widget |
3951 | ? $page_or_widget |
3994 | ? $page_or_widget |
3952 | : $self->{children}[$page_or_widget]; |
3995 | : $self->{children}[$page_or_widget]; |
3953 | |
3996 | |
|
|
3997 | $self->{current}->set_invisible if $self->{current} && $self->{visible}; |
|
|
3998 | |
3954 | $self->{current} = $widget; |
3999 | if (($self->{current} = $widget)) { |
|
|
4000 | $self->{current}->set_visible if $self->{current} && $self->{visible}; |
3955 | $self->{current}->configure (0, 0, $self->{w}, $self->{h}); |
4001 | $self->{current}->configure (0, 0, $self->{w}, $self->{h}); |
3956 | |
4002 | |
3957 | $self->emit (page_changed => $self->{current}); |
4003 | $self->emit (page_changed => $self->{current}); |
|
|
4004 | } |
3958 | |
4005 | |
3959 | $self->realloc; |
4006 | $self->realloc; |
3960 | } |
4007 | } |
3961 | |
4008 | |
3962 | sub visible_children { |
4009 | sub visible_children { |
3963 | $_[0]{current} |
4010 | $_[0]{current} || () |
3964 | } |
4011 | } |
3965 | |
4012 | |
3966 | sub size_request { |
4013 | sub size_request { |
3967 | my ($self) = @_; |
4014 | my ($self) = @_; |
3968 | |
4015 | |
|
|
4016 | $self->{current} |
3969 | $self->{current}->size_request |
4017 | ? $self->{current}->size_request |
|
|
4018 | : (0, 0) |
3970 | } |
4019 | } |
3971 | |
4020 | |
3972 | sub invoke_size_allocate { |
4021 | sub invoke_size_allocate { |
3973 | my ($self, $w, $h) = @_; |
4022 | my ($self, $w, $h) = @_; |
3974 | |
4023 | |
3975 | $self->{current}->configure (0, 0, $w, $h); |
4024 | $self->{current}->configure (0, 0, $w, $h) |
|
|
4025 | if $self->{current}; |
3976 | |
4026 | |
3977 | 1 |
4027 | 1 |
3978 | } |
4028 | } |
3979 | |
4029 | |
3980 | sub _draw { |
4030 | sub _draw { |
3981 | my ($self) = @_; |
4031 | my ($self) = @_; |
3982 | |
4032 | |
3983 | $self->{current}->draw; |
4033 | $self->{current}->draw |
|
|
4034 | if $self->{current}; |
3984 | } |
4035 | } |
3985 | |
4036 | |
3986 | ############################################################################# |
4037 | ############################################################################# |
3987 | |
4038 | |
3988 | package DC::UI::Notebook; |
4039 | package DC::UI::Notebook; |
… | |
… | |
4055 | } |
4106 | } |
4056 | |
4107 | |
4057 | sub pages { |
4108 | sub pages { |
4058 | my ($self) = @_; |
4109 | my ($self) = @_; |
4059 | $self->{multiplexer}->children |
4110 | $self->{multiplexer}->children |
|
|
4111 | } |
|
|
4112 | |
|
|
4113 | sub page_index { |
|
|
4114 | my ($self, $widget) = @_; |
|
|
4115 | |
|
|
4116 | my $i = 0; |
|
|
4117 | for ($self->pages) { |
|
|
4118 | if ($_ eq $widget) { return $i }; |
|
|
4119 | $i++; |
|
|
4120 | } |
|
|
4121 | |
|
|
4122 | undef |
4060 | } |
4123 | } |
4061 | |
4124 | |
4062 | sub add_tab { |
4125 | sub add_tab { |
4063 | my ($self, $title, $widget, $tooltip) = @_; |
4126 | my ($self, $title, $widget, $tooltip) = @_; |
4064 | |
4127 | |
… | |
… | |
4186 | $self |
4249 | $self |
4187 | } |
4250 | } |
4188 | |
4251 | |
4189 | sub reorder { |
4252 | sub reorder { |
4190 | my ($self) = @_; |
4253 | my ($self) = @_; |
4191 | my $NOW = Time::HiRes::time; |
4254 | my $NOW = EV::time; |
4192 | |
4255 | |
4193 | # freeze display when hovering over any label |
4256 | # freeze display when hovering over any label |
4194 | return if $DC::UI::TOOLTIP->{owner} |
4257 | return if $DC::UI::TOOLTIP->{owner} |
4195 | && grep $DC::UI::TOOLTIP->{owner} == $_->{label}, |
4258 | && grep $DC::UI::TOOLTIP->{owner} == $_->{label}, |
4196 | values %{ $self->{item} }; |
4259 | values %{ $self->{item} }; |
… | |
… | |
4246 | $label->{fg}[3] = $item->{fg}[3] || 1; |
4309 | $label->{fg}[3] = $item->{fg}[3] || 1; |
4247 | } |
4310 | } |
4248 | |
4311 | |
4249 | push @widgets, $label; |
4312 | push @widgets, $label; |
4250 | } |
4313 | } |
|
|
4314 | |
|
|
4315 | my $hash = join ",", @widgets; |
|
|
4316 | return if $hash eq $self->{last_widget_hash}; |
|
|
4317 | $self->{last_widget_hash} = $hash; |
4251 | |
4318 | |
4252 | $self->clear; |
4319 | $self->clear; |
4253 | $self->SUPER::add (reverse @widgets); |
4320 | $self->SUPER::add (reverse @widgets); |
4254 | } |
4321 | } |
4255 | |
4322 | |
… | |
… | |
4556 | |
4623 | |
4557 | ############################################################################# |
4624 | ############################################################################# |
4558 | |
4625 | |
4559 | package DC::UI; |
4626 | package DC::UI; |
4560 | |
4627 | |
4561 | $ROOT = new DC::UI::Root; |
4628 | $ROOT = new DC::UI::Root; |
4562 | $TOOLTIP = new DC::UI::Tooltip z => 900; |
4629 | $TOOLTIP = new DC::UI::Tooltip z => 900; |
4563 | |
4630 | |
4564 | 1 |
4631 | 1 |
4565 | |
|
|