7 use Time::HiRes qw(gettimeofday tv_interval);
13 our $PACKET_SIZE = 9; # 9 bytes + 0x05
14 our $LOG_ROTATE = 600;
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: $!";
36 my $now = gettimeofday;
39 portname => $portname,
46 track => $args->{track},
55 sub fh { return shift->{fh}; }
57 sub track { return shift->{track}; }
63 my $bytes_read = sysread $self->fh, $data, $PACKET_SIZE;
64 die "Read error on $self->{portname}: $!"
67 my @bytes = unpack("C*", $data);
69 # print join(' ', map { sprintf(" %02x", $_) } @bytes), "\n";
70 push @{ $self->{bytes} }, @bytes;
71 @bytes = @{ $self->{bytes} };
75 while (@bytes > $PACKET_SIZE) {
76 if ($bytes[0] != 0x55) {
77 push @bad_bytes, shift @bytes;
82 if ($bytes[$PACKET_SIZE] != 0x05
83 || SCX::CRC::digest(@bytes[0..$PACKET_SIZE-2])
84 != $bytes[$PACKET_SIZE-1]) {
85 push @bad_bytes, shift @bytes;
89 if (@bad_bytes) { # Report previous bad bytes first
90 $self->log_bytes(\@bad_bytes, "Cannot parse packet");
94 my @packet = splice @bytes, 0, $PACKET_SIZE+1;
95 my $rv = $self->handle_packet(@packet);
96 $self->log_bytes(\@packet, $rv);
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, $bytes, $msg) = @_;
113 $msg = defined $msg ? ' # ' . $msg : '';
115 my $now = gettimeofday;
117 if ($now - $self->{log_start} >= $LOG_ROTATE) {
118 close $self->{logfh};
119 $self->{log_gen} = $self->{log_gen} ? 0 : 1;
120 open my $fh, '>', $self->{logfile} . '.' . $self->{log_gen}
121 or die "Can't open $self->{logfile}.$self->{log_gen}: $!";
122 $self->{logfh} = $fh;
123 $self->{log_start} = $now;
126 $self->{logfh}->print(sprintf('% 10.3f', $now - $self->{starttime}),
127 (map { sprintf(" %02x", $_) } @$bytes),
129 $self->{logfh}->flush;
133 0xAA => \&bus_free_time_packet,
134 0xCC => \&car_programming_packet,
135 0xD0 => \&reset_packet,
136 0xD3 => \&standings_packet,
137 0xD4 => \&lap_time_packet,
138 0xD5 => \&race_setup_packet,
139 0xD6 => \&fuel_level_packet,
140 0xD7 => \&brake_set_packet,
141 0xDB => \&qualification_packet,
142 0xDC => \&end_of_race_packet,
143 0xDD => \&race_start_packet,
144 0xDE => \&display_change_packet,
145 0xEE => \&finish_line_packet,
146 0xFF => \&controller_status_packet,
150 my ($self, @data) = @_;
153 my @args = @data[2..7];
155 my $sub = $COMMANDS{$cmd};
156 return "Unknown packet"
159 return &$sub($self, @args);
162 sub bus_free_time_packet {
163 my ($self, @bytes) = @_;
165 my $msg = 'Strange bus free time packet'
169 || $bytes[5] != 0xF0;
171 return $msg; # No need to handle this, I think
174 sub car_programming_packet {
175 my ($self, @bytes) = @_;
177 my $msg = 'Strange car programming packet'
178 if ($bytes[0] & 0xF8) != 0 || ($bytes[0] & 0x07) > 5
183 || $bytes[5] != 0xFF;
189 my ($self, @bytes) = @_;
191 my $msg = 'Strange reset packet'
195 || $bytes[5] != 0xAA;
197 return $msg; # FIXME - to be implemented
200 sub standings_packet {
201 my ($self, @bytes) = @_;
203 my $msg = 'Strange standings packet'
204 if ($bytes[0] != 0xFF && ($bytes[0] & 0x07) > 5)
205 || ($bytes[1] != 0xFF && ($bytes[1] & 0x07) > 5)
206 || ($bytes[2] != 0xFF && ($bytes[2] & 0x07) > 5)
207 || ($bytes[3] != 0xFF && ($bytes[3] & 0x07) > 5)
208 || ($bytes[4] != 0xFF && ($bytes[4] & 0x07) > 5)
209 || ($bytes[5] != 0xFF && ($bytes[5] & 0x07) > 5);
213 push @standings, map { $_ != 0xFF ? $_ & (0x07) : () } @bytes;
215 return $msg; # FIXME - to be implemented
218 sub lap_time_packet {
219 my ($self, @bytes) = @_;
221 my $msg = 'Strange lap time packet'
225 || ($bytes[3] & 0xF0) != 0
229 my $nonzero = grep { $_ != 0 } @bytes;
232 my $round = 256*$bytes[1] + $bytes[2]
233 + ($bytes[3] & 2 ? 256 : 0)
234 + ($bytes[3] & 1 ? 1 : 0);
235 my $time = 256*$bytes[4] + $bytes[5]
236 + ($bytes[3] & 8 ? 256 : 0)
237 + ($bytes[3] & 4 ? 1 : 0);
238 if ($time == 65535) {
239 $self->track->car($car)->enter_pit_lane;
244 $self->track->car($car)->set_lap($round);
245 $self->track->car($car)->set_laptime($time);
247 # FIXME - probably reset race time or whatever
248 # all-zeros packet is sent after the race setup
256 sub race_setup_packet {
257 my ($self, @bytes) = @_;
259 my $msg = 'Strange race setup packet'
260 if ($bytes[0] != 0x00 && $bytes[0] != 0xFF)
265 || $bytes[5] != 0xFF;
268 $self->track->car($car)->set_lap(0);
269 $self->track->car($car)->set_laptime(undef);
272 $self->track->race_setup($bytes[0] == 0x00
274 : $bytes[1] & 0x0F * 256
275 + $bytes[2] & 0x0F * 16
278 return $msg; # FIXME - to be implemented
282 sub fuel_level_packet {
283 my ($self, @bytes) = @_;
285 my $msg = 'Strange fuel_level packet'
286 if ($bytes[0] >> 4) > 8
287 || ($bytes[0] & 0x0F) > 8
288 || ($bytes[1] >> 4) > 8
289 || ($bytes[1] & 0x0F) > 8
290 || ($bytes[2] >> 4) > 8
291 || ($bytes[2] & 0x0F) > 8
292 || ($bytes[5] != 0xAA && $bytes[5] != 0xFF);
295 $bytes[0] >> 4, $bytes[0] & 0x0f,
296 $bytes[1] >> 4, $bytes[1] & 0x0f,
297 $bytes[2] >> 4, $bytes[2] & 0x0f,
301 $self->track->car($car)->set_fuel($fuel[$car]);
308 sub brake_set_packet {
309 my ($self, @bytes) = @_;
311 return 'Unexpected brake_set packet (should be in the pit lane only)';
315 sub qualification_packet {
316 my ($self, @bytes) = @_;
318 my $msg = 'Strange qualification packet'
324 || $bytes[5] != 0xFF;
327 $self->track->car($car)->set_lap(undef);
328 $self->track->car($car)->set_laptime(undef);
331 return $msg; # FIXME - to be implemented
335 sub end_of_race_packet {
336 my ($self, @bytes) = @_;
338 my $msg = 'Strange end_of_race packet'
344 || $bytes[5] != 0xFF;
346 $self->track->race_end;
348 return $msg; # FIXME - to be implemented
352 sub race_start_packet {
353 my ($self, @bytes) = @_;
355 my $msg = 'Strange race_start packet'
361 || $bytes[5] != 0xAA;
363 $self->track->race_start;
365 return $msg; # FIXME - to be implemented
369 sub display_change_packet {
370 my ($self, @bytes) = @_;
372 my $msg = 'Strange display_change packet'
378 || $bytes[5] != 0xFF;
380 return $msg; # FIXME - to be implemented
384 sub finish_line_packet {
385 my ($self, @bytes) = @_;
388 for my $byte (@bytes) {
396 my $msg = 'Strange finish_line packet'
402 my $byte = $bytes[$i];
404 $pit_lane_entry = 1 if $byte == 0xF0;
405 push @cars_finished, $i if $byte == 0xE7;
408 if ($pit_lane_entry) {
409 for my $car (@cars_finished) {
410 $self->track->car($car)->enter_pit_lane;
414 return $msg; # FIXME - to be implemented
417 sub controller_status_packet {
418 my ($self, @bytes) = @_;
421 for my $byte (@bytes) {
422 next if $byte == 0xAA;
424 if ($byte & 0xC0) != 0xC0
425 || ($byte & 0x0F) > 12
428 my $msg = 'Strange controller_status packet'
432 $bytes[1] >> 4, $bytes[1] & 0x0f,
433 $bytes[2] >> 4, $bytes[2] & 0x0f,
434 $bytes[3] >> 4, $bytes[3] & 0x0f,
438 my $byte = $bytes[$car];
441 $self->track->car($car)->set_throttle(undef);
445 my $light = !($byte & 0x20);
446 my $backbutton = !($byte & 0x10);
447 my $throttle = $byte & 0x0f;
449 $self->track->car($car)->set_throttle($throttle);
450 $self->track->car($car)->set_light($light);
451 $self->track->car($car)->set_backbutton($backbutton);