X-Git-Url: https://www.fi.muni.cz/~kas/git//home/kas/public_html/git/?a=blobdiff_plain;ds=sidebyside;f=SCX%2FReader.pm;h=5422a4b4c43ea5f201ed65e1a1a1473ddb2499e7;hb=e5ecd9d0a9df93798930c678f4f4aa58e0e6a10a;hp=5a98a6d281ca7c22e97c444cddab0885003b1caf;hpb=68ff3ebd0073097de84fc55b22047cb5b9d98db7;p=slotcarman.git

diff --git a/SCX/Reader.pm b/SCX/Reader.pm
index 5a98a6d..5422a4b 100644
--- a/SCX/Reader.pm
+++ b/SCX/Reader.pm
@@ -2,19 +2,20 @@
 
 package SCX::Reader;
 
+use strict;
+
 use Time::HiRes qw(gettimeofday tv_interval);
 use FileHandle;
+use IO::Handle;
+use POSIX;
 use SCX::CRC;
 
-our $PACKET_SIZE = 10;
-our $LOG_ROTATE  = 600;
+our $PACKET_SIZE = 9; # 9 bytes + 0x05
+our $LOG_FILE_LIMIT = 10_000_000; # bytes
 
 sub new {
 	my ($class, $args) = @_;
 
-	my $callback = $args->{callback}
-		or die "callback arg not defined";
-
 	my $portname = $args->{portname}
 		or die "portname not specified";
 	
@@ -23,7 +24,7 @@ sub new {
 		die "stty died with code $? (no permissions?)";
 	}
 
-	open my $tty, '<:raw', $portname
+	sysopen(my $fh, $portname, O_RDONLY|O_NONBLOCK)
 		or die "Can't open $portname: $!";
 
 	my $logfile = $args->{logfile};
@@ -32,17 +33,13 @@ sub new {
 	open my $logfh, '>', "$logfile.$log_gen"
 	or die "Can't open $logfile.$log_gen: $!";
 
-	my $now = gettimeofday;
-
 	my $self = {
 		portname  => $portname,
-		fh        => $tty,
+		fh        => $fh,
 		logfile   => $logfile,
 		logfh     => $logfh,
 		log_gen   => $log_gen,
-		log_start => $now,
-		starttime => $now,
-		callback  => $callback,
+		track     => $args->{track},
 		bytes     => [],
 	};
 
@@ -53,6 +50,8 @@ sub new {
 
 sub fh { return shift->{fh}; }
 
+sub track { return shift->{track}; }
+
 sub read {
 	my ($self) = @_;
 
@@ -61,64 +60,390 @@ sub read {
 	die "Read error on $self->{portname}: $!"
 		if !$bytes_read;
 
-	my $now = gettimeofday;
-	if ($now - $self->{log_start} >= $LOG_ROTATE) {
-		close $self->{logfh};
-		$self->{log_gen} = $self->{log_gen} ? 0 : 1;
-		open my $fh, '>', $logfile . '.' . $self->{log_gen}
-			or die "Can't open $logfile.$self->{log_gen}: $!";
-		$self->{logfh} = $fh;
-		$self->{log_start} = $now;
-	}
+	$self->{last_read_time} = gettimeofday;
 
 	my @bytes = unpack("C*", $data);
 
-	$self->{logfh}->print(sprintf('% 10.3f', $now - $self->{starttime}),
-		(map { sprintf(" %02x", $_) } @bytes),
-		"\n");
-
+	# print join(' ', map { sprintf(" %02x", $_) } @bytes), "\n";
 	push @{ $self->{bytes} }, @bytes;
 	@bytes = @{ $self->{bytes} };
 
 	my @bad_bytes;
 
-	while (@bytes >= 2) {
+	while (@bytes > $PACKET_SIZE) {
 		if ($bytes[0] != 0x55) {
 			push @bad_bytes, shift @bytes;
 			next;
 		}
 		my $cmd = $bytes[1];
 
-		my $packet_size = $cmd >= 0x40 && $cmd <= 0x46 ? 4 : 9;
-		last if @bytes <= $packet_size;
-
-		if ($bytes[$packet_size] != 0x05
-			|| SCX::CRC::digest(@bytes[0..$packet_size-2])
-				!= $bytes[$packet_size-1]) {
+		if ($bytes[$PACKET_SIZE] != 0x05
+			|| SCX::CRC::digest(@bytes[0..$PACKET_SIZE-2])
+				!= $bytes[$PACKET_SIZE-1]) {
 			push @bad_bytes, shift @bytes;
 			next;
 		}
 		
-		if (@bad_bytes) {
-			$self->{logfh}->print("Cannot parse bytes",
-				(map { sprintf(' %02x', $_) } @bad_bytes),
-				"\n");
+		if (@bad_bytes) { # Report previous bad bytes first
+			$self->log_bytes(\@bad_bytes, "Cannot parse packet");
 			@bad_bytes = ();
 		}
 
-		$self->{logfh}->print("Callback\n");
-		&{ $self->{callback} }(@bytes[1..$packet_size]);
-		splice @bytes, 0, $packet_size+1;
+		my @packet = splice @bytes, 0, $PACKET_SIZE+1;
+		my $rv = $self->handle_packet(@packet);
+		$self->log_bytes(\@packet, $rv);
+		$self->track->packet_received($self->{last_read_time});
 	}
+
 	if (@bad_bytes) {
-		$self->{logfh}->print("Cannot parse bytes",
-			(map { sprintf(' %02x', $_) } @bad_bytes),
-			"\n");
-		@bad_bytes = ();
+		while (@bytes && $bytes[0] != 0x55) {
+			push @bad_bytes, shift @bytes;
+		}
+		$self->log_bytes(\@bad_bytes, "cannot parse packet");
 	}
 
 	@{ $self->{bytes} } = @bytes;
 }
 
+sub log_print {
+	my ($self, @data) = @_;
+
+	my $size = $self->{logfh}->tell;
+
+	if ($size >= $LOG_FILE_LIMIT) {
+		close $self->{logfh};
+		$self->{log_gen} = $self->{log_gen} ? 0 : 1;
+		open my $fh, '>', $self->{logfile} . '.' . $self->{log_gen}
+			or die "Can't open $self->{logfile}.$self->{log_gen}: $!";
+		$self->{logfh} = $fh;
+	}
+
+	$self->{logfh}->print(sprintf('% 10.3f ', $self->{last_read_time}),
+		join(' ', @data, "\n"));
+	$self->{logfh}->flush;
+}
+
+sub log_bytes {
+	my ($self, $bytes, $msg) = @_;
+
+	return if !@$bytes;
+
+	$msg = defined $msg ? '# ' . $msg : '';
+
+	$self->log_print((map { sprintf("%02x", $_) } @$bytes), $msg);
+}
+
+sub log_cmd {
+	my ($self, @args) = @_;
+
+	$self->log_print('cmd', @args);
+}
+
+our %COMMANDS = (
+	0xAA => \&bus_free_time_packet,
+	0xCC => \&car_programming_packet,
+	0xD0 => \&reset_packet,
+	0xD3 => \&standings_packet,
+	0xD4 => \&lap_time_packet,
+	0xD5 => \&race_setup_packet,
+	0xD6 => \&fuel_level_packet,
+	0xD7 => \&brake_set_packet,
+	0xDB => \&qualification_packet,
+	0xDC => \&end_of_race_packet,
+	0xDD => \&race_start_packet,
+	0xDE => \&display_change_packet,
+	0xEE => \&finish_line_packet,
+	0xFF => \&controller_status_packet,
+);
+
+sub handle_packet {
+	my ($self, @data) = @_;
+
+	my $cmd = $data[1];
+	my @args = @data[2..7];
+
+	my $sub = $COMMANDS{$cmd};
+	return "Unknown packet"
+		if !defined $sub;
+
+	return &$sub($self, @args);
+}
+
+sub bus_free_time_packet {
+	my ($self, @bytes) = @_;
+
+	my $msg = 'Strange bus free time packet'
+		if $bytes[2] != 0xF0
+		|| $bytes[3] != 0xF0
+		|| $bytes[4] != 0xF0
+		|| $bytes[5] != 0xF0;
+
+	return $msg; # No need to handle this, I think
+}
+
+sub car_programming_packet {
+	my ($self, @bytes) = @_;
+
+	my $msg = 'Strange car programming packet'
+		if ($bytes[0] & 0xF8) != 0 || ($bytes[0] & 0x07) > 5
+		|| $bytes[1] != 0xFE
+		|| $bytes[2] != 0xFF
+		|| $bytes[3] != 0xFF
+		|| $bytes[4] != 0xFF
+		|| $bytes[5] != 0xFF;
+
+	return $msg; # No need to handle this
+}
+
+sub reset_packet {
+	my ($self, @bytes) = @_;
+
+	my $msg = 'Strange reset packet'
+		if $bytes[0] != 0xFF
+		|| $bytes[3] != 0xAA
+		|| $bytes[4] != 0xAA
+		|| $bytes[5] != 0xAA;
+
+	$self->log_cmd('reset');
+	$self->track->reset;
+
+	return $msg;
+}
+
+sub standings_packet {
+	my ($self, @bytes) = @_;
+
+	my $msg = 'Strange standings packet'
+		if ($bytes[0] != 0xFF && ($bytes[0] & 0x07) > 5)
+		|| ($bytes[1] != 0xFF && ($bytes[1] & 0x07) > 5)
+		|| ($bytes[2] != 0xFF && ($bytes[2] & 0x07) > 5)
+		|| ($bytes[3] != 0xFF && ($bytes[3] & 0x07) > 5)
+		|| ($bytes[4] != 0xFF && ($bytes[4] & 0x07) > 5)
+		|| ($bytes[5] != 0xFF && ($bytes[5] & 0x07) > 5);
+
+	my @standings;
+
+	push @standings, map { $_ != 0xFF ? $_ & (0x07) : () } @bytes;
+
+	return $msg; # We do internal standings handling
+}
+
+sub lap_time_packet {
+	my ($self, @bytes) = @_;
+
+	my $msg = 'Strange lap time packet'
+		if $bytes[0] > 5
+		|| $bytes[1] & 0x01
+		|| $bytes[2] & 0x01
+		|| ($bytes[3] & 0xF0) != 0
+		|| $bytes[4] & 0x01
+		|| $bytes[5] & 0x01;
+
+	return $msg;
+}
+
+sub race_setup_packet {
+	my ($self, @bytes) = @_;
+
+	my $msg = 'Strange race setup packet'
+		if ($bytes[0] != 0x00 && $bytes[0] != 0xFF)
+		|| $bytes[1] & 0xF0
+		|| $bytes[2] & 0xF0
+		|| $bytes[3] & 0xF0
+		|| $bytes[4] != 0xFF
+		|| $bytes[5] != 0xFF;
+
+	my $rounds = $bytes[0] == 0x00
+		? 0
+		: ($bytes[1] & 0x0F) * 256
+			+ ($bytes[2] & 0x0F) * 16
+			+ ($bytes[3] & 0x0F);
+
+	$self->log_cmd('race_setup', $rounds);
+	$self->track->race_setup($rounds);
+
+	return $msg;
+}
+
+sub fuel_level_packet {
+	my ($self, @bytes) = @_;
+
+	my $msg = 'Strange fuel_level packet'
+		if ($bytes[0] >> 4) > 8
+		|| ($bytes[0] & 0x0F) > 8
+		|| ($bytes[1] >> 4) > 8
+		|| ($bytes[1] & 0x0F) > 8
+		|| ($bytes[2] >> 4) > 8
+		|| ($bytes[2] & 0x0F) > 8
+		|| ($bytes[5] != 0xAA && $bytes[5] != 0xFF);
+
+	my @fuel = (
+		$bytes[0] >> 4, $bytes[0] & 0x0f,
+		$bytes[1] >> 4, $bytes[1] & 0x0f,
+		$bytes[2] >> 4, $bytes[2] & 0x0f,
+	);
+
+	$self->log_cmd('fuel', @fuel);
+	for my $car (0..5) {
+		$self->track->car($car)->set_fuel($fuel[$car]);
+	}
+
+	return $msg;
+}
+
+
+sub brake_set_packet {
+	my ($self, @bytes) = @_;
+
+	return 'Unexpected brake_set packet (should be in the pit lane only)';
+}
+
+
+sub qualification_packet {
+	my ($self, @bytes) = @_;
+
+	my $msg = 'Strange qualification packet'
+		if $bytes[0] & 0xF0
+		|| $bytes[1] & 0xF0
+		|| $bytes[2] & 0xF0
+		|| $bytes[3] > 5
+		|| $bytes[4] != 0xFF
+		|| $bytes[5] != 0xFF;
+
+	$self->log_cmd('qualification_start');
+	$self->track->qualification_start;
+
+	return $msg;
+}
+
+
+sub end_of_race_packet {
+	my ($self, @bytes) = @_;
+
+	my $msg = 'Strange end_of_race packet'
+		if $bytes[0] != 0xFF
+		|| $bytes[1] != 0xFF
+		|| $bytes[2] != 0xFF
+		|| $bytes[3] != 0xFF
+		|| $bytes[4] != 0xFF
+		|| $bytes[5] != 0xFF;
+
+	$self->log_cmd('race_end');
+	$self->track->race_end;
+
+	return $msg;
+}
+
+
+sub race_start_packet {
+	my ($self, @bytes) = @_;
+
+	my $msg = 'Strange race_start packet'
+		if $bytes[0] != 0x00
+		|| $bytes[1] != 0xAA
+		|| $bytes[2] != 0xAA
+		|| $bytes[3] != 0xAA
+		|| $bytes[4] != 0xAA
+		|| $bytes[5] != 0xAA;
+
+	$self->log_cmd('race_start');
+	$self->track->race_start;
+
+	return $msg;
+}
+
+
+sub display_change_packet {
+	my ($self, @bytes) = @_;
+
+	my $msg = 'Strange display_change packet'
+		if $bytes[0] & 0xFE
+		|| $bytes[1] != 0xFF
+		|| $bytes[2] != 0xFF
+		|| $bytes[3] != 0xFF
+		|| $bytes[4] != 0xFF
+		|| $bytes[5] != 0xFF;
+
+	return $msg; # FIXME - to be implemented
+}
+
+
+sub finish_line_packet {
+	my ($self, @bytes) = @_;
+
+	my $fail;
+	for my $byte (@bytes) {
+		$fail = 1
+			if $byte != 0xAA
+			&& $byte != 0xE7
+			&& $byte != 0xF0
+			&& $byte != 0xFE
+	}
+
+	my $msg = 'Strange finish_line packet'
+		if $fail;
+
+	my $regular = 1;
+	my @cars_finished;
+	for my $i (0..5) {
+		my $byte = $bytes[$i];
+
+		$regular = 0
+			if $byte != 0xAA && $byte != 0xE7 && $byte != 0xFE;
+
+		push @cars_finished, $i if $byte == 0xE7;
+	}
+
+	$self->log_cmd('finish_line', $regular, @cars_finished);
+	$self->track->finish_line(
+		$self->{last_read_time},
+		$regular,
+		@cars_finished
+	);
+
+	return $msg;
+}
+
+sub controller_status_packet {
+	my ($self, @bytes) = @_;
+
+	my $fail;
+	for my $byte (@bytes) {
+		next if $byte == 0xAA;
+		$fail = 1
+			if ($byte & 0xC0) != 0xC0
+			|| ($byte & 0x0F) > 12
+	}
+
+	my $msg = 'Strange controller_status packet'
+		if $fail;
+
+	my @log_data;
+
+	for my $car (0..5) {
+		my $byte = $bytes[$car];
+
+		if ($byte == 0xAA) {
+			$self->track->car($car)->set_throttle(undef, undef,
+				$self->{last_read_time});
+			push @log_data, 'undef', '0';
+			next;
+		}
+
+		my $light = !($byte & 0x20);
+		my $backbutton = !($byte & 0x10);
+		my $throttle = $byte & 0x0f;
+
+		push @log_data, $throttle, $backbutton ? 1 : 0;
+		$self->track->car($car)->set_throttle($throttle, $backbutton,
+			$self->{last_read_time});
+		$self->track->car($car)->set_light($light);
+	}
+
+	$self->log_cmd('throttle', @log_data);
+
+	return $msg;
+}
+
 1;