#!/usr/bin/perl -w
#
# Syntax:  adjust_fig_lines [-h] [-d dash_value] [-o dot_value] 
#                           [-l line_style] [-n] [-f] filename [...]
#
# Purpose: Adjusts the distance parameter in dashed, dotted, etc.
#          lines of an xfig figure. This is useful for adapting this
#          parameter for xfig figures created from matlab eps figures
#          using pstoedit.
#          The distance parameter value 4.0 will be replaced by the
#          the value dash_value (default: 6.0) for dashed and dashed-*-dotted 
#          lines and by dot_value (default: 5.0) for dotted lines.
#          Use the -l flag to specify which line style should be adjusted
#             1 = Dashed
#             2 = Dotted
#             3 = Dash-dotted
#             4 = Dash-double-dotted
#             5 = Dash-triple-dotted
#          The argument can also be specified as, e.g., 1|2.
#          If the -l flag is not specified all of the above line styles will 
#          be adjusted.
#          If the -n flag is specified only the dashed and dashed-*-dotted will
#          be adjusted (i.e., -n is equivalent to -l 1|3|4|5).
#          Use the -f flag to automatically overwrite any existing fig file
#          (use with caution).
#          The -h flag shows the help info for this command.
#
# See also: pstoedit, fig2eps, figl2eps

# Created: Sep 18, 2011       by Bart De Schutter
# Last revised: Oct  9, 2011  by Bart De Schutter
#
# See http://www.deschutter.info/util/scripts.html for the latest version of
# this script.

# Status: public
# Category: xfig

###############################################################################
#
#  Main program.
#
###############################################################################

use strict;
use Inout;

my ($dash_value, $dot_value, $line_style_str, $ask);

$| = 1;               # Set autoflush on.
($dash_value, $dot_value, $line_style_str, $ask) = process_options ();
foreach my $fig_file (@ARGV)
{
   adjust_lines ($fig_file, $dash_value, $dot_value, $line_style_str, $ask);
}
exit;


###############################################################################
#
#  FUNCTION DEFINITIONS
#
###############################################################################

###############################################################################
#
#  ($dash_value, $dot_value, $line_style_str) = process_options ()
#
#  Processes the options flags, if any.
#
#  Inputs:  none
#
#  Outputs: $dash_value      replacement value for dashed lines
#           $dot_value       replacement value for dotted lines
#           $line_style_str  line styles to be replaced
#           $ask             whether or not to ask permission to overwrite
#                            existing fig files
#
#  Global variables: @ARGV          list of input arguments
#
###############################################################################

sub process_options
{
   my ($option, $dash_value, $dot_value, $line_style_str, $ask, $arg, $command);

   ( $command = $0 ) =~ s/.*\///;
   $dash_value = "6.0";
   $dot_value = "5.0";
   $line_style_str = "1|2|3|4|5";
   $ask = 1;
   while (  ( $#ARGV >= 0 ) && ( $ARGV[0] =~ /^-(.*)/ ) )
   {
      $option = $1;
      if ( $option eq "h" )
      {
         system("sed '/^\$/q;/^#!/d;s/^# //;s/^#//' $0 >&2");
         exit 1;
      }
      elsif ( $option =~ /^([dol])(.*)$/ )
      {
         $option = $1;
         $arg = $2;
         if ( $arg eq "" )
         {
            shift @ARGV;
            if ( $#ARGV >= 0 )
            {
               $arg = $ARGV[0];
            }
            else
            {
               syntax_error ("Option $option requires an extra argument.");
            }
         }
         if ( $option eq "l" )
         {
            if ( $arg !~ /^[1-5|]$/ )
            {
               syntax_error ("Wrong format for the line style argument.");
            }
            $line_style_str=$arg;
         }
         else  # so $option equals d or o
         {
            if ( $arg !~ /^[0-9.]+/ )
            {
               syntax_error ("The value of the distance parameter should ".
                             "be a nonnegative number.");
            }
            else
            {
               $dash_value = $arg if ( $option eq "d" );
               $dot_value = $arg if ( $option eq "o" );
            }
         }
      }
      elsif ( $option eq "n" )
      {
         $line_style_str = "1|3|4|5";
      }
      elsif ( $option eq "f" )
      {
         $ask = 0;
      }
      else
      {
         syntax_error ("Unknown option $option in $command.");
      }
      shift @ARGV;
   }
   if ( $#ARGV < 0 )
   {
      syntax_error ("$command requires at least 1 input argument.");
   }
   return ($dash_value, $dot_value, $line_style_str, $ask);
}


###############################################################################
#
#  adjust_lines ($fig_file, $dash_value, $dot_value, $line_style_str, $ask)
#
#  Adjusts the distance parameter in the given fig file.
#
#  Inputs:  $fig_file        file name string
#           $dash_value      replacement value for dashed lines
#           $dot_value       replacement value for dotted lines
#           $line_style_str  line styles to be replaced
#           $ask             whether or not to ask permission to overwrite
#                            existing fig files
#
#  Outputs: none
#
###############################################################################

sub adjust_lines
{
   my ($fig_file, $dash_value, $dot_value, $line_style_str, $ask) = @_;
   my ($base_name, $extension, $dest_file, $line, $ls, $answer);
   my ($dash_line, $dot_line);

   ($base_name, $extension) = get_extension ($fig_file, 0);
   $fig_file .= ".fig" if ( $extension eq "" );
   $dest_file = $base_name."_adjusted.fig";

#print "$line_style_str\n";
   open (FIG_FILE, "<$fig_file") || die ("Cannot open $fig_file");
   open (DEST_FILE, ">$dest_file") || die ("Cannot open $dest_file");
   while ( defined( $line = <FIG_FILE> ) )
   {
      chomp ($line);
      # 1: type 
      # 2: line_style 
      # 3: thick 
      # 4: pen_col 
      # 5: fill_col 
      # 6: depth 
      # 7: pen_style
      # 8: area_fill
      # 9: dist_par
      # 10: remainder
      if ( $line =~ /^2 (\d) ([-0-9]*) (\d+) ([-0-9]*) ([-0-9]*) (\d+) ([-0-9]*) ([-0-9]*) ([.\d]+) (.*)$/ )
      {
         $ls = $2;
         $dash_line = "2 $1 $2 $3 $4 $5 $6 $7 $8 $dash_value $10\n";
         $dot_line  = "2 $1 $2 $3 $4 $5 $6 $7 $8 $dot_value $10\n";
         if ( $ls =~ /$line_style_str/ )
         {
            print DEST_FILE ( $ls == 2 ) ? $dot_line : $dash_line;
         }
         else
         {
            print DEST_FILE $line."\n";
         }
      }
      else
      {
         print DEST_FILE $line."\n";
      }
   }
   print ("$fig_file transformed into $dest_file\n");
   close (DEST_FILE);
   close (FIG_FILE);
   if ( $ask )
   {
      print "\nMove $dest_file to $fig_file? y/n [n] ";
      chomp ($answer = <STDIN>);
   }
   if ( !$ask || ( $answer =~ /^y/i ) )
   {
      unlink ($fig_file) || die ("Cannot delete $fig_file");
      system ("mv $dest_file $fig_file ") == 0 || 
         die ("Cannot copy $dest_file to $fig_file");
   }
}