7 use Time::HiRes qw(gettimeofday tv_interval);
13 our $PACKET_SIZE = 9; # 9 bytes + 0x05
14 our $LOG_FILE_LIMIT = 10_000_000; # bytes
17 my ($class, $args) = @_;
19 my $portname = $args->{portname}
20 or die "portname not specified";
22 system 'stty', '-F', $portname, '115200', 'raw';
24 die "stty died with code $? (no permissions?)";
27 sysopen(my $fh, $portname, O_RDONLY|O_NONBLOCK)
28 or die "Can't open $portname: $!";
30 my $logfile = $args->{logfile};
33 open my $logfh, '>', "$logfile.$log_gen"
34 or die "Can't open $logfile.$log_gen: $!";
37 portname => $portname,
42 track => $args->{track},
51 sub fh { return shift->{fh}; }
53 sub track { return shift->{track}; }
59 my $bytes_read = sysread $self->fh, $data, $PACKET_SIZE;
60 die "Read error on $self->{portname}: $!"
63 $self->{last_read_time} = gettimeofday;
65 my @bytes = unpack("C*", $data);
67 # print join(' ', map { sprintf(" %02x", $_) } @bytes), "\n";
68 push @{ $self->{bytes} }, @bytes;
69 @bytes = @{ $self->{bytes} };
73 while (@bytes > $PACKET_SIZE) {
74 if ($bytes[0] != 0x55) {
75 push @bad_bytes, shift @bytes;
80 if ($bytes[$PACKET_SIZE] != 0x05
81 || SCX::CRC::digest(@bytes[0..$PACKET_SIZE-2])
82 != $bytes[$PACKET_SIZE-1]) {
83 push @bad_bytes, shift @bytes;
87 if (@bad_bytes) { # Report previous bad bytes first
88 $self->log_bytes(\@bad_bytes, "Cannot parse packet");
92 my @packet = splice @bytes, 0, $PACKET_SIZE+1;
93 my $rv = $self->handle_packet(@packet);
94 $self->log_bytes(\@packet, $rv);
95 $self->track->packet_received($self->{last_read_time});
99 while (@bytes && $bytes[0] != 0x55) {
100 push @bad_bytes, shift @bytes;
102 $self->log_bytes(\@bad_bytes, "cannot parse packet");
105 @{ $self->{bytes} } = @bytes;
109 my ($self, @data) = @_;
111 my $size = $self->{logfh}->tell;
113 if ($size >= $LOG_FILE_LIMIT) {
114 close $self->{logfh};
115 $self->{log_gen} = $self->{log_gen} ? 0 : 1;
116 open my $fh, '>', $self->{logfile} . '.' . $self->{log_gen}
117 or die "Can't open $self->{logfile}.$self->{log_gen}: $!";
118 $self->{logfh} = $fh;
121 $self->{logfh}->print(sprintf('% 10.3f ', $self->{last_read_time}),
122 join(' ', @data, "\n"));
123 $self->{logfh}->flush;
127 my ($self, $bytes, $msg) = @_;
131 $msg = defined $msg ? '# ' . $msg : '';
133 $self->log_print((map { sprintf("%02x", $_) } @$bytes), $msg);
137 my ($self, @args) = @_;
139 $self->log_print('cmd', @args);
143 0xAA => \&bus_free_time_packet,
144 0xCC => \&car_programming_packet,
145 0xD0 => \&reset_packet,
146 0xD3 => \&standings_packet,
147 0xD4 => \&lap_time_packet,
148 0xD5 => \&race_setup_packet,
149 0xD6 => \&fuel_level_packet,
150 0xD7 => \&brake_set_packet,
151 0xDB => \&qualification_packet,
152 0xDC => \&end_of_race_packet,
153 0xDD => \&race_start_packet,
154 0xDE => \&display_change_packet,
155 0xEE => \&finish_line_packet,
156 0xFF => \&controller_status_packet,
160 my ($self, @data) = @_;
163 my @args = @data[2..7];
165 my $sub = $COMMANDS{$cmd};
166 return "Unknown packet"
169 return &$sub($self, @args);
172 sub bus_free_time_packet {
173 my ($self, @bytes) = @_;
175 my $msg = 'Strange bus free time packet'
179 || $bytes[5] != 0xF0;
181 return $msg; # No need to handle this, I think
184 sub car_programming_packet {
185 my ($self, @bytes) = @_;
187 my $msg = 'Strange car programming packet'
188 if ($bytes[0] & 0xF8) != 0 || ($bytes[0] & 0x07) > 5
193 || $bytes[5] != 0xFF;
195 return $msg; # No need to handle this
199 my ($self, @bytes) = @_;
201 my $msg = 'Strange reset packet'
205 || $bytes[5] != 0xAA;
207 $self->log_cmd('reset');
213 sub standings_packet {
214 my ($self, @bytes) = @_;
216 my $msg = 'Strange standings packet'
217 if ($bytes[0] != 0xFF && ($bytes[0] & 0x07) > 5)
218 || ($bytes[1] != 0xFF && ($bytes[1] & 0x07) > 5)
219 || ($bytes[2] != 0xFF && ($bytes[2] & 0x07) > 5)
220 || ($bytes[3] != 0xFF && ($bytes[3] & 0x07) > 5)
221 || ($bytes[4] != 0xFF && ($bytes[4] & 0x07) > 5)
222 || ($bytes[5] != 0xFF && ($bytes[5] & 0x07) > 5);
226 push @standings, map { $_ != 0xFF ? $_ & (0x07) : () } @bytes;
228 return $msg; # We do internal standings handling
231 sub lap_time_packet {
232 my ($self, @bytes) = @_;
234 my $msg = 'Strange lap time packet'
238 || ($bytes[3] & 0xF0) != 0
245 sub race_setup_packet {
246 my ($self, @bytes) = @_;
248 my $msg = 'Strange race setup packet'
249 if ($bytes[0] != 0x00 && $bytes[0] != 0xFF)
254 || $bytes[5] != 0xFF;
256 my $rounds = $bytes[0] == 0x00
258 : ($bytes[1] & 0x0F) * 256
259 + ($bytes[2] & 0x0F) * 16
260 + ($bytes[3] & 0x0F);
262 $self->log_cmd('race_setup', $rounds);
263 $self->track->race_setup($rounds, $self->{last_read_time});
268 sub fuel_level_packet {
269 my ($self, @bytes) = @_;
271 my $msg = 'Strange fuel_level packet'
272 if ($bytes[0] >> 4) > 8
273 || ($bytes[0] & 0x0F) > 8
274 || ($bytes[1] >> 4) > 8
275 || ($bytes[1] & 0x0F) > 8
276 || ($bytes[2] >> 4) > 8
277 || ($bytes[2] & 0x0F) > 8
278 || ($bytes[5] != 0xAA && $bytes[5] != 0xFF);
281 $bytes[0] >> 4, $bytes[0] & 0x0f,
282 $bytes[1] >> 4, $bytes[1] & 0x0f,
283 $bytes[2] >> 4, $bytes[2] & 0x0f,
286 $self->log_cmd('fuel', @fuel);
288 $self->track->car($car)->set_fuel($fuel[$car]);
295 sub brake_set_packet {
296 my ($self, @bytes) = @_;
298 return 'Unexpected brake_set packet (should be in the pit lane only)';
302 sub qualification_packet {
303 my ($self, @bytes) = @_;
305 my $msg = 'Strange qualification packet'
311 || $bytes[5] != 0xFF;
313 my $rounds = ($bytes[0] & 0x0F) * 256
314 + ($bytes[1] & 0x0F) * 16
315 + ($bytes[2] & 0x0F);
316 my $cars = $bytes[3];
317 $self->log_cmd('qualification_start', $rounds, $cars);
318 $self->track->qualification_setup($rounds, $cars,
319 $self->{last_read_time});
325 sub end_of_race_packet {
326 my ($self, @bytes) = @_;
328 my $msg = 'Strange end_of_race packet'
334 || $bytes[5] != 0xFF;
336 $self->log_cmd('race_end');
337 $self->track->race_end;
343 sub race_start_packet {
344 my ($self, @bytes) = @_;
346 my $msg = 'Strange race_start packet'
352 || $bytes[5] != 0xAA;
354 $self->log_cmd('race_start');
355 $self->track->race_start($self->{last_read_time});
361 sub display_change_packet {
362 my ($self, @bytes) = @_;
364 my $msg = 'Strange display_change packet'
370 || $bytes[5] != 0xFF;
372 return $msg; # FIXME - to be implemented
376 sub finish_line_packet {
377 my ($self, @bytes) = @_;
380 for my $byte (@bytes) {
388 my $msg = 'Strange finish_line packet'
394 my $byte = $bytes[$i];
397 if $byte != 0xAA && $byte != 0xE7 && $byte != 0xFE;
399 push @cars_finished, $i if $byte == 0xE7;
402 $self->log_cmd('finish_line', $regular, @cars_finished);
403 $self->track->finish_line(
404 $self->{last_read_time},
412 sub controller_status_packet {
413 my ($self, @bytes) = @_;
416 for my $byte (@bytes) {
417 next if $byte == 0xAA;
419 if ($byte & 0xC0) != 0xC0
420 || ($byte & 0x0F) > 12
423 my $msg = 'Strange controller_status packet'
429 my $byte = $bytes[$car];
432 $self->track->car($car)->set_throttle(undef, undef,
433 $self->{last_read_time});
434 push @log_data, 'undef', '0';
438 my $light = !($byte & 0x20);
439 my $backbutton = !($byte & 0x10);
440 my $throttle = $byte & 0x0f;
442 push @log_data, $throttle, $backbutton ? 1 : 0;
443 $self->track->car($car)->set_throttle($throttle, $backbutton,
444 $self->{last_read_time});
445 $self->track->car($car)->set_light($light);
448 $self->log_cmd('throttle', @log_data);