File Coverage

blib/lib/Text/7Segment.pm
Criterion Covered Total %
statement 12 54 22.2
branch 0 14 0.0
condition 0 3 0.0
subroutine 4 8 50.0
pod 0 3 0.0
total 16 82 19.5


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