Difference between revisions of "Anri-chan/Source/anri.pl"
From SDA Knowledge Base
(a new beginning) |
(No difference)
|
Revision as of 22:19, 23 August 2008
#!/usr/bin/perl
############################################################################
# Credits
#
# nathan jahnke <njahnke@gmail.com>
# Ian Bennett
# Philip "ballofsnow" Cornell
# Brett "Psonar" Ables
#
# Anri is distributed under the terms of the Gnu General Public License 3.0:
# http://www.gnu.org/licenses/gpl-3.0.txt
############################################################################
############################################################################
# Initialization
#
# Some obvious stuff in here. Desktop location is set using the win32api
# module under Windows.
############################################################################
use warnings;
use strict 'subs';
package anri;
#version of this software, used in building the path to the executable, so must match the value from the installer
$version = '4a1';
#name of this file
$anripl = 'anri.pl';
#cute prompt for user input
$prompt = 'ANRI> ';
#what os are we running? unix is default since there are so many possible flavors
$os = 'unix';
$os = 'windows' if "$^O" eq "MSWin32";
if ($os eq 'windows') {
#the below api calls probably require the win32api module(?) to be installed which will have to be included in the anri installer ...
#get the name of the work directory. this is the desktop by default under windows
use Win32 qw(CSIDL_DESKTOPDIRECTORY);
$desktop = Win32::GetFolderPath(CSIDL_DESKTOPDIRECTORY);
#get the path to program files so we can build the anri program directory
use Win32 qw(CSIDL_PROGRAM_FILES);
$programfiles = Win32::GetFolderPath(CSIDL_PROGRAM_FILES);
#anri program directory
$anri_dir = "${programfiles}/anri_${version}";
#name of the directory containing dgindex.exe under anri's program directory and of the executable itself
$dgmpgdec_dir = "${anri_dir}/dgmpgdec152";
$dgmpgdec = 'dgmpgdec.exe';
#name of the directory containing virtualdub.exe under anri's program directory and of the executables both gui and cli
$vdub_dir = "${anri_dir}/VirtualDub-1.8.5";
$vdubgui = 'virtualdub.exe';
$vdubcli = 'vdub.exe';
#our encoders
$x264 = 'x264.exe';
$naac = 'neroaacenc.exe';
$mp4box = 'mp4box.exe';
#some anri support files
$directshowsourcelistfile = 'directshowsource_list.txt';
#set some keys in the registry to make vdub show only the input video pane (having both the input and output panes open as is default tends to confuse users)
&update_registry_key("CUser/Software/Freeware/VirtualDub/Persistence/Update input pane", "0x0001", "REG_DWORD");
&update_registry_key("CUser/Software/Freeware/VirtualDub/Persistence/Update output pane", "0x0000", "REG_DWORD");
#os-specific commands
$clear = "CLS";
#or, for debugging ...
$clear = "";
############################################################################
# Color Initialization
#
# Edit by: Psonar - Brett Ables
# Below is the code necessary to use the CECHO.exe function
# to add color to anrichan. Run CECHO.exe /? for usage help.
# CECHO.exe was written by Thomas Polaert.
#
# The environment variable CECHO is set to the absolute path
# of the CECHO.exe program so that %CECHO% may be used
# to call the function regardless of the working directory
#
# RESET_COLOR is used to reset the default color scheme
# after CECHO has been used to output different colors.
#
# Color is a DOS function that affects the whole command
# window at once. It is used only once here to initialize the
# background color of the window. 80 is the same as {black on gray}.
#
# CECHO is used in out_cls, out_info, out_error, and out_section.
############################################################################
$cecho = "${anri_dir}/cecho.exe";
$black_on_gray = '{black on gray}';
$gray_on_black = '{gray on black}';
$blue_on_black = '{blue on black}';
$white_on_black = '{white on black}';
$aqua_on_black = '{aqua on black}';
$blue_on_black = '{blue on black}';
$teal_on_gray = '{teal on gray}';
$navy_on_gray = '{navy on gray}';
$maroon_on_gray = '{maroon on gray}';
$maroon_on_silver = '{maroon on silver}';
$white_on_gray = '{white on gray}';
$red_on_gray = '{red on gray}';
$reset_color = "\"${cecho}\" ${black_on_gray}";
system("Color 80");
} else {
#FIXME UNIX DESKTOP
#color initialization
#os-specific commands
$clear = "clear";
}
#FIXME LOGFILE STUFF
#FIXME EXTERNAL CONFIGURATION FILE
#main menu
#TODO: using_settings
############################################################################
# Main menu
#
# Anri's home.
############################################################################
&out_cls;
&out_info("ON HERMESUS LUC ARSUS ESTARIAS AUC ELTRAS LI CELES! Now, let's get to work!");
&out_section("Main");
@mainmenu = (
['Rip DVD to hard drive (required for DVD material)', '&rip_dvd'],
['Start new project', '&project'],
['Extract sample', '&proc_sample'],
['Station ID preview', '&statid_sample'],
['Exit', 'exit 0;'],
);
&out_menu(@mainmenu);
while (<STDIN>) {
chomp;
if (m/^([1-5])$/) {
#execute the contents of this value in the array
eval($mainmenu[$1-1][1]);
last;
}
print "Invalid input.\n\n";
&out_menu(@mainmenu);
}
############################################################################
# Sample extraction procedure
#
# Sample extraction is basically regular mode minus a bunch of questions.
# This procedure gets called when a parameter "sample" has been sent to
# anri.bat. There isn't much documentation about how this works since this
# was meant to be short. One thing that's different is that the sample video
# will have separated fields. This is to avoid the problem with interlacing
# and the Yv12 colorspace. The fields are then weaved back together to
# determine DFnD.
############################################################################
sub proc_sample {
# &out_cls;
chdir($desktop);
#FIXME no_pause_before_indexing?
$projname = 'sample';
&make_projdir;
&load_plugins;
&out_cls_section("Sample Extraction");
&echo('DVD/MPEG source [y,n]');
print $prompt;
while (<STDIN>) {
chomp;
if (m/^[yn]$/) {
#y becomes 1 (true), n becomes 0 (false)
tr/yn/10/;
$_ ? &index_dvd : &q_avi;
last;
}
print "Invalid input.\n\n";
print $prompt;
}
&cp("${projname}.avs","${projname}_trimtemp.avs");
&echotofile("lanczos4resize(320,240)\n",">>","${projname}_trimtemp.avs");
&out_info("This sample will be 300 frames long. Pick the starting frame of a scene with");
&out_info("action.");
&echo("");
&out_info("Press ENTER to continue ...");
<STDIN>;
if ($os eq 'windows') {
system("START \"trimming vdub\" \"${vdub_dir}/${vdubgui}\" ${projname}_trimtemp.avs");
} else {
#how are we going to do this in unix? your guess is as good as mine
}
print $prompt;
while (<STDIN>) {
chomp;
if (m/^[0-9]+$/) {
$startframe = $_;
last;
}
print "Invalid input.\n\n";
print $prompt;
}
&echotofile("trim(${startframe},".($startframe+299).")\n",">>","${projname}.avs");
&echotofile("AssumeTFF\nSeparateFields\nconverttoyv12\n",">>","${projname}.avs");
&onepass("${desktop}/${projname}/${projname}.avs","${desktop}/${projname}/${projname}","128000","19",1);
&cp("${desktop}/${projname}/${projname}.mp4","${desktop}");
# @todel = (
# "${projname}*.avs",
# "${projname}.bak",
# "${projname}*.d2v",
# "${projname}VTS*",
# "log*.txt",
# );
chdir("${desktop}");
&rm("${desktop}/${projname}");
&echo("\n\n${white_on_gray}Finished. You will find a sample.mp4 file on your desktop. Feel free to rename it something more descriptive like nameofgame_sample.mp4.");
&echo("\n${red_on_gray} - READ -${white_on_gray} You will see that the video has been resized vertically.");
&echo("${red_on_gray}THIS IS NORMAL${white_on_gray} and will make it easier for the techies to help you.");
system($reset_color);
<STDIN>;
exit 0;
}
############################################################################
# File Handling
#
# Handle files in project directory.
############################################################################
sub make_projdir {
chdir($desktop);
mkdir($projname);# if !-e $projname;
chdir($projname);
&cp("${anri_dir}/silence_stereo_48000.wav","${desktop}/${projname}");
&cp("${dgmpgdec_dir}/infotemplate.avs","${desktop}/${projname}");
&cp("${anri_dir}/ntsc_d1.png","${desktop}/${projname}");
}
sub wipe_avs {
chdir("${desktop}/${projname}");
&rm("*.avs") if -e "${projname}.avs";
&cp("${projname}.bak","${projname}.avs");
&cp("plugins.bak","plugins.avs");
}
#load_plugins makes a file plugins.avs in the project directory that contains the proper loadplugin() or import() declarations for every plugin (defined as a file ending in .dll or .avs) found under $anri_dir/plugins.
sub load_plugins {
&rm("plugins.avs") if -e "plugins.avs";
opendir(PLUGINS, "${anri_dir}/plugins");
@plugins = readdir(PLUGINS);
closedir(PLUGINS);
for (@plugins) {
if (m/.*\.([dll]+)$/i) {
&echotofile("loadplugin(\"${anri_dir}/plugins/${_}\")\n",">>","plugins.avs");
} elsif (m/.*\.([avs]+)$/i) {
&echotofile("import(\"${anri_dir}/plugins/${_}\")\n",">>","plugins.avs");
}
}
&cp("plugins.avs","plugins.bak");
}
############################################################################
# Windows
#
# These subroutines make use of the win32api module.
############################################################################
#fullpathtokey, data, type
sub update_registry_key {
use Win32::TieRegistry(Delimiter=>"/",ArrayValues=>0);
$Registry->{$_[0]} = [ $_[1], $_[2] ];
}
############################################################################
# System
#
# These subroutines send OS-dependent shell commands.
############################################################################
#string, > or >>, filepath
#not much here yet but may need to modify in the future
sub echotofile {
open(OUTFILE, "${_[1]}${_[2]}");
print OUTFILE $_[0];
close(OUTFILE);
}
#path
#/D means change even if cwd is on a different drive letter
# sub cd {
# $flags = '';
# $flags = ' /D' if $os eq 'windows';
#
# #for debugging
# $command = "cd${flags} \"${_[0]}\"";
# print "$command\n";
# system($command);
# }
#path, newpath (both can be relative)
#/Y means overwrite (i.e. automatically say Yes to the overwrite question)
#/B means force binary copy (do not attempt to translate line endings)
#-R means recursive (copy directories and the files in them as well as just files)
sub cp {
if ($os eq 'windows') {
for (@_) {
#COPY gives me errors unless the path delimiter is \ under doze
s,/,\\,g if m,/,;
}
}
$command = 'cp';
$command = 'COPY' if $os eq 'windows';
$flags = ' -R';
$flags = ' /Y /B' if $os eq 'windows';
$redirect = '';
$redirect = ' > NUL' if $os eq 'windows';
$command = "${command}${flags} \"${_[0]}\" \"${_[1]}\"${redirect}";
#for debugging
# print $command."\n";
system($command);
}
#path
#-r means recursive (delete directories and the files in them as well as just files)
#-f means force (don't ask for confirmation, just do it - may be necessary on some red hat linux installs)
#/Q means don't ask for confirmation
#/S means recursive (delete directories and the files in them as well as just files)
sub rm {
if ($os eq 'windows') {
for (@_) {
#COPY gives me errors unless the path delimiter is \ under doze
s,/,\\,g if m,/,;
}
}
$command = 'rm';
$command = 'DEL' if $os eq 'windows';
$flags = ' -rf';
$flags = ' /Q /F' if $os eq 'windows';
for (@_) {
#is this a directory?
if (-d "$_") {
$command = 'RD' if $os eq 'windows';
$flags = ' /Q /S' if $os eq 'windows';
}
system("${command}${flags} \"${_}\"");
}
}
#lol it says subtitle - set the console's title
sub title {
if ($os eq 'windows') {
system('TITLE '.$_[0]);
} else {
system('declare -x PROMPT_COMMAND=\'printf "\e]0;'.$_[0].'\a"\'');
}
}
############################################################################
# Input
#
# These subroutines get data from the user.
############################################################################
############################################################################
# function: q_avi
#
# Ask the user if he wants to do manual input of file paths, or automatically
# by loading the files in a specified directory alphabetically.
############################################################################
sub q_avi {
$maxaudiobitrate = 320000;
&out_cls_section("AVI SOURCE");
&out_info("Enter the path to each avi file [i]ndividually or [a]utomatically. Note that if you choose automatic, Anri will load the files in an alphabetical manner. The files must have the same resolution and framerate to be joined together.");
&echo("");
print $prompt;
while (<STDIN>) {
chomp;
if (m/^([ia])$/) {
#i becomes 1 (true), a becomes 0 (false)
tr/ia/10/;
$_ ? &q_avi_i : &q_avi_a;
last;
}
print "Invalid input.\n\n";
print $prompt;
}
#IF "%auto%"=="y" GOTO avimethod_skip
#:avimethod_skip
#AVI files loaded, generate avs source lines.
&echotofile("import(\"${anri_dir}/sda.avs\")\n",">>","${projname}.avs");
&echotofile("import(\"${desktop}/${projname}/plugins.avs\")\n",">>","${projname}.avs");
$alignedsplice = '';
for $avifile (@avifiles) {
&echotofile($alignedsplice,">>","${projname}.avs");
if ($os eq 'windows') {
@fourccstuff = qx("${anri_dir}/cfourcc.exe" "${avifile}");
$fourcc = join('',@fourccstuff);
#"${anri_dir}/cfourcc.exe" "%avifolder%%%~G" >> running_log.txt
$fourcc =~ s/.*Use : (....).*/$1/s;
open(DSHOW, "${anri_dir}/${directshowsourcelistfile}");
@directshowsourcelist=<DSHOW>;
close(DSHOW);
for (@directshowsourcelist) {
chomp;
$use_dshow{lc($_)} = 1;
}
$sourcedecverb = 'avisource';
$sourcedecverb = 'directshowsource' if $use_dshow{lc($fourcc)};
&echotofile("${sourcedecverb}(\"${avifile}\")",">>","${projname}.avs");
$alignedsplice = "++\\\n";
} else {
#unix avi source declaration stuff goes here?
}
}
#newline needed
&echotofile("\nconverttoyuy2()\n",">>","${projname}.avs");
&cp("${projname}.avs","${projname}.bak");
}
############################################################################
# function: q_avi_i
#
# Manually add each file path to @avifiles. Do some validation; no
# resolution check yet.
############################################################################
sub q_avi_i {
&echo("");
&out_info('Path to source video file e.g. c:\path to\video.avi without quotes.');
&out_info(" - Type n to quit -");
&echo("");
#:q_avi_i_p2
print $prompt;
while (<STDIN>) {
chomp;
#error codes' precedence is descending, e.g. empty string is first because it is the most serious error
if ($_ eq '') {
$errormsg="You must enter a path, or type n to quit.";
} elsif (m/^n$/i) {
if (@avifiles < 1) {
$errormsg="You must load at least one avi file.";
} else {
last;
}
} elsif (!m/.*\.av[si]$/i) {
$errormsg="Must be an avi file, try again.";
} elsif (! -e $_) {
$errormsg="File does not exist, try again.";
} else {
push(@avifiles,$_);
&out_info('avi #'.@avifiles.' loaded successfully!');
&echo("");
print $prompt;
next;
}
&out_error($errormsg);
print $prompt;
}
}
############################################################################
# function: q_avi_a
#
# Automatic file loading. User just has to specify a directory and it will
# load the files alphabetically.
############################################################################
sub q_avi_a {
&echo("");
#saved this string in a variable for use later on down
$enterhelp = 'Enter the path to the avi folder e.g. c:\my video folder\ without quotes.';
&out_info($enterhelp);
print $prompt;
#Validate avifolder. Check for blank, then :\ for full path if windows, then see whether it exists.
while (<STDIN>) {
@avifiles = ();
chomp;
if (m/^$/) {
$errormsg="You must enter a path.";
} elsif (m/^.[^:][^\\].*/) {
$errormsg="Must be full path.";
} elsif (! -e $_) {
$errormsg="Folder does not exist.";
} else {
$avifolder = $_;
#remove any and all / or \ characters from the end of the path
$avifolder =~ s/[\/]*$//;
#build list
for (<$avifolder/*.avi>) {
push(@avifiles,$_);
print $_."\n";
}
#user can accept if files were found
if (@avifiles == 0) {
$errormsg = 'No avi files found in that folder!';
} else {
#Ask user if the list is good.
&echo('Continue [y] or rescan [n]?');
print $prompt;
while (<STDIN>) {
chomp;
last if (m/^[yn]$/);
print "Invalid input.\n\n";
print $prompt;
}
#do we need to do this whole thing again?
last if $_ eq 'y';
$errormsg = $enterhelp;
}
}
&out_error($errormsg);
print $prompt;
}
}
############################################################################
# Output
#
# These subroutines send data to the console.
############################################################################
sub echo {
$_[0] = '' if not defined $_[0];
if ($os eq 'windows') {
system("\"${cecho}\" ".$_[0].'{\n}');
} else {
print $_[0]."\n";
}
}
sub out_cls {
system($clear);
&echo("${gray_on_black} ");
&echo("${blue_on_black}===============================================================================");
&echo("${white_on_black} Speed Demos Archive Anri ${version}");
&echo("${aqua_on_black} http://speeddemosarchive.com/ http://www.metroid2002.com/ ");
&echo("${blue_on_black}===============================================================================");
&echo("");
system($reset_color);
}
sub out_info {
$_[0] = '' if not defined $_[0];
&echo("${white_on_gray}$_[0]");
system($reset_color);
}
sub out_error {
$_[0] = '' if not defined $_[0];
&echo("${maroon_on_gray}[!]");
&echo("${maroon_on_gray}[!] ${maroon_on_silver}".$_[0]);
&echo("${maroon_on_gray}[!]");
system($reset_color);
&echo("");
}
sub out_section {
$_[0] = '' if not defined $_[0];
&title("Anri-chan ${version} - ".$_[0]);
&echo("${teal_on_gray}-------------------------");
&echo("${navy_on_gray}".$_[0]."");
&echo("${teal_on_gray}-------------------------");
system($reset_color);
&echo("");
}
sub out_cls_section {
&out_cls;
&out_section($_[0]);
}
sub out_cls_info {
&out_cls;
&out_info($_[0]);
}
#print the numbered english half of a 2d array consisting of english,command pairs and show the anri prompt at the end
sub out_menu {
for ($i = 0; $i < @_; $i++) {
print " ".($i+1).". ".$_[$i][0]."\n";
}
print "\n${prompt}";
}
############################################################################
# Encoding
#
# Encode video in OS-specific ways.
############################################################################
#input filename, output basename, output audio bitrate in baud, x264 minimum quantizer, delete tempfiles boolean
sub onepass {
system("\"${anri_dir}/${x264}\" --qp ${_[3]} --ref 8 --mixed-refs --no-fast-pskip --bframes 5 --b-rdo --bime --weightb --nf --direct auto --subme 7 --analyse p8x8,b8x8,i4x4,p4x4 --threads auto --thread-input --progress --no-psnr --no-ssim --output \"${_[1]}_video.mp4\" \"${_[0]}\"");
system("\"${vdub_dir}/${vdubcli}\" \"${_[0]}\" /i \"${anri_dir}/audioout.vcf\" \"${_[1]}_temp.wav\"");
system("\"${anri_dir}/${naac}\" -br ${_[2]} -lc -if \"${_[1]}_temp.wav\" -of \"${_[1]}_audio.mp4\"");
system("\"${anri_dir}/${mp4box}\" -tmp . -new -add \"${_[1]}_video.mp4\" -add \"${_[1]}_audio.mp4\" \"${_[1]}.mp4\"");
if (${_[4]}) {
@todel = (
"${_[1]}_video.mp4",
"${_[1]}_temp.wav",
"${_[1]}_audio.mp4",
);
&rm(@todel);
}
}
