File Coverage

blib/lib/HiPi/Interface/HobbyTronicsBackpackV2.pm
Criterion Covered Total %
statement 18 99 18.1
branch 0 64 0.0
condition 0 6 0.0
subroutine 6 14 42.8
pod 0 8 0.0
total 24 191 12.5


line stmt bran cond sub pod time code
1             #########################################################################################
2             # Package HiPi::Interface::HobbyTronicsBackpackV2
3             # Description : HobbyTronics BackpackV2 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::HobbyTronicsBackpackV2;
10              
11             #########################################################################################
12              
13 1     1   1000 use strict;
  1         6  
  1         32  
14 1     1   5 use warnings;
  1         3  
  1         28  
15 1     1   11 use parent qw( HiPi::Interface::Common::HD44780 );
  1         2  
  1         39  
16 1     1   42 use Carp;
  1         4  
  1         53  
17 1     1   6 use HiPi qw( :rpi :lcd );
  1         2  
  1         382  
18 1     1   8 use HiPi::RaspberryPi;
  1         3  
  1         6  
19              
20             our $VERSION ='0.81';
21              
22             __PACKAGE__->create_accessors( qw( devicetype address devicename backend ) );
23              
24             sub new {
25 0     0 0   my( $class, %userparams) = @_;
26            
27             # handle deprecated devicetype param
28 0 0 0       if ( defined($userparams{devicetype}) && !defined($userparams{backend}) ) {
29 0           $userparams{backend} = $userparams{devicetype};
30             }
31            
32 0           my $pi = HiPi::RaspberryPi->new();
33            
34 0 0         my %params = (
35             # LCD
36             width => undef,
37             lines => undef,
38             backlightcontrol => 0,
39             device => undef,
40             positionmap => undef,
41             serialbuffermode => 1,
42            
43             # RX or i2c
44             backend => 'serialrx', # alt [serialrx|i2c|smbus]
45             address => undef,
46             devicename => undef,
47            
48             # SerialRX params
49             baudrate => 9600,
50             parity => 'none',
51             stopbits => 1,
52             databits => 8,
53             serial_devicename => '/dev/ttyAMA0',
54            
55             # i2c params
56             i2c_address => 0x3A,
57             i2c_devicename => ( $pi->board_type == RPI_BOARD_TYPE_1 ) ? '/dev/i2c-0' : '/dev/i2c-1',
58             );
59            
60             # get user params
61 0           foreach my $key( keys (%userparams) ) {
62 0           $params{$key} = $userparams{$key};
63             }
64            
65             # handle deprecated devicetype
66 0           $userparams{devicetype} = $userparams{backend};
67            
68 0 0         unless( defined($params{device}) ) {
69 0 0         if( lc($params{backend}) eq 'serialrx' ) {
    0          
    0          
70 0 0         $params{devicename} = $params{serial_devicename} unless $params{devicename};
71             # set a default port
72 0           my %devparams;
73 0           for (qw( devicename baudrate parity stopbits databits ) ) {
74 0           $devparams{$_} = $params{$_};
75             }
76 0           require HiPi::Device::SerialPort;
77            
78 0           $params{device} = HiPi::Device::SerialPort->new(%devparams);
79            
80             } elsif( $params{backend} eq 'bcm2835' ) {
81 0           require HiPi::BCM2835::I2C;
82 0 0         $params{devicename} = $params{i2c_devicename} unless $params{devicename};
83 0 0         $params{address} = $params{i2c_address} unless defined($params{address});
84            
85             $params{device} = HiPi::BCM2835::I2C->new(
86             address => $params{address},
87 0 0         peripheral => ( $params{devicename} eq '/dev/i2c-0' ) ? HiPi::BCM2835::I2C::BB_I2C_PERI_0() : HiPi::BCM2835::I2C::BB_I2C_PERI_1(),
88             );
89            
90             } elsif( $params{backend} =~ /^(i2c|smbus)$/i ) {
91            
92 0 0         $params{devicename} = $params{i2c_devicename} unless $params{devicename};
93 0 0         $params{address} = $params{i2c_address} unless defined($params{address});
94            
95 0           require HiPi::Device::I2C;
96            
97             $params{device} = HiPi::Device::I2C->new(
98             devicename => $params{devicename},
99             address => $params{address},
100             busmode => $params{backend},
101 0           );
102             }
103             }
104            
105 0           my $self = $class->SUPER::new(%params);
106 0           return $self;
107             }
108              
109             sub send_text {
110 0     0 0   my($self, $text) = @_;
111 0           $self->send_htv2_command( HTV2_CMD_PRINT, $text );
112             }
113              
114             sub send_command {
115 0     0 0   my($self, $command) = @_;
116 0           $self->send_htv2_command( HTV2_CMD_HD44780_CMD, $command );
117             }
118              
119             sub send_htv2_command {
120 0     0 0   my($self, $command, @params ) = @_;
121 0 0         if( $self->backend eq 'serialrx') {
122 0           my $buffer = chr($command);
123 0 0         if( $command == HTV2_CMD_PRINT ) {
124             # one param - a text string
125 0           $buffer .= $params[0];
126             } else {
127             # all other cases - params are ASCII char codes
128 0           for my $p ( @params ) {
129 0           $buffer .= chr($p);
130             }
131             }
132 0           return $self->device->write( $buffer . HTV2_END_SERIALRX_COMMAND );
133             } else {
134 0           my @i2cvals = ( $command );
135 0 0         if( $command == HTV2_CMD_PRINT ) {
136             # one param - a text string
137 0           my @strvals = split(//, $params[0]);
138 0           for my $p ( @strvals ) {
139 0           push @i2cvals, ord($p);
140             }
141             } else {
142             # all other cases - params are ASCII char codes
143 0 0         push(@i2cvals, @params) if @params;
144             }
145 0           return $self->device->bus_write( @i2cvals );
146             }
147             }
148              
149             sub backlight {
150 0     0 0   my($self, $brightness) = @_;
151 0 0         $brightness = 0 if $brightness < 0;
152 0 0         $brightness = 100 if $brightness > 100;
153            
154             # $brightness = 0 to 100
155             # we translate to 0 - 250
156            
157 0 0         return unless $self->backlightcontrol;
158 0           my $bset;
159 0 0         if($brightness < 0) {
    0          
160 0           $bset = 0;
161             } elsif( $brightness >= 250 ) {
162 0           $bset = 250;
163             } else {
164 0           $bset = int( 2.5 * $brightness);
165             }
166            
167 0           $self->send_htv2_command( HTV2_CMD_BACKLIGHT, $bset );
168             }
169              
170             sub update_baudrate {
171 0     0 0   my $self = shift;
172 0 0         return unless $self->backend eq 'serialrx';
173 0           my $baud = $self->device->baudrate;
174 0           my $bflag;
175            
176 0 0         if ($baud == 2400) {
    0          
    0          
    0          
    0          
    0          
    0          
    0          
177 0           $bflag = HTV2_BAUD_2400;
178             } elsif ($baud == 4800) {
179 0           $bflag = HTV2_BAUD_4800;
180             } elsif ($baud == 9600) {
181 0           $bflag = HTV2_BAUD_9600;
182             } elsif ($baud == 14400) {
183 0           $bflag = HTV2_BAUD_14400;
184             } elsif ($baud == 19200) {
185 0           $bflag = HTV2_BAUD_19200;
186             } elsif ($baud == 28800) {
187 0           $bflag = HTV2_BAUD_28800;
188             } elsif ($baud == 57600) {
189 0           $bflag = HTV2_BAUD_57600;
190             } elsif ($baud == 115200) {
191 0           $bflag = HTV2_BAUD_115200;
192             } else {
193 0           croak(qq(The baudrate of the serial device is not supported by the LCD controller));
194             }
195            
196 0           $self->send_htv2_command( HTV2_CMD_BAUD_RATE, $bflag );
197 0           carp('The HobbyTronicsBackpackV2 device must be powered off and on after changing baudrate.');
198             }
199              
200             sub update_geometry {
201 0     0 0   my $self = shift;
202 0           $self->send_htv2_command( HTV2_CMD_LCD_TYPE, $self->lines, $self->width );
203             }
204              
205             sub change_i2c_address {
206 0     0 0   my( $self, $newaddress) = @_;
207 0 0         if( $self->backend eq 'serialrx') {
208 0           carp('The HobbyTronicsBackpackV2 device is in Serial RX mode. You cannot change the i2c address.');
209 0           return;
210             }
211 0 0 0       if($newaddress < 1 || $newaddress > 127) {
212 0           croak('The i2c address must be in the range 1 - 127 ( 0x01 - 0x7F )');
213             }
214 0           $self->send_htv2_command( HTV2_CMD_I2C_ADDRESS, $newaddress );
215 0           carp('The HobbyTronicsBackpackV2 device must be powered off and on after changing i2c address.');
216             }
217              
218             1;
219              
220             __END__