SCX/GUI.pm

   1 #!/usr/bin/perl -w
   2
   3 package SCX::GUI;
   4
   5 use strict;
   6 use utf8;
   7
   8 use Encode;
   9 use Gtk2 '-init';
  10 use Glib qw(TRUE FALSE);
  11
  12 use SCX::Reader;
  13
  14 sub new {
  15         my ($class, $args) = @_;
  16
  17         my $self = {
  18                 throttle_images => [
  19                         load_image_set('img/throttle%d.svg', 13, 100)
  20                 ],
  21                 fuel_images => [
  22                         load_image_set('img/fuel%d.svg', 8, 60)
  23                 ],
  24                 car_images => load_image_dir('img/SCXCars', 100),
  25                 semaphore_images => [
  26                         load_image_set('img/semaphore%d.svg', 5, 200)
  27                 ],
  28                 builder => Gtk2::Builder->new,
  29                 semaphore_win => Gtk2::Window->new('popup'),
  30                 semaphore_img => Gtk2::Image->new,
  31         };
  32
  33         bless $self, $class;
  34
  35         $self->{builder}->add_from_file('slotcarman.glade');
  36
  37         $self->{builder}->connect_signals(undef);
  38
  39         my $pixbuf = $self->{semaphore_images}->[0];
  40         $self->{semaphore_img}->set_from_pixbuf($pixbuf);
  41         $self->{semaphore_img}->show;
  42         $self->{semaphore_win}->add($self->{semaphore_img});
  43         $self->{semaphore_win}->set_type_hint('splashscreen');
  44         $self->{semaphore_win}->set_position('center-on-parent');
  45         $self->{semaphore_win}->set_transient_for(
  46                 $self->{builder}->get_object('slotcarman')
  47         );
  48
  49         return $self;
  50 }
  51
  52 sub show {
  53         my ($self) = @_;
  54
  55         my $window = $self->{builder}->get_object('slotcarman');
  56         $window->signal_connect(delete_event => \&delete_event);
  57         $window->show();
  58 }
  59
  60 sub delete_event { Gtk2->main_quit; }
  61
  62 sub get_object { return shift->{builder}->get_object(@_); }
  63
  64 sub load_image_set {
  65         my ($pattern, $limit, $height) = @_;
  66
  67         my @rv;
  68         for my $i (0..$limit) {
  69                 my $file = sprintf($pattern, $i);
  70
  71                 my $dummy = Gtk2::Gdk::Pixbuf->new_from_file($file);
  72                 my $width = $dummy->get_width * $height / $dummy->get_height;
  73                 push @rv, Gtk2::Gdk::Pixbuf->new_from_file_at_scale(
  74                         $file, $width, $height, TRUE
  75                 );
  76         }
  77         return @rv;
  78 }
  79
  80 sub load_image_dir {
  81         my ($dir, $height) = @_;
  82
  83         my %rv;
  84         for my $file (<$dir/*>) {
  85                 $file = Encode::decode('utf-8', $file);
  86                 my $name = $file;
  87                 $name =~ s/.*\///;
  88                 $name =~ s/\..*?$//;
  89                 $name =~ s/[-_]/ /g;
  90                 $name =~ s/\s+/ /g;
  91
  92
  93                 my $dummy = Gtk2::Gdk::Pixbuf->new_from_file($file)
  94                         or next;
  95
  96                 my $width = $dummy->get_width * $height / $dummy->get_height;
  97                 $rv{$name} = Gtk2::Gdk::Pixbuf->new_from_file_at_scale(
  98                         $file, $width, $height, TRUE
  99                 );
 100         }
 101         return \%rv;
 102 }
 103
 104 sub set_throttle {
 105         my ($self, $row, $val) = @_;
 106
 107         $row++;
 108         $val = 13 if !defined $val;
 109
 110         my $image = $self->get_object("image_throttle$row");
 111         $image->set_from_pixbuf($self->{throttle_images}->[$val]);
 112 }
 113
 114 sub set_fuel {
 115         my ($self, $row, $val) = @_;
 116
 117         $row++;
 118         $val = 0 if !defined $val;
 119
 120         my $image = $self->get_object("image_fuel$row");
 121         $image->set_from_pixbuf($self->{fuel_images}->[$val]);
 122 }
 123
 124 sub set_car_icon {
 125         my ($self, $row, $name) = @_;
 126
 127         $row++;
 128         my $pixbuf = $self->{car_images}->{$name};
 129         if (!$pixbuf) {
 130                 print "No car image for $name.\n";
 131                 return;
 132         }
 133
 134         my $image = $self->get_object("image_car$row");
 135         $image->set_from_pixbuf($pixbuf);
 136 }
 137
 138 sub set_lap {
 139         my ($self, $row, $text) = @_;
 140
 141         ++$row;
 142         my $label = $self->get_object("label_lap$row")
 143                 or die "Can't get label_lap$row";
 144         $label->set_markup('<span font_desc="24" weight="bold">'.$text.'</span>');
 145 }
 146
 147 sub set_laptime {
 148         my ($self, $row, $text) = @_;
 149
 150         ++$row;
 151         my $label = $self->get_object("label_laptime$row")
 152                 or die "Can't get label_laptime$row";
 153         $label->set_markup('<span font_desc="18" weight="bold">'.$text.'</span>');
 154 }
 155
 156 sub set_best_lap {
 157         my ($self, $row, $text, $global) = @_;
 158
 159         ++$row;
 160         my $label = $self->get_object("label_best_lap$row")
 161                 or die "Can't get label_best_lap$row";
 162
 163         if ($global) {
 164                 $global = ' foreground="#e00000"';
 165         } else {
 166                 $global = '';
 167         }
 168
 169         $label->set_markup('<span font_desc="18" weight="bold"'.$global.'>'
 170                 .$text.'</span>');
 171 }
 172
 173 sub set_driver {
 174         my ($self, $row, $text) = @_;
 175
 176         ++$row;
 177         my $label = $self->get_object("label_name$row")
 178                 or die "Can't get label_lap$row";
 179         $label->set_markup('<span font_desc="18" weight="bold">'.$text.'</span>');
 180 }
 181
 182 sub enter_pit_lane {
 183         my ($self, $row) = @_;
 184         $self->set_laptime($row, 'PIT');
 185 }
 186
 187 sub leave_pit_lane {
 188         my ($self, $row) = @_;
 189         $self->set_laptime($row, 'GO!');
 190 }
 191
 192 sub show_semaphore {
 193         my ($self, $num) = @_;
 194
 195         my $win = $self->{semaphore_win};
 196         if (defined $num) {
 197                 my $img = $self->{semaphore_img};
 198                 my $pixbuf = $self->{semaphore_images}->[$num];
 199                 $img->set_from_pixbuf($pixbuf);
 200                 $win->show;
 201         } else {
 202                 $win->hide;
 203         }
 204 }
 205
 206 sub rounds {
 207         my ($self, $text) = @_;
 208
 209         my $label = $self->get_object("label_lap_global")
 210                 or die "Can't get label_lap_global";
 211         $label->set_markup('<span font_desc="18" weight="bold">Lap: '.$text.'</span>');
 212 }
 213
 214 sub time {
 215         my ($self, $text) = @_;
 216
 217         my $label = $self->get_object("label_time_global")
 218                 or die "Can't get label_time_global";
 219         $label->set_markup('<span font_desc="18" weight="bold">Time: '.$text.'</span>');
 220 }
 221
 222 sub best_lap {
 223         my ($self, $time, $who) = @_;
 224
 225         my $text = $time;
 226         $text .= ' by ' . $who
 227                 if defined $who;
 228
 229         my $label = $self->get_object("label_best_lap_global")
 230                 or die "Can't get label_best_lap_global";
 231         $label->set_markup('<span font_desc="18" weight="bold">Best lap: '.$text.'</span>');
 232 }
 233
 234 1;
 235