#!/usr/bin/perl -w

if($#ARGV!=0) {
  print "Usage: perl dvdprep_subs.pl <dir>\n";
  exit;
}
my $sourcedir=$ARGV[0];
my $destdir=$sourcedir . "_dvdprep";
my $framewidth;
my $frameheight;

if($^O eq "MSWin32") {
  @filelist=glob("\"$sourcedir\\\*.xml\"");
} else {
  @filelist=glob("\"$sourcedir/\*.xml\"");
}
my $listsize=@filelist;
if($listsize==0) {
  print "Error: No XML files found in $sourcedir\n";
  exit;
}

mkdir $destdir;

FILELOOP: for $sourcefile (@filelist) {
  my $graphic=0;
  my $x=0;
  my $y=0;
  my $height=0;
  my $width=0;
  my $sub_image="";
  my $token1="";
  my $token2="";
  my @arr;
  if($^O eq "MSWin32") {
    @arr=split(/\\/,$sourcefile);
  } else {
    @arr=split(/\//,$sourcefile);
  }
  my $fname=$arr[-1];
  print "Processing ".$fname."...\n";
  open(OLDXML, "<".$sourcefile);
  my $subframe="";
  if($^O eq "MSWin32") {
    open(NEWXML, '>' . $destdir . '\\' . $fname);
    $subframe=$destdir."\\_tmp_subframe.png";
  } else {
    open(NEWXML, '>' . $destdir . '/' . $fname);
    $subframe=$destdir."/_tmp_subframe.png";
  }
  foreach my $line (<OLDXML>) {
    if (index($line, '<Language Code') != -1) {
      @arr=split(/"/,$line);
      my $xml_lang=$arr[1];
      @arr=split(/-/,$fname);
      my $actual_lang=$arr[1];
      $token1="=\"".$xml_lang."\"";
      $token2="=\"".$actual_lang."\"";
      $line=~s/$token1/$token2/;
    }
    if (index($line, '<Graphic') != -1) {
      $graphic=1;
    }
    if($graphic==1) {
      if (index($line, "X=") != -1) {
        @arr=split(/X="/,$line);
        $x=$arr[1];
        @arr=split(/"/,$x);
        $x=$arr[0];
        $token1="X=\"".$x;
        $token2="X=\"0";
        $line=~s/$token1/$token2/;
      }
      if (index($line, "Y=") != -1) {
        @arr=split(/Y="/,$line);
        $y=$arr[1];
        @arr=split(/"/,$y);
        $y=$arr[0];
        $token1="Y=\"".$y;
        $token2="Y=\"0";
        $line=~s/$token1/$token2/;
      }
      if (index($line, "Height=") != -1) {
        @arr=split(/Height="/,$line);
        $height=$arr[1];
        @arr=split(/"/,$height);
        $height=$arr[0];
        $token1="Height=\"".$height;
        $token2="Height=\"".$frameheight;
        $line=~s/$token1/$token2/;
      }
      if (index($line, "Width=") != -1) {
        @arr=split(/Width="/,$line);
        $width=$arr[1];
        @arr=split(/"/,$width);
        $width=$arr[0];
        $token1="Width=\"".$width;
        $token2="Width=\"".$framewidth;
        $line=~s/$token1/$token2/;
      }
      if (index($line, ".png") != -1) {
        my $newy=$y;
        @arr=split(/>/,$line);
        $sub_image=$arr[1];
        @arr=split(/</,$sub_image);
        $sub_image=$arr[0];
# here, we define the number of pixels to shift subs UP on NTSC (_top is above centerline, _bottom is below)
# this helps subtitle lines to be either fully in or out of the frame when in 4:3 letterbox mode
# these values are optimized for DVD downscales of the despecialized editions and may be slightly off (but probably not noticeably) for other preservations
        my $yadjust_top=6;
        my $yadjust_bottom=-4;
# subtitles in these languages are a little larger, so they need different adjustment values
        if(index($sub_image,"-ara-")!=-1 || index($sub_image,"-fas-")!=-1) {
          $yadjust_top=18;
          $yadjust_bottom=-10;
        }
        if(index($sub_image,"-tha-")!=-1) {
          $yadjust_top=18;
          $yadjust_bottom=-14;
        }
        if(index($sub_image,"-hin-")!=-1) {
          $yadjust_top=18;
          $yadjust_bottom=-10;
        }
        if($frameheight!=480) {
          $yadjust_top=int($yadjust_top*$frameheight/480);
          $yadjust_bottom=int($yadjust_bottom*$frameheight/480);
        }
        if(!(-e $subframe)) {
          system("convert -size ".$framewidth."x".$frameheight." canvas:none -depth 4 ".$subframe);
        }
        if(index($sub_image,"-match-")==-1) { # no y adjustment for matching subs, they match only in 16:9 widescreen mode
          if(($y-$height/2)>=($frameheight/2)) {
            $newy=$y-$yadjust_bottom;
          } else {
            $newy=$y-$yadjust_top;
          }
        }
# we do some image manipulation here to ensure subtitles look their best
# the following subtitles tend to be problematic after being completely converted to a DVD format:
# english SDH subs ESB#619 (...two...) and ROTJ#783 (I...): they tend to not be white
        if(index($sub_image,"-sdh-")!=-1) {
# sdh subtitles get an extra-low white threshold to make sure the subtitles are actually white (not overwhelmed by the black background)
          if($^O eq "MSWin32") {
            system("convert ".$sourcedir."\\".$sub_image." -brightness-contrast 20 -white-threshold 50% -contrast-stretch 0 -depth 4 ".$destdir."\\_".$sub_image);
          } else {
            system("convert ".$sourcedir."/".$sub_image." -brightness-contrast 20 -white-threshold 50% -contrast-stretch 0 -depth 4 ".$destdir."/_".$sub_image);
          }
        } else {
# all other subtitles just get a brightness boost to make sure subtitles are actually white
          if($^O eq "MSWin32") {
            system("convert ".$sourcedir."\\".$sub_image." -brightness-contrast 20 -contrast-stretch 0 -depth 4 ".$destdir."\\_".$sub_image);
          } else {
            system("convert ".$sourcedir."/".$sub_image." -brightness-contrast 20 -contrast-stretch 0 -depth 4 ".$destdir."/_".$sub_image);
          }
        }
        if($^O eq "MSWin32") {
          system("composite -geometry +".$x."+".$newy." ".$destdir."\\_".$sub_image." ".$subframe." -depth 4 ".$destdir."\\".$sub_image);
          if(index($sub_image,"-sdh-")==-1) {
# here, we're thickening the black border around text to improve readability (does not apply to sdh subs)
            system("convert ".$destdir."\\".$sub_image." ( -clone 0 -alpha extract -threshold 90% ) ( -clone 1 -blur 2x2 -threshold 0 ) ( -clone 2 -fill black -opaque white ) ( -clone 3 -clone 0 -clone 1 -alpha off -compose over -composite ) -delete 0,1,3 +swap -alpha off -compose copy_opacity -composite ".$destdir."\\_".$sub_image);
            rename($destdir."\\_".$sub_image,$destdir."\\".$sub_image);
          } else {
            unlink($destdir."/_".$sub_image);
          }
        } else {
          system("composite -geometry +".$x."+".$newy." ".$destdir."/_".$sub_image." ".$subframe." -depth 4 ".$destdir."/".$sub_image);
          if(index($sub_image,"-sdh-")==-1) {
# here, we're thickening the black border around text to improve readability (does not apply to sdh subs)
            system("convert ".$destdir."/".$sub_image." \\( -clone 0 -alpha extract -threshold 90% \\) \\( -clone 1 -blur 2x2 -threshold 0 \\) \\( -clone 2 -fill black -opaque white \\) \\( -clone 3 -clone 0 -clone 1 -alpha off -compose over -composite \\) -delete 0,1,3 +swap -alpha off -compose copy_opacity -composite ".$destdir."/_".$sub_image);
            rename($destdir."/_".$sub_image,$destdir."/".$sub_image);
          } else {
            unlink($destdir."/_".$sub_image);
          }
        }
        $graphic=0;
      }
      print NEWXML $line;
    } else {
      if (index($line, "VideoFormat") != -1) {
        if (index($line, "480i") != -1) {
          $framewidth=720;
          $frameheight=480;
        } else {
          $framewidth=720;
          $frameheight=576;
        }
      }
      print NEWXML $line;
    }
  }
  close(OLDXML);
  close(NEWXML);
  unlink($subframe);
}

print "Process complete. DVD-prepped images can be found in $destdir.\n";