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 our $BASE_SIZE;
  13
  14 sub new {
  15         my ($class, $args) = @_;
  16
  17         my $self = {
  18                 img_height => $args->{img_height} || 100,
  19                 builder => Gtk2::Builder->new,
  20                 semaphore_win => Gtk2::Window->new('popup'),
  21                 semaphore_img => Gtk2::Image->new,
  22         };
  23
  24         bless $self, $class;
  25
  26         $self->{builder}->add_from_file('slotcarman.glade');
  27
  28         $self->{builder}->connect_signals(undef);
  29         $self->load_all_images;
  30         $self->set_font_sizes;
  31
  32         my $pixbuf = $self->{semaphore_images}->[0];
  33         $self->{semaphore_img}->set_from_pixbuf($pixbuf);
  34         $self->{semaphore_img}->show;
  35         $self->{semaphore_win}->add($self->{semaphore_img});
  36         $self->{semaphore_win}->set_type_hint('splashscreen');
  37         $self->{semaphore_win}->set_position('center-on-parent');
  38         $self->{semaphore_win}->set_transient_for(
  39                 $self->get_object('slotcarman')
  40         );
  41
  42         $self->get_object('image_car1')->signal_connect(
  43                 'size_allocate' => \&watch_resize,
  44                 $self,
  45         );
  46
  47         return $self;
  48 }
  49
  50 sub show {
  51         my ($self) = @_;
  52
  53         my $window = $self->{builder}->get_object('slotcarman');
  54         $window->signal_connect(delete_event => \&delete_event);
  55         $window->show();
  56 }
  57
  58 sub delete_event { Gtk2->main_quit; }
  59
  60 sub quit { Gtk2->main_quit; }
  61
  62 sub fullscreen {
  63         my ($self) = @_;
  64
  65         $self->get_object('slotcarman')->fullscreen;
  66         my $h = $self->get_object('image_car1')->allocation->height;
  67         print "h=$h\n";
  68 }
  69
  70 sub watch_resize {
  71         my ($window, $rectangle, $self) = @_;
  72         print "w=", $rectangle->width, ", h=", $rectangle->height, "\n";
  73         # TODO
  74 }
  75
  76 sub get_object { return shift->{builder}->get_object(@_); }
  77
  78 sub set_font_sizes {
  79         my ($self) = @_;
  80
  81         if ($self->{img_height} <= 80) {
  82                 $self->{label_font} = 10;
  83                 $self->{value_font} = 18;
  84                 $self->{lap_font} = 24;
  85         } elsif ($self->{img_height} <= 100) {
  86                 $self->{label_font} = 12;
  87                 $self->{value_font} = 20;
  88                 $self->{lap_font} = 28;
  89         } elsif ($self->{img_height} <= 120) {
  90                 $self->{label_font} = 14;
  91                 $self->{value_font} = 24;
  92                 $self->{lap_font} = 32;
  93         } elsif ($self->{img_height} <= 150) {
  94                 $self->{label_font} = 16;
  95                 $self->{value_font} = 28;
  96                 $self->{lap_font} = 36;
  97         } else {
  98                 $self->{label_font} = 18;
  99                 $self->{value_font} = 32;
 100                 $self->{lap_font} = 40;
 101         }
 102 }
 103
 104 sub load_all_images {
 105         my ($self) = @_;
 106
 107         my $h = $self->{img_height};
 108
 109         $self->{throttle_images} = [
 110                 load_image_set('img/throttle%d.svg', 13, $h)
 111         ];
 112         $self->{fuel_images} = [
 113                         load_image_set('img/fuel%d.svg', 8, int(0.6 * $h))
 114         ];
 115         $self->{car_images} = load_image_dir('img/SCXCars', $h),
 116         $self->{semaphore_images} => [
 117                         load_image_set('img/semaphore%d.svg', 5, 2 * $h)
 118         ];
 119 };
 120
 121 sub load_image_set {
 122         my ($pattern, $limit, $height) = @_;
 123
 124         my @rv;
 125         for my $i (0..$limit) {
 126                 my $file = sprintf($pattern, $i);
 127
 128                 my $dummy = Gtk2::Gdk::Pixbuf->new_from_file($file);
 129                 my $width = $dummy->get_width * $height / $dummy->get_height;
 130                 push @rv, Gtk2::Gdk::Pixbuf->new_from_file_at_scale(
 131                         $file, $width, $height, TRUE
 132                 );
 133         }
 134         return @rv;
 135 }
 136
 137 sub load_image_dir {
 138         my ($dir, $height) = @_;
 139
 140         my %rv;
 141         for my $file (<$dir/*>) {
 142                 $file = Encode::decode('utf-8', $file);
 143                 my $name = $file;
 144                 $name =~ s/.*\///;
 145                 $name =~ s/\..*?$//;
 146                 $name =~ s/[-_]/ /g;
 147                 $name =~ s/\s+/ /g;
 148
 149
 150                 my $dummy = Gtk2::Gdk::Pixbuf->new_from_file($file)
 151                         or next;
 152
 153                 my $width = $dummy->get_width * $height / $dummy->get_height;
 154                 $rv{$name} = Gtk2::Gdk::Pixbuf->new_from_file_at_scale(
 155                         $file, $width, $height, TRUE
 156                 );
 157         }
 158         return \%rv;
 159 }
 160
 161 sub set_throttle {
 162         my ($self, $row, $val) = @_;
 163
 164         $row++;
 165         $val = 13 if !defined $val;
 166
 167         my $image = $self->get_object("image_throttle$row");
 168         $image->set_from_pixbuf($self->{throttle_images}->[$val]);
 169 }
 170
 171 sub set_fuel {
 172         my ($self, $row, $val) = @_;
 173
 174         $row++;
 175         $val = 0 if !defined $val;
 176
 177         my $image = $self->get_object("image_fuel$row");
 178         $image->set_from_pixbuf($self->{fuel_images}->[$val]);
 179 }
 180
 181 sub set_car_icon {
 182         my ($self, $row, $name) = @_;
 183
 184         $row++;
 185         my $pixbuf = $self->{car_images}->{$name};
 186         if (!$pixbuf) {
 187                 print "No car image for $name.\n";
 188                 return;
 189         }
 190
 191         my $image = $self->get_object("image_car$row");
 192         $image->set_from_pixbuf($pixbuf);
 193 }
 194
 195 sub set_lap {
 196         my ($self, $row, $text) = @_;
 197
 198         ++$row;
 199         my $label = $self->get_object("label_lap$row")
 200                 or die "Can't get label_lap$row";
 201         $label->set_markup('<span font_desc="24" weight="bold">'.$text.'</span>');
 202 }
 203
 204 sub set_laptime {
 205         my ($self, $row, $text) = @_;
 206
 207         ++$row;
 208         my $label = $self->get_object("label_laptime$row")
 209                 or die "Can't get label_laptime$row";
 210         $label->set_markup('<span font_desc="18" weight="bold">'.$text.'</span>');
 211 }
 212
 213 sub set_avg_lap {
 214         my ($self, $row, $text) = @_;
 215
 216         ++$row;
 217         my $label = $self->get_object("label_avg_lap$row")
 218                 or die "Can't get label_avg_lap$row";
 219         $label->set_markup('<span font_desc="22" weight="bold">'.$text.'</span>');
 220 }
 221
 222 sub set_best_lap {
 223         my ($self, $row, $text, $global) = @_;
 224
 225         ++$row;
 226         my $label = $self->get_object("label_best_lap$row")
 227                 or die "Can't get label_best_lap$row";
 228
 229         if ($global) {
 230                 $global = ' foreground="#e00000"';
 231         } else {
 232                 $global = '';
 233         }
 234
 235         $label->set_markup('<span font_desc="18" weight="bold"'.$global.'>'
 236                 .$text.'</span>');
 237 }
 238
 239 sub set_driver {
 240         my ($self, $row, $text) = @_;
 241
 242         ++$row;
 243         my $label = $self->get_object("label_name$row")
 244                 or die "Can't get label_lap$row";
 245         $label->set_markup('<span font_desc="18" weight="bold">'.$text.'</span>');
 246 }
 247
 248 sub enter_pit_lane {
 249         my ($self, $row) = @_;
 250         $self->set_laptime($row, 'PIT');
 251 }
 252
 253 sub leave_pit_lane {
 254         my ($self, $row) = @_;
 255         $self->set_laptime($row, 'GO!');
 256 }
 257
 258 sub show_semaphore {
 259         my ($self, $num) = @_;
 260
 261         my $win = $self->{semaphore_win};
 262         if (defined $num) {
 263                 my $img = $self->{semaphore_img};
 264                 my $pixbuf = $self->{semaphore_images}->[$num];
 265                 $img->set_from_pixbuf($pixbuf);
 266                 $win->show;
 267         } else {
 268                 $win->hide;
 269         }
 270 }
 271
 272 sub rounds {
 273         my ($self, $text) = @_;
 274
 275         my $label = $self->get_object("label_lap_global")
 276                 or die "Can't get label_lap_global";
 277         $label->set_markup('<span font_desc="18" weight="bold">'.$text.'</span>');
 278 }
 279
 280 sub time {
 281         my ($self, $text) = @_;
 282
 283         my $label = $self->get_object("label_time_global")
 284                 or die "Can't get label_time_global";
 285         $label->set_markup('<span font_desc="18" weight="bold">'.$text.'</span>');
 286 }
 287
 288 sub best_lap {
 289         my ($self, $time, $who) = @_;
 290
 291         my $text = $time;
 292         $text .= ' by ' . $who
 293                 if defined $who;
 294
 295         my $label = $self->get_object("label_best_lap_global")
 296                 or die "Can't get label_best_lap_global";
 297         $label->set_markup('<span font_desc="18" weight="bold">'.$text.'</span>');
 298 }
 299
 300 1;
 301