File Coverage

blib/lib/Curses/UI/Time.pm
Criterion Covered Total %
statement 1 3 33.3
branch n/a
condition n/a
subroutine 1 1 100.0
pod n/a
total 2 4 50.0


line stmt bran cond sub pod time code
1             package Curses::UI::Time;
2              
3             # Pragmas.
4 2     2   28341 use Curses::UI::Widget;
  0            
  0            
5             use base qw(Curses::UI::ContainerWidget);
6             use strict;
7             use warnings;
8              
9             # Modules.
10             use Curses;
11             use Curses::UI::Common qw(keys_to_lowercase);
12             use Curses::UI::Label;
13             use Curses::UI::Number;
14             use Encode qw(decode_utf8);
15             use Readonly;
16              
17             # Constants.
18             Readonly::Scalar our $COLON => decode_utf8(<<'END');
19            
20             ██
21            
22             ██
23            
24             END
25             Readonly::Scalar our $DASH => q{-};
26             Readonly::Scalar our $HEIGHT_BASE => 5;
27             Readonly::Scalar our $HEIGHT_DATE => 7;
28             Readonly::Scalar our $YEAR_ADD => 1900;
29             Readonly::Scalar our $WIDTH_BASE => 32;
30             Readonly::Scalar our $WIDTH_COLON => 4;
31             Readonly::Scalar our $WIDTH_DATE => 10;
32             Readonly::Scalar our $WIDTH_NUM => 6;
33             Readonly::Scalar our $WIDTH_SEC => 52;
34             Readonly::Scalar our $WIDTH_SPACE => 1;
35              
36             # Version.
37             our $VERSION = 0.05;
38              
39             # Constructor.
40             sub new {
41             my ($class, %userargs) = @_;
42             keys_to_lowercase(\%userargs);
43             my %args = (
44             '-colon' => 1,
45             '-date' => 0,
46             '-fg' => -1,
47             '-time' => time,
48             '-second' => 0,
49             %userargs,
50             -focusable => 0,
51             );
52              
53             # Width and height.
54             if ($args{'-date'}) {
55             $args{'-height'} = height_by_windowscrheight($HEIGHT_DATE,
56             %args);
57             } else {
58             $args{'-height'} = height_by_windowscrheight($HEIGHT_BASE,
59             %args);
60             }
61             if ($args{'-second'}) {
62             $args{'-width'} = width_by_windowscrwidth($WIDTH_SEC, %args);
63             } else {
64             $args{'-width'} = width_by_windowscrwidth($WIDTH_BASE, %args);
65             }
66              
67             # Create the widget.
68             my $self = $class->SUPER::new(%args);
69              
70             # Parse time.
71             my ($sec, $min, $hour, $day, $mon, $year) = $self->_localtime($self->{'-time'});
72              
73             # Widgets.
74             my $x = 0;
75             $self->add(
76             'hour1', 'Curses::UI::Number',
77             '-fg' => $self->{'-fg'},
78             '-num' => (substr $hour, 0, 1),
79             '-x' => $x,
80             );
81             $x += $WIDTH_NUM + $WIDTH_SPACE;
82             $self->add(
83             'hour2', 'Curses::UI::Number',
84             '-fg' => $self->{'-fg'},
85             '-num' => (substr $hour, 1, 1),
86             '-x' => $x,
87             );
88             $x += $WIDTH_NUM + $WIDTH_SPACE;
89             $self->add(
90             'colon1', 'Label',
91             '-fg' => $self->{'-fg'},
92             '-hidden' => ! $self->{'-colon'},
93             '-text' => $COLON,
94             '-x' => $x,
95             );
96             $x += $WIDTH_COLON + $WIDTH_SPACE;
97             $self->add(
98             'min1', 'Curses::UI::Number',
99             '-fg' => $self->{'-fg'},
100             '-num' => (substr $min, 0, 1),
101             '-x' => $x,
102             );
103             $x += $WIDTH_NUM + $WIDTH_SPACE;
104             $self->add(
105             'min2', 'Curses::UI::Number',
106             '-fg' => $self->{'-fg'},
107             '-num' => (substr $min, 1, 1),
108             '-x' => $x,
109             );
110             if ($self->{'-second'}) {
111             $x += $WIDTH_NUM + $WIDTH_SPACE;
112             $self->add(
113             'colon2', 'Label',
114             '-fg' => $self->{'-fg'},
115             '-hidden' => ! $self->{'-colon'},
116             '-text' => $COLON,
117             '-x' => $x,
118             );
119             $x += $WIDTH_COLON + $WIDTH_SPACE;
120             $self->add(
121             'sec1', 'Curses::UI::Number',
122             '-fg' => $self->{'-fg'},
123             '-num' => (substr $sec, 0, 1),
124             '-x' => $x,
125             );
126             $x += $WIDTH_NUM + $WIDTH_SPACE;
127             $self->add(
128             'sec2', 'Curses::UI::Number',
129             '-fg' => $self->{'-fg'},
130             '-num' => (substr $sec, 1, 1),
131             '-x' => $x,
132             );
133             }
134             if ($self->{'-date'}) {
135             my $date_x = ($self->width - $WIDTH_DATE) / 2;
136             $self->add(
137             'date', 'Label',
138             '-text' => (join $DASH, $year, $mon, $day),
139             '-fg' => $self->{'-fg'},
140             '-x' => $date_x,
141             '-y' => $HEIGHT_DATE - 1,
142             );
143             }
144              
145             # Layout.
146             $self->layout;
147              
148             # Return object.
149             return $self;
150             }
151              
152             # Get or set colon flag.
153             sub colon {
154             my ($self, $colon) = @_;
155             if (defined $colon) {
156             $self->{'-colon'} = $colon;
157             if ($colon) {
158             $self->getobj('colon1')->show;
159             } else {
160             $self->getobj('colon1')->hide;
161             }
162             if ($self->{'-second'}) {
163             if ($colon) {
164             $self->getobj('colon2')->show;
165             } else {
166             $self->getobj('colon2')->hide;
167             }
168             }
169             }
170             return $self->{'-colon'};
171             }
172              
173             # Get or set time.
174             sub time {
175             my ($self, $time) = @_;
176             if (defined $time) {
177             $self->{'-time'} = $time;
178             my ($sec, $min, $hour, $day, $mon, $year)
179             = $self->_localtime($time);
180             $self->getobj('hour1')->num(substr $hour, 0, 1);
181             $self->getobj('hour2')->num(substr $hour, 1, 1);
182             $self->getobj('min1')->num(substr $min, 0, 1);
183             $self->getobj('min2')->num(substr $min, 1, 1);
184             if ($self->{'-second'}) {
185             $self->getobj('sec1')->num(substr $sec, 0, 1);
186             $self->getobj('sec2')->num(substr $sec, 1, 1);
187             }
188             if ($self->{'-date'}) {
189             $self->getobj('date')->text(join $DASH, $year, $mon,
190             $day);
191             }
192             }
193             return $self->{'-time'};
194             }
195              
196             # Get prepared time and date fields.
197             sub _localtime {
198             my ($self, $time) = @_;
199             my ($sec, $min, $hour, $day, $mon, $year) = localtime $time;
200             $sec = sprintf '%02d', $sec;
201             $min = sprintf '%02d', $min;
202             $hour = sprintf '%02d', $hour;
203             $day = sprintf '%02d', $day;
204             $mon = sprintf '%02d', ($mon + 1);
205             $year = sprintf '%04d', ($year + $YEAR_ADD);
206             return ($sec, $min, $hour, $day, $mon, $year);
207             }
208              
209             1;
210              
211             __END__