line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Text::7Segment; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
21917
|
use warnings; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
28
|
|
4
|
1
|
|
|
1
|
|
6
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
31
|
|
5
|
|
|
|
|
|
|
|
6
|
1
|
|
|
1
|
|
786
|
use version; our $VERSION = qv('v0.0.1_1'); |
|
1
|
|
|
|
|
2092
|
|
|
1
|
|
|
|
|
5
|
|
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
#TODO: conditionally use Autoloader if needed |
9
|
|
|
|
|
|
|
#todo: for autoloadding in windoze (needed for strawberry?) |
10
|
|
|
|
|
|
|
|
11
|
1
|
|
|
1
|
|
81
|
use Carp qw/carp/; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
910
|
|
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
{ |
14
|
|
|
|
|
|
|
# Following diagram shows the array index for each segment |
15
|
|
|
|
|
|
|
# 0_ |
16
|
|
|
|
|
|
|
# 1|_|3 element #2 in $segments{x} aref is the middle horizontal segment |
17
|
|
|
|
|
|
|
# 4|_|6 |
18
|
|
|
|
|
|
|
# 5 |
19
|
|
|
|
|
|
|
# the dot(.) represents an off segment, other characters represent an on segment |
20
|
|
|
|
|
|
|
# dot is replaced by space just before displaying |
21
|
|
|
|
|
|
|
# dot was chosen over space to keep things simple |
22
|
|
|
|
|
|
|
my %segments = ( |
23
|
|
|
|
|
|
|
0 => [qw( _ |
24
|
|
|
|
|
|
|
| . | |
25
|
|
|
|
|
|
|
| _ | |
26
|
|
|
|
|
|
|
)], |
27
|
|
|
|
|
|
|
1 => [qw( . |
28
|
|
|
|
|
|
|
. . | |
29
|
|
|
|
|
|
|
. . | |
30
|
|
|
|
|
|
|
)], |
31
|
|
|
|
|
|
|
2 => [qw( _ |
32
|
|
|
|
|
|
|
. _ | |
33
|
|
|
|
|
|
|
| _ . |
34
|
|
|
|
|
|
|
)], |
35
|
|
|
|
|
|
|
3 => [qw( _ |
36
|
|
|
|
|
|
|
. _ | |
37
|
|
|
|
|
|
|
. _ | |
38
|
|
|
|
|
|
|
)], |
39
|
|
|
|
|
|
|
4 => [qw( . |
40
|
|
|
|
|
|
|
| _ | |
41
|
|
|
|
|
|
|
. . | |
42
|
|
|
|
|
|
|
)], |
43
|
|
|
|
|
|
|
5 => [qw( _ |
44
|
|
|
|
|
|
|
| _ . |
45
|
|
|
|
|
|
|
. _ | |
46
|
|
|
|
|
|
|
)], |
47
|
|
|
|
|
|
|
6 => [qw( _ |
48
|
|
|
|
|
|
|
| _ . |
49
|
|
|
|
|
|
|
| _ | |
50
|
|
|
|
|
|
|
)], |
51
|
|
|
|
|
|
|
7 => [qw( _ |
52
|
|
|
|
|
|
|
. . | |
53
|
|
|
|
|
|
|
. . | |
54
|
|
|
|
|
|
|
)], |
55
|
|
|
|
|
|
|
8 => [qw( _ |
56
|
|
|
|
|
|
|
| _ | |
57
|
|
|
|
|
|
|
| _ | |
58
|
|
|
|
|
|
|
)], |
59
|
|
|
|
|
|
|
9 => [qw( _ |
60
|
|
|
|
|
|
|
| _ | |
61
|
|
|
|
|
|
|
. . | |
62
|
|
|
|
|
|
|
)], |
63
|
|
|
|
|
|
|
# colon |
64
|
|
|
|
|
|
|
':' => [qw( . |
65
|
|
|
|
|
|
|
. o . |
66
|
|
|
|
|
|
|
. o . |
67
|
|
|
|
|
|
|
)], |
68
|
|
|
|
|
|
|
# space |
69
|
|
|
|
|
|
|
' ' => [qw( . |
70
|
|
|
|
|
|
|
. . . |
71
|
|
|
|
|
|
|
. . . |
72
|
|
|
|
|
|
|
)], |
73
|
|
|
|
|
|
|
# underscore |
74
|
|
|
|
|
|
|
_ => [qw( . |
75
|
|
|
|
|
|
|
. . . |
76
|
|
|
|
|
|
|
. . . |
77
|
|
|
|
|
|
|
)], |
78
|
|
|
|
|
|
|
A => [qw( _ |
79
|
|
|
|
|
|
|
| _ | |
80
|
|
|
|
|
|
|
| . | |
81
|
|
|
|
|
|
|
)], |
82
|
|
|
|
|
|
|
a => [qw( _ |
83
|
|
|
|
|
|
|
. _ | |
84
|
|
|
|
|
|
|
| _ | |
85
|
|
|
|
|
|
|
)], |
86
|
|
|
|
|
|
|
B => [qw( _ |
87
|
|
|
|
|
|
|
| _ \) |
88
|
|
|
|
|
|
|
| _ \) |
89
|
|
|
|
|
|
|
)], |
90
|
|
|
|
|
|
|
b => [qw( . |
91
|
|
|
|
|
|
|
| _ . |
92
|
|
|
|
|
|
|
| _ | |
93
|
|
|
|
|
|
|
)], |
94
|
|
|
|
|
|
|
C => [qw( _ |
95
|
|
|
|
|
|
|
| . . |
96
|
|
|
|
|
|
|
| _ . |
97
|
|
|
|
|
|
|
)], |
98
|
|
|
|
|
|
|
c => [qw( . |
99
|
|
|
|
|
|
|
. _ . |
100
|
|
|
|
|
|
|
| _ . |
101
|
|
|
|
|
|
|
)], |
102
|
|
|
|
|
|
|
D => [qw( _ |
103
|
|
|
|
|
|
|
| . \ |
104
|
|
|
|
|
|
|
| _ / |
105
|
|
|
|
|
|
|
)], |
106
|
|
|
|
|
|
|
d => [qw( . |
107
|
|
|
|
|
|
|
. _ | |
108
|
|
|
|
|
|
|
| _ | |
109
|
|
|
|
|
|
|
)], |
110
|
|
|
|
|
|
|
E => [qw( _ |
111
|
|
|
|
|
|
|
| _ . |
112
|
|
|
|
|
|
|
| _ . |
113
|
|
|
|
|
|
|
)], |
114
|
|
|
|
|
|
|
e => [qw( _ |
115
|
|
|
|
|
|
|
| _ | |
116
|
|
|
|
|
|
|
| _ . |
117
|
|
|
|
|
|
|
)], |
118
|
|
|
|
|
|
|
F => [qw( _ |
119
|
|
|
|
|
|
|
| _ . |
120
|
|
|
|
|
|
|
| . . |
121
|
|
|
|
|
|
|
)], |
122
|
|
|
|
|
|
|
f => [qw( o |
123
|
|
|
|
|
|
|
| _ . |
124
|
|
|
|
|
|
|
| . . |
125
|
|
|
|
|
|
|
)], |
126
|
|
|
|
|
|
|
); |
127
|
|
|
|
|
|
|
my %defaults = ( |
128
|
|
|
|
|
|
|
segments => \%segments, |
129
|
|
|
|
|
|
|
string => '0123456789abcdefABCDEF', |
130
|
|
|
|
|
|
|
fancy_segments => 0, # 1 - allow chars other than _, |, o |
131
|
|
|
|
|
|
|
text_color => 'red', |
132
|
|
|
|
|
|
|
); |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
sub new { |
135
|
0
|
|
|
0
|
0
|
|
my $class = shift; |
136
|
0
|
|
|
|
|
|
my (%params) = @_; |
137
|
0
|
|
|
|
|
|
my $self = {}; |
138
|
|
|
|
|
|
|
#$self->segments = \%segments; |
139
|
0
|
|
|
|
|
|
foreach my $param (keys %defaults) { |
140
|
0
|
0
|
|
|
|
|
$self->{$param} = $params{$param} ? $params{$param} : $defaults{$param}; |
141
|
|
|
|
|
|
|
} |
142
|
|
|
|
|
|
|
|
143
|
0
|
|
|
|
|
|
return bless($self, $class); |
144
|
|
|
|
|
|
|
} |
145
|
|
|
|
|
|
|
} |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
sub lookup { |
148
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
149
|
0
|
|
|
|
|
|
my ($chr) = shift; |
150
|
|
|
|
|
|
|
|
151
|
0
|
0
|
|
|
|
|
if (! $self->fancy_segments) { |
152
|
0
|
0
|
|
|
|
|
$chr = lc $chr if ($chr =~ /[BD]/); |
153
|
0
|
0
|
|
|
|
|
$chr = uc $chr if ($chr =~ /[acef]/); |
154
|
|
|
|
|
|
|
} |
155
|
|
|
|
|
|
|
|
156
|
0
|
0
|
|
|
|
|
if (my $val = $self->segments->{$chr}) { |
157
|
0
|
|
|
|
|
|
map { s!\.! ! } @$val; |
|
0
|
|
|
|
|
|
|
158
|
0
|
|
|
|
|
|
return $val; |
159
|
|
|
|
|
|
|
} else { |
160
|
0
|
|
|
|
|
|
warn "Warning: Code not defined for $chr\n"; |
161
|
0
|
|
|
|
|
|
return []; |
162
|
|
|
|
|
|
|
} |
163
|
|
|
|
|
|
|
} |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
# every 7 segments character takes the space of 3 letters and 3 lines |
166
|
|
|
|
|
|
|
sub disp_str { |
167
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
168
|
0
|
|
|
|
|
|
my ($str) = @_; |
169
|
0
|
0
|
|
|
|
|
$str = ($str) ? $str : $self->{string}; |
170
|
0
|
|
|
|
|
|
my @str = split(//, $str); |
171
|
|
|
|
|
|
|
|
172
|
0
|
|
|
|
|
|
my @lookup; |
173
|
0
|
|
|
|
|
|
foreach my $chr (@str) { |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
# lookup the 7 seg code for chr |
176
|
0
|
|
|
|
|
|
push @lookup, $self->lookup($chr); |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
} |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
# the segment 0 |
181
|
0
|
|
|
|
|
|
map { print " $_->[0] " } @lookup; |
|
0
|
|
|
|
|
|
|
182
|
0
|
|
|
|
|
|
print "\n"; |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
# the segments 1..3 |
185
|
0
|
|
|
|
|
|
map { print @{$_}[1..3] } @lookup; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
186
|
0
|
|
|
|
|
|
print "\n"; |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
# the segments 4..6 |
189
|
0
|
|
|
|
|
|
map { print @{$_}[4..6] } @lookup; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
190
|
0
|
|
|
|
|
|
print "\n"; |
191
|
|
|
|
|
|
|
} |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
sub AUTOLOAD { |
194
|
0
|
|
|
0
|
|
|
my ($self) = shift; |
195
|
|
|
|
|
|
|
|
196
|
0
|
|
|
|
|
|
my $sub = $Text::7Segment::AUTOLOAD; |
197
|
0
|
|
|
|
|
|
(my $prop = $sub) =~ s/.*:://; |
198
|
|
|
|
|
|
|
|
199
|
0
|
|
|
|
|
|
my $val = shift; |
200
|
0
|
0
|
0
|
|
|
|
if(defined $val and $val ne '') { |
201
|
0
|
|
|
|
|
|
$self->{$prop} = $val; |
202
|
|
|
|
|
|
|
} |
203
|
0
|
|
|
|
|
|
return $self->{$prop}; |
204
|
|
|
|
|
|
|
} |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
1; |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
=head1 NAME |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
Text::7Segment - Display characters in seven-segment style in a text terminal. |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
*IMPORTANT:* The previous version - 0.0.1 - displayed the text using the Curses module. From this version, the module displays text in a plain terminal without Curses. Curses functionality is being shifted to Curses::7Segment which is coming soon. Please use the previous version if you need the ability to display more characters in a previous line. |
213
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
=head1 VERSION |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
This documentation refers to Text::7Segment version 0.0.1_1. This is alpha version, interface may change slightly. |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
=head1 SYNOPSIS |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
use Text::7Segment; |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
my $seg7 = Text::7Segment->new(); |
223
|
|
|
|
|
|
|
$seg7->disp_str(':0123456789 abcdef ABCDEJ'); |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
# all hex digits available in both upper and lower case |
226
|
|
|
|
|
|
|
$seg7->fancy_segments(1); |
227
|
|
|
|
|
|
|
$seg7->disp_str(':0123456789 abcdef ABCDEF'); |
228
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
=head1 DESCRIPTION |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
This module will display hexadecimal strings and a few other characters in 7 segment style in a terminal. This is the common display style used in lcd calculators, digital watches etc. |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
The 7-segment display is usually constrained by hardware, as in, the hardware has seven short segments laid out like the figure eight and subsets of the 7 segments can be turned on or off at a time to display various characters, for example, by applying appropriate voltages to hardware pins or by writing bits into a memory location. |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
This implementation is intended to be run in a terminal which of course supports a much richer character set and the constraints are purely logical. It is just an emulation of the 7 segment style display just for fun. |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
An advantage of this display style is that a character is readable from a distance due to the large size. An application could use it as a simple large font for displaying numeric data in a terminal window - e.g hw probe state (cpu-temperature, fan speed etc). |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
=head1 METHODS |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
=over |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
=item * |
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
new(): the class constructor. Returns a Text::7Segment object which is an instance of a 7-segment display in a text terminal. |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
default: same as the defaults in get/set methods below |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
Any get or set method name can be passed as a key/value pair to new() to override the corresponding default |
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
my $s = Text::7Segment->new(string => 'AaBbCc', fancy_segments => 1); |
253
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
The following methods can be called on the object: |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
=item * |
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
disp_str($str): display string $str in 7 segment style. |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
default: see the default in string() below |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
Depends on: fancy_segments |
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
Each character in output spans three text lines and three text columns, i.e a 3 x 3 grid on the text terminal. e.g The digit 8 in input will |
265
|
|
|
|
|
|
|
result in the following output: |
266
|
|
|
|
|
|
|
_ |
267
|
|
|
|
|
|
|
|_| |
268
|
|
|
|
|
|
|
|_| |
269
|
|
|
|
|
|
|
|
270
|
|
|
|
|
|
|
=item * |
271
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
get/set methods: The get/set methods below can be thought of as attributes in the object. When called with an argument they set the value of the attribute in the object. Without an argument they return the current value of the attribute. The following get/set methods are available: |
273
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
=over |
275
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
=item * |
277
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
string: get or set the hex string to be displayed. |
279
|
|
|
|
|
|
|
|
280
|
|
|
|
|
|
|
Default: 01234567890abcdefABCDEF |
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
Legal characters in the string are the hex digits (0..f), colon(:), underscore(_) and space( ). Also see the description of fancy_segments method below. |
283
|
|
|
|
|
|
|
|
284
|
|
|
|
|
|
|
=item * |
285
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
fancy_segments: get or set the fancy_segments flag |
287
|
|
|
|
|
|
|
|
288
|
|
|
|
|
|
|
Default: 0 (off) |
289
|
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
Normally, the 7 segment display can show the digits b and d in lowercase only because the uppercase B and D cannot be distinguished from 8 and 0 respectively. This is an inherent limitation of the 7 segment style. However, since we are just emulating the 7-segment display, we are able to cheat by using extra characters. |
291
|
|
|
|
|
|
|
|
292
|
|
|
|
|
|
|
When fancy_segments is not set, this module uses only the following characters: underscore(_), pipe(|) to diplay hex digits. Uppercase B and D in string are silently displayed in lowercase. |
293
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
When set to a true value, the slash(/) and closing-parens(\)) characters are also used so all the alphanumeric digits (a..f) can be displayed in both upper and lower case. |
295
|
|
|
|
|
|
|
|
296
|
|
|
|
|
|
|
=item * TODO: allow user to override any of the 7 segments or supply the whole %segments hash |
297
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
=back |
299
|
|
|
|
|
|
|
|
300
|
|
|
|
|
|
|
=back |
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
=head1 DIAGNOSTICS |
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
If the string contains a character outside of the character class [a..fA..F0..9: ], it will not be displayed and a warning will be given. It will be a good idea to redirect the error output to somewhere other than the terminal if this is likely. |
305
|
|
|
|
|
|
|
|
306
|
|
|
|
|
|
|
Warning: Code not defined for $chr |
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
=head1 CONFIGURATION AND ENVIRONMENT |
309
|
|
|
|
|
|
|
|
310
|
|
|
|
|
|
|
=head1 DEPENDENCIES |
311
|
|
|
|
|
|
|
|
312
|
|
|
|
|
|
|
None: this is a pure perl implementation that uses only the core modules. |
313
|
|
|
|
|
|
|
|
314
|
|
|
|
|
|
|
=head1 BUGS AND LIMITATIONS |
315
|
|
|
|
|
|
|
|
316
|
|
|
|
|
|
|
No known bug. Please report problems to manigrew (Manish.Grewal@gmail.com). Patches are welcome. |
317
|
|
|
|
|
|
|
|
318
|
|
|
|
|
|
|
The string to be displayed has to be specified a line at a time. This is because a character spans 3 lines and it is not possible to go back to a previous line in a terminal to show more characters. If you have a requirement to display more characters in a line later, see the module Curses::7Segment on CPAN. |
319
|
|
|
|
|
|
|
|
320
|
|
|
|
|
|
|
=head1 ROADMAP |
321
|
|
|
|
|
|
|
|
322
|
|
|
|
|
|
|
Following is a quick and dirty list of future enhancements: |
323
|
|
|
|
|
|
|
|
324
|
|
|
|
|
|
|
- support different size of character - not just 3x3, e.g like bsd banner command |
325
|
|
|
|
|
|
|
- allow lookup func override if not already available and also good to have an example of how it should be subclassed. |
326
|
|
|
|
|
|
|
- use standard conventional letters for segments (a..g) in var names/comments |
327
|
|
|
|
|
|
|
- use colors |
328
|
|
|
|
|
|
|
|
329
|
|
|
|
|
|
|
=head1 SEE ALSO |
330
|
|
|
|
|
|
|
|
331
|
|
|
|
|
|
|
=over |
332
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
=item * Curses::7Segment - Coming soon |
334
|
|
|
|
|
|
|
|
335
|
|
|
|
|
|
|
=item * http://en.wikipedia.org/wiki/Seven-segment_display |
336
|
|
|
|
|
|
|
|
337
|
|
|
|
|
|
|
=back |
338
|
|
|
|
|
|
|
|
339
|
|
|
|
|
|
|
=head1 AUTHOR |
340
|
|
|
|
|
|
|
|
341
|
|
|
|
|
|
|
manigrew (Manish.Grewal@gmail.com) |
342
|
|
|
|
|
|
|
|
343
|
|
|
|
|
|
|
=head1 LICENCE AND COPYRIGHT |
344
|
|
|
|
|
|
|
|
345
|
|
|
|
|
|
|
Copyright (c) 2013 manigre (Manish.Grewal@gmail.com). All rights reserved. |
346
|
|
|
|
|
|
|
|
347
|
|
|
|
|
|
|
This module is free software; you can redistribute it and/or modify it |
348
|
|
|
|
|
|
|
under the same terms as Perl itself. See L. |
349
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
=cut |