#!/usr/local/bin/tcl
#
# munge.tcl -- Tcl script to remove excess data from VRML 1.0 files
#
# Copyright (c) 1996 by Johan Hagman (Johan.Hagman@mailbox.swipnet.se).
#
# This is munge.tcl version 1.0, 18-May-96.
#
#   Disclaimer:
#
# This software is provided without support and without any obligation
# to assist in its use, correction, modification or enhancement.
#
# This software is provided "as is" with no warranties of any kind
# including the warranties of design, merchantibility and fitness for a
# particular purpose, or arising from a course of dealing, usage or trade
# practice.

proc convert {infile} {

    # Put outfile in current directory as <file>_munged.wrl
    set outfile [file rootname [file tail $infile]]_munged.wrl

    set ifd [open $infile r]
    set ofd [open $outfile w]

    # Do not change leading comments
    while {[gets $ifd line] >= 0 && [string first # $line] == 0} {
	puts $ofd $line
    }

    while {[gets $ifd line] >= 0} {

	# Remove spaces at beginning and end of line
	set line [string trim $line]

	# Ignore the line if it's empty
	if {[string length $line] == 0} {
	    continue
	}

	# Remove comment lines
	if {[string first # $line] == 0} {
	    continue;
	}

	# Remove comments at end of lines
	set commented [string first # $line]
	if {$commented > 0} {
	    set line [string range $line 0 [expr $commented - 1]]
	}

	# Reduce small exponential numbers to 0
	regsub -all {\-*[0-9]*\.[0-9]+e\-0[4-9]} $line {0} line

	# Reduce precision to three decimals
	regsub -all {(\.[0-9][0-9][0-9])([0-9]+)} $line {\1} line

	# Replace 0.0[more zeroes] with 0
	regsub -all {0\.0+$} $line 0 line

	# Replace <space>0. with <space>.
	regsub -all {(^| |	)0\.} $line { .} line

	# Replace <space>-0. with <space>-.
	regsub -all {(^| |	)-0\.} $line { -.} line

	# Spaces may have re-occured at beginning of line, trim again
	set line [string trim $line]

	# Replace <space>.000 with <space>0
	regsub -all {( |	)\.000} $line { 0} line

	# Remove spaces between commas
	regsub -all {([0-9],)( |	+)} $line {\1} line

	puts $ofd $line
    }       
    close $ifd
    close $ofd

    # Calculate and report file size reduction
    set insize [file size $infile]
    set outsize [file size $outfile]

    puts "$infile:\t\t$insize bytes"
    puts "$outfile:\t$outsize bytes, reduced by [format "%4.2f" \
		[expr (1.0 - $outsize.0 / $insize.0) * 100.0]]%"
}

#------------------------------------------------------------

proc usage {} {
    puts "usage: munge \[-v | -h\] infile.wrl"
    puts "\t-v, -h\t show program version and usage"
    exit
}

#------------------------------------------------------------

# Parse cmd line options. $argc and $argv contains args

# Create a list from $argv
set argvList [split $argv " "]

set idx 0
foreach arg $argvList {
    if {[string first - $arg] == 0 } {
	# Examine options
	switch [string index $arg 1] {
	    v - h { puts "munge version 1.0 by Johan.Hagman@mailbox.swipnet.se, 18 May 1996"
		usage; exit }
	    x { puts dummy }
	    #l { trace variable fd rw traceVar }
	    default { puts "munge: bad option \"$arg\""; usage }
	}
	incr argc -1
	incr idx
    } else {
	break
    }
}

# Must have at least one arg left
if {$argc < 1} {
    puts "munge: must specify input file"
    usage
}

# Get the argument
set infile [lindex $argvList $idx]

# File must be readable
if {![file readable $infile]} {
    puts "munge: cannot open \"$infile\""
    exit
}

# Input must be a .wrl file
if {[file extension $infile] != ".wrl"} {
    puts "munge: input file must be a .wrl file"
    exit
}

convert $infile
exit