
# This code is shared by all the ICEM CFD GUI's.
#
# Copyright (c) 1993 - 1995 Pacific Marketing and Consulting, Inc,
#       and ICEM Systems, GmbH.  All rights reserved.
# Author:  Wayne A. Christopher, wayne@icemcfd.com

proc iges_float {num} {
    regsub -nocase d $num e num
    if ![scan $num %f v] {
	error "Bad floating point number $num"
    }
    return $v
}

proc iges_get_units {file} {
    set global [load_iges "" $file 0 "" 1]
    set flag [lindex $global 14]
    set units [lindex $global 15]
    switch $flag {
	1 { return in }
	2 { return mm }
	4 { return ft }
	6 { return m }
	9 { return microns }
	10 { return cm }
	default {
	    mess "Warning: unknown unit system $flag ($units)\n" red
	    return ""
	}
    }
}

proc load_iges {w file verbose {create_prefix ""} {get_head 0}} {
    global iges_diag_file

    if [info exists iges_diag_file] {
	set diag_fp [open $iges_diag_file w]
    } else {
	set diag_fp stdout
    }
    
    # First, read the file into a set of arrays, indexed by the line numbers in
    # that section.  The arrays are called X_section, where X is G, D, etc.
    # Also we have X_count.
    set fp [open $file r]
    while {![eof $fp]} {
	# We don't want to have to subtract 1 from every index in the manual...
	set line " [gets $fp]"
	set type [string index $line 73]
	if {[scan [string range $line 74 80] %d number] < 1} {
	    # puts "SKIP: $line"
	    if ![info exists skipping] {
		set skipping 1
		#mess "Warning: skipping junk at the beginning of the IGES file\n" red
	    }
	    continue
	}
	if {$get_head && ($type == "D")} break
	
	set ${type}_section($number) [string range $line 0 80]
	set ${type}_count $number
    }
    close $fp
    
    if $verbose {
	if [info exists S_count] {
	    puts $diag_fp "Start section ----"
	    for {set i 1} {$i <= $S_count} {incr i} {
		puts $diag_fp [string range $S_section($i) 1 72]
	    }
	    puts $diag_fp "------------------"
	    puts $diag_fp ""
	}
    }
    
    # Now cat all the global lines together.
    if ![info exists G_count] {error "No global section"}
    set global ""
    for {set i 1} {$i <= $G_count} {incr i} {
	append global [string range $G_section($i) 1 72]
    }
    
    # Figure out the delimiter characters.
    set comma ,
    set semi \;
    if {[regexp ^,,.* $global dummy]} {
	set skip 2
    } elseif {[regexp ^1H(.)(.)1H(.)(.).* $global dummy a1 a2 b1 a3]} {
	if {($a1 != $a2) || ($a2 != $a3)} {error "param delim mismatch 1"}
	set comma $a1
	set semi $b1
	set skip 8
    } elseif {[regexp ^,1H(.),.* $global dummy b1]} {
	set semi $b1
	set skip 5
    } elseif {[regexp ^1H(.)(.)(.).* $global dummy a1 a2 a3]} {
	if {($a1 != $a2) || ($a2 != $a3)} {error "param delim mismatch 2"}
	set comma $a1
	set skip 5
    }
    set global [string range $global $skip end]
    
    set global [iges_split_line $global $comma $semi 3]
    
    if $get_head { return $global }
    
    if $verbose {
	puts $diag_fp "sending product id:        [lindex $global 3]"
	puts $diag_fp "file name:                 [lindex $global 4]"
	puts $diag_fp "system id:                 [lindex $global 5]"
	puts $diag_fp "preprocessor version:      [lindex $global 6]"
	puts $diag_fp "integer bits:              [lindex $global 7]"
	puts $diag_fp "max single power of 10:    [lindex $global 8]"
	puts $diag_fp "single significant digits: [lindex $global 9]"
	puts $diag_fp "max double power of 10:    [lindex $global 10]"
	puts $diag_fp "double significant digits: [lindex $global 11]"
	puts $diag_fp "recieving product id:      [lindex $global 12]"
	puts $diag_fp "model space scale:         [lindex $global 13]"
	puts $diag_fp "unit flag:                 [lindex $global 14]"
	puts $diag_fp "units:                     [lindex $global 15]"
	puts $diag_fp "max line weight grades:    [lindex $global 16]"
	puts $diag_fp "max line width:            [lindex $global 17]"
	puts $diag_fp "date of generation:        [lindex $global 18]"
	puts $diag_fp "minimum resolution:        [lindex $global 19]"
	puts $diag_fp "max coord value:           [lindex $global 20]"
	puts $diag_fp "author name:               [lindex $global 21]"
	puts $diag_fp "organization name:         [lindex $global 22]"
	puts $diag_fp "iges spec version:         [lindex $global 23]"
	puts $diag_fp "drafting standard:         [lindex $global 24]"
	puts $diag_fp "model creation date:       [lindex $global 25]"
    }
    
    # Now go through the directory and extract the entities.
    if ![info exists D_count] {puts "no entities!"; return}
    for {set ll 1} {$ll <= $D_count} {incr ll} {
	set line1 [string range $D_section($ll) 1 end]
	incr ll
	set line2 [string range $D_section($ll) 1 end]
	set line "$line1$line2"
	set ind 0
	foreach field {etype pline struct linefont level view transform label
	    statno seq1 etype2 lineweight color pcount formno res1 res2
	    elabel esub seq2} {
		set $field [string range $line $ind [expr {$ind + 7}]]
		incr ind 8
	    }
	
	if {$etype2 != $etype} {
	    puts stderr "Bad match: etype \"$etype\" etype2 \"$etype2\""
	    if {$diag_fp != "stdout"} { close $diag_fp }
	    return
	}
	set blank 0;  scan [string range $statno 0 1] %d blank
	set sub 0;    scan [string range $statno 2 3] %d sub
	set entuse 0; scan [string range $statno 4 5] %d entuse
	set hier 0;   scan [string range $statno 6 7] %d hier
	set blank_string [lindex {visible blanked} $blank]
	set sub_string [lindex {independent physical logical both} $sub]
	set entuse_string [lindex {geometry annotation definition other
	    logical/positional "2d parametric"} $entuse]
	set hier_string [lindex {"global top down" "global defer"
	    "use hierarchy property"} $hier]

	if $verbose {
	    puts $diag_fp ""
	    puts $diag_fp "Entity:"
	    puts $diag_fp "\tparam line:       $pline"
	    puts $diag_fp "\ttype:             $etype"
	    puts $diag_fp "\tstructure:        $struct"
	    puts $diag_fp "\tline font:        $linefont"
	    puts $diag_fp "\tlevel:            $level"
	    puts $diag_fp "\tview:             $view"
	    puts $diag_fp "\ttransform:        $transform"
	    puts $diag_fp "\tlabel:            $label"
	    puts $diag_fp "\tstatus:           $blank_string, $sub_string, $entuse_string, $hier_string"
	    puts $diag_fp "\tcolor:            $color"
	    puts $diag_fp "\tline weight:      $lineweight"
	    puts $diag_fp "\tparam line count: $pcount"
	    puts $diag_fp "\tform number:      $formno"
	    puts $diag_fp "\tlabel:            $elabel"
	    puts $diag_fp "\tsubscript:        $esub"
	}
	
	scan $level %d level
	scan $etype %d etype
	if {$etype == 0} continue
	
	# Now grab all the parameter lines.
	set paramlines {}	
	scan $pcount %d pcount
	scan $pline %d pline
	for {set l 0} {$l < $pcount} {incr l} {
	    append paramlines [string range $P_section([expr {$pline + $l}]) 1 64]
	}
	if {$paramlines == ""} continue
	
	set pl [string length $paramlines]
	
	if {$create_prefix != ""} {
	    ${create_prefix}_one_entity $w $etype $pl
	}
	
	set nparams [iges_split_line $paramlines $comma $semi 0]
	catch {unset params}
	set i 0
	foreach np $nparams { set params($i) $np; incr i }
	
	# For the time being, handle types:
	# 100 102 110 112 116 120 124 126 128 142 144
	case $etype in {
	    100 {
		if $verbose {
		    puts $diag_fp "\tCIRCULAR ARC ..."
		}
	    }
	    106 {
		# This is a work-a-round
		if {$params(1) == 1} {
		    scan $params(3) %g z
		    for {set i 0} {$i < $params(2)} {incr i} {
			scan $params([expr $i * 2 + 4]) %g x
			scan $params([expr $i * 2 + 5]) %g y
			set x [format %g $x]; set y [format %g $y]
			set p2 [list $x $y $z]
			if $i {
			    if {$p1 != $p2} {
				#puts "$i: $p1 -> $p2"
				${create_prefix}_110 $w $p1 $p2 $level $elabel 0
			    }
			}
			set p1 $p2
		    }
		}
	    }
	    102 {
		if $verbose {
		    puts $diag_fp "\tCOMPOSITE CURVE ..."
		}
	    }
	    108 {
		if $verbose {
		    puts $diag_fp "\tPLANE ..."
		}
	    }
	    110 {
		foreach i {1 2 3 4 5 6} {
		    set v($i) [iges_float $params($i)]
		}
		set p1 "$v(1) $v(2) $v(3)"
		set p2 "$v(4) $v(5) $v(6)"
		
		if $verbose {
		    puts $diag_fp "\tLINE: ($p1) -> ($p2)"
		}

		if {$create_prefix != ""} {
		    ${create_prefix}_110 $w $p1 $p2 $level $elabel
		}
	    }
	    112 {
		scan $params(1) %d stype
		scan $params(2) %d hvalue
		scan $params(3) %d dimensions
		scan $params(4) %d numsegs

		if {$stype != 6} {
		    if $verbose {
			puts $diag_fp "\tSPLINE type $stype..."
			puts $diag_fp "\tCan only handle bsplines (type 6)"
		    }
		    continue
		}
		
		set ind 5
		for {set n 0} {$n < $numsegs} {incr n} {
		    set val $params($ind)
		    if {$val == ""} {
			set breakpt($n) 0
		    } else {
			set breakpt($n) [iges_float $val]
		    }
		    incr ind
		}
		for {set n 0} {$n < $numsegs} {incr n} {
		    foreach vn {ax bx cx dx ay by cy dy az bz cz dz} {
			set val $params($ind)
			if {$val == ""} {
			    set ${vn}($n) 0
			} else {
			    set ${vn}($n) [iges_float $val]
			}
			incr ind
		    }
		}
		foreach vn {tpx0 tpx1 tpx2 tpx3 tpy0 tpy1 tpy2 tpy3 tpz0 tpz1
		    tpz2 tpz3} {
			set val $params($ind)
			if {$val == ""} {
			    set $vn 0
			} else {
			    set $vn [iges_float $val]
			}
			incr ind
		    }
		
		if $verbose {
		    puts $diag_fp "\tPARAMETRIC SPLINE: type $stype, h $hvalue, dims $dimensions, segments $numsegs"
		    for {set n 0} {$n < $numsegs} {incr n} {
			puts $diag_fp "\t$breakpt($n) $ax($n) $bx($n) $cx($n) $dx($n) $ay($n) $by($n) $cy($n) $dy($n) $az($n) $bz($n) $cz($n) $dz($n)"
		    }
		}
		
		if {$create_prefix != ""} {
		    # not sure what to do here
		}
	    }
	    116 {
		foreach i {1 2 3} {
		    set v($i) [iges_float $params($i)]
		}
		set p1 "$v(1) $v(2) $v(3)"
		
		if $verbose {
		    puts $diag_fp "\tPOINT: ($p1)"
		}
		
		if {$create_prefix != ""} {
		    ${create_prefix}_116 $w $p1 $level $elabel
		}
	    }
	    120 {
		if $verbose {
		    puts $diag_fp "\tSURFACE OF REVOLUTION ..."
		}
	    }
	    124 {
		if $verbose {
		    puts $diag_fp "\tMATRIX ..."
		    puts $diag_fp "\t$params(1) $params(2) $params(3)    $params(4)"
		    puts $diag_fp "\t$params(5) $params(6) $params(7)    $params(8)"
		    puts $diag_fp "\t$params(9) $params(10) $params(11)    $params(12)"
		}
	    }
	    126 {
		scan $params(1) %d k
		scan $params(2) %d m
		scan $params(3) %d planar
		scan $params(4) %d closed
		scan $params(5) %d polynomial
		scan $params(6) %d periodic
		
		set n [expr {1 + $k - $m}]
		set a [expr {$n + 2 * $m}]
		
		set ind 6
		for {set i -$m} {$i <= $n + $m} {incr i} {
		    set knot($i) [iges_float $params([incr ind])]
		}
		for {set i 0} {$i <= $k} {incr i} {
		    set weight($i) [iges_float $params([incr ind])]
		}
		for {set i 0} {$i <= $k} {incr i} {
		    set xval($i) [iges_float $params([incr ind])]
		    set yval($i) [iges_float $params([incr ind])]
		    set zval($i) [iges_float $params([incr ind])]
		}
		
		set startp [iges_float $params([incr ind])]
		set endp [iges_float $params([incr ind])]
		set xnorm [iges_float $params([incr ind])]
		set ynorm [iges_float $params([incr ind])]
		set znorm [iges_float $params([incr ind])]
		
		if $verbose {
		    puts $diag_fp "\tRATIONAL B-SPLINE CURVE ..."
		    puts $diag_fp "\tk = $k, m = $m"
		    puts $diag_fp \t nonewline
		    if $planar     { puts $diag_fp "planar, " nonewline } else { puts $diag_fp "nonplanar, " nonewline }
		    if $closed     { puts $diag_fp "closed, " nonewline } else { puts $diag_fp "open, " nonewline }
		    if $polynomial { puts $diag_fp "polynomial, " nonewline } else { puts $diag_fp "rational, " nonewline }
		    if $periodic   { puts $diag_fp "periodic" } else { puts $diag_fp "nonperiodic" }
		}
		set uknot_list {}; set vknot_list {}
		if $verbose {
		    puts $diag_fp "\tknots:"
		}
		for {set i -$m} {$i <= $n + $m} {incr i} {
		    if $verbose {
			puts $diag_fp "\t\t$i:\t$knot($i)"
		    }
		    lappend uknot_list $knot($i)
		}
		
		set weight_list {}
		if $verbose {
		    puts $diag_fp "\tweights:"
		}
		for {set i 0} {$i <= $k} {incr i} {
		    if $verbose {
			puts $diag_fp "\t\t$i:\t$weight($i)"
		    }
		    lappend weight_list $weight($i)
		}
		
		set control_list {}
		if $verbose {
		    puts $diag_fp "\tcontrol points:"
		}
		for {set i 0} {$i <= $k} {incr i} {
		    if $verbose {
			puts $diag_fp "\t\t$i:\t$xval($i), $yval($i), $zval($i)"
		    }
		    lappend control_list $xval($i)
		    lappend control_list $yval($i)
		    lappend control_list $zval($i)
		}
		if $verbose {
		    puts $diag_fp "\tparameter limits: $startp, $endp"
		    puts $diag_fp "\tnormal: $xnorm, $ynorm, $znorm"
		}
		
		if {$create_prefix != ""} {
		    ${create_prefix}_126 $w $polynomial $k $m $uknot_list \
			$weight_list $control_list $level $elabel
		}
	    }
	    128 {
		scan $params(1) %d k1
		scan $params(2) %d k2
		scan $params(3) %d m1
		scan $params(4) %d m2
		scan $params(5) %d closed1
		scan $params(6) %d closed2
		scan $params(7) %d polynomial
		scan $params(8) %d periodic1
		scan $params(9) %d periodic2
		
		set n1 [expr {1 + $k1 - $m1}]
		set n2 [expr {1 + $k2 - $m2}]
		set a [expr {$n1 + 2 * $m1}]
		set b [expr {$n2 + 2 * $m2}]
		set c [expr {(1 + $k1) * (1 + $k2)}]
		
		set ind 9

		for {set i -$m1} {$i <= $n1 + $m1} {incr i} {
		    set knot1($i) [iges_float $params([incr ind])]
		}
		for {set i -$m2} {$i <= $n2 + $m2} {incr i} {
		    set knot2($i) [iges_float $params([incr ind])]
		}
		for {set i 0} {$i <= $k2} {incr i} {
		    for {set j 0} {$j <= $k1} {incr j} {
			set weight($i,$j) [iges_float $params([incr ind])]
		    }
		}

		for {set i 0} {$i <= $k2} {incr i} {
		    for {set j 0} {$j <= $k1} {incr j} {
			set xval($i,$j) [iges_float $params([incr ind])]
			set yval($i,$j) [iges_float $params([incr ind])]
			set zval($i,$j) [iges_float $params([incr ind])]
		    }
		}
		set startu [iges_float $params([incr ind])]
		set endu [iges_float $params([incr ind])]
		set startv [iges_float $params([incr ind])]
		set endv [iges_float $params([incr ind])]
		
		if $verbose {
		    puts $diag_fp "\tRATIONAL B-SPLINE SURFACE ..."
		    puts $diag_fp "\tk1 = $k1, k2 = $k2, m1 = $m1, m2 = $m2"
		    set no -nonewline; puts $diag_fp {\t} nonewline
		    if $closed1    { puts $diag_fp "closed1, " } else { puts $diag_fp "open1, " }
		    if $closed2    { puts $diag_fp "closed2, " } else { puts $diag_fp "open2, " }
		    if $polynomial { puts $diag_fp "polynomial, " } else { puts $diag_fp "rational, "}
		    if $periodic1  { puts $diag_fp "periodic1" } else {puts $diag_fp "nonperiodic1, "}
		    if $periodic2  { puts $diag_fp "periodic2" } else { puts $diag_fp "nonperiodic2" }
		}

		set uknot_list {}; set vknot_list {}		
		if $verbose {
		    puts $diag_fp "\tu knots:"
		}
		for {set i -$m1} {$i <= $n1 + $m1} {incr i} {
		    if $verbose {
			puts $diag_fp "\t\t$i:\t$knot1($i)"
		    }
		    lappend uknot_list $knot1($i)
		}
		if $verbose {
		    puts $diag_fp "\tv knots:"
		}
		for {set i -$m2} {$i <= $n2 + $m2} {incr i} {
		    if $verbose {
			puts $diag_fp "\t\t$i:\t$knot2($i)"
		    }
		    lappend vknot_list $knot2($i)
		}
		
		set weight_list {}
		if $verbose {
		    puts $diag_fp "\tweights:"
		}
		for {set i 0} {$i <= $k2} {incr i} {
		    for {set j 0} {$j <= $k1} {incr j} {
			if $verbose {
			    puts $diag_fp "\t\t$i, $j:\t$weight($i,$j)"
			}
			lappend weight_list $weight($i,$j)
		    }
		}

		set control_list {}
		if $verbose {
		    puts $diag_fp "\tcontrol points:"
		}
		for {set i 0} {$i <= $k2} {incr i} {
		    for {set j 0} {$j <= $k1} {incr j} {
			if $verbose {
			    puts $diag_fp "\t\t$i, $j:\t$xval($i,$j), $yval($i,$j), $zval($i,$j)"
			}
			lappend control_list $xval($i,$j)
			lappend control_list $yval($i,$j)
			lappend control_list $zval($i,$j)
		    }
		}
		if $verbose {
		    puts $diag_fp "\tu parameter limits: $startu, $endu"
		    puts $diag_fp "\tv parameter limits: $startv, $endv"		
		}
		
		if {$create_prefix != ""} {
		    ${create_prefix}_128 $w $polynomial $k1 $m1 $k2 $m2 \
			    $uknot_list $vknot_list $weight_list \
			    $control_list $level $elabel
		}
            }
	    142 {
		if $verbose {
		    puts $diag_fp "\tPARAMETRIC SURFACE CURVE ..."
		    puts $diag_fp "\tcreation method:   $params(1)"
		    puts $diag_fp "\tsurface of curve:  $params(2)"
		    puts $diag_fp "\tparametric curve:  $params(3)"
		    puts $diag_fp "\tmodel space curve: $params(4)"
		    puts $diag_fp "\tpreference:        $params(5)"
		}
	    }
	    144 {
		if $verbose {
		    puts $diag_fp "\tTRIMMED SURFACE ..."
		    puts $diag_fp "\tsurface to be trimmed: $params(1)"
		    if $params(2) {
			puts $diag_fp "\touter boundary is boundary of D"
		    } else {
			puts $diag_fp "\touter boundary:        $params(4)"
		    }
		    puts $diag_fp "\tcurves in inner boundary: "
		    
		}
	    }
	    402 {
		if $verbose {
		    puts $diag_fp "\tASSOCIATIVITY ..."
		}
	    }
	    404 {
		if $verbose {
		    puts $diag_fp "\tDRAWING ..."
		}
	    }
	    406 {
		if $verbose {
		    puts $diag_fp "\tPROPERTY ..."
		}
	    }
	    410 {
		if $verbose {
		    puts $diag_fp "\tVIEW ..."
		}
	    }	    
	}
    }
    if {$diag_fp != "stdout"} { close $diag_fp }
}

