SCX/GUI.pm

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