#!/usr/bin/perl
#
# Programmer:	 Craig Stuart Sapp <craig@ccrma.stanford.edu>
# Creation Date: Wed Dec 28 13:21:22 PST 2011
# Last Modified: Fri Dec 30 10:33:01 PST 2011
# Program name:  score2eps
# Syntax:        PERL 5
# Usage:         score2eps [.pmx, .sxml and/or .mus file(s)]
#             or cat file.sxml | score2eps 
# Description:   Create .eps files with same base filename as input file(s).
#
# Options:
#    -d		debug mode: display SCORE editor while printing.  This is useful
#		   for locating problems in the printing process which prevents 
#	   	   exiting from dosemu.  Also useful for interacting with SCORE 
#                  editor when there are too many objects in a file.
#    -l #       Limit the maximum lines in a PMX file (does not check MUS 
#    		   files). The default maximum is 1150 lines.  If a file 
#    		   contains too many objects which exceed the display vectors 
#    		   in the SCORE editor, a warning message will appear which 
#    		   cannot be handled by automated processed (but can be dealt 
#    		   with manually when using the -d option).
#    -m file    Print main macro file and then exit without running it (useful
#                  for manual execution of the macro or for debugging).  Load
#                  the macro into the SCORE editor with the command "RES file".
#    -r         Replace any EPS files which already exist. (see also -s option)
#    -s	   	Skip any existing EPS files.  By default the program will exit
#		   with an error if it finds any existing EPS files which it 
#                  would overwrite. (see also -r option)
#    -w	dir	Set the working directory if not the current working directory.
#

use strict;
my $newline = "\r\n";    # MS-DOS newline character sequence (0x0d, 0x0a)

use Getopt::Mixed;       # command-line options parsing.
                         # If not installed, then type in terminal:
                         #     perl -MCPAN -e "install Getopt::Mixed"
use vars qw/ $opt_d /;   # run in debug mode if -d is given on command line.
use vars qw/ $opt_w /;   # set the default directory if not current one.
use vars qw/ $opt_s /;   # skip EPS files which already exist.
use vars qw/ $opt_r /;   # replace any EPS files which already exist.
use vars qw/ $opt_l /;   # maximum lines allowed in a PMX data file.
use vars qw/ $opt_m /;   # print macrofile and exit.
my $options     = 'd debug>d'; 
$options       .= ' w=s dir>w';  
$options       .= ' s skip>s';
$options       .= ' r overwrite>r';
$options       .= ' l=i pmxlinesmax>l';
$options       .= ' m=s macro>m';
Getopt::Mixed::getOptions($options);
my $debugQ       = int($opt_d); 
my $skipQ       = int($opt_s);
my $overwriteQ  = int($opt_r);
my $maxpmxlines = int($opt_l);
my $directory   = $opt_w; 
my $macrofile   = $opt_m;

$maxpmxlines = 1150 if $maxpmxlines <= 0;
$directory = "." if $directory =~ /^\s*$/;
my $tempfile = "temp";
$tempfile   .= int(rand(10000));
my $macroQ = 1;
$macroQ = 0 if $macrofile =~ /^\s*$/;
my %FILENAMES;   # check for duplicate filenames
$FILENAMES{""} = 1;
my $COUNTER = 0;  # keep track of which enumerated page is being printed


createBatchFile($directory, "$tempfile.bat") if !$macroQ;
if ($macroQ) {
   createMacroFile($directory, $macrofile, @ARGV);
} else {
   createMacroFile($directory, "$tempfile.mac", @ARGV);
}
exit(0) if $macroQ;
processFiles($directory, "$tempfile.bat");
cleanup();
exit(0);

###########################################################################


##############################
##
## cleanup -- Remove temporary files.
##

sub cleanup {
   unlink("$directory/$tempfile.bat");
   unlink("$directory/$tempfile.mac");
}



##############################
##
## createBatchFile -- Create a batch file to run SCOR4 and then exit dosemu.
##

sub createBatchFile {
   my ($directory, $filename) = @_;
   open (FILE, ">$directory/$filename") 
      or die "Cannot write $directory/$filename\n";
   print FILE "C:\\scor4\\scor4.exe\n";
   print FILE "exitemu\n";
   close FILE;
}


   
##############################
##
## createMacroFile -- Create a macrofile to do all of the work of creating EPS
##     files from the input ASCII/binary data files.
##

