
# The GUI for Autohex.
#
# Copyright (c) 1993, 1994 Pacific Marketing and Consulting
# Author:  Wayne A. Christopher, wayne@pmac.com
#          Pacific Marketing and Consulting, Berkeley, California

proc auto_save_tetin {{ssi 0}} {
    global autohex_root

    if ![file exists [directory tetin]] {
	cmd_mkdir [directory tetin]
    }

    set file1 [write_tetin 1]
    auto_bocos_families
    famboco_save [directory tetin]/family_boco
    famboco_save_old [directory tetin]/boco
    if $ssi {
	set file2 ${file1}_ssi
	if [tetin_do_ssi $file1 $file2] {
	    mess "Wrote tetin file with intersection curves to \"$file2\".\n"
	}
    }
}

proc write_tetin_file {file use_families {bbox ""} {also_domain 1} {write_file 1} \
			   {do_part ""} {inc_others 0} {suff ""} {use_sep 0}} {
    global domain tetin_volume_fams tetin_volface_fams
    global tetin_surface_fams
    global tetin_surface_fams_at_end
    global boco_nfamilies boco_family_name grid_perobject
    global grid_mapping cutouts_for_solid
    global family_for_shape tetin_all_shapes
    global smallest_gap shape_ecount tetin_do_offset_scale
    global grid_triangulation_tolerance grid_tetra_params
    global grid_cad_objects_found default_fluid_family app_name
    global volface_mat meshing_units no_basic_licenses
    global grid_coupling_otherparts grid_coupling_walls grid_coupling_cutouts
    
    #puts [list write_tetin_file $file $use_families $bbox $also_domain $write_file $do_part $inc_others $suff $use_sep]
    
    if [info exists tetin_do_offset_scale] {
	set_tetin_write_matrix $tetin_do_offset_scale
    } else {
	set_tetin_write_matrix "1 0 0 0  0 1 0 0  0 0 1 0  0 0 0 1"
    }

    if {[info commands app_before_write_tetin] != ""} {
	app_before_write_tetin
    }

    # Make up the list of objects we need ...  This routine gets called from the
    # auto_mesher code also so it's separated out.
    foreach n {tetin_all_shapes shapes_to_delete cont} v \
	[write_tetin_find_objects $also_domain $do_part $inc_others $suff $use_sep] {
	    set $n $v
	}
    
    if {($do_part != "") && ($bbox == "")} {
	set bbox [eval concat [bbox_of_objects $do_part]]
    }
    
    if {$use_families == 2} {
	set fluid _0_0
    } elseif [info exists default_fluid_family] {
	set fluid $default_fluid_family
    } else {
	set fluid FLUID
    }

    set grid_cad_objects_found 0

    catch {cmd_mkdir [file dirname $file]}

    set shape_ecount 1

    if {$use_families != 1} {
	catch {unset grid_mapping}
    }
    catch {unset family_for_shape}
    catch {unset volface_mat}
    set tetin_volume_fams _0_0
    set tetin_surface_fams ""
    set tetin_volface_fams ""
    set tetin_surface_fams_at_end ""
    
    set family_for_shape([$cont getval body_shape]) _0_0

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

    # First figure out the default sizes, etc.
    model_check 0
    set sm_feat $smallest_gap($do_part)

    set defmax [diagonal_model_size]
    if {$defmax && ($sm_feat / $defmax < 0.001)} {
	if {$do_part != ""} {
	    set inwhat "assembly [$do_part getval name]"
	} else {
	    set inwhat "the model"
	}
	mess "Warning: the smallest gap found in $inwhat is\
 		$sm_feat m. \
		This may cause problems for the tetra mesher.  We suggest\
		that you try to make this gap larger than\
		[expr $defmax / 1000.0] m.\n" red
    }

    set s [lindex [grid_get_sizes $do_part] 0]
    if {!$defmax || (($s < $defmax) && $s)} { set defmax $s }
    
    set natsize [expr $sm_feat * $grid_tetra_params(natural_size_factor)]

    if {$use_families != 1} {
	mess "Smallest feature = $sm_feat.\n"
	mess "Max size in mesh = $defmax ; natural size = $natsize.\n"
    }

    set mapnum 1
    
    # This is needed because in perfmix there are some surfaces which have
    # to have the lowest priority, but the material points in them should not

    set app_tetin_goes_at_end [info commands app_tetin_goes_at_end]
    set app_tetin_family_goes_at_end [info commands app_tetin_family_goes_at_end]
    set lines_for_end ""

    foreach shh $tetin_all_shapes {
	if [string match //* $shh] continue
	set sh [lindex $shh 0]
	set res [$sh verify tetra]
	if {$res != ""} {
	    set obj [$sh get -object]
	    if {$obj == ""} {
		set obname <unknown>
	    } else {
		set obname [$obj getval name]
	    }
	    mess "Object $obname, [$sh get -name]: $res\n" red
	}
    }

#    puts "ALL $tetin_all_shapes"
#    puts "USEF $use_families"

    set sm_feat 0
    
    if !$write_file return

    set fp [open $file w]

    puts $fp "set_triangulation_tolerance $grid_triangulation_tolerance"
    if {$use_families == 1} {
	puts $fp "read_family_boco family_boco"
    } else {
	puts $fp "read_family_boco family_boco_auto"
    }
    
    set need_default_fluid 1
    foreach shh $tetin_all_shapes {
	if [string match //* $shh] {
	    # This is a really hacky attempt to make the tetra NC stuff work 
	    # just the same as the mesher_auto stuff without rewriting all this
	    # code
	    if [string match //grid_coupling_otherparts* $shh] {
		lappend grid_coupling_otherparts($suff) [expr $mapnum - 1] \
		    .sub_[[lindex $shh 1] getval name] [lindex $shh 2]
	    } elseif [string match //grid_coupling_cutout $shh] {
		lappend grid_coupling_cutouts($suff) [expr $mapnum - 1]
	    } elseif [string match //ncwall* $shh] {
		set nn [expr $mapnum - 1]
		lappend "grid_mapping({} junk)" $nn
		set grid_mapping($nn) "$cont body"
		lappend grid_coupling_walls($suff) [lindex $shh 1] $nn 1
	    } else {
		puts $fp "\n$shh"
	    }
	    continue
	}
	
	set sh [lindex $shh 0]

	set obj [$sh get -object]
	set sectname [$sh get -name]

	set shkey [lrange $shh 1 end]
	if {$shkey == ""} { set shkey $sectname }

	if {$obj != ""} {
	    set comment "[$obj getval obtype] [$obj getval name] $sectname"
	    set obn [$obj getval name]
	    regsub -all \\. $obn _ obn
	    regsub -all " " $obn _ obn
	} else {
	    set comment "NC interface"
	}

	set sectcount 0

	if {$use_families != 1} {
	    if {$obj == $cont} {
		set mapn 0
	    } else {
		set mapn $mapnum; incr mapnum
	    }
	}

	# Here we have to do the cutouts before the actual object.
	# This is complex because the faces in the plane direction
	# have to be family DEF_SURF and the others have to have the
	# family of the enclosing block.

	if {($use_families != 1) && [info exists cutouts_for_solid($sh)]} {
	    foreach cc $cutouts_for_solid($sh) {
		set csh [lindex $cc 1]
		if {[info command $csh] == ""} continue

		set opening _${mapn}_OPEN
		set family_for_shape($csh) _0_0

		switch [$csh get -type] {
		    shape_hexa {
			set plane [[lindex $cc 0] si_value plane]
			# This is slightly bogus because all of them
			# shouldn't necessarily get face 1 ...
			set ff ""
			for {set i 0} {$i < 6} {incr i} {
			    if {$i / 2 == $plane} {
				lappend ff $opening
			    } else {
				lappend ff _${mapn}_1
			    }
			}
		    }
		    shape_cyl - shape_incline {
			set ff [list $opening $opening _${mapn}_1]
		    }
		    default { error "unknown cutout type" }
		}
		puts $fp "\n// cutout"
		set inp [eval $csh tetin_input 1 \
			     $grid_tetra_params(tetra_ratio) \
			     $grid_perobject DEF_SURF DEF_CURVE DEF_POINT $ff]
		$csh configure -priority 1000000 ;# a big number
		foreach line $inp {
		    puts -nonewline $fp $line
		}
		set pts [$csh tetin_matpoint $tetin_all_shapes \
			     "" $bbox]
		foreach pt $pts {
		    puts $fp "material_point $pt name\
				_0_0/$shape_ecount family _0_0"
		    incr shape_ecount
		}
		lappend tetin_surface_fams $opening
	    }
	}

	set shn $obn
	if {$sectname != "body"} {
	    append shn _$sectname
	}
	set shkey [lrange $shh 1 end]
	if {$shkey == ""} { set shkey $sectname }

	if {$shkey != $sectname} {
	    append shn _$shkey
	    regsub -all " " $shn _ shn
	}

	if {[$sh get -shtype] == "cad"} {
	    set grid_cad_objects_found 1
	}

	if {$use_families == 1} {
            set app app_get_family_for_side_[$obj getval obtype]
            if {[info commands $app] == ""} {set app ""}
	    switch [$sh get -shtype] {
		pipe {
		    set fams [$obj getval fam_edge]
		    if {$fams == ""} { set fams DEF_CURV }
		}
		cad {
		    set fams ""
                    set ff [$obj getval fam_point]
                    if {$ff == ""} {
                        set ff [tetin_nice_name [$obj getval name]]
                    }
                    lappend fams $ff
                    if {[$obj checkval fam_edge]} {
                        set ff [$obj getval fam_edge]
                    } else {
                        set ff [$obj getval fam_curve]
                    }
                    if {$ff == ""} {
                        set ff [tetin_nice_name [$obj getval name]]
                    }
                    lappend fams $ff
                    set ff [$obj getval fam_int]
                    if {$ff == ""} {
                        set ff [tetin_nice_name [$obj getval name]]
                    }
                    lappend fams $ff
                    if {[$obj checkval fam_face]} {
                        set ff [$obj getval fam_face]
                        if {$ff == ""} {
                            set ff [tetin_nice_name [$obj getval name]]
                        }
                        lappend fams $ff
                    } else {
                        foreach ss [$sh list_sides 0] {
                            if {$app == ""} {
                                set ff [$obj getval fam_[lindex $ss 1]]
                            } else {
                                set ff [$app $obj $sh [lindex $ss 0]]
                            }
                            set ff [tetin_nice_name $ff]
                            if {$ff == ""} {
                                set ff [tetin_default_family_name $obj SURF ""]
                            }
                            lappend fams $ff
                        }
                    }
		}
		default {
		    set ff [$obj getval fam_face]
		    if {$ff == ""} {
			set fams ""
			foreach ss [$sh list_sides 0] {
                            if {$app == ""} {
			        set ff [$obj getval fam_[lindex $ss 1]]
                            } else {
                                set ff [$app $obj $sh [lindex $ss 0]]
                            }
			    set ff [tetin_nice_name $ff]
			    if {$ff == ""} {
				set ff [tetin_default_family_name $obj SURF ""]
			    }
			    lappend fams $ff
			}
		    } else {
			set fams [tetin_nice_name $ff]
		    }
		    if {[$sh get_volume] == 0} {
			foreach f $fams {
			    if {[lsearch $tetin_surface_fams $f] < 0} {
				lappend tetin_surface_fams $f
			    }
			}
		    }
		}
	    }

	} else {
	    if {$obj != ""} {
		# The grid_mapping array has to reference the domain for subassemblies
		# here or the code gets confused
		set wobj $obj
		if {$obj == $cont} { set wobj $domain }
		set grid_mapping($mapn) "$wobj $shkey"
		lappend grid_mapping($wobj) $mapn
		set "grid_mapping($wobj $shkey)" $mapn
		set grid_mapping($sh) $mapn
	    }
	    set fams ""
	    if {([$sh get -shtype] == "quad") && \
		    ![$sh get -thickness]} {
		set nc [$sh get -numcopies]
		for {set i 1} {$i <= $nc} {incr i} {
		    set nam _${mapn}_$i
		    lappend fams $nam
		    if {[$sh get -split_flag] & 1} {
			set is_thin($nam) 1
		    }
		    lappend tetin_surface_fams $nam
		}
	    } elseif {[$sh get -shtype] == "circ"} {
		if {[$sh get -iradius] > 0} {
		    # the hub is id 2 but comes first
		    set sss1 {1 2}
		} else {
		    set sss1 1
		}
		foreach ss $sss1 {
		    set ssn _${mapn}_$ss
		    lappend fams $ssn
		    lappend tetin_surface_fams $ssn
		}
	    } elseif {[$sh get -shtype] == "cad"} {
		set ns [llength [$sh list_sides 0]]
                if {$ns > 0} {
 		    set fams [list _${mapn}_0 _${mapn}_0 _${mapn}_0]
                    for {set i 1} {$i <= $ns} {incr i} {
                        set ssn _${mapn}_$i
                        lappend fams $ssn
                        lappend tetin_surface_fams $ssn
                    }
                } else {
 		    set fams [list _${mapn}_0 _${mapn}_1 _${mapn}_0]
                    lappend tetin_surface_fams _${mapn}_1
                }
	    } else {
		set is_vol [expr {[$sh get_volume] > 0}]
		foreach ss [$sh list_sides 0] {
		    set nam _${mapn}_[lindex $ss 0]
		    lappend fams $nam
		    if {[lindex $ss 1] == "edge"} {
			# This is an annoying hack.
			set nv [$sh getval nverts]
			for {set i 2} {$i < $nv} {incr i} {
			    lappend fams $nam
			}
		    }

		    set at_end ""
		    if {($app_tetin_family_goes_at_end != "") &&
			[$app_tetin_family_goes_at_end $sh [lindex $ss 0]]} {
			set at_end _at_end
		    }
		    if [lindex $ss 0] {
			lappend tetin_surface_fams$at_end $nam
		    }
		    if {[$sh get -shtype] == "container"} {
			set volface_mat($nam) DEF_JUNK
		    } elseif $is_vol {
			if ![$sh get -volume_flag] {
			    set volface_mat($nam) DEF_JUNK
			} else {
			    set volface_mat($nam) _${mapn}_0
			}
		    }
		}
	    }
	}

	set cs [unit_convert $grid_tetra_params(tetra_size_on_curves) \
		    $meshing_units 0]
	set ss [unit_convert $grid_tetra_params(tetra_size_on_surfs) \
		    $meshing_units 0]
	if !$cs { set cs $defmax }
	if !$ss { set ss $defmax }

	$sh configure -def_curvesize $cs -def_surfsize $ss

	set dsurf [tetin_default_family_name $obj SURF DEF]
	set dcurve [tetin_default_family_name $obj CURVE DEF]
	set dpoint [tetin_default_family_name $obj POINT DEF]

	set use_p [expr $grid_perobject && [$sh get -grid_enabled]]
	set inp [eval $sh tetin_input 1 $grid_tetra_params(tetra_ratio) \
		     $use_p $dsurf $dcurve $dpoint $fams]
#puts "$sh tetin_input 1 $grid_tetra_params(tetra_ratio) $use_p $dsurf $dcurve $dpoint $fams"
	puts $fp "\n// $comment"
	if {$inp == ""} {
	    puts "eval $sh tetin_input 1 $grid_tetra_params(tetra_ratio) \
		     $use_p $dsurf $dcurve $dpoint $fams"
	}
	if {($obj == $cont) && !$need_default_fluid} {
	    set need_matp 0
	} else {
	    set need_matp 1
	}
	set divert_to_end 0
	set mpfam ""
	foreach line $inp {
	    set ism [string match material_point* $line]

	    if {($obj == $cont) && $ism && !$need_default_fluid} {
		continue
	    }

	    if {$use_families == 1} {
		set isfl [regsub -all __FLUID__ $line FLUID line]
	    } else {
		set isfl [regsub -all __FLUID__ $line _0_0 line]
	    }

	    if $isfl { set need_default_fluid 0 }

	    if {($app_tetin_goes_at_end != "") &&
		([string match define_curve* $line] ||
		 [string match define_surface* $line] ||
		 [string match prescribed_point* $line] ||
		 [string match material_point* $line])} {
		set divert_to_end [$app_tetin_goes_at_end $sh $line]
		if $divert_to_end {
		    lappend lines_for_end "\n// $comment"
		}
	    }
	    if $divert_to_end {
		lappend lines_for_end $line
	    } else {
		puts -nonewline $fp $line
	    }
	    if {$ism && !$isfl} {
		if {$use_families != 1} {
		    set family_for_shape($sh) _${mapn}_0
		    set mpfam _${mapn}_0
		} else {
		    set get 0
		    foreach v $line {
			if $get {
			    set mpfam $v
			    break
			} elseif {$v == "family"} {
			    set get 1
			}
		    }

		    set family_for_shape($sh) $mpfam
		}
		set need_matp 0
	    }
	}
	if {$mpfam != ""} { lappend tetin_volume_fams $mpfam }
	
	if {$need_matp && (([$sh get_volume] > 0) || ($obj == $cont) || ([$sh get -shtype] == "container"))} {
	    #puts "getting matp for [$obj getval name]"
	    switch $use_families {
		1 - 2 {
		    if {$obj == $cont} {
			set ff $fluid
		    } else {
			switch [$sh getval volume_flag] {
			    0 { set ff ORFN }
			    1 {
				set ff [$obj getval fam_int]
				if {$ff == ""} {
				    set ff [$obj getval name]
				    #set ff SOLID
				}
			    }
			    2 { set ff $fluid }
			}
		    }
		}
		0 {
		    if {$obj == $cont} {
			set ff _0_0
		    } elseif {[$sh get -shtype] == "container"} {
			set ff DEF_JUNK
		    } elseif [$sh getval volume_flag] {
			set ff _${mapn}_0
			if $mapn {
			    lappend tetin_volume_fams $ff
			}
		    } else {
			set ff DEF_JUNK
		    }
		}
	    }
	    set ff [tetin_nice_name $ff]
	    set family_for_shape($sh) $ff
	    #puts "XXX $sh tetin_matpoint \{$tetin_all_shapes\} \"\" \"$bbox\""
	    if {$ff == "DEF_JUNK"} {
		# This may be an assembly that is outside of the one we're meshing now
		# and it needs a DEF_JUNK point
		set pts [$sh tetin_matpoint $tetin_all_shapes "" ""]
	    } else {
		set pts [$sh tetin_matpoint $tetin_all_shapes "" $bbox]
	    }
	    #puts "XXX $pts"
	    foreach pt $pts {
		puts $fp "material_point $pt name $ff/$shape_ecount\
				family $ff"
		incr shape_ecount
	    }
	}
	set sm [$sh getval shortest]
	if {($sm > 0) && (($sm_feat == 0) || ($sm_feat > $sm))} {
	    set sm_feat $sm
	}
    }

    if {$lines_for_end != ""} {
	puts $fp "\n// Stuff that was diverted to the end of the tetin file"
	puts $fp "// so that it would have lowest priority"
	foreach l $lines_for_end {
	    puts -nonewline $fp $l
	}
    }

    if {[info commands app_special_tetin_stuff] == "app_special_tetin_stuff"} {
	set stuff [app_special_tetin_stuff]
	if {$stuff != ""} {
	    puts $fp "\n// Extra application-specific stuff."
	    foreach l $stuff {
		puts -nonewline $fp $l
	    }
	}
    }

    puts $fp "\ndefine_model $defmax reference_size 1 no_smear\
		natural_size $natsize \
		fast_transition \
		natural_size_refinement $grid_tetra_params(natural_size_refinement) \
		n_cells_in_gap $grid_tetra_params(n_cells_in_gap) \
		edge_criterion $grid_tetra_params(edge_criterion) \
		units m"

    puts $fp "affix 0"
    puts $fp "return"
    close $fp
    
    foreach sh $shapes_to_delete { $sh delete }
    
    set tetin_surface_fams [concat $tetin_surface_fams \
				$tetin_surface_fams_at_end]

    if {$use_families != 1} {
	global famboco_data
	set saved [array get famboco_data]
	catch {unset famboco_data}

	foreach f $tetin_surface_fams {
	    if [info exists is_thin($f)] {
		set famboco_data($f) [list "1 THIN"]
	    } else {
		set famboco_data($f) [list "1 GLOBAL_THIN"]
	    }
	    if ![info exists volface_mat($f)] {
		lappend famboco_data($f) "1 INT"
	    }
	}

	foreach f [array names volface_mat] {
	    lappend famboco_data($f) "1 GLOBAL_VFACE $volface_mat($f)"
	}

	foreach f $tetin_volume_fams {
	    set famboco_data($f) ""
	}
	famboco_save [file dirname $file]/family_boco_auto \
	    [concat $tetin_surface_fams $tetin_volume_fams]

	# Also make a dummy cart file for hexa.
	set fp [open [file dirname $file]/cart_file w]
	puts $fp "set_grid_type cartesian"
	puts $fp "define_grid i 2"
	puts $fp "0.0"
	puts $fp "1.0"
	puts $fp "define_grid j 2"
	puts $fp "0.0"
	puts $fp "1.0"
	puts $fp "define_grid k 2"
	puts $fp "0.0"
	puts $fp "1.0"
	puts $fp "return"
	close $fp

	catch {unset famboco_data}
	array set famboco_data $saved
    }
    
    catch {parray grid_coupling_walls}
}

proc write_tetin_find_objects {also_domain do_part inc_others suff use_sep} {
    global domain cutouts_for_solid tetin_part_shapes_bbox
    
    if {$do_part == ""} {
	set cont $domain
    } else {
	set cont $do_part
    }
    
    # ----------------------------------
    
    # We have to put these objects in the order:
    #
    # regular objects inside and intersecting with this assembly
    # non-conformal interface walls with other assemblies
    # flat objects which sit on the domain boundary
    # outside hollow blocks which should mask out the nonconformal faces
    # non-conformal interface walls
    # default domain walls
    #
    # This is the opposite of the order in the grid_input file
    
    foreach var {
	objects
	outside_hollow
	outside_flat
	outside_otherparts
	outside_otherpart_sides
	side_quads
    } val [grid_get_objects_inside_and_outside 0 $do_part $inc_others $use_sep] {
	set $var $val
    }
    
    # Exactly similar to hollow blocks are other mesh-separately parts that touch
    # this part.  Except that we have to remember to patch up the couplings when
    # reading in the mesh ....
    if {$outside_otherparts != ""} {
	lappend objects "// non-conformal interface walls with other assemblies" 0
	foreach op $outside_otherparts os $outside_otherpart_sides {
	    # This writes out the whole object - this is okay since the non-touching parts
	    # will get taken away since the inside is hollow ....
	    lappend objects "// for [$op getval name]" 0
	    lappend objects $op 0
	    lappend objects "//grid_coupling_otherparts $op $os" 0
	}
	lappend objects "// end of other asm walls" 0
    }
    
    # Now the touching quads (I guess they should come after the hollow and before
    # the other NC ones, although they had better not overlap an NC block)
    
    if {$outside_flat != ""} {
	lappend objects "// flat objects which sit on the domain boundary" 0
	foreach of $outside_flat { lappend objects $of 0 }
	lappend objects "// end of flat objects" 0
    }
    
    # We have to do something a bit strange here to handle hollow blocks
    # that might be touching the objects inside the part.  These hollow
    # blocks need to get treated the same as the domain walls.  But what is
    # strange is that we can't write them as volume objects because they
    # wouldn't mask out the quad objects we're using for the n.c. interfaces.
    # So make them into 2-d things ...  Also they have to have a priority
    # above the n.c. walls but below the regular flat objects that sit there.
    
    if {$outside_hollow != ""} {
	lappend objects "// hollow blocks which should mask out the nonconformal faces" 0
	foreach obj $outside_hollow {
	    lappend objects $obj 0 "//grid_coupling_cutout" 0
	}
	lappend objects "// end of hollow blocks" 0
    }
    
    set shapes_to_delete ""
    
    if {$side_quads != ""} {
	lappend objects "// non-conformal interface walls" 0
	
	foreach sq $side_quads {
	    foreach var {name pl start end side} val $sq { set $var $val }
	    
	    lappend objects "// $name" 0
	    array set pln {yz 0 xz 1 xy 2}; set plnum $pln($pl)
	    set sh [shape_quad -plane $plnum -point1 $start -point2 $end \
			-priority 1000000]
	    lappend objects $sh 0
	    lappend shapes_to_delete $sh
	    lappend objects "//ncwall $side" 0
	}
	lappend objects "// end of non-conformal interface walls" 0
    }
    
    if $also_domain { lappend objects $cont 1 }
    
    set tetin_all_shapes ""
    set part_shapes ""

    foreach {obj is_in_part} $objects {
	if [string match //* $obj] {
	    lappend tetin_all_shapes $obj
	    continue
	} elseif [string match shape_* $obj] {
	    lappend tetin_all_shapes $obj
	    if $is_in_part { lappend part_shapes $obj }
	    continue
	}
	
	set type [$obj getval obtype]
	set sectcount 0
	
	# Make sure the sections are ordered in the reverse of the section_list
	# order, but 2d before 3d
	set sect2d ""
	set sect3d ""
	
	foreach sectname [lreverse [$obj getval section_list]] {
	    set shape [$obj getval ${sectname}_shape]
	    if {[info commands app_special_grid_$type] != ""} {
		set shapes [app_special_grid_$type $obj $shape $sectname]
	    } else {
		set shapes $shape
	    }
	    foreach sh $shapes {
		if {[[lindex $sh 0] get_volume] > 0} {
		    lappend sect3d $sh
		} else {
		    lappend sect2d $sh
		}
	    }
	}
	
	foreach shh [concat $sect2d $sect3d] {
	    set sh [lindex $shh 0]
	    
	    # Somehow this happens sometimes.  Let's prevent it ...
	    if {$obj == $domain} {
		global current_shape shape_data
		$sh setval volume_flag 2
		if {$sh == $current_shape} {
		    set shape_data(volume_flag) 2
		}
	    }
	    
	    if {![$sh get -active] || ([$sh get -shtype] == "none")} continue
	    
	    set pri [expr ([$obj getval creation_order] + 1) - $sectcount * 0.01]
	    incr sectcount
	    #puts "[$obj getval name] $sh configure -priority $pri (cre [$obj getval creation_order])"
	    $sh configure -priority $pri
	    
	    lappend tetin_all_shapes $shh
	    if $is_in_part { lappend part_shapes $shh }
	    
	    if [info exists cutouts_for_solid($sh)] {
		foreach cc $cutouts_for_solid($sh) {
		    lappend tetin_all_shapes [lindex $cc 1]
		}
	    }
	}
    }
    
    set tetin_part_shapes_bbox [tdv_bbox_of_images $part_shapes]
    
    set ts ""
    foreach i $tetin_all_shapes {
	if {[string match //* $i] || ([info command $i] != "")} { lappend ts $i }
    }
    set tetin_all_shapes $ts
    
    return [list $tetin_all_shapes $shapes_to_delete $cont]
}

proc diagonal_model_size {} {
    global domain tdv_default
    set diag [[$domain getval body_shape] getval diagonal]
    if $diag { return $diag }
    set bb [$tdv_default bbox interesting]
    if {$bb == ""} { return 0 }
    set tot 0
    foreach i {0 1 2} {
	set d [expr [lindex [lindex $bb 1] $i] - [lindex [lindex $bb 0] $i]]
	set tot [expr $tot + $d * $d]
    }
    return [expr sqrt($tot)]
}

# This duplicates a bit of code from write_tetin_file

proc tetin_prism_family_list {only_famnames} {
    global domain default_fluid_family

    if [info exists default_fluid_family] {
	set fluid $default_fluid_family
    } else {
	set fluid FLUID
    }

    set mapnum 1
    set objects [grid_get_object_list 0 "" 0 0]
    foreach obj "$objects $domain" {
	set obn [$obj getval name]
	regsub -all \\. $obn _ obn
	regsub -all " " $obn _ obn
	set n 0

	set type [$obj getval obtype]
	# If this is defined it has to return the sections with higher priority
	# shapes coming later.
	set proc [info command app_section_list_for_meshing_$type]
	if {$proc != ""} {
	    set sections [lreverse [$proc $obj]]
	} else {
	    set sections [$obj getval section_list]
	}
	foreach sectname $sections {
	    set shape [$obj getval ${sectname}_shape]
	    if {[info commands app_special_grid_$type] != ""} {
		set shapes [app_special_grid_$type $obj $shape $sectname]
	    } else {
		set shapes $shape
	    }

	    foreach shh $shapes {
		set sh [lindex $shh 0]

		if {$obj == $domain} {
		    set mapn 0
		} else {
		    set mapn $mapnum; incr mapnum
		}

		foreach ss [$sh list_sides 0] {
		    set id _${mapn}_[lindex $ss 0]

		    set ff [$obj getval fam_face]
		    if {$ff == ""} {
			set ff [$obj getval fam_[lindex $ss 1]]
		    }
		    if {$ff == ""} { set ff default }
		    if {$ff != ""} {
			lappend found_f($ff) $id
		    }
		}

		if {([$sh get_volume] > 0) && [$sh getval volume_flag]} {
		    if {$obj == $domain} {
			set ff $fluid
		    } else {
			switch [$sh getval volume_flag] {
			    0 { set ff ORFN }
			    1 {
				set ff [$obj getval fam_int]
				if {$ff == ""} {
				    set ff [$obj getval name]
				}
			    }
			    2 { set ff $fluid }
			}
		    }
		    lappend found_v($ff) _${mapn}_0
		}
	    }
	}
    }

    set fams ""
    if $only_famnames {
	foreach f [lsort [array names found_f]] {
	    lappend fams $f
	}
	foreach f [lsort [array names found_v]] {
	    lappend fams $f
	}
    } else {
	foreach f [array names found_f] {
	    foreach i $found_f($f) { lappend fams "$i $f" }
	}
	foreach f [array names found_v] {
	    foreach i $found_v($f) { lappend fams "$i $f" }
	}
    }
    return $fams
}

# We don't do this right away because we might need them for putting in extra
# material points.

proc tetin_free_cutouts_for_solid {} {
    global cutouts_for_solid

    foreach sh [array names cutouts_for_solid] {
	foreach cc $cutouts_for_solid($sh) {
	    [lindex $cc 1] delete
	}
    }
    catch {unset cutouts_for_solid}
}

# pts is a list of {shape x y z}

proc add_matpoints_to_tetin {file pts} {
    global shape_ecount family_for_shape

    # First knock out the points that are there already
    set ifp [open $file r]
    while {![eof $ifp]} {
	set line [gets $ifp]
	if [string match material_point* $line] {
	    set already_there([lrange $line 1 3]) 1
	}
    }
    close $ifp

    mess "Adding [llength $pts] material points to $file, families:"
    set nadd 0; set nused 0

    foreach p $pts {
	set sh [lindex $p 0]
	if {$sh == ""} {
	    set ff _0_0
	} elseif [info exists family_for_shape($sh)] {
	    set ff $family_for_shape($sh)
	} else {
	    set ff DEF_JUNK
	    set name [[$sh get -object] getval name]
	    mess "Warning: expected a family for \"$name\" but none\
		was found\n" red
	}
	set np [lindex $p 1]
	if [info exists already_there($np)] {
	    incr nused
	} else {
	    lappend new_points($ff) $np
	    incr nadd
	}
    }
    foreach f [lsort [array names new_points]] { mess " $f" }
    mess "\n"
    if $nused {
	mess "Skipped $nused points which were already there\n"
	if !$nadd { return 0 }
    }
    set ifp [open $file r]
    set ofp [open ${file}__tmp w]

    while {![eof $ifp]} {
	set line [gets $ifp]
	puts $ofp $line
	if {[regexp {material_point .* family (.*)$} $line dummy ff] && \
		[info exists new_points($ff)]} {
	    mess "\t$ff: $new_points($ff)\n"
	    foreach np $new_points($ff) {
		puts $ofp "material_point $np name $ff/$shape_ecount\
			family $ff"
		incr shape_ecount
	    }
	    unset new_points($ff)
	} elseif {[string match define_model* $line]} {
	    # These must have been shapes that never got a material point.
	    foreach ff [array names new_points] {
		mess "\t$ff: $new_points($ff)\n"
		foreach np $new_points($ff) {
		    puts $ofp "material_point $np name $ff/$shape_ecount\
			family $ff"
		    incr shape_ecount
		}
		unset new_points($ff)
	    }
	}
    }
    close $ofp
    close $ifp
    cmd_rename ${file}__tmp $file
    return $nadd
}

proc write_tetin {use_families} {
    set dir [directory tetin]
    if ![file exists $dir] { cmd_mkdir $dir }

    set file [directory tetin]/autohex.tin

    mess "Writing $file ...\n"
    write_tetin_file $file $use_families
    mess "Done.\n"
    return $file
}

proc family_for_side {obj sh num} {
    global domain default_fluid_family default_side_family

    if [info exists default_fluid_family] {
	set fluid $default_fluid_family
    } else {
	set fluid FLUID
    }
    set app app_get_family_for_side_[$obj getval obtype]
    if {[info commands $app] != ""} {
        set ff [$app $obj $sh $num]
    } elseif $num {
	set ff [$obj getval fam_face]
    } else {
	set ff [$obj getval fam_int]
    }
    if {$ff == ""} {
	if $num {
	    set ss ""
	    foreach ss2 [$sh list_sides 0] {
		if {$num == [lindex $ss2 0]} {
		    set ss [lindex $ss2 1]
		    break
		}
	    }
	    if {$ss == ""} { error "side not found" }
	    #if [string match {side*} $ss] { set ss sides } ;# wierd hack
	} else {
	    set ss int
	}
	set ff [$obj getval fam_$ss]
	if {$ff == ""} {
	    if $num {
		set ff $default_side_family
	    } else {
		if {$obj == $domain} {
		    set ff $fluid
		} else {
		    switch [$sh getval volume_flag] {
			0 { set ff ORFN }
			1 {
			    set ff [$obj getval fam_int]
			    if {$ff == ""} {
				set ff [$obj getval name]
			    }
			}
			2 { set ff $fluid }
		    }
		}
	    }
	}
    }
    return [tetin_nice_name $ff]
}

proc tetin_set_fluid_family {} {
    global default_fluid_family

    set f [question "This is the family that will be used\nfor the volume\
		inside the domain\nbut not inside other objects." \
	       $default_fluid_family]
    if {$f != ""} { set default_fluid_family $f }
}

proc tetin_nice_name {name} {
    set name [string toupper [string trim $name]]
    foreach c {\\( \\) " " \\. "\t" /} {
	regsub -all $c $name _ name
    }
    return $name
}

proc tetin_default_family_name {obj what defs} {
    global default_families_from_object_names default_side_family
    global group_container
    global family_name_type family_name_nchars family_name_sep_dims

    if $default_families_from_object_names {
	set obn [$obj getval name]
	foreach g [$obj getval groups] {
	    if [$group_container($g) getval obj_use_as_family 0] {
		set obn [$group_container($g) getval name]
		break
	    }
	}
	set ff $obn
	switch $family_name_type {
	    full { }
	    nchars {
		if $family_name_nchars {
		    set ff [string range $ff 0 [expr $family_name_nchars - 1]]
		}
	    }
	    alpha {
		regexp {^([a-zA-Z]*)} $ff dummy ff
	    }
	}
	if $family_name_sep_dims {
	    append ff _${what}
	}
    } else {
	if {$defs != ""} {
	    # set ff $defs ??
	    set ff ${defs}_${what}
	} else {
	    set ff $default_side_family
	}
    }
    return [tetin_nice_name $ff]
}

proc tetin_do_ssi {in out} {
    global tetssi_path smooth_path autohex_root use_smoother_ssi ssish_path env

    cmd_rm $out
    if {[info exists use_smoother_ssi] && $use_smoother_ssi} {
	if {$smooth_path != "not_found"} {
	    set fff [directory]/smooth_ssi_in
	    set fp [open $fff w]
	    puts $fp "intersect_surfs unused all_surfs pairwise"
	    puts $fp "write_tetin_file $out"
	    close $fp
	    set cmd0 [list $smooth_path unused $in -no_domain]
	    run_background $cmd0 "" 1 ""
	    return [file exists $out]

	} else {
	    mess "Can't find smooth\n" red
	    return [file exists $out]
	}

    } else {
	if {$ssish_path != "not_found"} {
	    set tmp [cmd_tempfile ssish_in]
	    set fp [open $tmp w]
	    puts $fp [list tetssi $in $out]
	    close $fp
	    set cmd0 [list $ssish_path < $tmp]

	    set env(Ic_MXYZPTLK) FIX_THE_LICENSE_CODE
	    set otcl $env(TCL_LIBRARY)
####	    set env(TCL_LIBRARY) $autohex_root/lib/tcl8.1
	    run_background $cmd0 "" 1 "" [list "Intersecting*"]
	    unset env(Ic_MXYZPTLK)
	    set env(TCL_LIBRARY) $otcl
	    cmd_rm $tmp
	    if [info exists env(EDIT_SSI_FILE)] { edit_file $out }
	    return [file exists $out]

	} elseif {$tetssi_path != "not_found"} {
	    if 0 {
		set cmd0 [list $tetssi_path -r $in -w $out \
			      -i $autohex_root/lib/tetssi/part_in.ipa \
			      -o /tmp/part_out_[pid].ipa]
	    }
	    set cmd0 [list $tetssi_path -r $in -w $out]

	    run_background $cmd0 "" 1 "" [list "Intersecting*"]
	    cmd_rm /tmp/part_out_[pid].ipa
	    return [file exists $out]

	} else {
	    mess "Can't find tetssi\n" red
	    return 0
	}
    }
}

proc tetin_compute_offset_scale {} {
    global tetin_scale_used tetin_disable_offset_scale tdv_default

    if [info exists tetin_disable_offset_scale] {
	set tetin_scale_used 1
	return "1 0 0 0   0 1 0 0   0 0 1 0   0 0 0 1"
    }

    set bbox [$tdv_default bbox all_interesting]
    set mat [get_appropriate_tetin_matrix [lindex $bbox 0] [lindex $bbox 1]]
    set tetin_scale_used [lindex $mat 0]
    return $mat
}
