#!/usr/bin/perl -w
#
# Encode a video into a format suitable for a Nokia 770.
# (c) Andrew Flegg 2006. Released under the Artistic Licence.
#                        http://www.bleb.org/software/770/
#
# v1.36 (22-Oct-2007)
#    * Fix bug when only mp3lame available (reported by Ryan Abel)
#
# v1.35 (26-Sep-2006)
#    * Allow presets to specify a height to encode for, rather than a width.
#    * Make `mplayer' preset maximum height at 240 and increase max fps
#      (suggested by ssvb).
#
# v1.34 (21-Sep-2006)
#    * Win32 Perl can have weird effects, try to avoid.
#
# v1.33 (21-Aug-2006)
#    * Add "mplayer" preset for https://garage.maemo.org/projects/mplayer/
#    * Fix broken support for Windows (duh)
#
# v1.32 (30-Jul-2006)
#    * Add new maximum frame rate, and allow presets to override.
#    * Change "best" for maximum framerate.
#    * Add support for ActiveState's Perl.
#
# v1.31 (05-Jul-2006)
#    * Fix bug which resulted in incorrect resolution on very wide
#      sources (e.g. 2.35:1 films)
#
# v1.30 (26-May-2006)
#    * Add support for anamorphic data sources (e.g. DVDs)
#    * Add ability to pass through options to mencoder, for example:
#           770-encode -m-aid -m128 dvd://4 mydvd.avi
#
# v1.21 (19-May-2006)
#    * Add volume normalisation flag (suggested by Neil Jerram)
# 
# v1.20 (15-May-2006)
#    * Fix bug with rounding when optimising wider inputs
#    * Add two presets ("average" and "good"), with thanks to varis
#    * Add "--sample" option (suggested by varis)
#
# v1.11 (12-May-2006)
#    * Enhance "smallest" to better fit 770 screen
#    * Add "small" preset
#    * Fix cropping which just didn't work in some instances
#
# v1.10 (07-May-2006)
#    * More intelligent cropping.
#    * Fall back to lavc MP3 encoder if mp3lame not present
#    * Die if lavc isn't present
#    * Suppress "Skipping frame!" messages from mencoder
#
# v1.05 (03-May-2006)
#    * Make handle FLV files' dodgy framerate
#
# v1.00 (08-Apr-2006)
#    * Initial version: first 770-based media encoder aimed to:
#         a) Guarantee playable video
#         b) Use presets
#         c) Provide "optimised video"

use strict;
use warnings;
use Getopt::Long;

use vars qw(%PRESET);

%PRESET = (
    smallest => { abitrate => 32, vbitrate => 80, width => 240 },
    small    => { abitrate => 96, vbitrate => 96, width => 240 },
    average  => { abitrate => 96, vbitrate => 200, width => 320 },
    good     => { abitrate => 128, vbitrate => 240, width => 320 },
    best     => { abitrate => 128, vbitrate => 400, width => 352, fps => 25 },
    mplayer  => { abitrate => 128, vbitrate => 420, width => 400, height => 240, fps => 30 },
);

my %options = ();
Getopt::Long::Configure("bundling");
GetOptions(\%options, "help|?",
                      "preset|p=s",
                      "original-aspect|o",
                      "two-pass|2",
                      "sample|s",
                      "experimental|x",
                      "mencoder|m=s@",
                      "quiet|q",
);
$options{"preset"} ||= 'smallest';

die <<EOM if ($options{"help"} or not @ARGV == 2) and not $options{"preset"} eq 'list';
770-encode [options] <input> <output>    (c) Andrew Flegg 2006.
~~~~~~~                               Released under the Artistic Licence
Options:
    -h, --help               This message
    -q, --quiet              Be vewwy vewwy quiet
    -p, --preset=PRESET      Preset to use. Use --preset=list to see them all.
    -s, --sample             Produce a 30 second sample encoding
    -o, --original-aspect    Disable cropping image to better fit 770
    -2, --two-pass           Encode in two passes for better quality
    -x, --experimental       Fiddle with some mencoder options
    -m, --mencoder=ARGn      Pass through ARGn to mencoder. Can occur multiple times.

