File Coverage

blib/lib/HiPi/Interface/SerLCD.pm
Criterion Covered Total %
statement 15 77 19.4
branch 0 44 0.0
condition n/a
subroutine 5 16 31.2
pod 0 11 0.0
total 20 148 13.5


line stmt bran cond sub pod time code
1             #########################################################################################
2             # Package HiPi::Interface::SerLCD
3             # Description : SerLCD RX Enabled LCD Controller
4             # Copyright : Copyright (c) 2013-2017 Mark Dootson
5             # License : This is free software; you can redistribute it and/or modify it under
6             # the same terms as the Perl 5 programming language system itself.
7             #########################################################################################
8              
9             package HiPi::Interface::SerLCD;
10              
11             #########################################################################################
12              
13 1     1   1571 use strict;
  1         3  
  1         30  
14 1     1   5 use warnings;
  1         2  
  1         37  
15 1     1   4 use parent qw( HiPi::Interface::Common::HD44780 );
  1         2  
  1         9  
16 1     1   70 use Carp;
  1         2  
  1         66  
17 1     1   7 use HiPi qw( :lcd );
  1         2  
  1         1088  
18              
19             our $VERSION ='0.81';
20              
21             sub new {
22 0     0 0   my ($class, %userparams) = @_;
23            
24 0           my %params = (
25             # standard device
26             devicename => '/dev/ttyAMA0',
27            
28             # serial port
29             baudrate => 9600,
30             parity => 'none',
31             stopbits => 1,
32             databits => 8,
33            
34             # LCD
35             width => undef,
36             lines => undef,
37             backlightcontrol => 0,
38             device => undef,
39             positionmap => undef,
40             serialbuffermode => 1,
41             );
42            
43             # get user params
44 0           foreach my $key( keys (%userparams) ) {
45 0           $params{$key} = $userparams{$key};
46             }
47            
48 0 0         unless( defined($params{device}) ) {
49 0           my %portparams;
50 0           for (qw( devicename baudrate parity stopbits databits ) ) {
51 0           $portparams{$_} = $params{$_};
52             }
53 0           require HiPi::Device::SerialPort;
54 0           $params{device} = HiPi::Device::SerialPort->new(%portparams);
55             }
56            
57 0           my $self = $class->SUPER::new(%params);
58 0           return $self;
59             }
60              
61             sub send_text {
62 0     0 0   my($self, $text) = @_;
63 0           $self->device->write( $text );
64             }
65              
66             sub send_command {
67 0     0 0   my($self, $command) = @_;
68 0           $self->device->write( SLCD_START_COMMAND . chr($command) );
69             }
70              
71             sub send_special_command {
72 0     0 0   my($self, $command) = @_;
73 0           $self->device->write( SLCD_SPECIAL_COMMAND . chr($command) );
74             }
75              
76             sub backlight {
77 0     0 0   my($self, $brightness) = @_;
78 0 0         $brightness = 0 if $brightness < 0;
79 0 0         $brightness = 100 if $brightness > 100;
80            
81             # input $brightness = 0 to 100
82             #
83             # SerLCD uses a 30 range value 128 - 157
84             # to control brightness level
85            
86 0 0         return unless ($self->backlightcontrol);
87              
88 0           my $level;
89 0 0         if( $brightness == 0 ) {
    0          
    0          
90 0           $level = 128;
91             } elsif( $brightness == 1 ) {
92 0           $level = 129;
93             } elsif( $brightness == 100 ) {
94 0           $level = 157;
95             } else {
96 0           $level = int( 128.5 + ( ( $brightness / 100 ) * 30 ) );
97 0 0         $level = 129 if $level < 129;
98             }
99            
100 0 0         $level = 157 if $level > 157;
101            
102 0           $self->send_special_command( $level );
103             }
104              
105             sub update_baudrate {
106 0     0 0   my $self = shift;
107 0           my $baud = $self->device->baudrate;
108 0           my $bflag;
109            
110 0 0         if ($baud == 2400) {
    0          
    0          
    0          
    0          
    0          
111 0           $bflag = 11;
112             } elsif ($baud == 4800) {
113 0           $bflag = 12;
114             } elsif ($baud == 9600) {
115 0           $bflag = 13;
116             } elsif ($baud == 14400) {
117 0           $bflag = 14;
118             } elsif ($baud == 19200) {
119 0           $bflag = 15;
120             } elsif ($baud == 38400) {
121 0           $bflag = 16;
122             } else {
123 0           croak(qq(The baudrate of the serial device is not supported by the LCD controller));
124             }
125            
126 0           $self->send_special_command( $bflag );
127             }
128              
129             sub update_geometry {
130 0     0 0   my $self = shift;
131            
132 0 0         if($self->width == 20) {
133 0           $self->send_special_command( 3 );
134             }
135 0 0         if($self->width == 16) {
136 0           $self->send_special_command( 4 );
137             }
138 0 0         if($self->lines == 4) {
139 0           $self->send_special_command( 5 );
140             }
141 0 0         if($self->lines == 2) {
142 0           $self->send_special_command( 6 );
143             }
144 0 0         if($self->lines == 1) {
145 0           $self->send_special_command( 7 );
146             }
147             }
148              
149             sub enable_backlight {
150 0     0 0   my($self, $flag) = @_;
151 0 0         $flag = 1 if !defined($flag);
152 0 0         if( $flag ) {
153 0           $self->send_special_command( 1 );
154             } else {
155 0           $self->send_special_command( 2 );
156             }
157             }
158              
159             sub toggle_splashscreen {
160 0     0 0   $_[0]->send_special_command( 9 );
161             }
162              
163             sub init_lcd {
164 0     0 0   $_[0]->send_special_command( 8 );
165             }
166              
167             sub set_splashscreen {
168 0     0 0   $_[0]->send_special_command( 10 );
169             }
170              
171             1;
172              
173             __END__