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