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__ |