]> www.fi.muni.cz Git - slotcarman.git/blob - SCX/Parser.pm
Attempt to handle timing more exactly.
[slotcarman.git] / SCX / Parser.pm
1 #!/usr/bin/perl -w
2
3 package SCX::Parser;
4
5 use strict;
6 use SCX::CRC;
7
8 our $PACKET_SIZE = 9; # 9 bytes + 0x05
9
10 sub new {
11         my ($class, $args) = @_;
12
13         my $self = {
14                 bytes     => [],
15                 now       => 0,
16         };
17
18         bless $self, $class;
19
20         return $self;
21 }
22
23 sub now { return shift->{now} }
24
25 sub add_data {
26         my ($self, $time, @bytes) = @_;
27
28         push @{ $self->{bytes} }, @bytes;
29         @bytes = @{ $self->{bytes} };
30
31         $self->{now} = $time;
32
33         my @bad_bytes;
34
35         while (@bytes > $PACKET_SIZE) {
36                 if ($bytes[0] != 0x55) {
37                         push @bad_bytes, shift @bytes;
38                         next;
39                 }
40                 my $cmd = $bytes[1];
41
42                 if ($bytes[$PACKET_SIZE] != 0x05
43                         || SCX::CRC::digest(@bytes[0..$PACKET_SIZE-2])
44                                 != $bytes[$PACKET_SIZE-1]) {
45                         push @bad_bytes, shift @bytes;
46                         next;
47                 }
48                 
49                 if (@bad_bytes) { # Report previous bad bytes first
50                         $self->bad_bytes(@bad_bytes);
51                         @bad_bytes = ();
52                 }
53
54                 my @packet = splice @bytes, 0, $PACKET_SIZE+1;
55                 $self->log_packet(@packet);
56                 $self->parse_packet(@packet);
57         }
58
59         if (@bad_bytes) {
60                 while (@bytes && $bytes[0] != 0x55) {
61                         push @bad_bytes, shift @bytes;
62                 }
63                 $self->bad_bytes(@bad_bytes);
64         }
65
66         @{ $self->{bytes} } = @bytes;
67 }
68
69 # Subclass these:
70
71 sub log_packet { }
72 sub bad_bytes { }
73 sub unknown_packet { }
74 sub strange_packet { }
75
76 sub bus_free_time { }
77 sub car_programming { }
78 sub reset { }
79 sub standings { }
80 sub car_lap_time { }
81 sub race_setup { }
82 sub fuel_level { }
83 sub brake_set { }
84 sub qualification { }
85 sub end_of_race { }
86 sub race_start { }
87 sub display_change { }
88 sub finish_line { }
89 sub controller_status { }
90
91 our %COMMANDS = (
92         0xAA => \&bus_free_time_packet,
93         0xCC => \&car_programming_packet,
94         0xD0 => \&reset_packet,
95         0xD3 => \&standings_packet,
96         0xD4 => \&car_lap_time_packet,
97         0xD5 => \&race_setup_packet,
98         0xD6 => \&fuel_level_packet,
99         0xD7 => \&brake_set_packet,
100         0xDB => \&qualification_packet,
101         0xDC => \&end_of_race_packet,
102         0xDD => \&race_start_packet,
103         0xDE => \&display_change_packet,
104         0xEE => \&finish_line_packet,
105         0xFF => \&controller_status_packet,
106 );
107
108 sub parse_packet {
109         my ($self, @data) = @_;
110
111         my $cmd = $data[1];
112         my @args = @data[2..7];
113
114         my $sub = $COMMANDS{$cmd};
115
116         if (!defined $sub) {
117                 $self->unknown_packet($cmd, @args);
118                 return;
119         }
120
121         return &$sub($self, @args);
122 }
123
124 sub bus_free_time_packet {
125         my ($self, @bytes) = @_;
126
127         $self->strange_packet('bus free time', @bytes)
128                 if $bytes[2] != 0xF0
129                 || $bytes[3] != 0xF0
130                 || $bytes[4] != 0xF0
131                 || $bytes[5] != 0xF0;
132
133         $self->bus_free_time($bytes[1], $bytes[0]);
134 }
135
136 sub car_programming_packet {
137         my ($self, @bytes) = @_;
138
139         $self->strange_packet('car programming', @bytes)
140                 if ($bytes[0] & 0xF8) != 0 || ($bytes[0] & 0x07) > 5
141                 || $bytes[1] != 0xFE
142                 || $bytes[2] != 0xFF
143                 || $bytes[3] != 0xFF
144                 || $bytes[4] != 0xFF
145                 || $bytes[5] != 0xFF;
146
147         $self->car_programming($bytes[0] & 0x07);
148 }
149
150 sub reset_packet {
151         my ($self, @bytes) = @_;
152
153         $self->strange_packet('reset', @bytes)
154                 if $bytes[0] != 0xFF
155                 || $bytes[3] != 0xAA
156                 || $bytes[4] != 0xAA
157                 || $bytes[5] != 0xAA;
158
159         $self->reset($bytes[1], $bytes[2]);
160 }
161
162 sub standings_packet {
163         my ($self, @bytes) = @_;
164
165         self->strange_packet('standings', @bytes)
166                 if ($bytes[0] != 0xFF && ($bytes[0] & 0x07) > 5)
167                 || ($bytes[1] != 0xFF && ($bytes[1] & 0x07) > 5)
168                 || ($bytes[2] != 0xFF && ($bytes[2] & 0x07) > 5)
169                 || ($bytes[3] != 0xFF && ($bytes[3] & 0x07) > 5)
170                 || ($bytes[4] != 0xFF && ($bytes[4] & 0x07) > 5)
171                 || ($bytes[5] != 0xFF && ($bytes[5] & 0x07) > 5);
172
173         $self->standings(map { $_ != 0xFF ? $_ & (0x07) : () } @bytes);
174 }
175
176 sub car_lap_time_packet {
177         my ($self, @bytes) = @_;
178
179         $self->strange_packet('car lap time', @bytes)
180                 if $bytes[0] > 5
181                 || $bytes[1] & 0x01
182                 || $bytes[2] & 0x01
183                 || ($bytes[3] & 0xF0) != 0
184                 || $bytes[4] & 0x01
185                 || $bytes[5] & 0x01;
186
187         $self->car_lap_time($bytes[0],
188                 256*$bytes[1] + $bytes[2]
189                         + ($bytes[3] & 0x02 ? 256 : 0)
190                         + ($bytes[3] & 0x01 ? 1 : 0),
191                 sprintf('%.3f', 0.01024 * (256*$bytes[4] + $bytes[5]
192                         + ($bytes[3] & 0x08 ? 256 : 0)
193                         + ($bytes[3] & 0x04 ? 1 : 0))),
194                 sprintf('%04b', $bytes[3])
195         );
196 }
197
198 sub race_setup_packet {
199         my ($self, @bytes) = @_;
200
201         $self->strange_packet('race setup')
202                 if ($bytes[0] != 0x00 && $bytes[0] != 0xFF)
203                 || $bytes[1] & 0xF0
204                 || $bytes[2] & 0xF0
205                 || $bytes[3] & 0xF0
206                 || $bytes[4] != 0xFF
207                 || $bytes[5] != 0xFF;
208
209         my $rounds = $bytes[0] == 0x00
210                 ? 0
211                 : ($bytes[1] & 0x0F) * 256
212                         + ($bytes[2] & 0x0F) * 16
213                         + ($bytes[3] & 0x0F);
214
215         $self->race_setup($rounds);
216 }
217
218 sub fuel_level_packet {
219         my ($self, @bytes) = @_;
220
221         $self->strange_packet('fuel level')
222                 if ($bytes[0] >> 4) > 8
223                 || ($bytes[0] & 0x0F) > 8
224                 || ($bytes[1] >> 4) > 8
225                 || ($bytes[1] & 0x0F) > 8
226                 || ($bytes[2] >> 4) > 8
227                 || ($bytes[2] & 0x0F) > 8
228                 || ($bytes[5] != 0xAA && $bytes[5] != 0xFF);
229
230         my @fuel = (
231                 $bytes[0] >> 4, $bytes[0] & 0x0f,
232                 $bytes[1] >> 4, $bytes[1] & 0x0f,
233                 $bytes[2] >> 4, $bytes[2] & 0x0f,
234         );
235
236         $self->fuel_level(@fuel);
237 }
238
239 sub brake_set_packet {
240         my ($self, @bytes) = @_;
241
242         $self->strange_packet('brake set')
243                 if ($bytes[0] > 5)
244                 || ($bytes[1] != 0x00 && $bytes[1] != 0x02 && $bytes[1] != 0x04)
245                 || $bytes[2] != 0x83
246                 || $bytes[3] != 0x93
247                 || $bytes[4] != 0xDB
248                 || $bytes[5] != 0xFF;
249
250         $self->brake_set($bytes[0],
251                 $bytes[1] == 0x00 ? 0
252                 : $bytes[1] == 0x02 ? 50
253                 : 100);
254 }
255
256 sub qualification_packet {
257         my ($self, @bytes) = @_;
258
259         $self->strange_packet('qualification')
260                 if $bytes[0] & 0xF0
261                 || $bytes[1] & 0xF0
262                 || $bytes[2] & 0xF0
263                 || $bytes[3] > 6
264                 || $bytes[4] != 0xFF
265                 || $bytes[5] != 0xFF;
266
267         my $rounds = ($bytes[0] & 0x0F) * 256
268                         + ($bytes[1] & 0x0F) * 16
269                         + ($bytes[2] & 0x0F);
270         my $cars = $bytes[3];
271
272         $self->qualification($rounds, $cars);
273 }
274
275 sub end_of_race_packet {
276         my ($self, @bytes) = @_;
277
278         $self->strange_packet('end of race')
279                 if $bytes[0] != 0xFF
280                 || $bytes[1] != 0xFF
281                 || $bytes[2] != 0xFF
282                 || $bytes[3] != 0xFF
283                 || $bytes[4] != 0xFF
284                 || $bytes[5] != 0xFF;
285
286         $self->end_of_race();
287 }
288
289 sub race_start_packet {
290         my ($self, @bytes) = @_;
291
292         $self->strange_packet('race start')
293                 if $bytes[0] != 0x00
294                 || $bytes[1] != 0xAA
295                 || $bytes[2] != 0xAA
296                 || $bytes[3] != 0xAA
297                 || $bytes[4] != 0xAA
298                 || $bytes[5] != 0xAA;
299
300         $self->race_start();
301 }
302
303 sub display_change_packet {
304         my ($self, @bytes) = @_;
305
306         $self->strange_packet('display change')
307                 if $bytes[0] & 0xFE
308                 || $bytes[1] != 0xFF
309                 || $bytes[2] != 0xFF
310                 || $bytes[3] != 0xFF
311                 || $bytes[4] != 0xFF
312                 || $bytes[5] != 0xFF;
313
314         $self->display_change();
315 }
316
317 =comment
318
319 # FIXME: we still do not know the meaning of the bytes
320 sub finish_line_packet {
321         my ($self, @bytes) = @_;
322
323         my $fail;
324         for my $byte (@bytes) {
325                 $fail = 1
326                         if $byte != 0xAA
327                         && $byte != 0xE7
328                         && $byte != 0xF0
329                         && $byte != 0xFE
330         }
331
332         my $msg = 'Strange finish_line packet'
333                 if $fail;
334
335         my $regular = 1;
336         my @cars_finished;
337         for my $i (0..5) {
338                 my $byte = $bytes[$i];
339
340                 $regular = 0
341                         if $byte != 0xAA && $byte != 0xE7 && $byte != 0xFE;
342
343                 push @cars_finished, $i if $byte == 0xE7;
344         }
345
346         $self->log_cmd('finish_line', $regular, @cars_finished);
347         $self->track->finish_line(
348                 $self->{last_read_time},
349                 $regular,
350                 @cars_finished
351         );
352
353         return $msg;
354 }
355 =cut
356
357 sub finish_line_packet {
358         my ($self, @bytes) = @_;
359
360         my $fail;
361         for my $byte (@bytes) {
362                 $fail = 1
363                         if $byte != 0xAA
364                         && $byte != 0xE7
365                         && $byte != 0xF0
366                         && $byte != 0xFE
367         }
368
369         $self->strange_packet('finish line')
370                 if $fail;
371
372         my $regular = 1;
373         my @cars_finished;
374         for my $i (0..5) {
375                 my $byte = $bytes[$i];
376
377                 $regular = 0
378                         if $byte != 0xAA && $byte != 0xE7 && $byte != 0xFE;
379
380                 push @cars_finished, $i if $byte == 0xE7;
381         }
382
383         $self->finish_line($regular, @cars_finished);
384 }
385
386 sub controller_status_packet {
387         my ($self, @bytes) = @_;
388
389         my $fail;
390         for my $byte (@bytes) {
391                 next if $byte == 0xAA;
392                 $fail = 1
393                         if ($byte & 0xC0) != 0xC0
394                         || ($byte & 0x0F) > 12
395         }
396
397         $self->strange_packet('controller status')
398                 if $fail;
399
400         my @ctrl_data;
401
402         for my $car (0..5) {
403                 my $byte = $bytes[$car];
404
405                 if ($byte == 0xAA) {
406                         push @ctrl_data, undef;
407                         next;
408                 }
409
410                 my $light = ($byte & 0x20) ? 0 : 1;
411                 my $backbutton = ($byte & 0x10) ? 0 : 1;
412                 my $throttle = $byte & 0x0f;
413
414                 push @ctrl_data, {
415                         throttle => $throttle,
416                         button   => $backbutton,
417                         light    => $light,
418                 };
419         }
420
421         $self->controller_status(@ctrl_data);
422 }
423
424 1;
425