SCX/Track.pm

   1 #!/usr/bin/perl -w
   2
   3 package SCX::Track;
   4
   5 use strict;
   6 use Carp;
   7
   8 use Time::HiRes qw(gettimeofday);
   9 use Glib qw(TRUE FALSE);
  10 use SCX::Car;
  11
  12 our $SEMAPHORE_STEP = 1000;
  13
  14 sub new {
  15         my ($class, $args) = @_;
  16
  17         my $self;
  18
  19         $self->{gui} = $args->{gui} or croak;
  20         $self->{race_running} = 0;
  21         $self->{lap_counting_up} = 1;
  22
  23         bless $self, $class;
  24
  25         for my $i (0..5) {
  26                 $self->{cars}->[$i] = SCX::Car->new({
  27                         gui => $self->{gui},
  28                         id => $i,
  29                         track => $self,
  30                 });
  31                 $self->car($i)->set_order($i);
  32         }
  33
  34         return $self;
  35 }
  36
  37 sub car { return shift->{cars}->[shift]; }
  38
  39 sub race_start {
  40         my ($self) = @_;
  41
  42         return if $self->{race_running} || $self->{start_in_progress}
  43                 || $self->{qualification_running};
  44         $self->{round} = 0;
  45         $self->{race_running} = 0;
  46         $self->{start_in_progress} = 1;
  47         $self->{semaphore} = 0;
  48         $self->{gui}->show_semaphore(0);
  49         Glib::Timeout->add($SEMAPHORE_STEP, \&semaphore_step, $self);
  50 }
  51
  52 sub semaphore_step {
  53         my ($self) = @_;
  54
  55         return FALSE if !$self->{start_in_progress} && !$self->{race_running};
  56
  57         $self->{semaphore}++;
  58         if ($self->{semaphore} <= 5) {
  59                 $self->{gui}->show_semaphore($self->{semaphore});
  60                 my $timeout = $SEMAPHORE_STEP;
  61                 $timeout += $SEMAPHORE_STEP * rand()
  62                         if $self->{semaphore} == 5;
  63                 Glib::Timeout->add($timeout, \&semaphore_step, $self);
  64         } elsif ($self->{semaphore} == 6) {
  65                 $self->{race_running} = 1;
  66                 $self->{race_running_since} = gettimeofday;
  67                 $self->{start_in_progress} = undef;
  68                 $self->{gui}->show_semaphore(0);
  69                 Glib::Timeout->add($SEMAPHORE_STEP, \&semaphore_step, $self);
  70         } else {
  71                 $self->{gui}->show_semaphore(undef);
  72                 $self->{semaphore} = undef;
  73         }
  74         return FALSE;
  75 }
  76 sub race_end {
  77         my ($self) = @_;
  78
  79         $self->{race_running} = 0;
  80 }
  81
  82 sub race_setup {
  83         my ($self, $rounds) = @_;
  84
  85         $self->{round} = 0;
  86         if ($rounds) {
  87                 $self->{race_rounds} = $rounds;
  88         } else {
  89                 $self->{race_rounds} = 0;
  90         }
  91
  92         $self->print_rounds;
  93         $self->{best_lap} = undef;
  94
  95         $self->{gui}->show_semaphore(undef);
  96         $self->{race_running} = 0;
  97         $self->{start_in_progress} = 0;
  98
  99         $self->{gui}->time(undef);
 100         $self->{gui}->best_lap(undef);
 101 }
 102
 103 sub reset {
 104         my ($self) = @_;
 105
 106         $self->{race_running} = 0;
 107         $self->{start_in_progress} = 0;
 108         $self->{best_lap} = undef;
 109         $self->{round} = 0;
 110
 111         $self->print_rounds;
 112         $self->{gui}->best_lap(undef);
 113         $self->{gui}->time(undef);
 114
 115         for my $car (0..5) {
 116                 $self->car($car)->reset;
 117         }
 118 }
 119
 120 sub print_rounds {
 121         my ($self) = @_;
 122
 123         $self->{gui}->rounds($self->{qualification_running}
 124                 ? 'Qualification'
 125                 : $self->{race_rounds}
 126                 ? $self->{round} . '/' . $self->{race_rounds}
 127                 : $self->{round}
 128         );
 129 }
 130
 131 sub check_best_lap {
 132         my ($self, $time, $who) = @_;
 133
 134         return if !defined $time || $time == 0;
 135
 136 #       print "Check_best_lap $time $who vs ",
 137 #               defined $self->{best_lap} ? $self->{best_lap} : 'undef',
 138 #               "\n";
 139         if (!defined $self->{best_lap}
 140                 || $time < $self->{best_lap}) {
 141                 $self->{best_lap} = $time;
 142                 $self->{gui}->best_lap($time, $who);
 143                 return 1;
 144         }
 145         return 0;
 146 }
 147
 148 sub qualification_start {
 149         my ($self) = @_;
 150
 151         return if $self->{qualification_running};
 152         for my $car (0..5) {
 153                 $self->car($car)->set_lap(undef);
 154                 $self->car($car)->set_laptime(undef);
 155         }
 156
 157         $self->{qualification_running} = 1;
 158         $self->{gui}->rounds('Qualification');
 159         $self->{gui}->time(undef);
 160         $self->{gui}->best_lap(undef);
 161 }
 162
 163 sub packet_received {
 164         my ($self, $time) = @_;
 165
 166         if ($self->{race_running}) {
 167                 $self->{gui}->time($time - $self->{race_running_since});
 168         }
 169 }
 170
 171 sub recalc_order {
 172         my ($self, $now) = @_;
 173
 174         return if !$self->{race_running};
 175
 176         my @laps;
 177         my @times;
 178         for my $id (0..5) {
 179                 $laps[$id]  = $self->car($id)->{lap} // -1;
 180                 $times[$id] = $self->car($id)->{first_finish_time} // $now;
 181         }
 182
 183         my @new_order = sort {
 184                 $laps[$b] <=> $laps[$a]
 185                 ||
 186                 $times[$a] <=> $times[$b]
 187                 ||
 188                 $a <=> $b;
 189         } (0..5);
 190
 191         my $lap_max = $laps[$new_order[0]];
 192         if (defined $lap_max && $self->{round} && $lap_max != $self->{round}
 193                 && (!$self->{race_rounds}
 194                         || $lap_max <= $self->{race_rounds})) {
 195                 $self->{round} = $lap_max;
 196                 $self->print_rounds;
 197         }
 198
 199         for my $id (0..5) {
 200                 my $car = $new_order[$id];
 201                 if ($self->car($car)->{order} != $id) {
 202                         $self->car($car)->set_order($id);
 203                 }
 204         }
 205         return ($new_order[0], $lap_max, $times[$new_order[0]]);
 206 }
 207
 208 sub finish_line {
 209         my ($self, $time, $regular, @cars) = @_;
 210
 211         my %processed;
 212         my $was_processed;
 213
 214         for my $car (@cars) {
 215                 if ($self->car($car)->finish_line($time, $regular)) {
 216                         $processed{$car} = 1;
 217                         $was_processed = 1;
 218                 }
 219         }
 220
 221
 222         if ($was_processed) {
 223                 my ($first_car, $lap_max, $time_min)
 224                         = $self->recalc_order($time);
 225
 226                 for my $car (0..5) {
 227                         if ($processed{$car}) {
 228                                 $self->car($car)->recalc_distance(
 229                                         $lap_max, $time_min
 230                                 );
 231                         } else {
 232                                 #$self->car($car)->greyout_distance;
 233                         }
 234                 }
 235         }
 236 }
 237
 238 1;
 239