#!/usr/bin/perl
#
# s2plot-vrml2x3d.pl: post-process an S2PLOT-exported VRML (.wrl) file
#                     to remove unsupported elements (eg lineProperties)
#                     and create duplicate textures that are used with
#                     more than one colour.
#
# Use of this script implies acceptance of the requirement that at
# least one of the following papers be cited when the script is used
# to produce a published work:
#
# 1. Fluke, C.J., Barnes, D.G., Jones, N.T., "Interchanging Interactive
#    3-d graphics for Cosmology", submitted to Publications of the 
#    Astronomical Society of Australia, Oct 2008.
#
# 2. Barnes, D.G., Fluke, C.J., Bourke, P.D., Parry, O.T., 2006,
#    "An Advanced, Three-Dimensional Plotting Library for Astronomy",
#    Publications of the Astronomical Society of Australia, 23, 82.
#
# ==================================================================
# S2PLOT is freely available for non-commercial and educational use,
# however, it is not public-domain software. The programming library
# and documentation may not be redistributed or sub-licensed in any
# form without permission from Swinburne University of
# Technology. The programming library and sample codes are provided
# without warranty.
#
# We would appreciate it if research outcomes using S2PLOT would
# provide the following acknowledgement:
#
# "Three-dimensional visualisation was conducted with the S2PLOT
# progamming library"
#
# and a reference to
#
# D.G.Barnes, C.J.Fluke, P.D.Bourke & O.T.Parry, 2006, Publications
# of the Astronomical Society of Australia, 23(2), 82-93.
#
# S2PLOT development was funded through the Researcher Developer
# Grant Scheme at Swinburne University of Technology.
# ==================================================================
#
# original version: David Barnes, September 2008
#
# $Id: s2plot-vrml2x3d.pl 5329 2008-10-14 04:49:25Z dbarnes $

print "# s2plot-vrml2x3d.pl\n";
print "#\n";
print("# Use of this script implies acceptance of the requirement that at\n");
print("# least one of the following papers be cited when the script is used\n");
print("# to produce a published work:\n");
print("#\n");
print("# 1. Fluke, C.J., Barnes, D.G., Jones, N.T., \"Interchanging Interactive\n");
print("#    3-d graphics for Cosmology\", submitted to Publications of the\n");
print("#    Astronomical Society of Australia, Oct 2008.\n");
print("#\n");
print("# 2. Barnes, D.G., Fluke, C.J., Bourke, P.D., Parry, O.T., 2006,\n");
print("#    \"An Advanced, Three-Dimensional Plotting Library for Astronomy\",\n");
print("#    Publications of the Astronomical Society of Australia, 23, 82.\n");
print("#\n");

$in_appearance = 0;
$in_material = 0;
$has_colour = 0;
$in_texture = 0;
$has_texture = 0;
$this_texture = "";
@this_colour = (-1., -1., -1.);
$in_lineproperties = 0;

if ($#ARGV != 0) {
  die "Please provide wrl filename on command line\n";
}
$fin = $ARGV[0];
$fout = "mod-" . $fin;

open(FIN, "< $fin");
open(FOUT, "> $fout");

$nextout = "NULL";

# assoc. array for unique texture - colour combinations
%coltexts = ();
# counter for creating new (copied) files of textures
$idx = 0;

while(<FIN>) {

  if (!($nextout eq "NULL")) {
    print FOUT $nextout, "\n";
  }

  chop;
  $nextout = $_;

  if (/appearance Appearance {/) {
    $in_appearance = 1;
    next;
  }

  if ($in_appearance) {

    if (/material Material {/) {
      $in_material = 1;
      next;
    } elsif (/texture ImageTexture {/) {
      $in_texture = 1;
      next;
    } elsif (/lineProperties LineProperties {/) {
      $in_lineproperties = 1;
      $nextout = "NULL";
      next;
    }

    if ($in_lineproperties) {
      if (/}/) {
	$in_lineproperties = 0;
      }
      $nextout = "NULL";
      next;
    }

    if ($in_material) {

      #print "in material: ", $_, "\n";

      if (/emissiveColor\s+(.+)\s+(.+)\s+(.+)/) {
	@this_colour = ($1, $2, $3);
	$has_colour = 1;
	next;
      }
      if (/}/) {
	$in_material = 0;
	next;
      }
    }

    if ($in_texture) {

      #print "in texture: ", $_, "\n";

      if (/url\s+\[\s*"(.+)"\s*\]/) {
	$this_texture = $1;
	$has_texture = 1;

	if ($has_texture && $has_colour) {
	  # round colour components to 2 decimal places
	  # create hash of colours with this texture
	  # see if we've already made a copy for this combination
	  # copy texture and add to "dictionary" if new one needed
	  # use from dictionary
	  #print $this_texture, "\n";

	  $string = sprintf("%s:%4.2f:%4.2f:%4.2f", $this_texture,
			    $this_colour[0], $this_colour[1],
			    $this_colour[2]);

	  if (!exists($coltexts{$string})) {
	    $idx += 1;
	    
	    $texname = sprintf("duptex%05d.png", $idx);
	    system "cp $this_texture $texname";
	    $coltexts{$string} = $texname;

	  }

	  if (exists($coltexts{$string})) {

	    $nextout = sprintf("\t\t\turl [ \"%s\" ]\n",
			       $coltexts{$string});

	  } else {
	    die "Cannot find colour-texture combination to use!\n";
	  }


	}


	$has_texture = 0;
	$this_texture = "";
	$has_colour = 0;
	$this_colour = (-1., -1., -1.);
	next;
      }

      if (/}/) {
	$in_texture = 0;
	next;
      }
    }


    if (/}/ && !$in_texture && !$in_material) {
      $in_appearance = 0;
      next;
    }

  }
}

if (!($nextout eq "NULL")) {
  print FOUT $nextout, "\n";
}

close(FOUT);
close(FIN);

$xout = $fin;
$xout =~ s/\.wrl/\.x3d/;
system "v2x3d $fout $xout";
system "rm -f $fout";
