Perl driver for Kingpul RH216C scrolling LED sign

KingpulRH216C.pm

package MessageSign::KingpulRH216C;

use vars qw($VERSION);
($VERSION) = '$Revisioning$' =~ /\$Revisioning:\s+([^\s]+)/;

@ISA = qw( Exporter );

use POSIX qw|strftime|;
use strict;

=head1 MessageSign::KingpulRH216C

=head1 NAME

MessageSign::KingpulRH216C - Control a Kingpul RH216C scrolling LED sign

=head1 SYNOPSIS

    use MessageSign::KingpulRH216C;

=cut



# These post-/preambles are specific to the Kingpul RH216C

our $preamble_msg = (chr(0xaa) x 10).chr(0xbb).chr(0xaf);
our $preamble_gfx = (chr(0xaa) x 10).chr(0xbd);
our $preamble_time = (chr(0xaa) x 10).chr(0xbe).chr(0x31);

our $postamble_msg = chr(0xbf).chr(0xb1);
our $postamble_gfx = chr(0xbf).chr(0xb3);
our $postamble_time = chr(0xbf).chr(0xb1);


=head1 COMMAND STRUCTURE

=cut



=head1 LEAD COMMANDS AND TAIL COMMANDS

=cut

our %leads = ( 
			  'jump' => "\x8b\x03",
			  'left' => "\x80\x03",
			  'right' => "\x81\x03",
			  'up' => "\x82\x03",
			  'down' => "\x83\x03",
			  'flash' => "\x8a\x03",
			  'openc' => "\x84\x03",
			  'none' => '');

our %tails = (
			  'closec' => "\x85\x03",
			  'closelr' => "\x87\x03",
			  'clear' => "\x8e\x03",
			  'none' => '');


=head1 METHODS

=cut



=head2 MessageSign::KingpulRH216C

=over 4




=item $sign = new MessageSign::KingpulRH216C

Creates a new MessageSign::KingpulRH216C object.  This can be safely used for one message.

=cut

sub new ($) {
	my ($class) = @_;
	my $self = {buf=>''};
	bless($self, $class);
	return $self;
}





=item $sign->openc [$colour = 1]

Adds an "OPEN <-->" leading command to the message string.

=cut

sub openc($;$) {
	my ($self, $colour) = @_;
	$colour = 1 unless($colour);
	$self->{buf} .= "\x84".$colour;
}





=item $sign->closec [$colour = 1]

Adds a "CLOSE --><--" tail command to the message string.

=cut

sub closec($;$) {
	my ($self, $colour) = @_;
	$colour = 1 unless($colour);
	$self->{buf} .= "\x85".$colour;
}





=item $sign->clock

Adds a "CLOCK" command to the message string.

=cut

sub clock($) {
	my ($self) = @_;
	$self->{buf} .= "\x8f\x07";
}





=item $sign->clear

Adds a "CLEAR" tail command to the message string.

=cut

sub clear($) {
	my ($self) = @_;
	$self->{buf} .= "\x8e\x03";
}





=item $sign->flash

Adds a "FLASH" leading command to the message string.

=cut

sub flash($) {
	my ($self) = @_;
	$self->{buf} .= "\x8a\x03";
}





=item $sign->jump

Adds a "JUMP" leading command to the message string.

=cut

sub jump($) {
	my ($self) = @_;
	$self->{buf} .= "\x8b\x03";
}





=item $sign->gosub $program

EXPERIMENTAL: Adds a "GOSUB" command to the message string.  The manual
indicates that the GOSUB command should only be used in program 'A'.

=cut

sub gosub($$) {
	my ($self, $program) = @_;
	$self->{buf} .= "\xa2".$program;
}





=item $sign->fillflash [$colour = 1]

Adds a flashing bar to the message string.  Since this is not a standard
command, it uses up a reasonably large chunk of available message space.
However, it's good for grabbing attention.

=cut

sub fillflash($;$) {
	my ($self, $colour) = @_;
	$self->{buf} .= "\x8a\x03";
	$self->{buf} .= (chr($colour<<2 | $colour).':') x 16;
	$self->{buf} .= "\x8e\x03";
}





=item $sign->delay [$seconds = 1]

Adds a delay to the message string.

=cut

sub delay($;$) {
	my ($self, $seconds) = @_;
	$seconds = 1 unless($seconds>1 and $seconds<10);
	$self->{buf} .= "\xa1".int($seconds);
}





