File Coverage

blib/lib/Device/Pertelian.pm

Criterion	Covered	Total	%
statement	47	47	100.0
branch	4	8	50.0
condition			n/a
subroutine	11	11	100.0
pod	3	3	100.0
total	65	69	94.2

package Device::Pertelian;

use warnings;
use strict;

use fields qw/device _fh/;

use IO::Handle;
use Time::HiRes qw/usleep/;

=head1 NAME

Device::Pertelian - a driver for the Pertelian X2040 USB LCD

=cut

our $VERSION = '0.03';

=head1 SYNOPSIS

If you have a Pertelian X2040 USB LCD screen, then you can do
things with it.

    use Device::Pertelian;

    my $lcd = Device::Pertelian->new('/dev/ttyUSB0');
    $lcd->clearscreen();

    # write to the top row
    $lcd->writeline(0, "Hello, world!");
    ...

=head1 METHODS

=head2 new

The constructor accepts one parameter, $device, which is a path in /dev.
You may find it out from your logs.

=cut

sub new {
    my $self = shift;
    my $device = shift;

    unless (ref $self) {
        $self = fields::new($self);
    }

    if ($device) {
        $self->_open($device);
    }

    return $self;
}

sub _open {
    my ($self, $device) = @_;

    open $self->{_fh}, '>', $device
        or return;

    $self->{_fh}->autoflush(1);

    foreach (0x38, 0x06, 0x10, 0x0c) {
        $self->_writeout(pack('CC', 0xfe, $_));
    }

    return 1;
}

sub _writeout {
    my ($self, $buf) = @_;

    if ($self->{_fh}) {
        print {$self->{_fh}} $buf;
        usleep(1000);
    }
}

=head2 clearscreen

This function does a simple thing -- clears all the 4 lines of the screen.

=cut

=head2 writeline

This function takes two parameters, $row and $text. The screen has 4 rows,
so you may pass a number from 0 to 3 as $row and the $text should be
under 20 characters, that is the width of the screen.

=cut

sub writeline {
    my $self = shift;

    my ($row, $text) = @_;
    my @rowvals = (
        0x80,
        0x80 + 0x40,
        0x80 + 0x14,
        0x80 + 0x54);
    my $buf = pack('CC', 0xfe, $rowvals[$row]);
    $self->_writeout($buf);

    foreach (split(//, $text)) {
        $self->_writeout($_);
    }

    return 1;
}

sub clearscreen {
    my $self = shift;

    $self->_writeout(pack('CC', 0xfe, 1));
    usleep(10000);
}

=head1 AUTHOR

Alex Kapranoff, C<<  >>

=head1 BUGS

Please report any bugs or feature requests to C, or through
the web interface at L.  I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Device::Pertelian

You can also look for information at:

=over 4

=item * RT: CPAN's request tracker

L

=item * AnnoCPAN: Annotated CPAN documentation

L

=item * CPAN Ratings

L

=item * Search CPAN

L

=back

=head1 DOCUMENTATION

See L,
L
and the pertd software that vanished with the main website pertelian.com.

=head1 COPYRIGHT & LICENSE

Copyright 2008 Alex Kapranoff, all rights reserved.

This program is released under the following license: GPL version 3

In the included pertd.tgz archive there is code by:
Frans Meulenbroeks, Ron Lauzon, Pred S. Bundalo, Chmouel Boudjnah,
W. Richard Stevens.

The code in pertd.tgz is either in Public Domain or available for
distribution in unmodified form. See the relevant files.

=cut

1;