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, 100)
  23                 ],
  24                 car_images => load_image_dir('img/SCXCars', 100),
  25                 builder => Gtk2::Builder->new,
  26         };
  27
  28         bless $self, $class;
  29
  30         $self->{builder}->add_from_file('slotcarman.glade');
  31
  32         $self->{builder}->connect_signals(undef);
  33
  34         return $self;
  35 }
  36
  37 sub show {
  38         my ($self) = @_;
  39
  40         my $window = $self->{builder}->get_object('slotcarman');
  41         $window->show();
  42 }
  43
  44 sub get_object { return shift->{builder}->get_object(@_); }
  45
  46 sub load_image_set {
  47         my ($pattern, $limit, $height) = @_;
  48
  49         my @rv;
  50         for my $i (0..$limit) {
  51                 my $file = sprintf($pattern, $i);
  52
  53                 my $dummy = Gtk2::Gdk::Pixbuf->new_from_file($file);
  54                 my $width = $dummy->get_width * $height / $dummy->get_height;
  55                 push @rv, Gtk2::Gdk::Pixbuf->new_from_file_at_scale(
  56                         $file, $width, $height, TRUE
  57                 );
  58         }
  59         return @rv;
  60 }
  61
  62 sub load_image_dir {
  63         my ($dir, $height) = @_;
  64
  65         my %rv;
  66         for my $file (<$dir/*>) {
  67                 $file = Encode::decode('utf-8', $file);
  68                 my $name = $file;
  69                 $name =~ s/.*\///;
  70                 $name =~ s/\..*?$//;
  71                 $name =~ s/[-_]/ /g;
  72                 $name =~ s/\s+/ /g;
  73
  74
  75                 my $dummy = Gtk2::Gdk::Pixbuf->new_from_file($file)
  76                         or next;
  77
  78                 my $width = $dummy->get_width * $height / $dummy->get_height;
  79                 $rv{$name} = Gtk2::Gdk::Pixbuf->new_from_file_at_scale(
  80                         $file, $width, $height, TRUE
  81                 );
  82         }
  83         return \%rv;
  84 }
  85
  86 sub set_throttle {
  87         my ($self, $row, $val) = @_;
  88
  89         $row++;
  90         $val = 13 if !defined $val;
  91
  92         my $image = $self->get_object("image_throttle$row");
  93         $image->set_from_pixbuf($self->{throttle_images}->[$val]);
  94 }
  95
  96 sub set_fuel {
  97         my ($self, $row, $val) = @_;
  98
  99         $row++;
 100         $val = 0 if !defined $val;
 101
 102         my $image = $self->get_object("image_fuel$row");
 103         $image->set_from_pixbuf($self->{fuel_images}->[$val]);
 104 }
 105
 106 sub set_car_icon {
 107         my ($self, $row, $name) = @_;
 108
 109         $row++;
 110         my $pixbuf = $self->{car_images}->{$name};
 111         if (!$pixbuf) {
 112                 print "No car image for $name.\n";
 113                 return;
 114         }
 115
 116         my $image = $self->get_object("image_car$row");
 117         $image->set_from_pixbuf($pixbuf);
 118 }
 119
 120 sub set_lap {
 121         my ($self, $row, $text) = @_;
 122
 123         ++$row;
 124         my $label = $self->get_object("label_lap$row")
 125                 or die "Can't get label_lap$row";
 126         $label->set_markup('<span font_desc="24" weight="bold">'.$text.'</span>');
 127 }
 128
 129 sub set_laptime {
 130         my ($self, $row, $text) = @_;
 131
 132         ++$row;
 133         my $label = $self->get_object("label_laptime$row")
 134                 or die "Can't get label_laptime$row";
 135         $label->set_markup('<span font_desc="18" weight="bold">'.$text.'</span>');
 136 }
 137
 138 sub set_best_lap {
 139         my ($self, $row, $text) = @_;
 140
 141         ++$row;
 142         my $label = $self->get_object("label_best_lap$row")
 143                 or die "Can't get label_best_lap$row";
 144         $label->set_markup('<span font_desc="18" weight="bold">'.$text.'</span>');
 145 }
 146
 147 sub set_driver {
 148         my ($self, $row, $text) = @_;
 149
 150         ++$row;
 151         my $label = $self->get_object("label_name$row")
 152                 or die "Can't get label_lap$row";
 153         $label->set_markup('<span font_desc="18" weight="bold">'.$text.'</span>');
 154 }
 155
 156 sub enter_pit_lane {
 157         my ($self, $row) = @_;
 158         $self->set_laptime($row, 'PIT');
 159 }
 160
 161 sub leave_pit_lane {
 162         my ($self, $row) = @_;
 163         $self->set_laptime($row, '--');
 164 }
 165
 166 1;
 167