I have one of those LED signs that let you put clever sayings on them for the world to see. As cool as they are, they are much cooler when you control them with Perl. There are other programs out there to do this, but here is my own offering - a Perl/Tk app that lets you send messages and control sequences to the sign. As written it probably only works with Linux (as I don't have any other OS to test it on), but if someone would like to add enhancements, I'd like to include them.
#! /usr/bin/perl
################################################################
# This program by M. Litherland #
# http://nule.org/ #
# #
# Special thanks to Denis Hruza #
# http://users.neotechus.com/~hruzaden/betabrite/betabrite.htm #
# for his program bb-stockticker.pl which showed me that #
# this wouldn't work without the RUNLIST code. #
################################################################
# This code may be distibuted under the same terms as Perl
# itself.
use strict;
use warnings;
use Tk;
use Tk::DialogBox;
# Change this to be your comm port if needed.
use constant COMPORT => '/dev/ttyS0';
# This varies by model
use constant MAXSIZE => 8192;
# Header and footer sent to the unit.
use constant HEADER => qw/00 00 00 00 00 00 01 5a 30 30 02 41 41/;
use constant FOOTER => qw/04/;
# This tells the unit to run the command list.
use constant RUNLIST => qw/00 00 00 00 00 00 01 5a 30 30 02 45 2e 53 5
+5 41 04/;
# There are *lots* of these codes.
use constant CODES => {
ROTATE => [ qw/1b 20 61/ ],
RIGHT => [ qw/1b 20 68/ ],
LEFT => [ qw/1b 20 67/ ],
UP => [ qw/1b 20 65/ ],
DOWN => [ qw/1b 20 66/ ],
SPRAY => [ qw/1b 20 6e 35/ ],
AUTO => [ qw/1b 20 6f/ ],
SNOW => [ qw/1b 20 6e 32/ ],
TWINKLE => [ qw/1b 20 6e 30/ ],
SPARKLE => [ qw/1b 20 6e 31/ ],
INTER => [ qw/1b 20 6e 33/ ]
};
# There are more colors, but who cares?
use constant COLOR => {
RED => [ qw/1c 31/ ],
GREEN => [ qw/1c 32/ ],
AMBER => [ qw/1c 33/ ],
RAINBOW => [ qw/1c 39/ ],
MIX => [ qw/1c 42/ ],
};
# Some initialization stuff
$\ = "";
$/ = "";
$|++;
my $w = {};
$w->{confirm} = 0;
$w->{main} = MainWindow->new(-title => 'Beta-Brite Controller');
# Main widgets
$w->{buttons} = $w->{main}->Frame->pack(-fill => 'x');
$w->{control} = $w->{main}->Frame(-border => 2,-relief => 'groove')->p
+ack(-fill => 'x');
$w->{text} = $w->{main}->Text(-width => 80, -height => 25)->pack(-fill
+ => 'both', -expand => 1);
# Various generic commands
$w->{buttons}->Button(-text => 'Send', -command => [\&send, $w])->pack
+(-side => 'left');
$w->{buttons}->Button(-text => 'Clear', -command => sub {$w->{text}->d
+elete('1.0', 'end')})->pack(-side => 'left');
$w->{buttons}->Button(-text => 'Exit', -command => sub {exit})->pack(-
+side => 'right');
# These buttons generate command sequences sent to the unit
$w->{control}->Label(-text => 'Modes: ')->pack(-side => 'left');
# Frames for two rows of buttons.
$w->{modes} = $w->{control}->Frame->pack(-side => 'left');
$w->{modest} = $w->{modes}->Frame->pack;
$w->{modesb} = $w->{modes}->Frame->pack;
# Top row.
$w->{modest}->Button(
-text => 'Rotate',
-command => sub {$w->{text}->insert('insert', "/*ROTATE*/")}
)->pack(-side => 'left');
$w->{modest}->Button(
-text => 'Left',
-command => sub {$w->{text}->insert('insert', "/*LEFT*/")}
)->pack(-side => 'left');
$w->{modest}->Button(
-text => 'Right',
-command => sub {$w->{text}->insert('insert', "/*RIGHT*/")}
)->pack(-side => 'left');
$w->{modest}->Button(
-text => 'Up',
-command => sub {$w->{text}->insert('insert', "/*UP*/")}
)->pack(-side => 'left');
$w->{modest}->Button(
-text => 'Down',
-command => sub {$w->{text}->insert('insert', "/*DOWN*/")}
)->pack(-side => 'left');
$w->{modest}->Button(
-text => 'Spray',
-command => sub {$w->{text}->insert('insert', "/*SPRAY*/")}
)->pack(-side => 'left');
# Bottom row.
$w->{modesb}->Button(
-text => 'Auto',
-command => sub {$w->{text}->insert('insert', "/*AUTO*/")}
)->pack(-side => 'left');
$w->{modesb}->Button(
-text => 'Snow',
-command => sub {$w->{text}->insert('insert', "/*SNOW*/")}
)->pack(-side => 'left');
$w->{modesb}->Button(
-text => 'Twinkle',
-command => sub {$w->{text}->insert('insert', "/*TWINKLE*/")}
)->pack(-side => 'left');
$w->{modesb}->Button(
-text => 'Sparkle',
-command => sub {$w->{text}->insert('insert', "/*SPARKLE*/")}
)->pack(-side => 'left');
$w->{modesb}->Button(
-text => 'Interlock',
-command => sub {$w->{text}->insert('insert', "/*INTER*/")}
)->pack(-side => 'left');
# These buttons generate color sequences sent to the unit
$w->{control}->Label(-text => 'Colors: ')->pack(-side => 'left');
# Frames for two rows of buttons.
$w->{color} = $w->{control}->Frame->pack(-side => 'left');
$w->{colort} = $w->{color}->Frame->pack;
$w->{colorb} = $w->{color}->Frame->pack;
# Top row.
$w->{colort}->Button(
-text => 'Red',
-command => sub {$w->{text}->insert('insert', "/*RED*/")}
)->pack(-side => 'left');
$w->{colort}->Button(
-text => 'Green',
-command => sub {$w->{text}->insert('insert', "/*GREEN*/")}
)->pack(-side => 'left');
$w->{colort}->Button(
-text => 'Amber',
-command => sub {$w->{text}->insert('insert', "/*AMBER*/")}
)->pack(-side => 'left');
# Bottom row.
$w->{colorb}->Button(
-text => 'Rainbow',
-command => sub {$w->{text}->insert('insert', "/*RAINBOW*/")}
)->pack(-side => 'left');
$w->{colorb}->Button(
-text => 'Automix',
-command => sub {$w->{text}->insert('insert', "/*MIX*/")}
)->pack(-side => 'left');
# An initial phrase to set it.
$w->{text}->insert('1.0', "/*SPARKLE*//*RED*/Just /*GREEN*/another /*A
+MBER*/Perl /*GREEN*/hacker,");
MainLoop;
exit;
sub send
{
my $w = shift;
if (!$w->{confirm})
{
my $dialog = $w->{main}->DialogBox(-title => "Using ".COMPORT,
+ -buttons => ['OK', 'Cancel']);
$dialog->Label(-text => 'Are you sure you have your comm port
+set correctly?')->pack;
$dialog->Label(-text => 'Something like: stty 9600 -opost -ocr
+nl -onlcr cs7 parenb -parodd < /dev/ttyS0')->pack;
$dialog->Label(-text => 'Make sure you can write to the device
+ too: chmod 777 /dev/ttyS0')->pack;
my $popup = $dialog->Show;
return unless ($popup eq 'OK');
$w->{confirm} = 1;
}
# Process text from window.
my $text = $w->{text}->get('1.0', 'end');
$text =~ s/\r//g;
$text =~ s/\n//g;
# Make sure the text has required attributes.
my $init = "";
if ($text =~ /^\/\*(\w+)\*\//)
{
$init = $1;
if (!defined(&CODES->{$init}))
{
my $dialog = $w->{main}->DialogBox(-title => "Error", -but
+tons => ['OK']);
$dialog->Label(-text => 'Sorry - you have to start the tex
+t with a command.')->pack;
my $popup = $dialog->Show;
return;
}
}
else
{
my $dialog = $w->{main}->DialogBox(-title => "Error", -buttons
+ => ['OK']);
$dialog->Label(-text => 'Sorry - you have to start the text wi
+th a command.')->pack;
my $popup = $dialog->Show;
return;
}
# Process codes and colors embedded in text.
for (keys %{&CODES})
{
if ($text =~ /\/\*$_\*\//)
{
my $repl = join "", map{pack("H*", $_)} @{&CODES->{$_}};
$text =~ s/\/\*$_\*\//$repl/g;
}
}
for (keys %{&COLOR})
{
if ($text =~ /\/\*$_\*\//)
{
my $repl = join "", map{pack("H*", $_)} @{&COLOR->{$_}};
$text =~ s/\/\*$_\*\//$repl/g;
}
}
my $command = join "", map{pack("H*", $_)} HEADER;
$command .= $text;
$command .= join "", map{pack("H*", $_)} FOOTER;
open COMM, ">".COMPORT || die "Could not open comport($!): ".COMPO
+RT." !\n";
#open COMM, ">out" || die "Could not open tempfile($!): out!\n";
binmode COMM;
print COMM $command;
print COMM RUNLIST;
close COMM;
}
{NULE}
--
http://www.nule.org
