lib/HTML5TV/Slides.pm

   1 package HTML5TV::Slides;
   2
   3 use warnings;
   4 use strict;
   5
   6 use SDL::App;
   7 use SDL::Surface;
   8 use SDL::Rect;
   9 use SDL::Tool::Font;
  10
  11 use Data::Dump qw/dump/;
  12
  13 sub new {
  14         my $class = shift;
  15         my $current_slide = shift || die "need current slide coderef!";
  16         my $self = {
  17                 last_slide => 0,
  18                 last_t => 0,
  19                 current_slide => $current_slide,
  20                 width  => 0,
  21                 height => 0,
  22         };
  23         bless $self, $class;
  24 }
  25
  26 sub current_slide {
  27         my $self = shift;
  28         $self->{current_slide}->( shift );
  29 }
  30
  31 sub progress_bar;
  32
  33 sub show {
  34         my $self = shift;
  35         my $t = shift;
  36         my $length = shift;
  37         my @subtitles = @_;
  38
  39         my $current_slide = $self->current_slide($t);
  40
  41         my $dt = $t - $self->{last_t};
  42
  43         if ( $self->{last_slide} == $current_slide ) {
  44                 if ( $dt > 1 ) {
  45                         $self->{last_t} = $t;
  46                         $self->progress_bar( $t, $length, @subtitles );
  47                         return;
  48                 }
  49                 return;
  50         }
  51
  52         $self->{last_slide} = $current_slide;
  53         warn "slide change $current_slide\n";
  54
  55         my @slide_paths =
  56                 sort {
  57                         my $n_a = $1 if $a =~ m{(\d+)};
  58                         my $n_b = $1 if $b =~ m{(\d+)};
  59                         $n_a <=> $n_b || $a cmp $b
  60                 } glob("media/_editing/s/1/*")
  61         ;
  62
  63         if ( ! $self->{width} || ! $self->{height} ) {
  64                 my $slide = SDL::Surface->new( -name => $slide_paths[0] );
  65                 $self->{width}  = $slide->width;
  66                 $self->{height} = $slide->height;
  67         }
  68
  69         my @factors = ( qw/ 4 4 4 4 1 2 2 4 4 4 4 / );
  70
  71         my ( $x, $y ) = ( 0, 0 );
  72
  73         my $background = SDL::Color->new( -r => 0, -g => 0, -b => 0 );
  74         my $overlay_color = SDL::Color->new( -r => 0xff, -g => 0xff, -b => 0x88 );
  75
  76         foreach my $i ( 0 .. $#factors ) {
  77
  78                 my $factor = $factors[$i] || die "no factor $i in ",dump @factors;
  79
  80                 my $to = SDL::Rect->new(
  81                         -width  => $self->{width}  / $factor,
  82                         -height => $self->{height} / $factor,
  83                         -x      => $x,
  84                         -y      => $y,
  85                 );
  86
  87                 my $pos = $self->current_slide($t) + $i - 5;
  88                 my $path = $slide_paths[ $pos ];
  89
  90                 if ( $pos < 0 || ! $path ) {
  91
  92                         $self->{app}->fill( $to, $background ) if $self->{app};
  93
  94                 } else {
  95
  96                         $path =~ s{/s/[124]/(\D*(\d+))}{/s/$factor/$1};
  97                         my $nr = $2;
  98
  99                         my $slide = SDL::Surface->new( -name => $path );
 100
 101                         my $subtitle_text = $nr;
 102                         foreach my $s ( @subtitles ) {
 103                                 if ( $s->[2] =~ m/\[(\d+)\]/ && $1 == $nr ) {
 104                                         $subtitle_text = $s->[2];
 105                                         last;
 106                                 }
 107                         }
 108
 109                         my $font = SDL::Tool::Font->new(
 110                                 -normal => 1,
 111                                 -ttfont => 'media/slides.ttf', # FIXME
 112                                 -size => 40 / $factor,
 113                                 -fg => $background,
 114                                 -bg => $background,
 115                         );
 116                         $font->print( $slide, 4, 4, $subtitle_text );
 117                         $font->print( $slide, 4, 6, $subtitle_text );
 118                         $font->print( $slide, 6, 4, $subtitle_text );
 119                         $font->print( $slide, 6, 6, $subtitle_text );
 120                         $font->print( $slide, 5, 5, $subtitle_text );
 121
 122                         SDL::Tool::Font->new(
 123                                 -normal => 1,
 124                                 -ttfont => 'media/slides.ttf', # FIXME
 125                                 -size => 40 / $factor,
 126                                 -fg => $overlay_color,
 127                                 -bg => $background,
 128                         )->print( $slide, 5, 5, $subtitle_text );
 129
 130                         my $rect = SDL::Rect->new(
 131                                 -width  => $slide->width(),
 132                                 -height => $slide->height(),
 133                                 -x      => 0,
 134                                 -y      => 0,
 135                         );
 136
 137 #                       warn "$x $y $path\n";
 138
 139                         if ( ! $self->{app} ) {
 140
 141                                 $self->{app} = SDL::App->new(
 142                                         -width  => $self->{width},
 143                                         -height => ( $self->{height} * 2 ) + 20,
 144                                         -depth  => 24,
 145                                         -title  => 'Slides',
 146                                 );
 147
 148                         }
 149
 150                         $slide->blit( $rect, $self->{app}, $to );
 151
 152                 }
 153
 154                 $self->{app}->update( $to ) if $self->{app};
 155
 156                 $x += $self->{width} / $factor;
 157
 158                 if ( $x >= $self->{width} ) {
 159                         $x = 0;
 160                         $y += $self->{height} / $factor;
 161                         $y += 5;
 162                 }
 163
 164         }
 165
 166         $self->progress_bar( $t, $length, @subtitles );
 167 }
 168
 169 sub progress_bar {
 170         my $self = shift;
 171
 172         my $t = shift;
 173         my $length = shift;
 174         my @subtitles = @_;
 175
 176         return unless $self->{app};
 177
 178
 179                 my $w_1s = $self->{width} / $length;
 180
 181                 my $bar_h = 3;
 182                 my $y_bar = int( $self->{height} / 4 ) + 1;
 183
 184                 my $bar_back = SDL::Color->new( -r => 0, -g => 0, -b => 0 );
 185                 my $rect = SDL::Rect->new(
 186                         -width  => $self->{width},
 187                         -height => $bar_h,
 188                         -x      => 0,
 189                         -y      => $y_bar,
 190                 );
 191
 192                 $self->{app}->fill( $rect, $bar_back );
 193 #               $self->{app}->update( $rect );
 194
 195                 my $col_slide    = SDL::Color->new( -r => 0xcc, -g => 0xcc, -b => 0x00 );
 196                 my $col_subtitle = SDL::Color->new( -r => 0xcc, -g => 0x00, -b => 0x00 );
 197                 my $col_pos      = SDL::Color->new( -r => 0xff, -g => 0xff, -b => 0xff );
 198
 199
 200                 foreach my $s ( @subtitles ) {
 201
 202                         next unless defined $s->[0];
 203
 204                         my $s_x = int( $s->[0] * $w_1s + 0.9 );
 205                         my $s_w = int( abs( $s->[1] - $s->[0] ) * $w_1s );
 206                         $s_w = 1 if $s_w < 1;
 207
 208 #                       warn "$s_x $s_w ", $s->[2];
 209
 210                         my $rect = SDL::Rect->new(
 211                                 -width => $s_w,
 212                                 -height => $bar_h,
 213                                 -x => $s_x,
 214                                 -y => $y_bar,
 215                         );
 216                         $self->{app}->fill( $rect, $s->[2] =~ m/\[\d+\]/ ? $col_slide : $col_subtitle );
 217 #                       $self->{app}->update( $rect );
 218                 }
 219
 220                 my $rect_pos = SDL::Rect->new(
 221                         -width => $bar_h,
 222                         -height => $bar_h,
 223                         -x => int( $t * $w_1s - $bar_h / 2 ),
 224                         -y => $y_bar,
 225                 );
 226                 $self->{app}->fill( $rect_pos, $col_pos );
 227 #               $self->{app}->update( $rect );
 228
 229                 $self->{app}->sync;
 230
 231 }
 232
 233 1;