#!/usr/local/bin/perl
#
# xpm-fix file...                         -- just fix all these files
# xpm-fix [-o out_file] [-n name] file    -- fix this file
# xpm-fix [-o out_file] [-n name]         -- pipeline (stding to stdout)
#
#   This perl script fixed the icon name stored inside the xpm and sets all
# the colors of the xpm to proper X RBG color names.  To do this the
# program uses a inverted RGB color database "/tmp/color.*" to find the
# color name of a pixel value present in the xpm.  The `mk-color-db'
# program will be called automatically if the database have not been
# created yet.
#   This program is especially usful after converting a Portable Pixmap or
# other format into a X pixmap file.
#
#  Anthony Thyssen          3 Oct 1993     anthony@cit.gu.edu.au
#
$COLOR = "/usr/tmp/color";   # the location of the inverted color database
$pixel_t = 'H12';
$tmp = '/tmp/xpm-fix' . $$;
$b = "                                                                     \r";
$| = 1;   # auto flush stdout

#------------------------------------------------------------------------------
# Subroutines

sub Usage {
  print STDERR @_;
  print STDERR "usage: xpm-fix [-o outfile] [-n name] [file]\n";
  print STDERR " or  : xpm-fix file...\n";
  exit 10;
}

sub message {
  #  clear the line and print a message
  print $b, '  ', @_, "\r";
}

sub error {
  # clear line and output error message
  print $b;
  warn @_;
}

sub do_file {
  local($input, $output, $name) = @_;

  # convert name to a style suitable for inclusion in xpm
  $name =~ s#^.*/([^/]*)$#\1#;
  $name =~ s#[^\w]#_#;
  $name =~ s#^(.*)(_xpm|_ppm|_recol|_recol_bad)$#\1#;

  # substitute the name for pixel values  : look up database
  while (<$input>) {
    if ( /XPM/.../pixels/ ) {
      if ( /^static/ && /\*/) {     # name substitute
        $_ = join( '', 'static char *', $name, "_xpm[] = {\n");
      }
      $pixel =~ tr/abcdef/ABCDEF/;    # pixel name must be uppercase
      if ( ($pixel) = /\sc\s+#([0-9A-F]+)/ ) {  # color substitute
	$pixel = join( '', substr($pixel, 0, 1) x 4,
	                   substr($pixel, 1, 1) x 4,
                           substr($pixel, 2, 1) x 4 ) if length($pixel) == 3;
	$pixel = join( '', substr($pixel, 0, 2) x 2,
	                   substr($pixel, 2, 2) x 2,
                           substr($pixel, 4, 2) x 2 ) if length($pixel) == 6;
	s/#[0-9A-Fa-f]+/$color/
	     if  $color = $COLOR{ pack( $pixel_t, $pixel ) };

        # Uncomment to see color substitutions made
        # print STDERR "pixel = #$pixel   color = $color\n";
      }
    }
    print $output $_;
  }
}

#------------------------------------------------------------------------------
# Main program

# --- Process options ---
while( $_ = $ARGV[0], ($_, $arg) = /^-(.)(.*)/ ) {
  shift;
  if ( /-/ ) { last };
  if ( /o/ ) { $outfile    =  $arg || shift;  next }
  if ( /n/ ) { $name       =  $arg || shift;  next }
  &Usage( "Bad Option `-", $_, $arg, "'\n" );
}
undef($arg);

# set the standard output name to insert
$outname = 'noname';
$outname = $outfile   if $outfile;
$outname = $name      if $name;
undef($name);

# --- Open the pixel to color database ---
if ( ! -f $COLOR . ".dir" ) {
  warn( "Unable to find \"color\" database! -- tring to create it\n" );
  system( 'mk-color-db >/dev/null' );
}
dbmopen(%COLOR, $COLOR, undef) || die "Unable to open color database\n";


# --- do the job one of three methods ---
if ( $#ARGV > 0 || ( $#ARGV == 0 && ! defined $outfile ) ) {
  # multiple files  or  one file and no outfile given
  die "Unable to use given out_file with multiple files -- quiting\n"
    if defined $outfile;
  foreach $filename ( @ARGV ) {
    &message( 'fixing colors for "', $filename, '"' );
    if ( ! open( FILE , $filename ) ) {
      &error( 'Unable to open file "', $filename, '" : ', $!, "\n" );
      next;
    }
    open( TMP, ">$tmp" );
    &do_file( FILE, TMP, $filename );
    close FILE;
    close TMP;
    system( 'mv', $tmp, $filename );
  }
  print( $b, "DONE!\n" );
}
elsif ( $#ARGV == 0 ) {
  # one file given as well as a outfile
  if ( ! open( FILE , $ARGV[0] ) ) {
    &error( 'Unable to open file "', $ARGV[0], '" : ', $!, "\n" );
    exit 0;
  }
  if ( ! open( OUTFILE , ">$outfile" ) ) {
    &error( 'Unable to open file "', $outfile, '" : ', $!, "\n" );
    exit 0;
  }
  &do_file( FILE, OUTFILE, $outname );
  close FILE;
  close OUTFILE;
}
else {
  # no files given -- stdin only
  if( $outfile ) {
    if ( ! open( OUTFILE , ">$outfile" ) ) {
      &error( 'Unable to open file "', $outfile, '" : ', $!, "\n" );
      exit 0;
    }
    &do_file( STDIN, OUTFILE, $outname );
    close OUTFILE;
  }
  else {
    &do_file( STDIN, STDOUT, $outname );
  }
}

dbmclose(COLOR);