Please report bugs to <andrew\@bleb.org>. Thanks.

EOM

die "Available presets:\n  ", join("\n  ", keys(%PRESET))."\n" if $options{"preset"} eq 'list';

my $twoPass   = defined($options{"two-pass"});
my $preset    = $PRESET{$options{"preset"}} or die "Unknown preset.\n";
my $maxFps    = $preset->{fps} || 15;
my $optimise  = 1 unless defined($options{"original-aspect"});
my @cropLimit = (0.15, 0.2);

my $idealRatio = 800/480; # i.e. 15/9

my ($inFile, $outFile) = @ARGV[0..1] or die "syntax: $0 <file> <output>";

die "mplayer doesn't support lavc encoder\n" unless (&mencoderSupports('oac')->{'lavc'} || &mencoderSupports('oac')->{'mp3lame'}) && &mencoderSupports('ovc')->{'lavc'};

# -- Now build up the command line...
#
my @params = ( $inFile, '-o', $outFile, '-srate', 44100 );

# -- Downmix to mono if low audio rate...
#
my $af = 'volnorm';
if ($preset->{abitrate} < 64) {
  push @params, '-channels', 1;
  $af .= ',channels=1';
}

# -- Audio/video encoding...
#
if (&mencoderSupports('oac')->{'mp3lame'}) {
  push @params, '-oac', 'mp3lame',
                '-lameopts', 'vbr=0:br='.$preset->{abitrate}.
                ($preset->{abitrate} < 64 ? ':mode=3' : '');
} else {
  push @params, '-oac', 'lavc', '-lavcopts', 'acodec=mp3:abitrate='.$preset->{abitrate};
}
push @params, '-af', $af;

push @params, '-ovc', 'lavc',
              '-lavcopts', 'vcodec=mpeg4:vbitrate='.$preset->{vbitrate};
$params[-1] .= ':tcplx_mask=0.1:scplx_mask=0.1:mbd=1' if defined($options{"experimental"});
              
              
my $info = &movieInfo($inFile) or die "Failed to get movie info.\n";

# -- Handle anamorphic DVDs...
#
my $anamorphic = 1;
if ($info->{aspect} == 2) {
  $anamorphic = 4/3;
} elsif ($info->{aspect} == 3) {
  $anamorphic = 16/9;
} elsif ($info->{aspect} == 4) {
  $anamorphic = 2.11;
}

$info->{width} *= $info->{height} * $anamorphic / $info->{width} if $anamorphic != 1;

# -- Optimise for target screen...
#
my $aspect = $info->{width} / $info->{height};
my $scale  = $preset->{width} / $info->{width};
$scale = $preset->{height} / $info->{height} if ($aspect < $idealRatio) and $preset->{height};

my ($w, $h) = (&nearest($info->{width} * $scale, 16),
               &nearest($info->{height} * $scale, 16));
