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()); }