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},
57 sub fh { return shift->{fh}; }
59 sub track { return shift->{track}; }
65 my $bytes_read = sysread $self->fh, $data, $PACKET_SIZE;
66 die "Read error on $self->{portname}: $!"
69 $self->{last_read_time} = gettimeofday;
71 my @bytes = unpack("C*", $data);
73 # print join(' ', map { sprintf(" %02x", $_) } @bytes), "\n";
74 push @{ $self->{bytes} }, @bytes;
75 @bytes = @{ $self->{bytes} };
79 while (@bytes > $PACKET_SIZE) {
80 if ($bytes[0] != 0x55) {
81 push @bad_bytes, shift @bytes;
86 if ($bytes[$PACKET_SIZE] != 0x05
87 || SCX::CRC::digest(@bytes[0..$PACKET_SIZE-2])
88 != $bytes[$PACKET_SIZE-1]) {
89 push @bad_bytes, shift @bytes;
93 if (@bad_bytes) { # Report previous bad bytes first
94 $self->log_bytes(\@bad_bytes, "Cannot parse packet");
98 my @packet = splice @bytes, 0, $PACKET_SIZE+1;
99 my $rv = $self->handle_packet(@packet);
100 $self->log_bytes(\@packet, $rv);
101 $self->track->packet_received($self->{last_read_time});
104 while (@bytes && $bytes[0] != 0x55) {
105 push @bad_bytes, shift @bytes;
107 $self->log_bytes(\@bad_bytes, "cannot parse packet");
110 @{ $self->{bytes} } = @bytes;
114 my ($self, $bytes, $msg) = @_;
118 $msg = defined $msg ? ' # ' . $msg : '';
120 my $now = $self->{last_read_time};
122 if ($now - $self->{log_start} >= $LOG_ROTATE) {
123 close $self->{logfh};
124 $self->{log_gen} = $self->{log_gen} ? 0 : 1;
125 open my $fh, '>', $self->{logfile} . '.' . $self->{log_gen}
126 or die "Can't open $self->{logfile}.$self->{log_gen}: $!";
127 $self->{logfh} = $fh;
128 $self->{log_start} = $now;
131 $self->{logfh}->print(sprintf('% 10.3f', $now - $self->{starttime}),
132 (map { sprintf(" %02x", $_) } @$bytes),
134 $self->{logfh}->flush;
138 0xAA => \&bus_free_time_packet,
139 0xCC => \&car_programming_packet,
140 0xD0 => \&reset_packet,
141 0xD3 => \&standings_packet,
142 0xD4 => \&lap_time_packet,
143 0xD5 => \&race_setup_packet,
144 0xD6 => \&fuel_level_packet,
145 0xD7 => \&brake_set_packet,
146 0xDB => \&qualification_packet,
147 0xDC => \&end_of_race_packet,
148 0xDD => \&race_start_packet,
149 0xDE => \&display_change_packet,
150 0xEE => \&finish_line_packet,
151 0xFF => \&controller_status_packet,
155 my ($self, @data) = @_;
158 my @args = @data[2..7];
160 my $sub = $COMMANDS{$cmd};
161 return "Unknown packet"
164 return &$sub($self, @args);
167 sub bus_free_time_packet {
168 my ($self, @bytes) = @_;
170 my $msg = 'Strange bus free time packet'
174 || $bytes[5] != 0xF0;
176 return $msg; # No need to handle this, I think
179 sub car_programming_packet {
180 my ($self, @bytes) = @_;
182 my $msg = 'Strange car programming packet'
183 if ($bytes[0] & 0xF8) != 0 || ($bytes[0] & 0x07) > 5
188 || $bytes[5] != 0xFF;
190 return $msg; # No need to handle this
194 my ($self, @bytes) = @_;
196 my $msg = 'Strange reset packet'
200 || $bytes[5] != 0xAA;
204 return $msg; # FIXME - to be implemented
207 sub standings_packet {
208 my ($self, @bytes) = @_;
210 my $msg = 'Strange standings packet'
211 if ($bytes[0] != 0xFF && ($bytes[0] & 0x07) > 5)
212 || ($bytes[1] != 0xFF && ($bytes[1] & 0x07) > 5)
213 || ($bytes[2] != 0xFF && ($bytes[2] & 0x07) > 5)
214 || ($bytes[3] != 0xFF && ($bytes[3] & 0x07) > 5)
215 || ($bytes[4] != 0xFF && ($bytes[4] & 0x07) > 5)
216 || ($bytes[5] != 0xFF && ($bytes[5] & 0x07) > 5);
220 push @standings, map { $_ != 0xFF ? $_ & (0x07) : () } @bytes;
222 return $msg; # FIXME - to be implemented
225 sub lap_time_packet {
226 my ($self, @bytes) = @_;
228 my $msg = 'Strange lap time packet'
232 || ($bytes[3] & 0xF0) != 0
237 # Moving to internal timekeeping
238 my $nonzero = grep { $_ != 0 } @bytes;
241 my $round = 256*$bytes[1] + $bytes[2]
242 + ($bytes[3] & 2 ? 256 : 0)
243 + ($bytes[3] & 1 ? 1 : 0);
244 my $time = 256*$bytes[4] + $bytes[5]
245 + ($bytes[3] & 8 ? 256 : 0)
246 + ($bytes[3] & 4 ? 1 : 0);
247 if ($time == 65535) {
248 $self->track->car($car)->enter_pit_lane;
253 $self->track->car($car)->set_lap($round);
254 $self->track->car($car)->set_laptime($time);
256 # FIXME - probably reset race time or whatever
257 # all-zeros packet is sent after the race setup
266 sub race_setup_packet {
267 my ($self, @bytes) = @_;
269 my $msg = 'Strange race setup packet'
270 if ($bytes[0] != 0x00 && $bytes[0] != 0xFF)
275 || $bytes[5] != 0xFF;
277 $self->track->race_setup($bytes[0] == 0x00
279 : ($bytes[1] & 0x0F) * 256
280 + ($bytes[2] & 0x0F) * 16
281 + ($bytes[3] & 0x0F));
287 sub fuel_level_packet {
288 my ($self, @bytes) = @_;
290 my $msg = 'Strange fuel_level packet'
291 if ($bytes[0] >> 4) > 8
292 || ($bytes[0] & 0x0F) > 8
293 || ($bytes[1] >> 4) > 8
294 || ($bytes[1] & 0x0F) > 8
295 || ($bytes[2] >> 4) > 8
296 || ($bytes[2] & 0x0F) > 8
297 || ($bytes[5] != 0xAA && $bytes[5] != 0xFF);
300 $bytes[0] >> 4, $bytes[0] & 0x0f,
301 $bytes[1] >> 4, $bytes[1] & 0x0f,
302 $bytes[2] >> 4, $bytes[2] & 0x0f,
306 $self->track->car($car)->set_fuel($fuel[$car]);
313 sub brake_set_packet {
314 my ($self, @bytes) = @_;
316 return 'Unexpected brake_set packet (should be in the pit lane only)';
320 sub qualification_packet {
321 my ($self, @bytes) = @_;
323 my $msg = 'Strange qualification packet'
329 || $bytes[5] != 0xFF;
331 $self->track->qualification_start;
337 sub end_of_race_packet {
338 my ($self, @bytes) = @_;
340 my $msg = 'Strange end_of_race packet'
346 || $bytes[5] != 0xFF;
348 $self->track->race_end;
354 sub race_start_packet {
355 my ($self, @bytes) = @_;
357 my $msg = 'Strange race_start packet'
363 || $bytes[5] != 0xAA;
365 $self->track->race_start;
371 sub display_change_packet {
372 my ($self, @bytes) = @_;
374 my $msg = 'Strange display_change packet'
380 || $bytes[5] != 0xFF;
382 return $msg; # FIXME - to be implemented
386 sub finish_line_packet {
387 my ($self, @bytes) = @_;
390 for my $byte (@bytes) {
398 my $msg = 'Strange finish_line packet'
404 my $byte = $bytes[$i];
407 if $byte != 0xAA && $byte != 0xE7 && $byte != 0xFE;
409 push @cars_finished, $i if $byte == 0xE7;
412 $self->track->finish_line(
413 $self->{last_read_time},
421 sub controller_status_packet {
422 my ($self, @bytes) = @_;
425 for my $byte (@bytes) {
426 next if $byte == 0xAA;
428 if ($byte & 0xC0) != 0xC0
429 || ($byte & 0x0F) > 12
432 my $msg = 'Strange controller_status packet'
436 $bytes[1] >> 4, $bytes[1] & 0x0f,
437 $bytes[2] >> 4, $bytes[2] & 0x0f,
438 $bytes[3] >> 4, $bytes[3] & 0x0f,
442 my $byte = $bytes[$car];
445 $self->track->car($car)->set_throttle(undef);
449 my $light = !($byte & 0x20);
450 my $backbutton = !($byte & 0x10);
451 my $throttle = $byte & 0x0f;
453 $self->track->car($car)->set_throttle($throttle,
454 $self->{last_read_time});
455 $self->track->car($car)->set_light($light);
456 $self->track->car($car)->set_backbutton($backbutton);