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
  10 use Data::Dump qw/dump/;
  11
  12 sub new {
  13         my $class = shift;
  14         my $current_slide = shift || die "need current slide coderef!";
  15         my $self = {
  16                 last_nr => -42,
  17                 current_slide => $current_slide,
  18         };
  19         bless $self, $class;
  20 }
  21
  22 sub current_slide {
  23         my $self = shift;
  24         $self->{current_slide}->( shift );
  25 }
  26
  27 sub show {
  28         my ( $self, $t ) = @_;
  29
  30         my @subtitles =
  31                 sort {
  32                         my $n_a = $1 if $a =~ m{(\d+)};
  33                         my $n_b = $1 if $b =~ m{(\d+)};
  34                         $n_a <=> $n_b || $a cmp $b
  35                 } glob("media/_editing/s/1/*")
  36         ;
  37
  38         my $slide = SDL::Surface->new( -name => $subtitles[0] );
  39         my $w = $slide->width;
  40         my $h = $slide->height;
  41
  42         my @factors = ( qw/ 4 4 4 4 1 2 2 4 4 4 4 / );
  43
  44         my ( $x, $y ) = ( 0, 0 );
  45
  46         my $background = SDL::Color->new( -r => 0x11, -g => 0x11, -b => 0x33 );
  47
  48         foreach my $i ( 0 .. $#factors ) {
  49
  50                 my $factor = $factors[$i] || die "no factor $i in ",dump @factors;
  51
  52                 my $to = SDL::Rect->new(
  53                         -width  => $w / $factor,
  54                         -height => $h / $factor,
  55                         -x      => $x,
  56                         -y      => $y,
  57                 );
  58
  59                 my $pos = $self->current_slide($t) + $i - 5;
  60
  61                 if ( $pos < 0 ) {
  62
  63                         $slide->fill( $to, $background );
  64
  65                 } else {
  66
  67                         my $path = $subtitles[ $pos ];
  68                         $path =~ s{/s/[124]/}{/s/$factor/};
  69
  70                         my $slide = SDL::Surface->new( -name => $path );
  71
  72                         my $rect = SDL::Rect->new(
  73                                 -width  => $slide->width(),
  74                                 -height => $slide->height(),
  75                                 -x      => 0,
  76                                 -y      => 0,
  77                         );
  78
  79 #                       warn "$x $y $path\n";
  80
  81                         if ( ! $self->{app} ) {
  82
  83                                 $self->{app} = SDL::App->new(
  84                                         -width  => $w,
  85                                         -height => $h * 2,
  86                                         -depth  => 24,
  87                                         -title  => 'Slides',
  88                                 );
  89
  90                         }
  91
  92                         $slide->blit( $rect, $self->{app}, $to );
  93
  94                 }
  95
  96                 $self->{app}->update( $to ) if $self->{app};
  97
  98                 $x += $w / $factor;
  99
 100                 if ( $x >= $w ) {
 101                         $x = 0;
 102                         $y += $h / $factor;
 103                 }
 104
 105         }
 106
 107         $self->{app}->sync;
 108
 109 }
 110
 111 1;