if ($optimise) {
  my ($cropWidth, $cropHeight);
  my $ratio  = abs($aspect - $idealRatio) / $aspect;
  if ($aspect > $idealRatio) {
    # Too wide...
    print "Width needs trimming by $ratio from $w x $h\n";
    $ratio = $cropLimit[0] if $ratio > $cropLimit[0];
     
    my $resultRatio  = $info->{width} * (1 - $ratio) / $info->{height};
    my $targetHeight = &nearest( $preset->{width} / $resultRatio, 16 );
    my $scale   = $targetHeight / $info->{height};
    ($w, $h) = (&nearest($info->{width} * (1 - $ratio) * $scale, 16), $targetHeight);
      
    ($cropWidth, $cropHeight) = (int($w / $scale), int($h / $scale));
      
  } elsif (($aspect < $idealRatio) and $preset->{height}) {
    # Too tall, but we've got a maximum height...
    print "Height needs trimming by $ratio from $w x $h to ".$preset->{height}."\n";
    $ratio = $cropLimit[1] if $ratio > $cropLimit[1];

    my $resultRatio  = $info->{width} / ($info->{height} * (1 - $ratio));
    my $targetWidth = &nearest( $preset->{height} * $resultRatio, 16 );
    my $scale   = $targetWidth / $info->{width};
    ($w, $h) = ($targetWidth, &nearest($info->{height} * (1 - $ratio) * $scale, 16));
      
    ($cropWidth, $cropHeight) = (int($w / $scale), int($h / $scale));
    
  } elsif ($aspect < $idealRatio) {
    # Too tall...
    print "Height needs trimming by $ratio from $w x $h\n";
    $ratio = $cropLimit[1] if $ratio > $cropLimit[1];
    ($w, $h) = (&nearest($info->{width} * $scale, 16), &nearest($info->{height} * $scale, 16));
    
    $h = &nearest($h * (1 - $ratio), 16);
    ($cropWidth, $cropHeight) = (int($w / $scale), int($h / $scale));
  }
  
  push @params, '-vf-add', "crop=$cropWidth:$cropHeight" if $cropWidth and $cropHeight;
}

push @params, '-vf-add', "scale=$w:$h";

# -- Work out the framerate...
#
my $ofps   = $info->{framerate};
$ofps /= 2 while $ofps > $maxFps;
push @params, '-ofps', $ofps;

# -- Miscellaneous options...
#
push @params, '-ffourcc', 'DIVX', '-noidx';
push @params, '-force-avi-aspect', $w/$h;
push @params, '-quiet' if $options{"quiet"};
push @params, '-endpos', '30' if $options{"sample"};
push @params, @{ $options{"mencoder"} } if $options{"mencoder"};

# -- Execute it...
#
print "Invoking mencoder ".join(" ", @params)."...\n";
close(STDERR);
if ($twoPass) {
  my @localParams = map { /^vcodec=/ ? "$_:vpass=1:turbo" : $_ } @params;
  system('mencoder', @localParams);
  print "Pass 1 complete.\n";

  @localParams = map { /^vcodec=/ ? "$_:vpass=2" : $_ } @params;
  exec('mencoder', @localParams);
  
  die "Not yet implemented, sorry. Will be trivial...";
} else {
  exec('mencoder', @params);
}
exit;


# -- Round to the nearest modulo --------------------------------------
#
sub nearest() {
  my ($num, $multiple) = @_;
  
  return int(0.5 + $num / $multiple) * $multiple;
}


# -- Get movie info ---------------------------------------------------
#
sub movieInfo() {
  my ($file) = @_;

  if ($^O eq 'MSWin32') {
    $_ = `mencoder $file -endpos 0 -oac copy -ovc copy -o nul: 2>&1`;
  } else {
    $_ = `mencoder \Q$file\E -endpos 0 -oac copy -ovc copy -o /dev/null 2>&1`;
  }
  
  if ($@) {
    warn "Failed to get movie info: $@\n";
    return undef;
  }
  
  my %info = ( file => $file );
  
  ($info{format}, 
   $info{width}, $info{height},
   $info{framerate},
   $info{vbitrate},
  ) = m{^VIDEO:\s*
               \[?(\w+)\]?.*?
               (\d+)x(\d+).*?
               ([\d\.]+)\s*fps.*?
               ([\d\.]+)\s*kbps
  }mx or return undef;
  
  $info{aspect}   = $1 if /^VIDEO:.*?\(aspect\s+(\d+)\)/m;
  $info{aspect} ||= 1;
  
  # If it's a Flash Video with a dodgy framerate, guess (badly)...
  $info{framerate} = 28 if $info{format} =~ /^FLV/ and $info{framerate} >= 1000;
  
  #use Data::Dumper; print Dumper(\%info);
  return \%info;
}


# -- Return a hash of mencoder encoders ------------------------------=
#
sub mencoderSupports {
  my ($type) = @_;
  
  my $list = `mencoder -\Q$type\E help 2>&1`;
  my %data = $list =~ /^   (\w+)\s*-\s*(.*)$/mg;
  return \%data;
}