… | |
… | |
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 | |
… | |
… | |
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 | |
… | |
… | |
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 |
… | |
… | |
2516 | |
2523 | |
2517 | sub new { |
2524 | sub new { |
2518 | my $class = shift; |
2525 | my $class = shift; |
2519 | |
2526 | |
2520 | $class->SUPER::new ( |
2527 | $class->SUPER::new ( |
|
|
2528 | fontsize => 1, |
2521 | padding_x => 2, |
2529 | padding_x => 2, |
2522 | padding_y => 2, |
2530 | padding_y => 2, |
2523 | fg => [1, 1, 1], |
2531 | fg => [1, 1, 1], |
2524 | active_fg => [1, 1, 0], |
2532 | active_fg => [1, 1, 0], |
2525 | bg => [0, 0, 0, 0.2], |
2533 | bg => [0, 0, 0, 0.2], |
… | |
… | |
2531 | } |
2539 | } |
2532 | |
2540 | |
2533 | sub size_request { |
2541 | sub size_request { |
2534 | my ($self) = @_; |
2542 | my ($self) = @_; |
2535 | |
2543 | |
2536 | (6) x 2 |
2544 | ($self->{fontsize} * $::FONTSIZE) x 2 |
2537 | } |
2545 | } |
2538 | |
2546 | |
2539 | sub toggle { |
2547 | sub toggle { |
2540 | my ($self) = @_; |
2548 | my ($self) = @_; |
2541 | |
2549 | |
… | |
… | |
2839 | |
2847 | |
2840 | sub new { |
2848 | sub new { |
2841 | my ($class, %arg) = @_; |
2849 | my ($class, %arg) = @_; |
2842 | |
2850 | |
2843 | my $self = $class->SUPER::new ( |
2851 | my $self = $class->SUPER::new ( |
|
|
2852 | padding_x => 2, |
|
|
2853 | padding_y => 2, |
2844 | fg => [1, 1, 1], |
2854 | fg => [1, 1, 1], |
2845 | bg => [0, 0, 1, 0.2], |
2855 | bg => [0, 0, 1, 0.2], |
2846 | bar => [0.7, 0.5, 0.1, 0.8], |
2856 | bar => [0.7, 0.5, 0.1, 0.8], |
2847 | outline => [0.4, 0.3, 0], |
2857 | outline => [0.4, 0.3, 0], |
2848 | fontsize => 0.9, |
2858 | fontsize => 0.9, |
… | |
… | |
2888 | my ($self) = @_; |
2898 | my ($self) = @_; |
2889 | |
2899 | |
2890 | glEnable GL_BLEND; |
2900 | glEnable GL_BLEND; |
2891 | glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA; |
2901 | glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA; |
2892 | |
2902 | |
|
|
2903 | my $px = $self->{padding_x}; |
|
|
2904 | my $py = $self->{padding_y}; |
|
|
2905 | |
2893 | if ($self->{value} >= 0) { |
2906 | if ($self->{value} >= 0) { |
2894 | my $s = int 2 + ($self->{w} - 4) * $self->{value}; |
2907 | my $s = int $px + ($self->{w} - $px * 2) * $self->{value}; |
2895 | |
2908 | |
2896 | glColor_premultiply @{$self->{bar}}; |
2909 | glColor_premultiply @{$self->{bar}}; |
2897 | glRect 2, 2, $s, $self->{h} - 2; |
2910 | glRect $px, $py, $s, $self->{h} - $py; |
2898 | glColor_premultiply @{$self->{bg}}; |
2911 | glColor_premultiply @{$self->{bg}}; |
2899 | glRect $s, 2, $self->{w} - 2, $self->{h} - 2; |
2912 | glRect $s , $py, $self->{w} - $px, $self->{h} - $py; |
2900 | } |
2913 | } |
2901 | |
2914 | |
2902 | glColor_premultiply @{$self->{outline}}; |
2915 | glColor_premultiply @{$self->{outline}}; |
|
|
2916 | |
|
|
2917 | $px -= .5; |
|
|
2918 | $py -= .5; |
|
|
2919 | |
2903 | 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; |
2904 | |
2921 | |
2905 | glDisable GL_BLEND; |
2922 | glDisable GL_BLEND; |
2906 | |
2923 | |
2907 | { |
2924 | { |
2908 | local $self->{bg}; # do not draw background |
2925 | local $self->{bg}; # do not draw background |
… | |
… | |
2917 | our @ISA = DC::UI::Progress::; |
2934 | our @ISA = DC::UI::Progress::; |
2918 | |
2935 | |
2919 | sub new { |
2936 | sub new { |
2920 | my ($class, %arg) = @_; |
2937 | my ($class, %arg) = @_; |
2921 | |
2938 | |
|
|
2939 | my $tt = exists $arg{tooltip} ? "$arg{tooltip}\n\n" : ""; |
|
|
2940 | |
2922 | my $self = $class->SUPER::new ( |
2941 | my $self = $class->SUPER::new ( |
|
|
2942 | %arg, |
2923 | tooltip => sub { |
2943 | tooltip => sub { |
2924 | my ($self) = @_; |
2944 | my ($self) = @_; |
2925 | |
2945 | |
2926 | 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, |
2927 | $self->{lvl}, |
2948 | $self->{lvl}, |
2928 | ::formsep ($self->{exp}), |
2949 | ::formsep ($self->{exp}), |
2929 | ::formsep ($self->{nxt}), |
2950 | ::formsep ($self->{nxt}), |
2930 | ::formsep ($self->{nxt} - $self->{exp}), |
2951 | ::formsep ($self->{nxt} - $self->{exp}), |
|
|
2952 | $self->_percent * 100, |
2931 | }, |
2953 | }, |
2932 | %arg |
|
|
2933 | ); |
2954 | ); |
2934 | |
2955 | |
2935 | $::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}) } |
2936 | if $::CONN; |
2957 | if $::CONN; |
2937 | |
2958 | |
… | |
… | |
2945 | if $::CONN; |
2966 | if $::CONN; |
2946 | |
2967 | |
2947 | $self->SUPER::DESTROY; |
2968 | $self->SUPER::DESTROY; |
2948 | } |
2969 | } |
2949 | |
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 | |
2950 | sub set_value { |
2985 | sub set_value { |
2951 | my ($self, $lvl, $exp) = @_; |
2986 | my ($self, $lvl, $exp) = @_; |
2952 | |
2987 | |
2953 | $self->{lvl} = $lvl; |
2988 | $self->{lvl} = $lvl; |
2954 | $self->{exp} = $exp; |
2989 | $self->{exp} = $exp; |
2955 | |
2990 | |
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); |
2991 | $self->SUPER::set_value ($self->_percent); |
2968 | } |
2992 | } |
2969 | |
2993 | |
2970 | ############################################################################# |
2994 | ############################################################################# |
2971 | |
2995 | |
2972 | package DC::UI::Gauge; |
2996 | package DC::UI::Gauge; |
… | |
… | |
3702 | aspect => 1, |
3726 | aspect => 1, |
3703 | can_events => 0, |
3727 | can_events => 0, |
3704 | @_, |
3728 | @_, |
3705 | ); |
3729 | ); |
3706 | |
3730 | |
3707 | if ($self->{anim} && $self->{animspeed}) { |
|
|
3708 | DC::weaken (my $widget = $self); |
|
|
3709 | |
|
|
3710 | $self->{animspeed} = List::Util::max 0.05, $self->{animspeed}; |
|
|
3711 | $self->{timer} = EV::periodic_ns 0, $self->{animspeed}, undef, sub { |
|
|
3712 | return unless $::CONN; |
|
|
3713 | |
|
|
3714 | my $w = $widget |
|
|
3715 | or return; |
|
|
3716 | |
|
|
3717 | ++$w->{frame}; |
|
|
3718 | $w->update_face; |
|
|
3719 | |
|
|
3720 | # somehow, $widget can go away |
|
|
3721 | $w->update; |
|
|
3722 | $w->update_timer; |
|
|
3723 | }; |
|
|
3724 | |
|
|
3725 | $self->update_face; |
|
|
3726 | $self->update_timer; |
3731 | $self->update_anim; |
3727 | } |
|
|
3728 | |
3732 | |
3729 | $self |
3733 | $self |
3730 | } |
3734 | } |
3731 | |
3735 | |
3732 | sub update_timer { |
3736 | sub update_timer { |
… | |
… | |
3755 | $tex->upload (sub { $self->reconfigure }); |
3759 | $tex->upload (sub { $self->reconfigure }); |
3756 | } |
3760 | } |
3757 | } |
3761 | } |
3758 | } |
3762 | } |
3759 | } |
3763 | } |
|
|
3764 | } |
|
|
3765 | } |
|
|
3766 | |
|
|
3767 | sub update_anim { |
|
|
3768 | my ($self) = @_; |
|
|
3769 | |
|
|
3770 | if ($self->{anim} && $self->{animspeed}) { |
|
|
3771 | DC::weaken (my $widget = $self); |
|
|
3772 | |
|
|
3773 | $self->{animspeed} = List::Util::max 0.05, $self->{animspeed}; |
|
|
3774 | $self->{timer} = EV::periodic_ns 0, $self->{animspeed}, undef, sub { |
|
|
3775 | return unless $::CONN; |
|
|
3776 | |
|
|
3777 | my $w = $widget |
|
|
3778 | or return; |
|
|
3779 | |
|
|
3780 | ++$w->{frame}; |
|
|
3781 | $w->update_face; |
|
|
3782 | |
|
|
3783 | # somehow, $widget can go away |
|
|
3784 | $w->update; |
|
|
3785 | $w->update_timer; |
|
|
3786 | }; |
|
|
3787 | |
|
|
3788 | $self->update_face; |
|
|
3789 | $self->update_timer; |
|
|
3790 | } else { |
|
|
3791 | delete $self->{timer}; |
3760 | } |
3792 | } |
3761 | } |
3793 | } |
3762 | |
3794 | |
3763 | sub size_request { |
3795 | sub size_request { |
3764 | my ($self) = @_; |
3796 | my ($self) = @_; |
… | |
… | |
3786 | return unless $self->{visible}; |
3818 | return unless $self->{visible}; |
3787 | |
3819 | |
3788 | $self->SUPER::update; |
3820 | $self->SUPER::update; |
3789 | } |
3821 | } |
3790 | |
3822 | |
|
|
3823 | sub set_face { |
|
|
3824 | my ($self, $face) = @_; |
|
|
3825 | |
|
|
3826 | $self->{face} = $face; |
|
|
3827 | $self->reconfigure; |
|
|
3828 | } |
|
|
3829 | |
|
|
3830 | sub set_anim { |
|
|
3831 | my ($self, $anim) = @_; |
|
|
3832 | |
|
|
3833 | $self->{anim} = $anim; |
|
|
3834 | $self->update_anim; |
|
|
3835 | } |
|
|
3836 | |
|
|
3837 | sub set_animspeed { |
|
|
3838 | my ($self, $animspeed) = @_; |
|
|
3839 | |
|
|
3840 | $self->{animspeed} = $animspeed; |
|
|
3841 | $self->update_anim; |
|
|
3842 | } |
|
|
3843 | |
3791 | sub invoke_visibility_change { |
3844 | sub invoke_visibility_change { |
3792 | my ($self) = @_; |
3845 | my ($self) = @_; |
3793 | |
3846 | |
3794 | $self->update_timer; |
3847 | $self->update_timer; |
3795 | |
3848 | |
… | |
… | |
3891 | # maybe save $GRAB? must be careful about events... |
3944 | # maybe save $GRAB? must be careful about events... |
3892 | $GRAB = $self; |
3945 | $GRAB = $self; |
3893 | $self->{button} = $ev->{button}; |
3946 | $self->{button} = $ev->{button}; |
3894 | |
3947 | |
3895 | $self->show; |
3948 | $self->show; |
3896 | $self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5); |
3949 | |
|
|
3950 | my $x = $ev->{x}; |
|
|
3951 | my $y = $ev->{y}; |
|
|
3952 | |
|
|
3953 | $self->{root}->on_post_alloc ($self => sub { |
|
|
3954 | $self->move_abs ($x - $self->{w} * 0.25, $y - $self->{border} * $::FONTSIZE * .5); |
|
|
3955 | }); |
|
|
3956 | |
|
|
3957 | 1 # so it can be used inside event handlers |
3897 | } |
3958 | } |
3898 | |
3959 | |
3899 | sub invoke_mouse_motion { |
3960 | sub invoke_mouse_motion { |
3900 | my ($self, $ev, $x, $y) = @_; |
3961 | my ($self, $ev, $x, $y) = @_; |
3901 | |
3962 | |
… | |
… | |
3944 | my ($self, @widgets) = @_; |
4005 | my ($self, @widgets) = @_; |
3945 | |
4006 | |
3946 | $self->SUPER::add (@widgets); |
4007 | $self->SUPER::add (@widgets); |
3947 | |
4008 | |
3948 | $self->set_current_page (0) |
4009 | $self->set_current_page (0) |
3949 | unless @widgets == @{ $self->{children} }; |
4010 | if @widgets == @{ $self->{children} }; |
3950 | } |
4011 | } |
3951 | |
4012 | |
3952 | sub get_current_page { |
4013 | sub get_current_page { |
3953 | my ($self) = @_; |
4014 | my ($self) = @_; |
3954 | |
4015 | |
… | |
… | |
4595 | |
4656 | |
4596 | $ROOT = new DC::UI::Root; |
4657 | $ROOT = new DC::UI::Root; |
4597 | $TOOLTIP = new DC::UI::Tooltip z => 900; |
4658 | $TOOLTIP = new DC::UI::Tooltip z => 900; |
4598 | |
4659 | |
4599 | 1 |
4660 | 1 |
4600 | |
|
|