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;
267 $self->track->race_setup($bytes[0] == 0x00
269 : $bytes[1] & 0x0F * 256
270 + $bytes[2] & 0x0F * 16
273 return $msg; # FIXME - to be implemented
277 sub fuel_level_packet {
278 my ($self, @bytes) = @_;
280 my $msg = 'Strange fuel_level packet'
281 if ($bytes[0] >> 4) > 8
282 || ($bytes[0] & 0x0F) > 8
283 || ($bytes[1] >> 4) > 8
284 || ($bytes[1] & 0x0F) > 8
285 || ($bytes[2] >> 4) > 8
286 || ($bytes[2] & 0x0F) > 8
287 || ($bytes[5] != 0xAA && $bytes[5] != 0xFF);
290 $bytes[0] >> 4, $bytes[0] & 0x0f,
291 $bytes[1] >> 4, $bytes[1] & 0x0f,
292 $bytes[2] >> 4, $bytes[2] & 0x0f,
296 $self->track->car($car)->set_fuel($fuel[$car]);
303 sub brake_set_packet {
304 my ($self, @bytes) = @_;
306 return 'Unexpected brake_set packet (should be in the pit lane only)';
310 sub qualification_packet {
311 my ($self, @bytes) = @_;
313 my $msg = 'Strange qualification packet'
319 || $bytes[5] != 0xFF;
322 $self->track->car($car)->set_lap(undef);
323 $self->track->car($car)->set_laptime(undef);
326 return $msg; # FIXME - to be implemented
330 sub end_of_race_packet {
331 my ($self, @bytes) = @_;
333 my $msg = 'Strange end_of_race packet'
339 || $bytes[5] != 0xFF;
341 $self->track->race_end;
343 return $msg; # FIXME - to be implemented
347 sub race_start_packet {
348 my ($self, @bytes) = @_;
350 my $msg = 'Strange race_start packet'
356 || $bytes[5] != 0xAA;
358 $self->track->race_start;
360 return $msg; # FIXME - to be implemented
364 sub display_change_packet {
365 my ($self, @bytes) = @_;
367 my $msg = 'Strange display_change packet'
373 || $bytes[5] != 0xFF;
375 return $msg; # FIXME - to be implemented
379 sub finish_line_packet {
380 my ($self, @bytes) = @_;
383 for my $byte (@bytes) {
391 my $msg = 'Strange finish_line packet'
397 my $byte = $bytes[$i];
399 $pit_lane_entry = 1 if $byte == 0xF0;
400 push @cars_finished, $i if $byte == 0xE7;
403 if ($pit_lane_entry) {
404 for my $car (@cars_finished) {
405 $self->track->car($car)->enter_pit_lane;
409 return $msg; # FIXME - to be implemented
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'
427 $bytes[1] >> 4, $bytes[1] & 0x0f,
428 $bytes[2] >> 4, $bytes[2] & 0x0f,
429 $bytes[3] >> 4, $bytes[3] & 0x0f,
433 my $byte = $bytes[$car];
436 $self->track->car($car)->set_throttle(undef);
440 my $light = !($byte & 0x20);
441 my $backbutton = !($byte & 0x10);
442 my $throttle = $byte & 0x0f;
444 $self->track->car($car)->set_throttle($throttle);
445 $self->track->car($car)->set_light($light);
446 $self->track->car($car)->set_backbutton($backbutton);