]> www.fi.muni.cz Git - slotcarman.git/blob - SCX/GUI.pm
More debugging.
[slotcarman.git] / 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