sub createMacroFile {
   my ($directory, $macrofile, @filelist) = @_;
   open (MACRO, ">$directory/$macrofile") or die;
   my ($file, $filename, $drive, $dosdir, $basename, $extension);

   if (@ARGV == 0) {
      # read ScoreXML file from standard input
      printScoreXmlMacro($directory, "<STDIN>", "");
   } else {
      for (my $i=0; $i<@filelist; $i++) {
         $filename = $filelist[$i];
         ($drive, $dosdir, $file) = 
               getDosDriveDirAndFilename($directory, $filename);
         $basename  = $file;
         if ($FILENAMES{$basename} != 0) {
            die "Error: filename already used: $basename";
         }
         $FILENAMES{$basename}++;
         $basename  =~ s/\.[^.]*//;
         $extension = $file;
         $extension =~ s/^$basename\.//;
         next if $skipQ && -r "$directory/$basename.eps";
         $dosdir =~ s/\\+/\\/g;
         if (($extension =~ /mus/i) || ($extension =~ /pag/i)) {
            print MACRO "${newline}CD $drive:$dosdir$newline"; 
            print MACRO "${newline}RS$newline" if $COUNTER++ > 0;
            print MACRO "G ";
            print MACRO "$basename.$extension$newline";
         } elsif ($extension =~ /xml/i) {
            printScoreXmlMacro($directory, $basename, $extension);
            next;
         } else {
            # load contents of PMX into macro since RES cannot be nested.
            if (!open(PMX, "$directory/$filename")) {
               cleanup();
               die "Cannot read PMX data: $directory/$filename\n";
            }
            my @pmx = <PMX>;
            close PMX;
            if (@pmx > $maxpmxlines) {
               # Automation get stuck (unless debugging) if the
               # display vector size is too large.  When using -d, you can
               # press the "any key" to skip over the warning messages.
               # Note that this test is only approximate and is not done
               # for binary data.
               print "WARNING: file too big: skipping $directory/$filename\n";
               next;
            }
            # print MACRO "${newline}CD $drive:$dosdir$newline"; 
            print MACRO "RS$newline" if $COUNTER++ > 0;
            my $line;
            foreach $line (@pmx) {
               chomp $line;
               $line =~ s/$//;
               print MACRO "$line$newline";
            }
         }
         printPrint($directory, $basename);
      }
   }

   print MACRO "${newline}EXIT$newline";
   print MACRO "Y$newline";
   close MACRO;
}


##############################
##
## printPrint -- print the PRINT command for a SCORE macro
##

sub printPrint {
   my ($directory, $basename)  = @_;

   print MACRO "PRINT$newline";
   print MACRO "1 $basename.eps$newline";
   if (-r "$directory/$basename.eps") {
      next if $skipQ;
      if ($overwriteQ) {
         unlink("$directory/$basename.eps");
      } else {
         cleanup();
         die "ERROR: Delete EPS file to continue: $directory/$basename.eps\n";
      }
   }
   print MACRO "G$newline";
}



##############################
##
## processFiles -- start dosemu, run SCOR4 and then load macrofile.
##

sub processFiles {
   my ($directory, $macrofile) = @_;
   my $keystrokes = "\\P3;";        # set keypress speed
   if ($debugQ != 0) {
      $keystrokes = "\\P20;";       # slow down keystrokes for debugging
      $keystrokes .= "\\r";         # detect keyboard type in -t mode
   }

   my ($drive, $dir) = getDosDriveDirAndFilename($directory, "none");
   $keystrokes .= "$drive:\\r" if $drive !~ /^\s*$/;
   $keystrokes .= "cd $dir\\r" if $dir   !~ /^\s*$/;

   # Run the batch script:
   $keystrokes .= "$macrofile\\r";
   # Add extra \r to skip the splash screen:
   $keystrokes .= "\\r";
   $keystrokes .= "res ";            # REad ASCII data (macro file)
   $keystrokes .= "$tempfile.mac\\r";# Script to do the processing

   my $command = "LANG=none dosemu -quiet";
   if ($debugQ == 0) {
      $command .= " -t";
   }
   $command .= " -input \"$keystrokes\"";
   if ($debugQ == 0) {
      $command .= " &> /dev/null";
   }
   
   my $tcommand = $command;
   $tcommand =~ s/\\+/\\/g;
   print "$tcommand\n" if $debugQ != 0;
   `$command`;                       # run the command
}



##############################
##
## getDosDriveDirAndFilename -- return the DOS drive and directory for a 
##     particular (unix) file.  The C drive is presumed to be 
##     ~/.dosemu/drive_c.  The home directory (~/) is presumed to be the 
##     D drive.  Both of these are the defaul dosemu mappings for these drives.
##

