package trains;
use strict;
use Win32::SerialPort qw(:STAT 0.19);
1;
sub new {
my $class = shift;
my $port = new Win32::SerialPort('COM1', 1) or die "Can't open port: $^E\n";
$port->handshake('none');
$port->baudrate(2400);
$port->databits(8);
$port->stopbits(2);
$port->parity('none');
$port->write_settings() or die "Can't establish connection: $^E\n";
my $self = {
port => $port,
};
bless $self, $class;
return $self;
}
sub DESTROY {
my $self = shift;
$self->{port}->close();
}
sub transmit {
my $self = shift;
local $| = undef;
print 'transmitting: ';
foreach (@_) {
printf('%08b (0x%02x, %03d) ', $_, $_, $_);
$self->{port}->transmit_char($_);
}
select(undef, undef, undef, 0.15);
print "\n";
}
sub receive {
my $self = shift;
print 'receiving : ';
my $data = $self->{port}->input;
foreach (split(//, $data)) {
printf('%08b (0x%02x, %03d) ', ord($_), ord($_), ord($_));
}
print "\n";
return $data;
}
# COMMON FOR ANY OS
# Everything from this point on could be split into a common superclass
sub boolsplit {
my $self = shift;
my @output;
foreach my $byte (split(//, $_[0])) {
foreach my $bit (0..7) {
push(@output, (ord($byte) & (1 << $bit)) > 0);
}
}
return @output;
}
sub stop {
my $self = shift;
$self->transmit(97);
}
sub start {
my $self = shift;
$self->transmit(96);
}
sub engine { # engine id, speed 0..14, function-p
my $self = shift;
warn "engine id ($_[0]) out of range\n" if $_[0] < 1 or $_[0] > 80;
warn "speed ($_[1]) out of range\n" if $_[1] < 0 or $_[1] > 14;
$self->transmit($_[1] + ($_[2] ? 16 : 0), $_[0]);
}
sub invert { # engine id, function-p
my $self = shift;
warn "engine id ($_[0]) out of range" if $_[0] < 1 or $_[0] > 80;
# for some reason, you need to send an engine stop command first
$self->engine($_[0], 0, $_[1]);
$self->transmit(15 + ($_[1] ? 16 : 0), $_[0]);
$self->engine($_[0], 0, $_[1]);
}
sub functions { # engine id, f1, f2, f3, f4
my $self = shift;
warn "engine id ($_[0]) out of range\n" if $_[0] < 1 or $_[0] > 80;
$self->transmit(64 + ($_[1] ? 1 : 0) + ($_[2] ? 2 : 0) + ($_[3] ? 4 : 0) + ($_[4] ? 8 : 0), $_[0]);
}
sub switch { # switch id, direction (1 is branch/outer/red, 0 is straight/inner/green)
my $self = shift;
warn "switch id ($_[0]) out of range\n" if $_[0] < 1 or $_[0] > 256;
$self->transmit($_[1] ? 34 : 33, $_[0] == 256 ? 0 : $_[0]);
$self->transmit(32);
}
sub sense { # sensor id
my $self = shift;
warn "sensor id ($_[0]) out of range\n" if $_[0] < 1 or $_[0] > 31;
$self->transmit(192 + $_[0]);
return $self->boolsplit($self->receive());
}
sub senses { # number of sensors to read
my $self = shift;
warn "sensor count ($_[0]) out of range\n" if $_[0] < 1 or $_[0] > 31;
$self->transmit(128 + $_[0]);
return $self->boolsplit($self->receive());
}