proc load_dxf {w file verbose {create_prefix ""}} {
    set fp [open $file r]
    
    set what ""
    while {![eof $fp]} {
	set type [string trim [gets $fp]]
	set value [string trim [gets $fp]]
	
	if {$type == 0} {
	    # Flush the data we have accumulated.
	    switch $what {
		line {
		    iges_handle_110 $w \
			[list [lindex $param(10) 0] \
			     [lindex $param(20) 0] \
			     [lindex $param(30) 0]] \
			[list [lindex $param(11) 0] \
			     [lindex $param(21) 0] \
			     [lindex $param(31) 0]] \
			"" 0
		}
		vertex {
		    iges_handle_116 $w \
			[list [lindex $param(10) 0] \
			     [lindex $param(20) 0] \
			     [lindex $param(30) 0]] \
			"" 0
		}
		lwpolyline {
		    foreach i {10 20 30} {
			if ![info exists param($i)] { set param($i) "" }
		    }
		    set px ""
		    foreach x $param(10) y $param(20) z $param(30) {
			if {$x == ""} { set x 0 }
			if {$y == ""} { set y 0 }
			if {$z == ""} { set z 0 }
			if {$px != ""} {
			    iges_handle_110 $w [list $px $py $pz] \
				[list $x $y $z] "" 0
			}
			set px $x; set py $y; set pz $z
		    }
		}
	    }
	    if {$value == "CLASS"} {
		set type [string trim [gets $fp]]
		set value [string trim [gets $fp]]
	    }
	    switch $value {
		LINE       { set what line }
		VERTEX     { set what vertex }
		LWPOLYLINE { set what lwpolyline }
		EOF        { set done 1 }
		default    { set what "" }
	    }
	    catch {unset param}
	    if [info exists done] break
	    continue
	}
	lappend param($type) $value
    }
    close $fp
}

# This is more complicated than it should be because of the H strings.  We just
# convert them into regular strings.

if 0 {
if {[info commands iges_split_line] == ""} {
    proc iges_split_line {line comma semi {dummy_front 1}} {
	set line [lindex [split $line $semi] 0]
	set params [split $line $comma]
	set nparams {}
	for {set i 0} {$i < $dummy_front} {incr i} {lappend nparams -}
	set needed 0
	foreach p $params {
	    if $needed {
		append accum ,
		append accum $p
		incr needed [expr {-[string length $p] - 1}]
		if {$needed < 0} {
		    error "Screwed up H string"
		} elseif !$needed {
		    lappend nparams $rest
		}
	    } elseif {[regexp {([0-9]+)H(.*)} $p dummy len rest]} {
		set needed [expr {$len - [string length $rest]}]
		if {$needed < 0} {
		    error "Screwed up H string"
		} elseif !$needed {
		    lappend nparams $rest
		} else {
		    set accum $rest
		}
	    } else {
		lappend nparams $p
	    }
	}
	return $nparams
    }
}
}