=item $sign->text $string [, $colour = 1 [, $delay = 0 [, $lead = 'jump' [, $tail = 'none' [, $colours = null]]]]]

Adds a text block correctly multiplexed with colour information, with an
optional following delay and lead and tail transitions.

=cut

sub text($$;$$$$) {
	my ($self, $str, $colour, $delay, $lead, $tail, $colours) = @_;
	$colour = 1 unless($colour);
	$lead = 'jump' unless($lead);
	$tail = 'none' unless($tail);

	if($lead eq 'jump') {
		if(length($str) < 16) {
			$str = $str.(' ' x (16-length($str)));
 		}
	}

	$str =~ tr{: <}{ :\x5f};

	if($colours) {
		my @chrs = split('', $str);
		my @cols = split('', $colours);
		$str = '';
		while(@chrs) {
			my $col = shift @cols;
			my $chr = shift @chrs;
			if(chr($col)) {
				$str .= chr(ord($col)-48).$chr;
			} else {
				$str .= chr($colour).$chr;
			}
		}
	} else {
		$str = chr($colour).join(chr($colour), split('', $str));
	}

	$self->{buf} .= $leads{$lead};
	$self->{buf} .= $str;
	$self->{buf} .= "\xa1".($delay%10) if($delay>0);
	$self->{buf} .= $tails{$tail} if($tail ne 'none');
}



=item $sign->dobig [ $colour = 1 ]

Adds a 'DOBIG' leading command to the message buffer.

=cut

sub dobig($;$) {
	my ($self, $colour) = @_;
	$colour = 1 unless($colour);
	$self->{buf} .= "\x8d$colour";
}




=item $sign->set_clock $device_serialport

Sets the sign's internal clock to the current system local time.  This
should be done before issuing any message commands.

=cut

sub set_clock($$) {
	my ($self, $serial) = @_;
	my $str = $preamble_time;
	$str .= strftime "%y%m%d%H%M%S", localtime;
	$str .= $postamble_time;
	my $count_out = $serial->write($str);
	warn "write failed\n"         unless ($count_out);
	warn "write incomplete\n"     if ( $count_out != length($str) );
	sleep 1;
}




=item $sign->write $device_serialport [, $program = 'A']

Outputs the current message buffer to the sign using the given
Device::SerialPort (which should already be configured for communication
to the sign).  EXPERIMENTAL: The sign can store multiple programs, with
'A' being the primary one.  I do not use this function and so it is
effectively untested.

=cut

sub write($$;$) {
	my ($self, $serial, $program) = @_;
	my $str = $self->as_string(0, $program);
	my $count_out = $serial->write($str);
	my $len = length($str);
	warn "write failed ($len)\n"         unless ($count_out);
	warn "write incomplete ($len != $count_out)\n"     if ( $count_out != length($str) );
}




=item $sign->as_string [, $without_wrapper = false [, $program = 'A' ]]

Returns the current message buffer as a string to be sent to the sign,
either with the control wrapper or without.

=cut

sub as_string($;$$) {
	my ($self, $without_wrapper, $program) = @_;
	$program = 'A' unless($program);
	return $self->{buf} if($without_wrapper);
	return $preamble_msg.$program.$self->{buf}.$postamble_msg;
}




=item $sign->revert_to_clock $device_serialport

Switches the sign to a looping clock display.  Useful for idle time.

=cut

sub revert_to_clock($$) {
	my ($self, $serial) = @_;
	$self->{buf} = '';
	$self->clock();
	$self->write($serial, 'A');
}





sub send_sheep($$) {
	my ($self, $serial) = @_;
	my $str = $preamble_gfx;
	$str .= "\x00\x1a\x3f\x7f\x1e\x3f\x1f\x1a\x3f\x1f\x1e\x3f\x1f";
	$str .= "\x08\x7f\x1e\x0f\x0e\x06\x04\x1f\x1e\x08\x08\x00\x00";
	$str .= $postamble_gfx;
	$self->{sheepsent} = 1;
	my $count_out = $serial->write($str);
	warn "write failed\n"         unless ($count_out);
	warn "write incomplete\n"     if ( $count_out != length($str) );
}

sub sheep($) {
	my ($self) = @_;
	$self->{buf} .= "\x10\x00\x10\x08";
}



1;

__END__

=head1 AUTHOR

Tom Gidden <[email protected]>

=cut