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