sub getDosDriveDirAndFilename {
   my ($directory, $filename) = @_;

   $filename    =~ s/\/+/\\/g;
   $filename    =~ s/\\+/\\\\/g;
   if ($filename =~ /\\/) {
      if ($filename =~ /^(.*\\)([^\\]*)/) {
         $directory  = $1;
         $filename = $2;
      }
   }
   
   my $cwd      = "";
   my $homedir  = $ENV{'HOME'};
   if (($directory =~ /^\s*$/) || ($directory eq ".")) {
      $cwd      = $ENV{'PWD'};
      $directory  = $cwd;
   } 
   my $dosdrive = "c";
   my $dosdir   = "/";
   if ($directory =~ /^([a-zA-Z]):(.*)/) {
      $dosdrive = $1;
      $dosdir   = $2;
   } elsif ($directory =~ /^$homedir/) {
      if ($directory =~ /^$homedir\/.dosemu\/drive_([a-zA-Z])\/?(.*)/) {
         $dosdrive = "$1";
         $dosdir   = "/$2";
      } elsif ($directory =~ /^$homedir\/?(.*)/) {
         $dosdrive = "d";
         $dosdir   = "/$1";
      }
   } elsif ($directory !~ /^\s*$/) {
      $dosdir = "/$directory";
   }
   $dosdir =~ s/\/+/\\\\\\\\/g;
   $dosdir =~ s/\\+$//;

   return ($dosdrive, $dosdir, $filename);
}



##############################
##
## printScoreXmlMacro -- converts a ScoreXML file into macro data.  Assumes
##     that the <obj> entries are separated by newlines.  Also a few more
##     non-generalized assumptions which presume pretty formatting, such as
##     filename on same line as <name> element, and no '>' character inside
##     of the @text of <obj>.
##

sub printScoreXmlMacro { 
   my ($directory, $basename, $extension) = @_;

   if (($basename !~ /^\s*$/) and ($basename ne "<STDIN>")) {
      open (XML, "$directory/$basename.$extension") 
         or die "Counld not open $directory/$basename.$extension for reading";
   } else {
      open (XML, "-") or die;
   }
   my $line;
   my $filename;
   my $hasdata = 0;
   my $drive;
   my $dosdir;
   my $file;
   my $suppress = 0;
   while ($line = <XML>) {
      if ($line =~ /<scoreFile[^>]*>/) {
         $filename = "";
         $hasdata = 0;
         ($drive, $dosdir, $file) = getDosDriveDirAndFilename($directory, $filename);
         $dosdir =~ s/\\+/\\/g;
         #print MACRO "${newline}CD $drive:$dosdir$newline"; 
         print MACRO "${newline}RS$newline" if $COUNTER++ > 0;
      } elsif ((!$suppress) and $hasdata and ($line =~ /<\/scoreFile>/)) {
         printPrint($directory, $filename);
      } elsif ($line =~ /<name[^>]*>([^<]*)/) {
         $filename = $1;
         $filename =~ s/^\s*//;
         $filename =~ s/^\s$//;
         if ($FILENAMES{$filename} != 0) {
            die "Error: filename already used: $filename";
         }
         if (-r "$directory/$basename.eps") {
            if ($skipQ) {
               # need to skip this file because it is already printed.
               $suppress = 1;
            } elsif ($overwriteQ) {
               unlink("$directory/$basename.eps");
            } else {
               cleanup();
               die "ERROR: Delete EPS file to continue: $directory/$basename.eps\n";
            }
         } else {
            $suppress = 0;
         }

         $FILENAMES{$filename}++;
      } elsif ($line =~ /<obj\s+([^>]*)/) {
         $hasdata++;
         printScoreObject($1);
      }
   }

   close XML;
}



##############################
##
## printScoreObject -- print a ScoreXML <obj> attributes as a SCORE 
##     macro object.
##

sub printScoreObject {
   my ($string) = @_;
   my @data;
   my $text = "";
   if ($string =~ s/text\s*=\s*"([^"]*)"//) {
      $text = $1;
   } elsif ($string =~ s/text\s*=\s*'([^']*)'//) {
      $text = $1;
   }
   while ($string =~ s/p(\d+)\s*=\s*["']([^'"]*)['"]//) {
      $data[int($1)] = $2;
   }
   my $i;
   my $value;
   $data[1] = "t" if int($data[1]) == 16;
   for ($i=1; $i<@data; $i++) {
      $value = $data[$i];
      $value = "0." if $value =~ /^\s*$/;
      print MACRO "$value ";
   }
   print MACRO "$newline";
   if ((int($data[1]) == 16) or ($data[1] =~ /^\s*t\s*$/i) or 
       (int($data[1] == 15))) {
      print MACRO "$text$newline";
   }
}


