… | |
… | |
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 | |
… | |
… | |
530 | sub connect { |
532 | sub connect { |
531 | my ($self, $signal, $cb) = @_; |
533 | my ($self, $signal, $cb) = @_; |
532 | |
534 | |
533 | push @{ $self->{signal_cb}{$signal} }, $cb; |
535 | push @{ $self->{signal_cb}{$signal} }, $cb; |
534 | |
536 | |
535 | defined wantarray and DC::guard { |
537 | defined wantarray and Guard::guard { |
536 | @{ $self->{signal_cb}{$signal} } = grep $_ != $cb, |
538 | @{ $self->{signal_cb}{$signal} } = grep $_ != $cb, |
537 | @{ $self->{signal_cb}{$signal} }; |
539 | @{ $self->{signal_cb}{$signal} }; |
538 | } |
540 | } |
539 | } |
541 | } |
540 | |
542 | |
… | |
… | |
652 | $class->SUPER::new ( |
654 | $class->SUPER::new ( |
653 | #bg => [0, 0, 0, 0.2], |
655 | #bg => [0, 0, 0, 0.2], |
654 | #active_bg => [1, 1, 1, 0.5], |
656 | #active_bg => [1, 1, 1, 0.5], |
655 | @_ |
657 | @_ |
656 | ) |
658 | ) |
|
|
659 | } |
|
|
660 | |
|
|
661 | sub set_bg { |
|
|
662 | my ($self, $bg) = @_; |
|
|
663 | |
|
|
664 | $self->{bg} = $bg; |
|
|
665 | $self->update; |
657 | } |
666 | } |
658 | |
667 | |
659 | sub _draw { |
668 | sub _draw { |
660 | my ($self) = @_; |
669 | my ($self) = @_; |
661 | |
670 | |
… | |
… | |
2521 | |
2530 | |
2522 | sub new { |
2531 | sub new { |
2523 | my $class = shift; |
2532 | my $class = shift; |
2524 | |
2533 | |
2525 | $class->SUPER::new ( |
2534 | $class->SUPER::new ( |
|
|
2535 | fontsize => 1, |
2526 | padding_x => 2, |
2536 | padding_x => 2, |
2527 | padding_y => 2, |
2537 | padding_y => 2, |
2528 | fg => [1, 1, 1], |
2538 | fg => [1, 1, 1], |
2529 | active_fg => [1, 1, 0], |
2539 | active_fg => [1, 1, 0], |
2530 | bg => [0, 0, 0, 0.2], |
2540 | bg => [0, 0, 0, 0.2], |
… | |
… | |
2536 | } |
2546 | } |
2537 | |
2547 | |
2538 | sub size_request { |
2548 | sub size_request { |
2539 | my ($self) = @_; |
2549 | my ($self) = @_; |
2540 | |
2550 | |
2541 | (6) x 2 |
2551 | ($self->{fontsize} * $::FONTSIZE) x 2 |
2542 | } |
2552 | } |
2543 | |
2553 | |
2544 | sub toggle { |
2554 | sub toggle { |
2545 | my ($self) = @_; |
2555 | my ($self) = @_; |
2546 | |
2556 | |
… | |
… | |
2938 | my $self = $class->SUPER::new ( |
2948 | my $self = $class->SUPER::new ( |
2939 | %arg, |
2949 | %arg, |
2940 | tooltip => sub { |
2950 | tooltip => sub { |
2941 | my ($self) = @_; |
2951 | my ($self) = @_; |
2942 | |
2952 | |
2943 | sprintf "%slevel %d\n%s points\n%s next level\n%s to go", |
2953 | sprintf "%slevel %d\n%s points\n%s next level\n%s to go, %d%% done", |
2944 | $tt, |
2954 | $tt, |
2945 | $self->{lvl}, |
2955 | $self->{lvl}, |
2946 | ::formsep ($self->{exp}), |
2956 | ::formsep ($self->{exp}), |
2947 | ::formsep ($self->{nxt}), |
2957 | ::formsep ($self->{nxt}), |
2948 | ::formsep ($self->{nxt} - $self->{exp}), |
2958 | ::formsep ($self->{nxt} - $self->{exp}), |
|
|
2959 | $self->_percent * 100, |
2949 | }, |
2960 | }, |
2950 | ); |
2961 | ); |
2951 | |
2962 | |
2952 | $::CONN->{on_exp_update}{$self+0} = sub { $self->set_value ($self->{value}) } |
2963 | $::CONN->{on_exp_update}{$self+0} = sub { $self->set_value ($self->{value}) } |
2953 | if $::CONN; |
2964 | if $::CONN; |
… | |
… | |
2962 | if $::CONN; |
2973 | if $::CONN; |
2963 | |
2974 | |
2964 | $self->SUPER::DESTROY; |
2975 | $self->SUPER::DESTROY; |
2965 | } |
2976 | } |
2966 | |
2977 | |
|
|
2978 | sub _percent { |
|
|
2979 | my ($self) = @_; |
|
|
2980 | |
|
|
2981 | my $table = $::CONN && $::CONN->{exp_table} |
|
|
2982 | or return -1; |
|
|
2983 | |
|
|
2984 | my $l0 = $table->[$self->{lvl} - 1]; |
|
|
2985 | my $l1 = $table->[$self->{lvl}]; |
|
|
2986 | |
|
|
2987 | $self->{nxt} = $l1; |
|
|
2988 | |
|
|
2989 | ($self->{exp} - $l0) / ($l1 - $l0) |
|
|
2990 | } |
|
|
2991 | |
2967 | sub set_value { |
2992 | sub set_value { |
2968 | my ($self, $lvl, $exp) = @_; |
2993 | my ($self, $lvl, $exp) = @_; |
2969 | |
2994 | |
2970 | $self->{lvl} = $lvl; |
2995 | $self->{lvl} = $lvl; |
2971 | $self->{exp} = $exp; |
2996 | $self->{exp} = $exp; |
2972 | |
2997 | |
2973 | my $v = -1; |
|
|
2974 | |
|
|
2975 | if ($::CONN && (my $table = $::CONN->{exp_table})) { |
|
|
2976 | my $l0 = $table->[$lvl - 1]; |
|
|
2977 | my $l1 = $table->[$lvl]; |
|
|
2978 | |
|
|
2979 | $self->{nxt} = $l1; |
|
|
2980 | |
|
|
2981 | $v = ($exp - $l0) / ($l1 - $l0); |
|
|
2982 | } |
|
|
2983 | |
|
|
2984 | $self->SUPER::set_value ($v); |
2998 | $self->SUPER::set_value ($self->_percent); |
2985 | } |
2999 | } |
2986 | |
3000 | |
2987 | ############################################################################# |
3001 | ############################################################################# |
2988 | |
3002 | |
2989 | package DC::UI::Gauge; |
3003 | package DC::UI::Gauge; |
… | |
… | |
3719 | aspect => 1, |
3733 | aspect => 1, |
3720 | can_events => 0, |
3734 | can_events => 0, |
3721 | @_, |
3735 | @_, |
3722 | ); |
3736 | ); |
3723 | |
3737 | |
3724 | if ($self->{anim} && $self->{animspeed}) { |
|
|
3725 | DC::weaken (my $widget = $self); |
|
|
3726 | |
|
|
3727 | $self->{animspeed} = List::Util::max 0.05, $self->{animspeed}; |
|
|
3728 | $self->{timer} = EV::periodic_ns 0, $self->{animspeed}, undef, sub { |
|
|
3729 | return unless $::CONN; |
|
|
3730 | |
|
|
3731 | my $w = $widget |
|
|
3732 | or return; |
|
|
3733 | |
|
|
3734 | ++$w->{frame}; |
|
|
3735 | $w->update_face; |
|
|
3736 | |
|
|
3737 | # somehow, $widget can go away |
|
|
3738 | $w->update; |
|
|
3739 | $w->update_timer; |
|
|
3740 | }; |
|
|
3741 | |
|
|
3742 | $self->update_face; |
|
|
3743 | $self->update_timer; |
3738 | $self->update_anim; |
3744 | } |
|
|
3745 | |
3739 | |
3746 | $self |
3740 | $self |
3747 | } |
3741 | } |
3748 | |
3742 | |
3749 | sub update_timer { |
3743 | sub update_timer { |
… | |
… | |
3772 | $tex->upload (sub { $self->reconfigure }); |
3766 | $tex->upload (sub { $self->reconfigure }); |
3773 | } |
3767 | } |
3774 | } |
3768 | } |
3775 | } |
3769 | } |
3776 | } |
3770 | } |
|
|
3771 | } |
|
|
3772 | } |
|
|
3773 | |
|
|
3774 | sub update_anim { |
|
|
3775 | my ($self) = @_; |
|
|
3776 | |
|
|
3777 | if ($self->{anim} && $self->{animspeed}) { |
|
|
3778 | DC::weaken (my $widget = $self); |
|
|
3779 | |
|
|
3780 | $self->{animspeed} = List::Util::max 0.05, $self->{animspeed}; |
|
|
3781 | $self->{timer} = EV::periodic_ns 0, $self->{animspeed}, undef, sub { |
|
|
3782 | return unless $::CONN; |
|
|
3783 | |
|
|
3784 | my $w = $widget |
|
|
3785 | or return; |
|
|
3786 | |
|
|
3787 | ++$w->{frame}; |
|
|
3788 | $w->update_face; |
|
|
3789 | |
|
|
3790 | # somehow, $widget can go away |
|
|
3791 | $w->update; |
|
|
3792 | $w->update_timer; |
|
|
3793 | }; |
|
|
3794 | |
|
|
3795 | $self->update_face; |
|
|
3796 | $self->update_timer; |
|
|
3797 | } else { |
|
|
3798 | delete $self->{timer}; |
3777 | } |
3799 | } |
3778 | } |
3800 | } |
3779 | |
3801 | |
3780 | sub size_request { |
3802 | sub size_request { |
3781 | my ($self) = @_; |
3803 | my ($self) = @_; |
… | |
… | |
3803 | return unless $self->{visible}; |
3825 | return unless $self->{visible}; |
3804 | |
3826 | |
3805 | $self->SUPER::update; |
3827 | $self->SUPER::update; |
3806 | } |
3828 | } |
3807 | |
3829 | |
|
|
3830 | sub set_face { |
|
|
3831 | my ($self, $face) = @_; |
|
|
3832 | |
|
|
3833 | $self->{face} = $face; |
|
|
3834 | $self->reconfigure; |
|
|
3835 | } |
|
|
3836 | |
|
|
3837 | sub set_anim { |
|
|
3838 | my ($self, $anim) = @_; |
|
|
3839 | |
|
|
3840 | $self->{anim} = $anim; |
|
|
3841 | $self->update_anim; |
|
|
3842 | } |
|
|
3843 | |
|
|
3844 | sub set_animspeed { |
|
|
3845 | my ($self, $animspeed) = @_; |
|
|
3846 | |
|
|
3847 | $self->{animspeed} = $animspeed; |
|
|
3848 | $self->update_anim; |
|
|
3849 | } |
|
|
3850 | |
3808 | sub invoke_visibility_change { |
3851 | sub invoke_visibility_change { |
3809 | my ($self) = @_; |
3852 | my ($self) = @_; |
3810 | |
3853 | |
3811 | $self->update_timer; |
3854 | $self->update_timer; |
3812 | |
3855 | |
… | |
… | |
3908 | # maybe save $GRAB? must be careful about events... |
3951 | # maybe save $GRAB? must be careful about events... |
3909 | $GRAB = $self; |
3952 | $GRAB = $self; |
3910 | $self->{button} = $ev->{button}; |
3953 | $self->{button} = $ev->{button}; |
3911 | |
3954 | |
3912 | $self->show; |
3955 | $self->show; |
3913 | $self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5); |
3956 | |
|
|
3957 | my $x = $ev->{x}; |
|
|
3958 | my $y = $ev->{y}; |
|
|
3959 | |
|
|
3960 | $self->{root}->on_post_alloc ($self => sub { |
|
|
3961 | $self->move_abs ($x - $self->{w} * 0.25, $y - $self->{border} * $::FONTSIZE * .5); |
|
|
3962 | }); |
3914 | |
3963 | |
3915 | 1 # so it can be used inside event handlers |
3964 | 1 # so it can be used inside event handlers |
3916 | } |
3965 | } |
3917 | |
3966 | |
3918 | sub invoke_mouse_motion { |
3967 | sub invoke_mouse_motion { |