libsubtitle-perl/bin/ssa-retime

#!/usr/bin/env perl

use strict;
use warnings;
use lib 'lib';
use utf8;

use Getopt::Long;
use Subtitle::Format::SSA;
use Subtitle::TimePoint;
use Subtitle::Utils ':timing';

my @points;

sub usage {
  my ($msg) = @_;
  print $msg, "\n" if $msg;
  print <<USAGE;
Usage: ssa-retime <mode> [<options>] -i <file> [ -o <file>]

Modes are:
  * framerate       Recalculate timing for different fps
  * shift           Shift timing in given points
  * drift           Adjust timing of whole file by time points

Common options:
  -h                This help.
  -i <file>         Input file. (mandatory).
  -o <file>         Output file. Default: write to stdout.
  -v                Be verbose.

Specific options for 'framerate' mode:
  -f <float>        Source framerate. Default: 25.0 fps.
  -F <float>        Target framerate.

Specific options for 'shift' mode:
  -m <mode>         How to apply shift by points:
                    * seq -- apply timeshifts one by one to end of file (default)
                    * rst -- every next point overrides previous
  -p <time>/<time>  Point of fixup & time shift in it. Option can be
                    specified more than once. (see man for details)
                    Both args must be in form [+-][[h:]m:]s[.ms]

Specific options for 'drift' mode:
  -p <time>/<time>  Point of fixup & time shift in it. Option can be
                    specified more than once. (see man for details)
                    Both args must be in form [+-][[h:]m:]s[.ms]
USAGE
  exit 1;
}

sub add_point {
  my ($opt, $val) = @_;
  my $p = Subtitle::TimePoint->new;
  my $err = $p->parse($val);
  die "$err\n" if $err;
  push @points, $p;
  @points = sort { $a->time <=> $b->time } @points;
}

########### init ###################
$| = 1;

unless (@ARGV and $ARGV[0] =~ m{^(framerate|shift|drift)$}oi) {
  usage("You should set mode by first arg");
}
my $mode = shift @ARGV;

my %opts = ( loglevel => 0, inrate => 25.0, amode => 'seq');
GetOptions(
  'h|help'        => \&usage,
  'v|verbose+'    => \$opts{loglevel},
  'i|infile=s'    => \$opts{infile},
  'o|outfile=s'   => \$opts{outfile},

  'm|amode=s'     => \$opts{amode},

  'f|inrate=f'    => \$opts{inrate},
  'F|outrate=f'   => \$opts{outrate},

  'p|point=s'     => \&add_point,
);

if ($mode eq 'framerate') {
  $opts{outrate}
    or die "You should set '-F' option in this mode\n";
  ($opts{inrate} != 0.0 and $opts{outrate} != 0.0)
    or die "Framerate can't be zero\n";
} elsif ($mode eq 'shift') {
  scalar(@points)
    or die "You should specify at least one timepoint\n";
  ($opts{amode} eq 'seq' or $opts{amode} eq 'rst')
    or die "Value of -m option should be 'seq' or 'rst'\n";
} elsif ($mode eq 'drift') {
  scalar(@points)
    or die "You should specify at least one timepoint\n";
} else {
  usage();
}

$opts{infile}
  or die "No input file\n";

my $ssa = Subtitle::Format::SSA->new(debug => ($opts{loglevel} >= 2 ? 1 : 0));
unless ($ssa->from_file($opts{infile})) {
  foreach my $line (@{ $ssa->{log} }) {
    print $line, "\n";
  }
  exit 1;
}

if ($mode eq 'framerate') {
  my $mod = $opts{inrate} / $opts{outrate};
  foreach my $e (@{ $ssa->events }) {
    $e->t_start($e->t_start * $mod);
    $e->t_start($e->t_end   * $mod);
  }
} elsif ($mode eq 'shift') {
  if ($opts{amode} eq 'seq') {
    while (my $p = shift @points) {
      foreach my $e (@{ $ssa->events }) {
        next if $p->time > $e->t_start;
        $e->t_start($e->t_start + $p->shift);
        $e->t_end  ($e->t_end   + $p->shift);
      } # foreach @events
    } # while @points
  } elsif ($opts{amode} eq 'rst') {
    while (my $p = shift @points) {
      # use time of next point as upper limit for current
      my $end = @points ? $points[0]->time : 0;
      foreach my $e (@{ $ssa->events }) {
        next if $p->time      >  $e->t_start; # too early
        next if $end and $end <= $e->t_start; # too late
        $e->t_start($e->t_start + $p->shift);
        $e->t_end  ($e->t_end   + $p->shift);
      } # foreach @events
    } # while @points
  }
} elsif ($mode eq 'drift') {
  if ($points[0]->time >= 0.2) {
    # add starting point
    my $p = Subtitle::TimePoint->new(time => 0.0, shift => 0.0);
    unshift @points, $p;
  }
  # add endpoint, if needed
  my $maxtime = 0.0;
  foreach my $e (@{ $ssa->events }) {
    next unless $e->t_end > $maxtime;
    $maxtime = $e->t_end;
  }
  if ($maxtime > $points[-1]->time) {
    my $p = Subtitle::TimePoint->new(time => $maxtime, shift => 0.0);
    push @points, $p;
  }
  if ($opts{loglevel} >= 1) {
    # dump points list
    print "Final points list:\n";
    foreach my $p (@points) {
      printf "- %d:%02d:%02d.%03d ~ %.3f\n", make_timing($p->time), $p->shift;
    }
    print "-" x 30, "\n";
  }
  # video: 40s 47s    64s
  # |-------*---*------*---------|
  #         ^   ^      ^-- b (-3.0s)
  #         |   `--------- t ( ?.?s)
  #         `------------- a ( 0.5s)
  # ----------------------------------------------------
  # pct = (47.0 - 40.0) / (64.0 - 40.0) => 0.29 (29%)
  # abs = (0.5 ~~ -3.0)                 => -3.5
  # mod = -3.5 * 0.29                   => -1.01
  # t  += 0.5 + -1.01                   => -0.51s
  # ----------------------------------------------------
  # real retime
  $ssa->sort_events;
  foreach my $e (@{ $ssa->events }) {
    while ($points[1]->time <= $e->t_start) {
      if ($opts{loglevel} >= 2) {
        printf "move timepoints: %d:%02d:%02d.%03d (endpoint) <= %d:%02d:%02d.%03d (event)\n",
          make_timing($points[1]->time), make_timing($e->t_start);
      }
      shift @points;
    }
    my ($a, $b) = @points;
    my $pct = ($e->t_start - $a->time) / ($b->time - $a->time);
    my $abs = ($a->shift > $b->shift)
            ? ($a->shift - $b->shift)
            : ($b->shift - $a->shift);
    my $mod = ($a->shift > $b->shift)
            ? ($a->shift - $abs * $pct)
            : ($a->shift + $abs * $pct);
    $e->t_start($e->t_start + $mod);
    $e->t_end  ($e->t_end   + $mod);
    next unless $opts{loglevel} >= 2;
    printf "- %d:%02d:%02d.%03d ~ %.3f\n", make_timing($e->t_start), $mod;
  }
}

if ($opts{outfile}) {
  print $ssa->to_file($opts{outfile});
} else {
  print $ssa->to_string;
}

exit 0;