File Coverage

blib/lib/Device/Arduino/LCD.pm

Criterion	Covered	Total	%
statement	12	106	11.3
branch	0	32	0.0
condition	0	22	0.0
subroutine	4	24	16.6
pod	1	20	5.0
total	17	204	8.3

package Device::Arduino::LCD;

use strict;
use Device::SerialPort qw[ :ALL ];

our $VERSION = '1.02';

$|++;

# defaults.
$Device::Arduino::LCD::Device	     = '/dev/tty.usbserial';
$Device::Arduino::LCD::Baud	     = 9600;
$Device::Arduino::LCD::READ_TIMEOUT  = 10;

use Class::MethodMaker [ scalar => [ qw[ port baud ] ]];

use constant {
  ROW_ONE_TEXT => '01',
  ROW_TWO_TEXT => '02',
  SCROLL_UP    => '03',
  PLACE_STRING => '04',
  SCROLL_LEFT  => '05',
  CLEAR        => '06',
  SET_GAUGE    => '07',
  MAKE_CHAR    => '08',
  SEND_CMD     => '09',
  PRINT        => '10',
  WRITE_ASCII  => '11',
  RESET        => '99',
};

# transmission control.
our $HEADER_START = "\x1A";
our $DATA_START   = "\x1B";
our $DATA_END     = "\x1C";
our $STRING_TOK   = "\x1D";

sub new {
  my $class = shift;
  my ($device, $baud) = @_;
  $device ||= $Device::Arduino::LCD::Device;
  $baud   ||= $Device::Arduino::LCD::Baud;
  my $port = Device::SerialPort->new($device)
    or die "can't open serial device: $!";
  $port->baudrate($baud);
  $port->read_char_time(0);
  $port->read_const_time(1000);
  return bless { port => $port, baud => $baud }, $class;
}

sub send {
  my ($self, $command, $payload) = @_;
  my $cmd = $self->encapsulate($command, $payload);
  $self->port->write($cmd);
}

sub encapsulate {
  my ($self, $command, $payload) = @_;
  return join '' => $HEADER_START, $command, $DATA_START, $payload, $DATA_END;
}

sub receive {
  my $self = shift;
  my ($buffer, $chars, $timeout) =
    ("", 0, $Device::Arduino::LCD::READ_TIMEOUT);
  while ($timeout > 0) {
    my ($count, $saw) = $self->port->read(255);
    if ($count > 0) {
      $chars  += $count;
      $buffer .= $saw;
      last if $chars;
    }
    else {
      $timeout--;
    }
  }
  return $buffer;
}

sub reset {
  my $self = shift;
  $self->send(RESET);
}

sub first_line {
  my ($self, $text) = @_;
  $self->send(ROW_ONE_TEXT, $text);
}

sub second_line {
  my ($self, $text) = @_;
  $self->send(ROW_TWO_TEXT, $text);
}

sub clear {
  my ($self, $pre_delay, $post_delay) = @_;
  sleep ($pre_delay || 0);
  $self->send(CLEAR);
  sleep ($post_delay || 0);
}

sub scroll_left {
  my ($self, $delay) = @_;
  $self->send(SCROLL_LEFT, $delay);
}

sub scroll_up {
  my ($self, $text, $pre_delay, $internal_delay, $post_delay) = @_;
  my @text = ref $text eq 'ARRAY' ? @$text : ($text);
  sleep ($pre_delay || 0);
  for (@text) {
    $self->send(SCROLL_UP, $_);
    sleep ($internal_delay || 0);
  }
  sleep ($post_delay || 0);
}

sub place_string {
  my ($self, $text, $row, $col) = @_;
  my $payload = join $STRING_TOK => $row, $col, $text;
  $self->send(PLACE_STRING, $payload);
}

sub gauge_pct {
  my ($self, $gauge, $pct) = @_;
  $pct = $pct > 1 ? $pct/100 : $pct;
  my $step_level = 255 * $pct;
  my $payload = join $STRING_TOK => $gauge, $step_level;
  $self->send(SET_GAUGE, $payload);
}

sub command {
  my ($self, $command) = @_;
  $self->send(SEND_CMD, $command);
}

sub print_char {
  my ($self, $char) = @_;
  $self->send(PRINT, ord(substr($char, 0, 1)));
}

sub write_ascii {
  my ($self, $ascii, $row, $col) = @_;
  my $payload = join $STRING_TOK => $row, $col, $ascii;
  $self->send(WRITE_ASCII, $payload);
}

sub make_char {
  my ($self, $ascii, @data) = @_;

  die "out out bounds" unless $ascii <= 7 and $ascii >=0;
  @data = ref $data[0] eq 'ARRAY' ? @{ $data[0] } : @data;
  die "bad character data" unless scalar @data == 8;
  my $payload = join $STRING_TOK => $ascii, @data;
  $self->send(MAKE_CHAR, $payload);
}

sub convert_to_char {
  my ($self, $ascii, @lines) = @_;
  return undef unless $ascii >=0 and $ascii <= 7;

  my @values = ();

  for my $line_number (0 .. 7) { # starting at the top
    $values[$line_number] = 128;
    my $line = $lines[$line_number];
    return undef unless (ref $line eq 'ARRAY');
    my @line = @$line;
    for my $i (0 .. 4) {
      $values[$line_number] += (2 ** (4-$i)) if lc $line[$i] eq 'x';
    }
  }

  $self->make_char($ascii, @values);
  return \@values;
}



# bargraph support.

sub graph {
  my ($self, $val, $row, $col) = @_;
  if ($val == 0) { # print a space.
    $self->place_string(" ", $row, $col);
  }
  elsif ($val <= 8) {
    $self->write_ascii($val - 1, $row, $col);
  }
}

sub tallgraph {
  my ($self, $val, $col) = @_;
  if ($val == 0) {
    $self->place_string(" ", 1, $col);
    $self->place_string(" ", 2, $col);
  }
  elsif ($val <= 8) {
    $self->place_string(" ",      1, $col);
    $self->write_ascii($val - 1,  2, $col);
  }
  elsif ($val <= 16) {
    $self->write_ascii($val - 9, 1, $col);
    $self->write_ascii(7,        2, $col);
  }
}

sub init_bargraph {
  my ($self) = shift;
  my $data = [ [128,128,128,128,128,128,128,159],
	       [128,128,128,128,128,128,159,159],
	       [128,128,128,128,128,159,159,159],
	       [128,128,128,128,159,159,159,159],
	       [128,128,128,159,159,159,159,159],
	       [128,128,159,159,159,159,159,159],
	       [128,159,159,159,159,159,159,159],
	       [159,159,159,159,159,159,159,159] ];
  my $i = 0;
  for (@$data) { $self->make_char($i++, $_) };
}



1;

__END__