mirror of
https://github.com/brmlab/brmdoor.git
synced 2025-06-07 11:14:01 +02:00
714 lines
16 KiB
Perl
Executable file
714 lines
16 KiB
Perl
Executable file
#!/usr/bin/perl
|
|
# 2011 (c) Petr Baudis <pasky@suse.cz>, brmlab
|
|
# You can distribute this under the same terms as Perl itself.
|
|
|
|
use strict;
|
|
use warnings;
|
|
use POE;
|
|
|
|
our $channel = "#brmlab";
|
|
our $streamurl = "http://nat.brmlab.cz:8090/brmstream.asf";
|
|
our $devdoor = $ARGV[0]; $devdoor ||= "/dev/ttyUSB0";
|
|
our $devasign = $ARGV[0]; $devasign ||= "/dev/ttyUSB1";
|
|
our ($status, $streaming, $topic) = (0, 0, 'BRMLAB OPEN');
|
|
|
|
my $irc = brmd::IRC->new();
|
|
my $web = brmd::WWW->new();
|
|
my $door = brmd::Door->new();
|
|
my $stream = brmd::Stream->new();
|
|
my $alphasign = brmd::Alphasign->new();
|
|
|
|
|
|
POE::Session->create(
|
|
package_states => [
|
|
main => [ qw(_default _start
|
|
status_update streaming_update) ],
|
|
],
|
|
heap => { irc => $irc, web => $web, door => $door, stream => $stream, alphasign => $alphasign },
|
|
);
|
|
|
|
$poe_kernel->run();
|
|
|
|
|
|
sub _start {
|
|
$poe_kernel->post($_[HEAP]->{web}, 'register');
|
|
$poe_kernel->post($_[HEAP]->{door}, 'register');
|
|
}
|
|
|
|
sub _default {
|
|
my ($event, $args) = @_[ARG0 .. $#_];
|
|
my @output = ( (scalar localtime), "main $event: " );
|
|
|
|
for my $arg (@$args) {
|
|
if ( ref $arg eq 'ARRAY' ) {
|
|
push( @output, '[' . join(', ', @$arg ) . ']' );
|
|
}
|
|
else {
|
|
push( @output, "'$arg'" );
|
|
}
|
|
}
|
|
print join ' ', @output, "\n";
|
|
}
|
|
|
|
sub status_str {
|
|
$status ? 'OPEN' : 'CLOSED';
|
|
}
|
|
|
|
sub streaming_str {
|
|
$streaming ? 'ON AIR' : 'OFF AIR';
|
|
}
|
|
|
|
sub status_update {
|
|
my ($self, $newstatus, $manual, $nick) = @_[OBJECT, ARG0 .. ARG2];
|
|
$status = $newstatus;
|
|
my $st = status_str();
|
|
|
|
if ($manual) {
|
|
$poe_kernel->post($door, 'status_override', $status);
|
|
}
|
|
|
|
$poe_kernel->post( $irc, 'notify_update', 'brmstatus', $st, undef, $manual, $nick );
|
|
}
|
|
|
|
sub streaming_update {
|
|
my ($self, $newstreaming) = @_[OBJECT, ARG0];
|
|
$streaming = $newstreaming;
|
|
if ($streaming) {
|
|
$poe_kernel->post( $_, 'stream_start' ) for ($stream, $alphasign);
|
|
} else {
|
|
$poe_kernel->post( $_, 'stream_stop' ) for ($stream, $alphasign);
|
|
}
|
|
|
|
my $st = streaming_str();
|
|
$poe_kernel->post( $irc, 'notify_update', 'brmvideo', $st, $streaming ? $streamurl : undef );
|
|
}
|
|
|
|
|
|
## Door serial
|
|
|
|
package brmd::Door;
|
|
|
|
use POE qw(Wheel::ReadWrite Filter::Line);
|
|
use Symbol qw(gensym);
|
|
use Device::SerialPort;
|
|
|
|
sub new {
|
|
my $class = shift;
|
|
my $self = bless { }, $class;
|
|
|
|
POE::Session->create(
|
|
object_states => [
|
|
$self => [ qw(_start _default register
|
|
serial_input serial_error
|
|
status_override) ],
|
|
],
|
|
);
|
|
|
|
return $self;
|
|
}
|
|
|
|
sub _start {
|
|
$_[KERNEL]->alias_set("$_[OBJECT]");
|
|
|
|
$_[HEAP]->{serial} = POE::Wheel::ReadWrite->new(
|
|
Handle => serial_open($devdoor),
|
|
Filter => POE::Filter::Line->new(
|
|
InputLiteral => "\x0A", # Received line endings.
|
|
OutputLiteral => "\x0A", # Sent line endings.
|
|
),
|
|
InputEvent => "serial_input",
|
|
ErrorEvent => "serial_error",
|
|
) or die "Door fail: $!";
|
|
}
|
|
|
|
sub _default {
|
|
my ($event, $args) = @_[ARG0 .. $#_];
|
|
my @output = ( (scalar localtime), "Door $event: " );
|
|
|
|
for my $arg (@$args) {
|
|
if ( ref $arg eq 'ARRAY' ) {
|
|
push( @output, '[' . join(', ', @$arg ) . ']' );
|
|
}
|
|
else {
|
|
push( @output, "'$arg'" );
|
|
}
|
|
}
|
|
print join ' ', @output, "\n";
|
|
}
|
|
|
|
sub register {
|
|
my ($self, $sender) = @_[OBJECT, SENDER];
|
|
my $sid = $sender->ID;
|
|
$poe_kernel->refcount_increment($sid, 'observer_door'); # XXX: No decrement
|
|
push (@{$self->{'observers'}}, $sid);
|
|
}
|
|
|
|
sub serial_open {
|
|
my ($device) = @_;
|
|
# Open a serial port, and tie it to a file handle for POE.
|
|
my $handle = gensym();
|
|
my $port = tie(*$handle, "Device::SerialPort", $device);
|
|
die "can't open port: $!" unless $port;
|
|
$port->datatype('raw');
|
|
$port->baudrate(9600);
|
|
$port->databits(8);
|
|
$port->parity("none");
|
|
$port->stopbits(1);
|
|
$port->handshake("none");
|
|
$port->write_settings();
|
|
return $handle;
|
|
}
|
|
|
|
sub serial_input {
|
|
my ($self, $input) = @_[OBJECT, ARG0];
|
|
print ((scalar localtime)." $input\n");
|
|
$input =~ /^(\d) (\d) (.*)$/ or return;
|
|
my ($cur_status, $cur_streaming, $brm) = ($1, $2, $3);
|
|
if ($cur_status != $status) {
|
|
foreach (@{$self->{observers}}) {
|
|
$poe_kernel->post($_, 'status_update', $cur_status);
|
|
}
|
|
}
|
|
if ($cur_streaming != $streaming) {
|
|
foreach (@{$self->{observers}}) {
|
|
$poe_kernel->post($_, 'streaming_update', $cur_streaming);
|
|
}
|
|
}
|
|
if ($brm =~ s/^CARD //) {
|
|
print "from door: $input\n";
|
|
if ($brm =~ /^UNKNOWN/) {
|
|
$poe_kernel->post( $irc, 'notify_door_unauth' );
|
|
} else {
|
|
$poe_kernel->post( $irc, 'notify_door_unlocked', $brm );
|
|
}
|
|
}
|
|
}
|
|
|
|
sub serial_error {
|
|
my ($heap) = ($_[HEAP]);
|
|
print "$_[ARG0] error $_[ARG1]: $_[ARG2]\n";
|
|
print "bye!\n";
|
|
}
|
|
|
|
sub status_override {
|
|
my ($heap, $status) = @_[HEAP, ARG0];
|
|
my $serial = $heap->{serial};
|
|
$serial->put('s'.$status);
|
|
$serial->flush();
|
|
}
|
|
|
|
|
|
|
|
## Web interface
|
|
|
|
package brmd::WWW;
|
|
|
|
use POE qw(Component::Server::HTTP);
|
|
use HTTP::Status qw/RC_OK/;
|
|
use CGI;
|
|
|
|
sub new {
|
|
my $class = shift;
|
|
my $self = bless { }, $class;
|
|
|
|
my $web = POE::Component::Server::HTTP->new(
|
|
Port => 8088,
|
|
ContentHandler => {
|
|
"/brmstatus.html" => \&web_brmstatus_html,
|
|
"/brmstatus.js" => \&web_brmstatus_js,
|
|
"/brmstatus.png" => \&web_brmstatus_png,
|
|
"/brmstatus.txt" => \&web_brmstatus_txt,
|
|
"/brmstatus-switch" => sub { $self->web_brmstatus_switch(@_) },
|
|
"/" => \&web_index
|
|
},
|
|
Headers => {Server => 'brmd/xxx'},
|
|
) or die "WWW fail: $!";
|
|
|
|
POE::Session->create(
|
|
object_states => [
|
|
$self => [ qw(_start _default register) ],
|
|
],
|
|
heap => { web => $web },
|
|
);
|
|
|
|
return $self;
|
|
}
|
|
|
|
sub _start {
|
|
$_[KERNEL]->alias_set("$_[OBJECT]");
|
|
}
|
|
|
|
sub _default {
|
|
my ($event, $args) = @_[ARG0 .. $#_];
|
|
my @output = ( (scalar localtime), "WWW $event: " );
|
|
|
|
for my $arg (@$args) {
|
|
if ( ref $arg eq 'ARRAY' ) {
|
|
push( @output, '[' . join(', ', @$arg ) . ']' );
|
|
}
|
|
else {
|
|
push( @output, "'$arg'" );
|
|
}
|
|
}
|
|
print join ' ', @output, "\n";
|
|
}
|
|
|
|
sub register {
|
|
my ($self, $sender) = @_[OBJECT, SENDER];
|
|
my $sid = $sender->ID;
|
|
$poe_kernel->refcount_increment($sid, 'observer_WWW'); # XXX: No decrement
|
|
push (@{$self->{'observers'}}, $sid);
|
|
}
|
|
|
|
sub disable_caching {
|
|
my ($response) = @_;
|
|
$response->push_header("Cache-Control", "no-cache, must-revalidate");
|
|
$response->push_header("Expires", "Sat, 26 Jul 1997 05:00:00 GMT");
|
|
}
|
|
|
|
sub web_index {
|
|
my ($request, $response) = @_;
|
|
|
|
my $sts = main::status_str();
|
|
my $str = main::streaming_str();
|
|
|
|
$response->protocol("HTTP/1.1");
|
|
$response->code(RC_OK);
|
|
$response->push_header("Content-Type", "text/html");
|
|
disable_caching($response);
|
|
|
|
my $r_link = '';
|
|
$streaming and $r_link .= '<a href="'.$streamurl.'">watch now!</a>';
|
|
|
|
$response->content(<<EOT
|
|
<html>
|
|
<head><title>brmd</title></head>
|
|
<body>
|
|
<img src="http://brmlab.cz/lib/tpl/brmlab/images/brmlab_logo.png" alt="brmlab" align="right" />
|
|
<h1>brmd web interface</h1>
|
|
<p>Enjoy the view!</p>
|
|
<ul>
|
|
<li><strong>brmstatus</strong> ($sts) <a href="brmstatus.html">status page</a> | <a href="brmstatus.js">javascript code</a> | <a href="brmstatus.txt">plaintext file</a> | <a href="brmstatus.png">picture</a></li>
|
|
<li><strong>brmvideo</strong> ($str) $r_link</li>
|
|
</ul>
|
|
<p align="right"><a href="http://github.com/brmlab/brmdoor">(view source)</a></p>
|
|
</body></html>
|
|
EOT
|
|
);
|
|
|
|
return RC_OK;
|
|
}
|
|
|
|
sub web_brmstatus_html {
|
|
my ($request, $response) = @_;
|
|
|
|
my $bg = $status ? 'lightgreen' : '#DEE7EC';
|
|
my $st = $status ? 'OPEN' : 'CLOSED';
|
|
|
|
$response->protocol("HTTP/1.1");
|
|
$response->code(RC_OK);
|
|
$response->push_header("Content-Type", "text/html");
|
|
disable_caching($response);
|
|
|
|
$response->content(<<EOT
|
|
<html>
|
|
<head><title>brmstatus</title></head>
|
|
<body bgcolor="$bg">
|
|
<h1 align="center">brmlab is $st</h1>
|
|
<table style="border: 1pt solid" align="center"><tr><td>
|
|
<h2 align="center">Manual Override</h2>
|
|
<p>
|
|
<form method="post" action="brmstatus-switch">
|
|
<strong>Perpetrator:</strong>
|
|
<input type="text" name="nick" />
|
|
<input type="submit" name="s" value="Switch status" />
|
|
</form>
|
|
</p>
|
|
</td></tr></table>
|
|
</body></html>
|
|
EOT
|
|
);
|
|
|
|
return RC_OK;
|
|
}
|
|
|
|
sub web_brmstatus_js {
|
|
my ($request, $response) = @_;
|
|
|
|
$response->protocol("HTTP/1.1");
|
|
$response->code(RC_OK);
|
|
$response->push_header("Content-Type", "text/javascript");
|
|
disable_caching($response);
|
|
|
|
$response->content(<<EOT
|
|
function brmstatus() { return ($status); }
|
|
EOT
|
|
);
|
|
|
|
return RC_OK;
|
|
}
|
|
|
|
sub web_brmstatus_txt {
|
|
my ($request, $response) = @_;
|
|
|
|
my $st = main::status_str();
|
|
|
|
$response->protocol("HTTP/1.1");
|
|
$response->code(RC_OK);
|
|
$response->push_header("Content-Type", "text/plain");
|
|
disable_caching($response);
|
|
|
|
$response->content($st);
|
|
|
|
return RC_OK;
|
|
}
|
|
|
|
sub web_brmstatus_png {
|
|
my ($request, $response) = @_;
|
|
|
|
open my $img, ($status ? "status-open.png" : "status-closed.png");
|
|
local $/;
|
|
my $imgdata = <$img>;
|
|
close $img;
|
|
|
|
$response->protocol("HTTP/1.1");
|
|
$response->code(RC_OK);
|
|
$response->push_header("Content-Type", "image/png");
|
|
disable_caching($response);
|
|
|
|
$response->content($imgdata);
|
|
|
|
return RC_OK;
|
|
}
|
|
|
|
sub web_brmstatus_switch {
|
|
my ($self, $request, $response) = @_;
|
|
|
|
my $q = new CGI($request->content);
|
|
my $nick = $q->param('nick');
|
|
|
|
my $newstatus = not $status;
|
|
foreach (@{$self->{observers}}) {
|
|
$poe_kernel->post($_, 'status_update', $newstatus, 'web', $nick);
|
|
}
|
|
|
|
$response->protocol("HTTP/1.1");
|
|
$response->code(302);
|
|
$response->header('Location' => 'brmstatus.html');
|
|
|
|
return RC_OK;
|
|
}
|
|
|
|
|
|
## IRC
|
|
|
|
package brmd::IRC;
|
|
|
|
use POE qw(Component::IRC Component::IRC::Plugin::Connector);
|
|
|
|
sub new {
|
|
my $class = shift;
|
|
my $self = bless { }, $class;
|
|
|
|
my $irc = POE::Component::IRC->spawn(
|
|
nick => 'brmbot',
|
|
ircname => 'The Brmitron',
|
|
server => 'irc.freenode.org',
|
|
) or die "IRC fail: $!";
|
|
my $connector = POE::Component::IRC::Plugin::Connector->new();
|
|
|
|
POE::Session->create(
|
|
object_states => [
|
|
$self => [ qw(_start _default
|
|
irc_001 irc_public irc_332 irc_topic
|
|
notify_update
|
|
notify_door_unauth notify_door_unlocked) ],
|
|
],
|
|
heap => { irc => $irc, connector => $connector },
|
|
);
|
|
|
|
return $self;
|
|
}
|
|
|
|
sub _start {
|
|
$_[KERNEL]->alias_set("$_[OBJECT]");
|
|
my $irc = $_[HEAP]->{irc};
|
|
$irc->yield( register => 'all' );
|
|
$irc->plugin_add( 'Connector' => $_[HEAP]->{connector} );
|
|
$irc->yield( connect => { } );
|
|
}
|
|
|
|
sub _default {
|
|
my ($event, $args) = @_[ARG0 .. $#_];
|
|
my @output = ( (scalar localtime), "IRC $event: " );
|
|
|
|
for my $arg (@$args) {
|
|
if ( ref $arg eq 'ARRAY' ) {
|
|
push( @output, '[' . join(', ', @$arg ) . ']' );
|
|
}
|
|
else {
|
|
push( @output, "'$arg'" );
|
|
}
|
|
}
|
|
print join ' ', @output, "\n";
|
|
}
|
|
|
|
sub irc_001 {
|
|
my $sender = $_[SENDER];
|
|
|
|
# Since this is an irc_* event, we can get the component's object by
|
|
# accessing the heap of the sender. Then we register and connect to the
|
|
# specified server.
|
|
my $irc = $sender->get_heap();
|
|
|
|
print "Connected to ", $irc->server_name(), "\n";
|
|
|
|
$irc->yield( join => $channel );
|
|
}
|
|
|
|
sub irc_public {
|
|
my ($sender, $who, $where, $what) = @_[SENDER, ARG0 .. ARG2];
|
|
my $irc = $sender->get_heap();
|
|
my $nick = ( split /!/, $who )[0];
|
|
my $channel = $where->[0];
|
|
|
|
if ( my ($rot13) = $what =~ /^rot13 (.+)/ ) {
|
|
$rot13 =~ tr[a-zA-Z][n-za-mN-ZA-M];
|
|
$irc->yield( privmsg => $channel => "$nick: $rot13" );
|
|
}
|
|
}
|
|
|
|
sub irc_332 {
|
|
my ($sender, $server, $str, $data) = @_[SENDER, ARG0 .. ARG2];
|
|
$topic = $data->[1];
|
|
print "new topic: $topic\n";
|
|
topic_update($_[HEAP]->{irc});
|
|
}
|
|
|
|
sub irc_topic {
|
|
my ($sender, $who, $where, $what) = @_[SENDER, ARG0 .. ARG2];
|
|
my $channel = $where;
|
|
$topic = $what;
|
|
print "new topic: $topic\n";
|
|
topic_update($_[HEAP]->{irc});
|
|
}
|
|
|
|
sub topic_update {
|
|
my ($irc) = @_;
|
|
my $newtopic = $topic;
|
|
if ($status) {
|
|
$newtopic =~ s/BRMLAB CLOSED/BRMLAB OPEN/g;
|
|
} else {
|
|
$newtopic =~ s/BRMLAB OPEN/BRMLAB CLOSED/g;
|
|
}
|
|
if ($streaming) {
|
|
$newtopic =~ s#OFF AIR#ON AIR ($streamurl)#g;
|
|
} else {
|
|
$newtopic =~ s#ON AIR.*? \|#OFF AIR |#g;
|
|
}
|
|
if ($newtopic ne $topic) {
|
|
$topic = $newtopic;
|
|
$irc->yield (topic => $channel => $topic );
|
|
}
|
|
}
|
|
|
|
sub notify_update {
|
|
my ($sender, $comp, $status, $extra, $manual, $nick) = @_[SENDER, ARG0 .. ARG4];
|
|
my $irc = $_[HEAP]->{irc};
|
|
my $msg = "[$comp] update: \002$status\002";
|
|
$extra and $msg .= " $extra";
|
|
$manual and $msg .= " ($manual manual override by $nick)";
|
|
$irc->yield (privmsg => $channel => $msg );
|
|
topic_update($irc);
|
|
}
|
|
|
|
sub notify_door_unauth {
|
|
my ($sender) = $_[SENDER];
|
|
my $irc = $_[HEAP]->{irc};
|
|
my $msg = "[door] unauthorized access denied!";
|
|
$irc->yield (privmsg => $channel => $msg );
|
|
}
|
|
|
|
sub notify_door_unlocked {
|
|
my ($sender, $nick) = @_[SENDER, ARG0];
|
|
my $irc = $_[HEAP]->{irc};
|
|
my $msg = "[door] unlocked by: \002$nick";
|
|
$irc->yield (privmsg => $channel => $msg );
|
|
}
|
|
|
|
1;
|
|
|
|
|
|
## Live Stream
|
|
|
|
package brmd::Stream;
|
|
|
|
use POE;
|
|
|
|
sub new {
|
|
my $class = shift;
|
|
my $self = bless { }, $class;
|
|
|
|
POE::Session->create(
|
|
object_states => [
|
|
$self => [ qw(_start _default
|
|
stream_start stream_stop) ],
|
|
],
|
|
);
|
|
|
|
return $self;
|
|
}
|
|
|
|
sub _start {
|
|
$_[KERNEL]->alias_set("$_[OBJECT]");
|
|
}
|
|
|
|
sub _default {
|
|
my ($event, $args) = @_[ARG0 .. $#_];
|
|
my @output = ( (scalar localtime), "Stream $event: " );
|
|
|
|
for my $arg (@$args) {
|
|
if ( ref $arg eq 'ARRAY' ) {
|
|
push( @output, '[' . join(', ', @$arg ) . ']' );
|
|
}
|
|
else {
|
|
push( @output, "'$arg'" );
|
|
}
|
|
}
|
|
print join ' ', @output, "\n";
|
|
}
|
|
|
|
sub stream_switch {
|
|
my ($s) = @_;
|
|
system('ssh brmstream@brmvid "echo '.($s?'START':'STOP').' >/tmp/brmstream"');
|
|
}
|
|
|
|
sub stream_start {
|
|
stream_switch(1);
|
|
}
|
|
|
|
sub stream_stop {
|
|
stream_switch(0);
|
|
}
|
|
|
|
1;
|
|
|
|
|
|
## Alphasign LED Display
|
|
|
|
package brmd::Alphasign;
|
|
|
|
use POE qw(Wheel::ReadWrite Filter::Block);
|
|
use Symbol qw(gensym);
|
|
use Device::SerialPort;
|
|
|
|
sub new {
|
|
my $class = shift;
|
|
my $self = bless { }, $class;
|
|
|
|
POE::Session->create(
|
|
object_states => [
|
|
$self => [ qw(_start _default
|
|
serial_error text
|
|
stream_start stream_stop) ],
|
|
],
|
|
);
|
|
|
|
return $self;
|
|
}
|
|
|
|
sub _start {
|
|
$_[KERNEL]->alias_set("$_[OBJECT]");
|
|
|
|
$_[HEAP]->{serial} = POE::Wheel::ReadWrite->new(
|
|
Handle => serial_open($devasign),
|
|
Filter => POE::Filter::Block->new(
|
|
LengthCodec => [ \&as_encoder, \&as_decoder ],
|
|
),
|
|
ErrorEvent => "serial_error",
|
|
) or die "Alphasign fail: $!";
|
|
}
|
|
|
|
sub _default {
|
|
my ($event, $args) = @_[ARG0 .. $#_];
|
|
my @output = ( (scalar localtime), "Alphasign $event: " );
|
|
|
|
for my $arg (@$args) {
|
|
if ( ref $arg eq 'ARRAY' ) {
|
|
push( @output, '[' . join(', ', @$arg ) . ']' );
|
|
}
|
|
else {
|
|
push( @output, "'$arg'" );
|
|
}
|
|
}
|
|
print join ' ', @output, "\n";
|
|
}
|
|
|
|
sub serial_open {
|
|
my ($device) = @_;
|
|
# Open a serial port, and tie it to a file handle for POE.
|
|
my $handle = gensym();
|
|
my $port = tie(*$handle, "Device::SerialPort", $device);
|
|
die "can't open port: $!" unless $port;
|
|
$port->datatype('raw');
|
|
$port->baudrate(9600);
|
|
$port->databits(8);
|
|
$port->parity("none");
|
|
$port->stopbits(1);
|
|
$port->handshake("none");
|
|
$port->write_settings();
|
|
$port->write("E\$" . "AAU0100FF00" . "CDU075A2000" . "BBL000F0000");
|
|
return $handle;
|
|
}
|
|
|
|
sub serial_error {
|
|
my ($heap) = ($_[HEAP]);
|
|
print "$_[ARG0] error $_[ARG1]: $_[ARG2]\n";
|
|
print "bye!\n";
|
|
}
|
|
|
|
sub as_encoder {
|
|
my $stuff = shift;
|
|
$$stuff = "\x00" x 5 # packet sync characters
|
|
. "\x01" # start of header
|
|
. "Z" # all types
|
|
. "00" # broadcast address
|
|
. "\x02" # start of text
|
|
. $$stuff # raw data
|
|
. "\x04"; # end of transmission
|
|
return;
|
|
}
|
|
|
|
sub as_decoder {
|
|
return 1; # XXX
|
|
}
|
|
|
|
# TODO: have text() a simple markup parser, and raw_text() for writing it out
|
|
|
|
sub text {
|
|
my ($heap, $mode, $string) = (@_[HEAP, ARG0, ARG1]);
|
|
print "out text: $mode, $string\n";
|
|
my $s = "A" # text mode
|
|
. "A" # file label
|
|
. "\x1B" # start of text
|
|
. " " # use middle line (irrelevant on singleline display)
|
|
. $mode # display mode
|
|
. "\x1C1" # set default color = red
|
|
. $string; # text to display
|
|
$_[HEAP]{serial}->put($s);
|
|
}
|
|
|
|
#sub stream_switch {
|
|
# my ($s) = @_;
|
|
# system('~/alphasign/'.($s?'on':'off').'_air.py');
|
|
#}
|
|
|
|
sub stream_start {
|
|
$_[KERNEL]->yield('text', 'b', "\x1D01ON AIR\x1D00");
|
|
}
|
|
|
|
sub stream_stop {
|
|
$_[KERNEL]->yield('text', 'b', "\x1D00OFF AIR\x1D00");
|
|
}
|
|
|
|
1;
|