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         ++$row if defined $row && $row =~ /\A\d+\z/xms;
 179
 180         my $name = defined $row ? $prefix.$row : $prefix;
 181
 182         my $image = $self->get_object($name)
 183                 or croak "Can't get image named $name";
 184
 185         my $set = $self->{$imgset.'_images'};
 186         my $pixbuf = (ref($set) eq 'ARRAY')
 187                 ? $set->[$value]
 188                 : $set->{$value};
 189
 190         $image->set_from_pixbuf($pixbuf);
 191 }
 192
 193 sub set_throttle {
 194         my ($self, $row, $val) = @_;
 195
 196         $val = 13 if !defined $val;
 197         $self->set_image('image_throttle', $row, 'throttle', $val);
 198 }
 199
 200 sub set_fuel {
 201         my ($self, $row, $val) = @_;
 202
 203         $self->set_image('image_fuel', $row, 'fuel', $val || 0);
 204 }
 205
 206 sub set_car_icon {
 207         my ($self, $row, $name) = @_;
 208
 209         $self->set_image('image_car', $row, 'car', $name);
 210 }
 211
 212 sub set_lap {
 213         my ($self, $row, $text) = @_;
 214
 215         $self->set_label('label_lap', $row, $text, 'lap');
 216 }
 217
 218 sub set_laptime {
 219         my ($self, $row, $text) = @_;
 220
 221         $self->set_label('label_laptime', $row, $text);
 222 }
 223
 224 sub set_avg_lap {
 225         my ($self, $row, $text) = @_;
 226
 227         $self->set_label('label_avg_lap', $row, $text);
 228 }
 229
 230 sub set_best_lap {
 231         my ($self, $row, $text) = @_;
 232
 233         $self->set_label('label_best_lap', $row, $text);
 234 }
 235
 236 sub set_name {
 237         my ($self, $row, $text) = @_;
 238
 239         $self->set_label('label_name', $row, $text);
 240 }
 241
 242 sub enter_pit_lane {
 243         my ($self, $row) = @_;
 244         $self->set_laptime($row, 'PIT');
 245 }
 246
 247 sub leave_pit_lane {
 248         my ($self, $row) = @_;
 249         $self->set_laptime($row, 'GO!');
 250 }
 251
 252 sub show_semaphore {
 253         my ($self, $num) = @_;
 254
 255         my $win = $self->{semaphore_win};
 256         if (defined $num) {
 257                 my $img = $self->{semaphore_img};
 258                 my $pixbuf = $self->{semaphore_images}->[$num];
 259                 $img->set_from_pixbuf($pixbuf);
 260                 $win->show;
 261         } else {
 262                 $win->hide;
 263         }
 264 }
 265
 266 sub rounds {
 267         my ($self, $text) = @_;
 268
 269         $self->set_label('label_lap_global', undef, $text);
 270 }
 271
 272 sub time {
 273         my ($self, $text) = @_;
 274
 275         $self->set_label('label_time_global', undef, $text);
 276 }
 277
 278 sub best_lap {
 279         my ($self, $time, $who) = @_;
 280
 281         my $text = $time;
 282         $text .= ' by ' . $who
 283                 if defined $who;
 284         $self->set_label('label_best_lap_global', undef, $text);
 285 }
 286
 287 1;
 288