| 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
|
|
1763
|
use strict; |
|
|
1
|
|
|
|
|
3
|
|
|
|
1
|
|
|
|
|
31
|
|
|
14
|
1
|
|
|
1
|
|
6
|
use warnings; |
|
|
1
|
|
|
|
|
3
|
|
|
|
1
|
|
|
|
|
67
|
|
|
15
|
1
|
|
|
1
|
|
7
|
use parent qw( HiPi::Interface::Common::HD44780 ); |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
7
|
|
|
16
|
1
|
|
|
1
|
|
73
|
use Carp; |
|
|
1
|
|
|
|
|
1
|
|
|
|
1
|
|
|
|
|
68
|
|
|
17
|
1
|
|
|
1
|
|
6
|
use HiPi qw( :lcd ); |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
932
|
|
|
18
|
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
our $VERSION ='0.80'; |
|
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__ |