#!/usr/bin/perl
################################################################################
# for2latex - Converts a FORTRAN 77/90/95, or F source code to LaTeX2e
# with highlighted coloured syntax.
#
# Copyright (C) 2000 Luis Randez
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2, or (at your option)
# any later version.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this file.  If not, write to the Free Software Foundation,
# 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
#
# Send any bug reports to randez@posta.unizar.es
#
########### change to uppercase or lowercase if options are set on #############
# 
sub uplo{
  my $uplo = $_[0];    
  $uplo =~ tr/A-Z/a-z/ if($lower); $uplo =~ tr/a-z/A-Z/ if($upper);
  $uplo =~ s/:/:{\\null}/g; 
  return $uplo;
}
############ change some special symbols in LaTeX2e ############################
sub change{
  my $change = $_[0];     
  $change =~ s/[\\]/9a\*98u/g; $change =~ s/[\$]/\\\$/g;
  $change =~ s/#/\\#/g;        $change =~ s/%/\\%/g;            
  $change =~ s/&/\\&/g;        $change =~ s/</\$<\$/g; 
  $change =~ s/>/\$>\$/g;      $change =~ s/{/\\{/g;
  $change =~ s/}/\\}/g;        $change =~ s/[\^]/\\^ /g;
  $change =~ s/~/\\~ /g;       $change =~ s/9a\*98u/\$\\backslash\$/g;
  return $change;
}
################### write a comment line #######################################
sub comentario{                         
  my $comentario = $_[0];
  $comentario = change($comentario);
  $comentario =~ s/_/\\_/g; $comentario =~ s/ /\\ /g; $linecom++;
  print logo "\\\\$color_com\{$high_com\{$comentario}}\n";
  return;
}
################### change quotes properly #####################################
sub change_quot{
  my $change_quot = $_[0];     
  $change_quot =~ s/"(.*?)"/``$1"/g; $change_quot =~ s/'(.*?)'/`$1'/g;
  return $change_quot;
}
################## read a line, chomp, ... #####################################
sub lee{ 
  my $indice = $_[0]; 
  $linea_uni = $code[$indice]; chomp $linea_uni; $linea_uni = tabi($linea_uni); 
  return $linea_uni;
}
#### replace tabs by an appropriate number of spaces (taken from code2html) ####
sub tabi{
  my $tabi = $_[0];
  while (($at = index($tabi,$tab)) != -1){
     $truetab = 1;
     $cnt = ($TABSTOP - ($at % $TABSTOP));
     $replace = " " x $cnt if ($cnt);
     $tabi =~ s/$tab/$replace/;
  }
  return $tabi;
}
##################### write the header of the LaTeX2e file #####################
sub top{     
  print logo "\\documentclass $document_options {article} \n";
  if($color ne "")
    {
      if($opt_pdftex eq "") {print logo "\\usepackage[dvips]{color}\n";}
      else {print logo "\\usepackage[pdftex,dvipsnames]{color}\n";}
    }
  print logo "\\hoffset    = $hoffset \n";
#  print logo "\\pagestyle{empty} \n";
  print logo "\\voffset    = $voffset \n";
  print logo "\\textheight = $textheight \n";
  print logo "\\textwidth  = $textwidth \n";
  print logo "\\begin{document} \n";
  print logo "% <==== CUT HERE ======= \n";
}
##################### write the bottom of the LaTeX2e file #####################
sub bot{ print logo "% <==== CUT HERE ======= \n\\end{document}\n"; }
############## split a line composed of several ones correctly #################
sub split_f9x{
  @multilinea = split($tab, $total);
  $indent = $indent[0]; $indent =~ s/ /\\ /g; $aux=$indent.$multilinea[0];
  for($t=1; $t<=$i; $t++){
     $indent = $indent[$t]; $indent =~ s/ /\\ /g; $indent =~ s/&/$pp/g;
     if($tipo ne "fortran77") {
     	   $aux = $aux.$pp."\\\\ {\\tt$indent}".$multilinea[$t];}
     else{ $aux = $aux."\\\\ {\\tt$indent}".$multilinea[$t];}
  }
  $total = $aux;
  return $total;
}
############### join several lineas continued into a only one ##################
sub join_f9x{
  while ( $linea =~ /^(\s*)(\&){0,1}(\s*)(.*)(\&){1}\s*(!.*){0,1}$/){ 
    $linea1.=$4.$tab; $indent[$i]=$1.$2.$3; $i++;
    comentario($6) if($6 ne "") ;
    $k++; $linea = lee($k); 	
    while($linea=~ /$comments/){comentario($linea); $k++; $linea = lee($k);}
  }   
  if($linea =~ /^(\s*\d+\s*)/)    {$indent[$i]=$1; $linea =~ s/$1//;}
  elsif($linea =~ /^(\s*&{1}\s*)/){$linea=~ s/^(\s*&{1}\s*)//; $indent[$i]=$1;}
  elsif($linea =~ /(^\s*)(.+)/)   {$linea =~ s/(^\s*)//; $indent[$i]=$1;}
  $linea1.=$linea;
  return $linea1;
}
############################### MAIN SUBROUTINE ################################
sub f2t{
  $filein=$_[0]; $aux = $filein; $aux =~ m/^(.*)\.(.*)/;
  $name =$1; $ext=$2; $fileout=$name.".tex"; $truetab = 0; 
  $tipo = "fortran77";        # default
###### line comments (f9x -> !, *), (f77 -> !, *, c, C), (F-> !) ###############
  if ($ext eq "f90" || $ext eq "f95") { $tipo = "fortran9x";
	             $comments = "(^!|^ +!|^[\*]|^ +[\*])";}
  elsif ($ext eq "F") {$tipo="F"; $comments = "(^!|^ +!)";}
  else                {$comments = "(^!|^[\*]|^c|^C)";}
  print " processing $filein ($tipo file)--> $fileout ... \n";
####### open the input file ####################################################
  open(pepe,$filein)  || die "error open input file \n";
    @code = <pepe>; 
  close(pepe);
  $num_lin = @code;                         # number of lines of the source code
##### modify the continuation line in fortran 77 style to fortran9x/F style ####
  $new="     &";
  for($k=0; $k<$num_lin; $k++) {
    $linea  =lee($k); $linea2 =lee($k+1);   
    if($tipo eq "fortran77" && $linea2 =~ /^(\s{5}\S{1}\s*)(.*)/){
      if($linea !~ /(.*)&\s*$/){$code[$k]=$linea.$sym;} else {$code[$k]=$linea;}    	
    }
    else {$code[$k] = $linea; }
    $code[$k]=~ s/^\s{5}\S{1}/$new/ if($tipo eq "fortran77");
   };
###### open the output file ####################################################
  open(logo,">$fileout") || die "error open output file\n";
  $linecom=0; top if($complet);                      # begin of the LaTeX2e file
  print logo "\\begin{flushleft} \n {\\tt \n \\noindent \n\\obeyspaces \n";
################################################################################
  $k=0;         # main index 
  while ($k<=$num_lin-1) {
    $indent =""; $linea=lee($k); $last="";
################################################################################
    if($linea =~ /$comments/){ comentario($linea); $k++; next }
################################################################################
    $linea1=""; $i=0;
############### join lines (check for continuation lines in fortran) ###########
    join_f9x;  $linea =$linea1;
    $linea = change($linea);        
###### scan the line to search quotes, keywords, specifiers, functions, ... ####
    $imprime = "";
    while($linea =~ /('.*?'|".*?")|\b$Keyword\b|\b$func\b\s*\(|[,\(]\s*\b$spec\b\s*=|(!)/i) {
######################### highlight keywords, ... ##############################
      $car=""; $f1=$1; $f2=$2; $f3=$3; $f4=$4; $f5=$5; 
      $antes=$`; $despu=$'; $pound=$&;
      if($f2.$f3.$f4 ne ""){$pound =uplo($pound);}
      if   ($f1 ne ""){
     	$tmp=change_quot($pound); $susti ="$color_quot\{$high_quot\{$tmp}}";}
      elsif($f3 ne ""){ @aux = split('\(',$pound); $car="(";
                        $susti = "$color_fcn\{$high_fcn\{@aux}}";}
      elsif($f4 ne ""){ $tmp1=$pound; $tmp1=~ s/(^[,\(])//;
     	                @aux = split('=',$tmp1); $car="=";
                        $susti = "$1$color_spe\{$high_spe\{@aux}}";}
##### there are identical words in Keywords, functions and specifiers? #########
      elsif($f2 ne "") {
     	$susti = "$color_key\{$high_key\{$pound}}"; $tmp= $f2; $tmp= uplo($tmp); 
     	  if($antes=~/(.*);\s*/ || $antes eq ""){$car_ant="1"} else{$car_ant=""}
	  if($car_ant eq "" && $tmp =~ /\b$ambi\b/i){
           if($linea=~ /\b($tmp)\b\s*(\W?)/i ) {
             if( $2 eq "(") {$susti = "$color_fcn\{$high_fcn\{$tmp}}";}
             if( $2 eq "=") {$susti = "$color_spe\{$high_spe\{$tmp}}";}
           }
      }
      if($susti =~ /(\\sc{[\w\s]+}{1,1})/ ){
      	$tmp=lc($1); $susti =~ s/(\\sc{[\w\s]+}{1,1})/$tmp/;}
    }
################### check for comments at the last of a line ###################
      if($f5 ne ""){$last="$color_com\{$high_com\{$f5 $despu}}"; $linea=$antes;}
      else         {$antes = uplo($antes);
      	$imprime = $imprime.$antes.$susti; $linea =$car.$despu;}
  }
  $linea = uplo($linea); 
  $imprime = $imprime.$linea; $total = $imprime.$last; $total =~ s/_/\\_/g;    
  if( $total =~ /^\s*$/) {print logo"\\medskip \n";}
  else { $total ="{\\tt\\ ".$total."}";
      	 if($total=~ /\t/g){ split_f9x; }
         else {$indent[0]=~ s/ /\\ /g; $total="\\mbox{".$indent[0].$total."}";}
         print logo "\\\\ $total\n";
  }
  $k++;
  }
print logo "}\n \\end{flushleft} \n";
print logo "% number of comments lines $linecom \n";
print logo "% number of FORTRAN code lines ", $num_lin-$linecom ,"\n";
if ($truetab ==1) {print logo "% detected tabs in $filein \n";}
print logo "% generated by for2latex version $versionr \n";
bot if($complet);
close(logo);
}
################################################################################
$versionr = "1.10";
use Getopt::Long;
@knownoptions = ("color|k",
                 "colorkey|ck=s",
                 "colorfcn|cf=s",
                 "colorspe|cs=s",
                 "colorcom|cc=s",
                 "colorstr|ca=s",                                                   
                 "complet|c",
                 "fontsize|f=s",
                 "help|h",
                 "highkey|hk=s",
                 "highfcn|hf=s",
                 "highspe|hs=s",
                 "highcom|hc=s",
                 "highstr|ha=s",                                                   
                 "lower|l",
                 "papersize|p=s",
		 "pdftex|pdf",
                 "tab|t=s",
                 "upper|u",
                 "version|V");
GetOptions (@knownoptions) || exit ;
################################################################################
if ($opt_version) {
   print " \n for2latex version $versionr  \n";
   print " for2latex is a perl script which converts a FORTRAN77, FORTRAN90,\n";
   print " FORTRAN95 or F code to syntax highlighted and colouring \n";
   print " LaTeX2e file by applying regular expressions.\n\n";
   print " Copyright (C) 2000 Luis Randez \n\n";
   print " randez\@posta.unizar.es \n\n";
   exit();
}
if ($opt_help) {
   print " \n for2latex  \n";
   print "  [--complet/-c] (default is no complet)\n";
   print "  with this option, the resulting file is ready to \n";
   print "  compile with LaTeX2e. \n\n";
   print "  [--fontsize/-f=font] (default font=10pt, only with option -c)\n";
   print "  where the font size must be accepted in LaTeX2e. \n\n";
   print "  [--help/-h] \n\n";
   print "  [--lower/-l] (default is no modify the input file) \n";
   print "  all lines starting with valid sentences in FORTRAN \n";
   print "  are set in lowercase mode, except words between quotes \n";
   print "  or comments after the symbol ! at the end of a line. \n\n";
   print "  [--papersize/-p=paper] (default paper=a4paper, only with option -c)\n";
   print "  where the paper size must be accepted in LaTeX2e. \n\n";
   print "  [--tab/-t=wide] (default is wide=8)\n";
   print "  replace tabs for a number given of spaces. \n\n";
   print "  [--upper/-u] (default is no modify the input file) \n";
   print "  all lines starting with valid sentences in FORTRAN \n";
   print "  are set in uppercase mode, except words between quotes \n";
   print "  or comments after the symbol ! at the end of a line. \n\n";
   print "  [--version/-V] \n\n";
   print "  [--pdftex/-pdf] (default output is dvi). Necessary to  \n\n";
   print "  do pdflatex with option complet \n\n";   
   print "  (highlighting)\n\n";
   print "  for2latex tries to highlight (and colouring) five classes of words, \n\n";
   print "  (1) keywords\n  (2) functions\n  (3) specifiers\n";
   print "  (4) comments\n  (5) words between quotes \n\n";
   print "  and the command option for highlight is:\n\n";
   print "  [--color/-k] (default is no colouring)\n";
   print "  (1) [--color_key/-ck=colour] (default keyword colour=Blue)\n";
   print "  (2) [--color_fcn/-cf=colour] (default function colour=Red)\n";
   print "  (3) [--color_spe/-cs=colour] (default specifier colour=Lavender)\n";
   print "  (4) [--color_com/-cc=colour] (default comment colour=Gray)\n";
   print "  (5) [--color_str/-ca=colour] (default quotes colour=Brown)\n\n";  
   print "  (colours allowed: the 68 predefinided internal colours \n ";
   print "  of the dvips PostScript driver, e.g. Emerald, DarkOrchid,...\n";
   print "  Remember put usenames in documentclass and \n";
   print "  \\usepackage[dvips]{color} if option complet it is not used. )\n\n";
   print "  (1) [--high_key/-hk=font] (default keyword font=sc)\n";
   print "  (2) [--high_fcn/-hf=font] (default function font=bf)\n";
   print "  (3) [--high_spe/-hs=font] (default specifier font=sf)\n";
   print "  (4) [--high_com/-hc=font] (default comment font=it)\n";
   print "  (5) [--high_str/-ha=font] (default quotes font=sl)\n\n";  
   print "  (fonts allowed: sc, bf, sf, sl, it, tt)\n";
   print "  (the font sc is ignored in comments and between quotes)\n\n";
   print "  NOTES: \n";
   print "  (*) a FORTRAN9x file is considered with extension .f9x,\n"; 
   print "      a F file with extension .F, else for2latex considered \n";
   print "      a FORTRAN77 file. \n\n";  
   print "  (*) for2latex tries to preserve the same number of lines \n";
   print "      than the original file, so if a FORTRAN line is very long, \n";
   print "      (or the font size is big, or the upper option is set), \n";
   print "      when the resulting file is procesed with LaTeX, \n";
   print "      may appear overfull errors. \n\n";                                             
   print "  e.g. \n\n";
   print "  for2latex -c -f=12pt -p=letterpaper -t=7 file1.f90\n\n";
   print "  for2latex -l -t=8 -hk=bf -hs=bf -hc=tt -ha=tt file2.f77\n\n";
   print "  for2latex -c -k -f=12pt -ck=Orange  file3.f90\n\n";
   print "  for2latex -c -k -hk=tt -hf=tt -hs=tt -hc=tt -ha=tt *.f90 (only colouring)\n\n";
   print "  the output files are named file1.tex and file2.tex. \n\n";
   print "  with no option is the same as \n";
   print "  for2latex file1.f90 -t=8 -hk=sc -hf=bf -hs=sf -hc=it -ha=sl\n";
   exit();
}

################################################################################
#                               MAIN PROGRAM                                   #
################################################################################
$tab="\t"; $sym="  &";
$TABSTOP = 8;         # default is substitute one tab = 8 spaces
$lower   = "";        # default is the same text (no lowercase mode)
$upper   = "";        # default is the same text (no uppercase mode)
$complet = "";        # default is the complet file ready to process 
$font    = "10pt";    # default size font in latex
$paper   = "a4paper"; # default paper in latex
$color   = "";        # default color is no color
$pdftex  = "";        # default is no pdf
######### define defaults fonts for HIGHLIGHTED SYNTAX #########################
$high_key  ="\\sc";   # font used for FORTRAN keywords    
$high_fcn  ="\\bf";   # font used for intrinsic FORTRAN functions
$high_spe  ="\\sf";   # font used for FORTRAN specifiers
$high_com  ="\\it";   # font used for comments
$high_quot ="\\sl";   # font used for string and character constants
######### define defaults colors ###############################################
$color_key  ="";  $color_fcn  ="";  $color_spe  ="";
$color_com  ="";  $color_quot ="";
##### define the defaults for the page in latex (only works with option -c) ####
$hoffset = " -2 true cm";    $voffset = " -3 true cm";
$textheight = "26 true cm";  $textwidth = "16.5 true cm";
################## check input options  ########################################
if ($opt_color)      {
    $color=",usenames";               $color_key  ="\\textcolor{Blue}";
    $color_fcn  ="\\textcolor{Red}";  $color_spe  ="\\textcolor{Magenta}";
    $color_com  ="\\textcolor{Gray}"; $color_quot ="\\textcolor{Brown}";
    if ($opt_colorkey) {$color_key  ="\\textcolor{".$opt_colorkey."}";}
    if ($opt_colorfcn) {$color_fcn  ="\\textcolor{".$opt_colorfcn."}";}
    if ($opt_colorspe) {$color_spe  ="\\textcolor{".$opt_colorspe."}";}
    if ($opt_colorcom) {$color_com  ="\\textcolor{".$opt_colorcom."}";}
    if ($opt_colorstr) {$color_quot ="\\textcolor{".$opt_colorstr."}";}
};
if ($opt_complet)    {
    $complet = "complet";
    if ($opt_fontsize)   {$font=$opt_fontsize};
    if ($opt_papersize)  {$paper=$opt_papersize};
}
if ($opt_lower)      {$lower="lower"};
if ($opt_upper)      {$upper="upper"};
if ($opt_tab)        {$TABSTOP=$opt_tab};
if ($opt_highkey)    {$high_key  ="\\".$opt_highkey};
if ($opt_highfcn)    {$high_fcn  ="\\".$opt_highfcn};
if ($opt_highspe)    {$high_spe  ="\\".$opt_highspe};
if ($opt_highcom)    {$high_com  ="\\".$opt_highcom};
if ($opt_highstr)    {$high_quot ="\\".$opt_highstr};
$document_options = "\[$font,$paper$color\]";
if($color) {$pp="\\textcolor{black}{\\tt\\&}";} else {$pp="{\\tt\\&}";}
## define the keywords, functions, specifiers and ambiguous words in FORTRAN ###
#
$Keyword="(ACCEPT|allocatable|allocate|ASSIGN|AUTOMATIC|BACKSPACE|BLOCK|byte|CALL|case *default|case|character|CLOSE|COMMON|complex|contains|CONTINUE|cycle|DATA|deallocate|DECODE|DELETE|DIMENSION|DO|double *complex|double *precision|double|elemental|ELSE|else *if|ELSEIF|elsewhere|ENCODE|end *do|END *FILE|end *forall|end *function|END *IF|end *interface|end *module|END *PROGRAM|end *select|end *subroutine|end *type|ENDFILE|END|ENDIF|endwhere|ENTRY|EQUIVALENCE|EXIT|EXTERNAL|forall|FORMAT|FUNCTION|GO *TO|GOTO|IF|implicit *double *precision|implicit *none|implicit *real|IMPLICIT|INCLUDE|INQUIRE|integer|intent|interface *ASSIGNMENT|interface *operator|interface|INTRINSIC|LOGICAL|MAP|module|namelist|NONE|nullify|ON|only|OPEN|optional|PARAMETER|PAUSE|POINTER|PRINT|private|procedure|PROGRAM|public|pure|real|READ|RECORD|recursive|result|RETURN|REWIND|rewrite|SAVE|select|STATIC|STOP|STRUCTURE|SUBROUTINE|SYSTEM|target|THEN|TO|TYPE|UNION|UNLOCK|use|VIRTUAL|VOLATILE|where|WHILE|WRITE)";
#
$func="(abs|achar|acos|adjustl|adjustr|aimag|aint|all|allocated|anint|any|asin|associated|atan|atan2|bit_size|btest|ceiling|char|cmplx|conjg|cos|cosh|count|cshift|date_and_time|dble|digits|dim|dot_product|dprod|eoshift|epsilon|exp|exponent|floor|fraction|huge|iachar|iand|ibclr|ibits|ibset|ichar|ieor|ifix|index|int|ior|ishft|ishftc|kind|lbound|len|len_trim|lge|lgt|llt|lle|log|log10|logical|lshift|malloc|matmul|max|maxexponent|maxloc|maxval|merge|min|minexponent|minloc|minval|mod|modulo|mvbits|nearest|nint|not|pack|precision|present|product|radix|random_seed|random_number|range|real|repeat|reshape|rrspacing|rshift|scale|scan|selected_int_kind|selected_real_kind|set_exponent|shape|sign|sin|sinh|size|spacing|spread|sqrt|sum|system_clock|tan|tanh|tiny|transfer|transpose|trim|ubound|unpack|verify)";
#
$spec="(access|action|advance|back|binary|blank|blocksize|carriagecontrol|count_rate|delim|dim|direct|end|eor|err|exist|field|file|fmt|form|formatted|iofocus|iolength|iostat|kind|qqmask|len|mask|mode|name|named|ncopies|nextrec|nml|number|opened|order|pad|position|put|read|readwrite|rec|recl|sequential|shape|share|size|source|stat|status|unformatted|unit|vector|write)";
#
$ambi = "(end|logical|read|real|write)";
################################################################################
if($#ARGV==-1) { print "missing input file\n"; }
else {
  for ($kq=0; $kq<=$#ARGV; $kq++){ if(-f $ARGV[$kq]){ f2t($ARGV[$kq]); }
  else {print "$ARGV[$kq] not found \n"; next;}
  }
}
########################## END PROGRAM #########################################