File Coverage

blib/lib/HiPi/Interface/Common/HD44780.pm
Criterion Covered Total %
statement 15 58 25.8
branch 0 16 0.0
condition 0 6 0.0
subroutine 5 18 27.7
pod 0 13 0.0
total 20 111 18.0


line stmt bran cond sub pod time code
1             #########################################################################################
2             # Package HiPi::Interface::Common::HD44780
3             # Description : Control a LCD based on HD44780
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::Common::HD44780;
10              
11             #########################################################################################
12              
13 1     1   470 use strict;
  1         2  
  1         25  
14 1     1   5 use warnings;
  1         2  
  1         23  
15 1     1   6 use parent qw( HiPi::Interface );
  1         2  
  1         6  
16 1     1   55 use Carp;
  1         2  
  1         76  
17 1     1   7 use HiPi qw( :lcd );
  1         2  
  1         1055  
18              
19             our $VERSION ='0.80';
20              
21             __PACKAGE__->create_accessors( qw(
22             width lines backlightcontrol positionmap devicename serialbuffermode
23             ) );
24              
25              
26             sub new {
27 0     0 0   my ($class, %userparams ) = @_;
28            
29 0           my %params = (
30             width => undef,
31             lines => undef,
32             backlightcontrol => 0,
33             device => undef,
34             positionmap => undef,
35             );
36            
37             # get user params
38 0           foreach my $key( keys (%userparams) ) {
39 0           $params{$key} = $userparams{$key};
40             }
41            
42 0 0         croak('A derived class must provide a device') unless(defined($params{device}));
43            
44 0 0         unless( $params{positionmap} ) {
45             # setup default position map
46 0 0 0       unless( $params{width} =~ /^(16|20)$/ && $params{lines} =~ /^(2|4)$/) {
47 0           croak('HiPi::Interface::Common::HD44780 only supports default LCD types 16x2, 16x4, 20x2, 20x4' );
48             }
49 0           my (@pmap, @line1, @line2, @line3, @line4, @buffers);
50            
51 0 0 0       if( $params{width} == 16 && $params{serialbuffermode} ) {
52 0           @line1 = (0..15);
53 0           @line2 = (64..79);
54 0           @line3 = (16..31);
55 0           @line4 = (80..95);
56             } else {
57 0           @line1 = (0..19);
58 0           @line2 = (64..83);
59 0           @line3 = (20..39);
60 0           @line4 = (84..103);
61             }
62            
63 0 0         if( $params{lines} == 2 ) {
    0          
64 0           @pmap = ( @line1, @line2 );
65             } elsif( $params{lines} == 4 ) {
66 0           @pmap = ( @line1, @line2, @line3, @line4 );
67             }
68            
69 0           $params{positionmap} = \@pmap;
70             }
71            
72 0           my $self = $class->SUPER::new(%params);
73            
74 0           $self->update_geometry; # will set cols / lines to controller
75            
76 0           return $self;
77             }
78              
79             sub enable {
80 0     0 0   my($self, $enable) = @_;
81 0 0         $enable = 1 unless defined($enable);
82 0 0         my $command = ( $enable ) ? HD44780_DISPLAY_ON : HD44780_DISPLAY_OFF;
83 0           $self->send_command( $command ) ;
84             }
85              
86             sub set_cursor_position {
87 0     0 0   my($self, $col, $row) = @_;
88 0           my $pos = $col + ( $row * $self->width );
89 0           $self->send_command( HD44780_CURSOR_POSITION + $self->positionmap->[$pos] );
90             }
91              
92             sub move_cursor_left {
93 0     0 0   $_[0]->send_command( HD44780_SHIFT_CURSOR_LEFT );
94             }
95              
96             sub move_cursor_right {
97 0     0 0   $_[0]->send_command( HD44780_SHIFT_CURSOR_RIGHT );
98             }
99              
100 0     0 0   sub home { $_[0]->send_command( HD44780_HOME_UNSHIFT ); }
101              
102 0     0 0   sub clear { $_[0]->send_command( HD44780_CLEAR_DISPLAY ); $_[0]->delayMicroseconds(2000); }
  0            
103              
104 0     0 0   sub set_cursor_mode { $_[0]->send_command( $_[1] ); }
105              
106 0     0 0   sub backlight { croak('backlight must be overriden in derived class'); }
107              
108 0     0 0   sub send_text { croak('send_text must be overriden in derived class'); }
109              
110 0     0 0   sub send_command { croak('send_command must be overriden in derived class'); }
111              
112 0     0 0   sub update_baudrate { croak('update_baudrate must be overriden in derived class'); }
113              
114 0     0 0   sub update_geometry { croak('update_geometry must be overriden in derived class'); }
115              
116             1;
117              
118             __END__