… | |
… | |
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}; |
… | |
… | |
2405 | our @ISA = DC::UI::Bin::; |
2405 | our @ISA = DC::UI::Bin::; |
2406 | |
2406 | |
2407 | use DC::OpenGL; |
2407 | use DC::OpenGL; |
2408 | |
2408 | |
2409 | my @tex = |
2409 | my @tex = |
2410 | map { new_from_file DC::Texture DC::find_rcfile $_, mipmap => 1 } |
2410 | map { new_from_resource DC::Texture $_, mipmap => 1 } |
2411 | qw(b1_button_inactive.png b1_button_active.png); |
2411 | qw(b1_button_inactive.png b1_button_active.png); |
2412 | |
2412 | |
2413 | sub new { |
2413 | sub new { |
2414 | my $class = shift; |
2414 | my $class = shift; |
2415 | |
2415 | |
… | |
… | |
2454 | our @ISA = DC::UI::Label::; |
2454 | our @ISA = DC::UI::Label::; |
2455 | |
2455 | |
2456 | use DC::OpenGL; |
2456 | use DC::OpenGL; |
2457 | |
2457 | |
2458 | my @tex = |
2458 | my @tex = |
2459 | map { new_from_file DC::Texture DC::find_rcfile $_, mipmap => 1 } |
2459 | map { new_from_resource DC::Texture $_, mipmap => 1 } |
2460 | qw(b1_button_inactive.png b1_button_active.png); |
2460 | qw(b1_button_inactive.png b1_button_active.png); |
2461 | |
2461 | |
2462 | sub new { |
2462 | sub new { |
2463 | my $class = shift; |
2463 | my $class = shift; |
2464 | |
2464 | |
… | |
… | |
2507 | package DC::UI::CheckBox; |
2507 | package DC::UI::CheckBox; |
2508 | |
2508 | |
2509 | our @ISA = DC::UI::DrawBG::; |
2509 | our @ISA = DC::UI::DrawBG::; |
2510 | |
2510 | |
2511 | my @tex = |
2511 | my @tex = |
2512 | map { new_from_file DC::Texture DC::find_rcfile $_, mipmap => 1 } |
2512 | map { new_from_resource DC::Texture $_, mipmap => 1 } |
2513 | qw(c1_checkbox_bg.png c1_checkbox_active.png); |
2513 | qw(c1_checkbox_bg.png c1_checkbox_active.png); |
2514 | |
2514 | |
2515 | use DC::OpenGL; |
2515 | use DC::OpenGL; |
2516 | |
2516 | |
2517 | sub new { |
2517 | sub new { |
… | |
… | |
2598 | |
2598 | |
2599 | $self->{path} || $self->{tex} |
2599 | $self->{path} || $self->{tex} |
2600 | or Carp::croak "'path' or 'tex' attributes required"; |
2600 | or Carp::croak "'path' or 'tex' attributes required"; |
2601 | |
2601 | |
2602 | $self->{tex} ||= $texture_cache{$self->{path}} ||= |
2602 | $self->{tex} ||= $texture_cache{$self->{path}} ||= |
2603 | new_from_file DC::Texture DC::find_rcfile $self->{path}, mipmap => 1; |
2603 | new_from_resource DC::Texture $self->{path}, mipmap => 1; |
2604 | |
2604 | |
2605 | DC::weaken $texture_cache{$self->{path}}; |
2605 | DC::weaken $texture_cache{$self->{path}}; |
2606 | |
2606 | |
2607 | $self->{aspect} ||= $self->{tex}{w} / $self->{tex}{h}; |
2607 | $self->{aspect} ||= $self->{tex}{w} / $self->{tex}{h}; |
2608 | |
2608 | |
… | |
… | |
2704 | |
2704 | |
2705 | use DC::OpenGL; |
2705 | use DC::OpenGL; |
2706 | |
2706 | |
2707 | my %tex = ( |
2707 | my %tex = ( |
2708 | food => [ |
2708 | food => [ |
2709 | map { new_from_file DC::Texture DC::find_rcfile $_, mipmap => 1 } |
2709 | map { new_from_resource DC::Texture $_, mipmap => 1 } |
2710 | qw/g1_food_gauge_empty.png g1_food_gauge_full.png/ |
2710 | qw/g1_food_gauge_empty.png g1_food_gauge_full.png/ |
2711 | ], |
2711 | ], |
2712 | grace => [ |
2712 | grace => [ |
2713 | map { new_from_file DC::Texture DC::find_rcfile $_, mipmap => 1 } |
2713 | 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/ |
2714 | qw/g1_grace_gauge_empty.png g1_grace_gauge_full.png g1_grace_gauge_overflow.png/ |
2715 | ], |
2715 | ], |
2716 | hp => [ |
2716 | hp => [ |
2717 | map { new_from_file DC::Texture DC::find_rcfile $_, mipmap => 1 } |
2717 | map { new_from_resource DC::Texture $_, mipmap => 1 } |
2718 | qw/g1_hp_gauge_empty.png g1_hp_gauge_full.png/ |
2718 | qw/g1_hp_gauge_empty.png g1_hp_gauge_full.png/ |
2719 | ], |
2719 | ], |
2720 | mana => [ |
2720 | mana => [ |
2721 | map { new_from_file DC::Texture DC::find_rcfile $_, mipmap => 1 } |
2721 | 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/ |
2722 | qw/g1_mana_gauge_empty.png g1_mana_gauge_full.png g1_mana_gauge_overflow.png/ |
2723 | ], |
2723 | ], |
2724 | ); |
2724 | ); |
2725 | |
2725 | |
2726 | # eg. VGauge->new (gauge => 'food'), default gauge: food |
2726 | # eg. VGauge->new (gauge => 'food'), default gauge: food |
… | |
… | |
3023 | use DC::OpenGL; |
3023 | use DC::OpenGL; |
3024 | |
3024 | |
3025 | our @ISA = DC::UI::DrawBG::; |
3025 | our @ISA = DC::UI::DrawBG::; |
3026 | |
3026 | |
3027 | my @tex = |
3027 | my @tex = |
3028 | map { new_from_file DC::Texture DC::find_rcfile $_ } |
3028 | map { new_from_resource DC::Texture $_ } |
3029 | qw(s1_slider.png s1_slider_bg.png); |
3029 | qw(s1_slider.png s1_slider_bg.png); |
3030 | |
3030 | |
3031 | sub new { |
3031 | sub new { |
3032 | my $class = shift; |
3032 | my $class = shift; |
3033 | |
3033 | |
… | |
… | |
3070 | sub set_value { |
3070 | sub set_value { |
3071 | my ($self, $value) = @_; |
3071 | my ($self, $value) = @_; |
3072 | |
3072 | |
3073 | my ($old_value, $lo, $hi, $page, $unit) = @{$self->{range}}; |
3073 | my ($old_value, $lo, $hi, $page, $unit) = @{$self->{range}}; |
3074 | |
3074 | |
3075 | $hi = $lo + 1 if $hi <= $lo; |
3075 | $hi = $lo if $hi < $lo; |
3076 | |
3076 | |
3077 | $page = $hi - $lo if $page > $hi - $lo; |
3077 | $value = $hi - $page if $value > $hi - $page; |
3078 | |
|
|
3079 | $value = $lo if $value < $lo; |
3078 | $value = $lo if $value < $lo; |
3080 | $value = $hi - $page if $value > $hi - $page; |
|
|
3081 | |
3079 | |
3082 | $value = $lo + $unit * int +($value - $lo + $unit * 0.5) / $unit |
3080 | $value = $lo + $unit * int +($value - $lo + $unit * 0.5) / $unit |
3083 | if $unit; |
3081 | if $unit; |
3084 | |
3082 | |
3085 | @{$self->{range}} = ($value, $lo, $hi, $page, $unit); |
3083 | @{$self->{range}} = ($value, $lo, $hi, $page, $unit); |
… | |
… | |
3149 | my ($self) = @_; |
3147 | my ($self) = @_; |
3150 | |
3148 | |
3151 | unless ($self->{knob_w}) { |
3149 | unless ($self->{knob_w}) { |
3152 | $self->set_value ($self->{range}[0]); |
3150 | $self->set_value ($self->{range}[0]); |
3153 | |
3151 | |
3154 | my ($value, $lo, $hi, $page) = @{$self->{range}}; |
3152 | my ($value, $lo, $hi, $page, $unit) = @{$self->{range}}; |
3155 | my $range = ($hi - $page - $lo) || 1e-100; |
3153 | my $range = ($hi - $page - $lo) || 1e-10; |
3156 | |
3154 | |
3157 | 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}; |
3158 | |
3156 | |
3159 | $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; |
3160 | $self->{scale} = 1 - 2 * $self->{offset} || 1e-100; |
3158 | $self->{scale} = 1 - 2 * $self->{offset} || 1e-100; |
3161 | |
3159 | |
3162 | $value = ($value - $lo) / $range; |
3160 | $value = ($value - $lo) / $range; |