… | |
… | |
1344 | our @ISA = DC::UI::Bin::; |
1344 | our @ISA = DC::UI::Bin::; |
1345 | |
1345 | |
1346 | use DC::OpenGL; |
1346 | use DC::OpenGL; |
1347 | |
1347 | |
1348 | my $bg = |
1348 | my $bg = |
1349 | new_from_file DC::Texture DC::find_rcfile "d1_bg.png", |
1349 | new_from_resource DC::Texture "d1_bg.png", |
1350 | mipmap => 1, wrap => 1; |
1350 | mipmap => 1, wrap => 1; |
1351 | |
1351 | |
1352 | my @border = |
1352 | my @border = |
1353 | map { new_from_file DC::Texture DC::find_rcfile $_, mipmap => 1 } |
1353 | 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); |
1354 | qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png); |
1355 | |
1355 | |
1356 | my @icon = |
1356 | my @icon = |
1357 | map { new_from_file DC::Texture DC::find_rcfile $_, mipmap => 1 } |
1357 | map { new_from_resource DC::Texture $_, mipmap => 1 } |
1358 | qw(x1_move.png x1_resize.png); |
1358 | qw(x1_move.png x1_resize.png); |
1359 | |
1359 | |
1360 | sub new { |
1360 | sub new { |
1361 | my ($class, %arg) = @_; |
1361 | my ($class, %arg) = @_; |
1362 | |
1362 | |
1363 | my $self = $class->SUPER::new ( |
1363 | my $self = $class->SUPER::new ( |
1364 | bg => [1, 1, 1, 1], |
1364 | bg => [1, 1, 1, 1], |
1365 | border_bg => [1, 1, 1, 1], |
1365 | border_bg => [1, 1, 1, 1], |
1366 | border => 0.6, |
1366 | border => 1, |
1367 | can_events => 1, |
1367 | can_events => 1, |
1368 | min_w => 64, |
1368 | min_w => 64, |
1369 | min_h => 32, |
1369 | min_h => 32, |
1370 | %arg, |
1370 | %arg, |
1371 | ); |
1371 | ); |
… | |
… | |
2158 | |
2158 | |
2159 | my $text = $self->get_text; |
2159 | my $text = $self->get_text; |
2160 | |
2160 | |
2161 | $self->{cursor} = List::Util::max 0, List::Util::min $self->{cursor}, length $text; |
2161 | $self->{cursor} = List::Util::max 0, List::Util::min $self->{cursor}, length $text; |
2162 | |
2162 | |
2163 | if ($uni == 8) { |
2163 | if ($sym == DC::SDLK_BACKSPACE) { |
2164 | substr $text, --$self->{cursor}, 1, "" if $self->{cursor}; |
2164 | substr $text, --$self->{cursor}, 1, "" if $self->{cursor}; |
2165 | } elsif ($uni == 127) { |
2165 | } elsif ($sym == DC::SDLK_DELETE) { |
2166 | substr $text, $self->{cursor}, 1, ""; |
2166 | substr $text, $self->{cursor}, 1, ""; |
2167 | } elsif ($sym == DC::SDLK_LEFT) { |
2167 | } elsif ($sym == DC::SDLK_LEFT) { |
2168 | --$self->{cursor} if $self->{cursor}; |
2168 | --$self->{cursor} if $self->{cursor}; |
2169 | } elsif ($sym == DC::SDLK_RIGHT) { |
2169 | } elsif ($sym == DC::SDLK_RIGHT) { |
2170 | ++$self->{cursor} if $self->{cursor} < length $self->{text}; |
2170 | ++$self->{cursor} if $self->{cursor} < length $self->{text}; |
… | |
… | |
2291 | |
2291 | |
2292 | our @ISA = DC::UI::EntryBase::; |
2292 | our @ISA = DC::UI::EntryBase::; |
2293 | |
2293 | |
2294 | use DC::OpenGL; |
2294 | use DC::OpenGL; |
2295 | |
2295 | |
|
|
2296 | sub new { |
|
|
2297 | my $class = shift; |
|
|
2298 | |
|
|
2299 | $class->SUPER::new ( |
|
|
2300 | history_pointer => -1, |
|
|
2301 | @_ |
|
|
2302 | ) |
|
|
2303 | } |
|
|
2304 | |
|
|
2305 | |
2296 | sub invoke_key_down { |
2306 | sub invoke_key_down { |
2297 | my ($self, $ev) = @_; |
2307 | my ($self, $ev) = @_; |
2298 | |
2308 | |
2299 | my $sym = $ev->{sym}; |
2309 | my $sym = $ev->{sym}; |
2300 | |
2310 | |
… | |
… | |
2324 | $self->{history_pointer} = -1 if $self->{history_pointer} < 0; |
2334 | $self->{history_pointer} = -1 if $self->{history_pointer} < 0; |
2325 | |
2335 | |
2326 | if ($self->{history_pointer} >= 0) { |
2336 | if ($self->{history_pointer} >= 0) { |
2327 | $self->set_text ($self->{history}->[$self->{history_pointer}]); |
2337 | $self->set_text ($self->{history}->[$self->{history_pointer}]); |
2328 | } else { |
2338 | } else { |
|
|
2339 | if (defined $self->{history_saveback}) { |
2329 | $self->set_text ($self->{history_saveback}); |
2340 | $self->set_text ($self->{history_saveback}); |
|
|
2341 | $self->{history_saveback} = undef; |
|
|
2342 | } |
2330 | } |
2343 | } |
2331 | |
2344 | |
2332 | } else { |
2345 | } else { |
2333 | return $self->SUPER::invoke_key_down ($ev) |
2346 | return $self->SUPER::invoke_key_down ($ev) |
2334 | } |
2347 | } |
… | |
… | |
2392 | our @ISA = DC::UI::Bin::; |
2405 | our @ISA = DC::UI::Bin::; |
2393 | |
2406 | |
2394 | use DC::OpenGL; |
2407 | use DC::OpenGL; |
2395 | |
2408 | |
2396 | my @tex = |
2409 | my @tex = |
2397 | map { new_from_file DC::Texture DC::find_rcfile $_, mipmap => 1 } |
2410 | map { new_from_resource DC::Texture $_, mipmap => 1 } |
2398 | qw(b1_button_inactive.png b1_button_active.png); |
2411 | qw(b1_button_inactive.png b1_button_active.png); |
2399 | |
2412 | |
2400 | sub new { |
2413 | sub new { |
2401 | my $class = shift; |
2414 | my $class = shift; |
2402 | |
2415 | |
… | |
… | |
2441 | our @ISA = DC::UI::Label::; |
2454 | our @ISA = DC::UI::Label::; |
2442 | |
2455 | |
2443 | use DC::OpenGL; |
2456 | use DC::OpenGL; |
2444 | |
2457 | |
2445 | my @tex = |
2458 | my @tex = |
2446 | map { new_from_file DC::Texture DC::find_rcfile $_, mipmap => 1 } |
2459 | map { new_from_resource DC::Texture $_, mipmap => 1 } |
2447 | qw(b1_button_inactive.png b1_button_active.png); |
2460 | qw(b1_button_inactive.png b1_button_active.png); |
2448 | |
2461 | |
2449 | sub new { |
2462 | sub new { |
2450 | my $class = shift; |
2463 | my $class = shift; |
2451 | |
2464 | |
… | |
… | |
2494 | package DC::UI::CheckBox; |
2507 | package DC::UI::CheckBox; |
2495 | |
2508 | |
2496 | our @ISA = DC::UI::DrawBG::; |
2509 | our @ISA = DC::UI::DrawBG::; |
2497 | |
2510 | |
2498 | my @tex = |
2511 | my @tex = |
2499 | map { new_from_file DC::Texture DC::find_rcfile $_, mipmap => 1 } |
2512 | map { new_from_resource DC::Texture $_, mipmap => 1 } |
2500 | qw(c1_checkbox_bg.png c1_checkbox_active.png); |
2513 | qw(c1_checkbox_bg.png c1_checkbox_active.png); |
2501 | |
2514 | |
2502 | use DC::OpenGL; |
2515 | use DC::OpenGL; |
2503 | |
2516 | |
2504 | sub new { |
2517 | sub new { |
… | |
… | |
2585 | |
2598 | |
2586 | $self->{path} || $self->{tex} |
2599 | $self->{path} || $self->{tex} |
2587 | or Carp::croak "'path' or 'tex' attributes required"; |
2600 | or Carp::croak "'path' or 'tex' attributes required"; |
2588 | |
2601 | |
2589 | $self->{tex} ||= $texture_cache{$self->{path}} ||= |
2602 | $self->{tex} ||= $texture_cache{$self->{path}} ||= |
2590 | new_from_file DC::Texture DC::find_rcfile $self->{path}, mipmap => 1; |
2603 | new_from_resource DC::Texture $self->{path}, mipmap => 1; |
2591 | |
2604 | |
2592 | DC::weaken $texture_cache{$self->{path}}; |
2605 | DC::weaken $texture_cache{$self->{path}}; |
2593 | |
2606 | |
2594 | $self->{aspect} ||= $self->{tex}{w} / $self->{tex}{h}; |
2607 | $self->{aspect} ||= $self->{tex}{w} / $self->{tex}{h}; |
2595 | |
2608 | |
… | |
… | |
2691 | |
2704 | |
2692 | use DC::OpenGL; |
2705 | use DC::OpenGL; |
2693 | |
2706 | |
2694 | my %tex = ( |
2707 | my %tex = ( |
2695 | food => [ |
2708 | food => [ |
2696 | map { new_from_file DC::Texture DC::find_rcfile $_, mipmap => 1 } |
2709 | map { new_from_resource DC::Texture $_, mipmap => 1 } |
2697 | qw/g1_food_gauge_empty.png g1_food_gauge_full.png/ |
2710 | qw/g1_food_gauge_empty.png g1_food_gauge_full.png/ |
2698 | ], |
2711 | ], |
2699 | grace => [ |
2712 | grace => [ |
2700 | map { new_from_file DC::Texture DC::find_rcfile $_, mipmap => 1 } |
2713 | 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/ |
2714 | qw/g1_grace_gauge_empty.png g1_grace_gauge_full.png g1_grace_gauge_overflow.png/ |
2702 | ], |
2715 | ], |
2703 | hp => [ |
2716 | hp => [ |
2704 | map { new_from_file DC::Texture DC::find_rcfile $_, mipmap => 1 } |
2717 | map { new_from_resource DC::Texture $_, mipmap => 1 } |
2705 | qw/g1_hp_gauge_empty.png g1_hp_gauge_full.png/ |
2718 | qw/g1_hp_gauge_empty.png g1_hp_gauge_full.png/ |
2706 | ], |
2719 | ], |
2707 | mana => [ |
2720 | mana => [ |
2708 | map { new_from_file DC::Texture DC::find_rcfile $_, mipmap => 1 } |
2721 | 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/ |
2722 | qw/g1_mana_gauge_empty.png g1_mana_gauge_full.png g1_mana_gauge_overflow.png/ |
2710 | ], |
2723 | ], |
2711 | ); |
2724 | ); |
2712 | |
2725 | |
2713 | # eg. VGauge->new (gauge => 'food'), default gauge: food |
2726 | # eg. VGauge->new (gauge => 'food'), default gauge: food |
… | |
… | |
3010 | use DC::OpenGL; |
3023 | use DC::OpenGL; |
3011 | |
3024 | |
3012 | our @ISA = DC::UI::DrawBG::; |
3025 | our @ISA = DC::UI::DrawBG::; |
3013 | |
3026 | |
3014 | my @tex = |
3027 | my @tex = |
3015 | map { new_from_file DC::Texture DC::find_rcfile $_ } |
3028 | map { new_from_resource DC::Texture $_ } |
3016 | qw(s1_slider.png s1_slider_bg.png); |
3029 | qw(s1_slider.png s1_slider_bg.png); |
3017 | |
3030 | |
3018 | sub new { |
3031 | sub new { |
3019 | my $class = shift; |
3032 | my $class = shift; |
3020 | |
3033 | |
… | |
… | |
3057 | sub set_value { |
3070 | sub set_value { |
3058 | my ($self, $value) = @_; |
3071 | my ($self, $value) = @_; |
3059 | |
3072 | |
3060 | my ($old_value, $lo, $hi, $page, $unit) = @{$self->{range}}; |
3073 | my ($old_value, $lo, $hi, $page, $unit) = @{$self->{range}}; |
3061 | |
3074 | |
3062 | $hi = $lo + 1 if $hi <= $lo; |
3075 | $hi = $lo if $hi < $lo; |
3063 | |
3076 | |
3064 | $page = $hi - $lo if $page > $hi - $lo; |
3077 | $value = $hi - $page if $value > $hi - $page; |
3065 | |
|
|
3066 | $value = $lo if $value < $lo; |
3078 | $value = $lo if $value < $lo; |
3067 | $value = $hi - $page if $value > $hi - $page; |
|
|
3068 | |
3079 | |
3069 | $value = $lo + $unit * int +($value - $lo + $unit * 0.5) / $unit |
3080 | $value = $lo + $unit * int +($value - $lo + $unit * 0.5) / $unit |
3070 | if $unit; |
3081 | if $unit; |
3071 | |
3082 | |
3072 | @{$self->{range}} = ($value, $lo, $hi, $page, $unit); |
3083 | @{$self->{range}} = ($value, $lo, $hi, $page, $unit); |
… | |
… | |
3136 | my ($self) = @_; |
3147 | my ($self) = @_; |
3137 | |
3148 | |
3138 | unless ($self->{knob_w}) { |
3149 | unless ($self->{knob_w}) { |
3139 | $self->set_value ($self->{range}[0]); |
3150 | $self->set_value ($self->{range}[0]); |
3140 | |
3151 | |
3141 | my ($value, $lo, $hi, $page) = @{$self->{range}}; |
3152 | my ($value, $lo, $hi, $page, $unit) = @{$self->{range}}; |
3142 | my $range = ($hi - $page - $lo) || 1e-100; |
3153 | my $range = ($hi - $page - $lo) || 1e-10; |
3143 | |
3154 | |
3144 | my $knob_w = List::Util::min 1, $page / ($hi - $lo) || 0.1; |
3155 | my $knob_w = List::Util::min 1, $page / (($hi - $lo) || 1e-10) || 24 / $self->{w}; |
3145 | |
3156 | |
3146 | $self->{offset} = List::Util::max $self->{inner_pad}, $knob_w * 0.5; |
3157 | $self->{offset} = List::Util::max $self->{inner_pad}, $knob_w * 0.5; |
3147 | $self->{scale} = 1 - 2 * $self->{offset} || 1e-100; |
3158 | $self->{scale} = 1 - 2 * $self->{offset} || 1e-100; |
3148 | |
3159 | |
3149 | $value = ($value - $lo) / $range; |
3160 | $value = ($value - $lo) / $range; |
… | |
… | |
3845 | $widget = new DC::UI::HBox |
3856 | $widget = new DC::UI::HBox |
3846 | can_hover => 1, |
3857 | can_hover => 1, |
3847 | can_events => 1, |
3858 | can_events => 1, |
3848 | tooltip => $tooltip, |
3859 | tooltip => $tooltip, |
3849 | children => [ |
3860 | children => [ |
3850 | (new DC::UI::Label markup => $left, expand => 1), |
3861 | (new DC::UI::Label markup => $left , align => 0, expand => 1), |
3851 | (new DC::UI::Label markup => $right, align => 1), |
3862 | (new DC::UI::Label markup => $right, align => 1), |
3852 | ], |
3863 | ], |
3853 | ; |
3864 | ; |
3854 | |
3865 | |
3855 | } else { |
3866 | } else { |
… | |
… | |
4568 | |
4579 | |
4569 | ############################################################################# |
4580 | ############################################################################# |
4570 | |
4581 | |
4571 | package DC::UI; |
4582 | package DC::UI; |
4572 | |
4583 | |
4573 | $ROOT = new DC::UI::Root; |
4584 | $ROOT = new DC::UI::Root; |
4574 | $TOOLTIP = new DC::UI::Tooltip z => 900; |
4585 | $TOOLTIP = new DC::UI::Tooltip z => 900; |
4575 | |
4586 | |
4576 | 1 |
4587 | 1 |
4577 | |
4588 | |