
# This code creates the user interface for the mesh editor.
#
# Copyright (c) 1997 Pacific Marketing and Consulting, Inc,
#       and ICEM Systems, GmbH.  All rights reserved.
# Author:  Wayne A. Christopher, wayne@icemcfd.com

proc unstruct_split_double_wall { } {
    busy 1
    foreach m [ic_uns_split_double_wall all] {
	mess "$m"
    }
    busy 0
}

proc unstruct_edges {} {
    busy 1
    foreach m [ic_uns_check_edges all] {
	mess "$m"
    }
    busy 0
}

proc unstruct_max_vertex_degree {} {
    mess "[ic_uns_max_vertex_degree all]\n"
}

proc unstruct_split_prisms {} {
    global smooth
    set d [form_init .split_prisms "Split Prisms"]
    if {$d != ""} {
	form_frame $d.fams ridge 2 {1 0}
	
	set ln 0
	if { [ info exists smooth(n_layers) ] == 0 } {
	    set smooth(n_layers) "3"
	}
	form_label $d.nlayersl "number of layers" "$ln 0"
	form_entry $d.nlayers smooth(n_layers) int  \
	    "$ln 1"
	
	if { [ info exists smooth(prism_ratio) ] == 0 } {
	    set smooth(prism_ratio) "1.5"
	}
# prism ratio
	if { ! [ info exists smooth(use_ratio) ] } {
	    set smooth(use_ratio) 1
	}
	incr ln
	form_radiobutton $d.prism_ratiol "prism ratio" \
			smooth(use_ratio) 1 "$ln 0"
	form_entry $d.prism_ratio smooth(prism_ratio) float \
	    "$ln 1" { { smooth(use_ratio) 1 } }

	incr ln
	form_radiobutton $d.prism_heightl "prism height" \
			smooth(use_ratio) 0 "$ln 0"
	form_entry $d.prism_height smooth(prism_height) float \
	    "$ln 1" { { smooth(use_ratio) 0 } }
	

	if { [ info exists smooth(only_one) ] == 0 } {
		set smooth(only_one) 0
		set smooth(layer_number) 0
	}

	incr ln
	form_checkbutton $d.onlyf "Only layer number (0,1,2...)" smooth(only_one) "$ln 0"
	form_entry $d.layern smooth(layer_number) int "$ln 1"  \
		smooth(only_one)

	
	form_finish +300+300
    }
    if ![form_wait .split_prisms] return
    
    if { $smooth(only_one) } {
	set layer_number $smooth(layer_number)
    } else {
	set layer_number -1
    }
    if { $smooth(use_ratio)  } {
        ic_uns_split_prisms all $smooth(n_layers) $smooth(prism_ratio) \
			$layer_number
    } else {
    	ic_uns_split_prisms all $smooth(n_layers) $smooth(prism_ratio) \
			$layer_number $smooth(prism_height)
    }
}

proc unstruct_redistribute_prism_edge {} {
    global smooth
    set d [form_init .redo_prisms "Redistribute prism edge"]
    if {$d != ""} {
	form_frame $d.fams ridge 2 {1 0}
	
	set ln 0
	incr ln
	if { [ info exists smooth(prism_height) ] == 0 } {
	    set smooth(prism_height) "1"
	}
	form_label $d.prism_heightl "initial height" "$ln 0"
	form_entry $d.prism_height smooth(prism_height) float \
	    "$ln 1"

	
	form_finish +300+300
    }
    if ![form_wait .redo_prisms] return
    
    ic_uns_redistribute_prism_edge $smooth(prism_height) 
}

proc unstruct_dissolve_prisms {} {
    global smooth
    set d [form_init .dissolve_prisms "Dissolve Prisms"]
    if {$d != ""} {
	form_frame $d.fams ridge 2 {1 0}
	
	set ln 0
	if { [ info exists smooth(height_ratio) ] == 0 } {
	    set smooth(height_ratio) "1.0"
	}
	form_label $d.ht_ratl "height ratio" "$ln 0"
	form_entry $d.ht_ratv smooth(height_ratio) float  \
	    "$ln 1"
	
	incr ln
	if { [ info exists smooth(prism_quality) ] == 0 } {
	    set smooth(prism_quality) "0.05"
	}
	form_label $d.prism_ql "prism quality" "$ln 0"
	form_entry $d.prism_q smooth(prism_quality) float \
	    "$ln 1"
	
	incr ln
	if { [ info exists smooth(triangle_quality) ] == 0 } {
	    set smooth(triangle_quality) .3
	}
	form_label $d.tri_ql "triangle quality" "$ln 0"
	form_entry $d.tri_q smooth(triangle_quality) float \
	    "$ln 1"
	
	incr ln
	if { [ info exists smooth(clear_tops) ] == 0 } {
	    set smooth(clear_tops) 1
	}
	form_checkbutton $d.clear_t "Clear tops" \
	    smooth(clear_tops) "$ln 0"
	
	form_finish +300+300
    }
    if ![form_wait .dissolve_prisms] return
    
    set types [ic_uns_list_types]
    if { [ lsearch $types PYRA_5 ] < 0 || \
	     [ lsearch $types TETRA_4 ] < 0 } {
	# kill the smoother form if it doesn't have pyramids or tetras
	form_kill .smoother
    }
    
    set which all ;# perhaps some selection mode later; but this fixes bug
    ic_uns_dissolve_prisms $which $smooth(height_ratio) \
	$smooth(prism_quality) \
	$smooth(triangle_quality) \
	$smooth(clear_tops)
}


# this is shared by unstruct_split_internal_faces & unstruct_do_reorient
proc unstruct_internal_faces_options_get {varname} {
    set opts_fam ""
    foreach f [ic_uns_internal_wall_families_get] {
	set col [family_color_for_name $f]
	lappend opts_fam [list $f -text $f -selectbackground $col \
		-foreground $col -command \
		[list fam_toggle_highlight $f $varname]]		
    }
    return $opts_fam
}

proc unstruct_split_internal_faces {} {
    global split_family new_split_family
    catch { unset split_family }
    catch { unset new_split_family }
    
    set opts_fam [unstruct_internal_faces_options_get split_family]
    if {$opts_fam == ""} {
	mess "There are no internal faces\n" red
	return
    }

    set d [form_init .split_internal "Split internal faces"]
    if {$d != ""} {
	form_frame $d.fams ridge 2 {1 0 -cols 2}
	form_label $d.fams.l "Split families:" {0 0 -cols 2}

	form_frame $d.fams.sel ridge 2 {3 0}
	form_label $d.fams.new_faml "New family suffix" { 4 0 }
	form_entry $d.fams.new_fam new_split_family string "4 1"
	
	form_finish +300+300
    }
    
    set d .split_internal.main
    check_box $d.fams.sel $opts_fam 6 split_family
    
    set ret [form_wait .split_internal]
    ic_uns_reset_selected
    if !$ret return

    set split_f ""
    foreach f [array names split_family] {
	if $split_family($f) { lappend split_f $f }
    }
    
    mess "new_split_family $new_split_family\n"
    foreach i [ic_uns_split_internal_faces all $split_f $new_split_family ] {
	mess "$i\n"
    }
}

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

proc unstruct_consistent { { count_open "" } { flood_fill 1 } {subset ""}} {
    if {$subset == ""} {
	set subset all
    }
    mess "Making volume mesh consistent with surface mesh...\n"
    ic_uns_make_consistent $subset $count_open $flood_fill
    mess "Done.\n"
}

proc unstruct_split_pyras {} {
    ic_uns_split_pyras all
}

proc unstruct_coarsen {} {
    global coarsen
    
    if {[ic_count_elements TETRA_4] + [ic_count_elements TRI_3] +[ic_count_elements QUAD_4] == 0 } {
	error "Can only coarsen a tetra/quad/triangle mesh."
    }

    if { [ info exists coarsen(n_iter) ] == 0 } {
	set coarsen(n_iter) 5
    }
    if { [ info exists coarsen(surface) ] == 0 } {
	set coarsen(surface) 1
    }
    set d [form_init .coarsen "Coarsen mesh"]
    if {$d != ""} {
	set ln 0
	form_frame $d.b flat 0 {0 0}
	if 0 {
	    this is broken
	form_radiobutton $d.b.all "All elements" coarsen(all) 1 "$ln 0"

	incr ln
	form_radiobutton $d.b.vis "Active families/types" coarsen(all) 0 "$ln 0"

	}
	set coarsen(all) 1
	
	
	incr ln
	form_label $d.b.aspl "Min aspect" "$ln 0"
	form_entry $d.b.asp coarsen(aspect) float "$ln 1"

	incr ln
	form_label $d.b.maxsl "Max size" "$ln 0"
	form_entry $d.b.maxs coarsen(max_size) float_blank "$ln 1"

	incr ln
	form_label $d.b.n_iterl "Number of iterations" "$ln 0"
	form_entry $d.b.n_iter coarsen(n_iter) int "$ln 1"

	incr ln
	form_checkbutton $d.b.surface "Coarsen surface" coarsen(surface) "$ln 0"

	incr ln
	form_checkbutton $d.b.size_check "Check sizes" coarsen(check_size) "$ln 0"

	if { [ic_count_elements TETRA_4] == 0 } {
		incr ln
		form_label $d.b.toll "Max deviation" "$ln 0"
		form_entry $d.b.tol coarsen(tolerance) float "$ln 1"
	}
	
	form_frame $d.fixed ridge 2 {0 1 -rows 2}
	form_label $d.fixed.l "Frozen families:" {0 0}
	form_frame $d.fixed.sel ridge 2 {3 0}
	
	form_finish +300+300
    }
    
    set opts_fixed ""
    foreach f [ic_uns_list_families] {
	if { $f == "ORFN" } continue
	set col [family_color_for_name $f]
	lappend opts_fixed [list $f -text $f -selectbackground $col]
	if ![info exists coarsen($f)] { set coarsen($f) 0 }
    }
    set opts_fixed [lsort -command "family_name_compare 2" $opts_fixed]
    
    check_box .coarsen.main.fixed.sel $opts_fixed 6 coarsen
    
    if ![form_wait .coarsen] return
    
    set fix ""
    foreach f [ic_uns_list_families] {
	if { $f == "ORFN" } continue
	if $coarsen($f) { lappend fix $f }
    }
    
    mess "Before: [ic_count_elements] elements, [ic_count_nodes] nodes\n"

    ic_uns_coarsen all $coarsen(aspect) $fix $coarsen(tolerance) \
	$coarsen(n_iter) $coarsen(surface) $coarsen(check_size) \
	$coarsen(max_size)
    
    mess "After: [ic_count_elements] elements, [ic_count_nodes] nodes\n"
}

proc unstruct_merge {} {
    global merge_family merge_fixed remove_interface
    catch { unset merge_family }
    catch { unset merge_fixed }
    set remove_interface 0
    
    set opts_fam ""
    foreach f [ic_uns_list_families 2] {
	set col [family_color_for_name $f]
	lappend opts_fam [list $f -text $f -selectbackground $col]
    }
    set opts_fam [lsort -command "family_name_compare 2" $opts_fam]
    
    set opts_fixed ""
    foreach f [ic_uns_list_families 3] {
	set col [family_color_for_name $f]
	lappend opts_fixed [list $f -text $f -selectbackground $col]
    }
    set opts_fixed [lsort -command "family_name_compare 2" $opts_fixed]
    
    set d [form_init .merge_meshes "Merge meshes"]
    if {$d != ""} {
	form_frame $d.fams ridge 2 {1 0}
	form_label $d.fams.l "Merge surface:" {0 0}
	form_frame $d.fams.sel ridge 2 {3 0}
	
	form_frame $d.fixed ridge 2 {1 1}
	form_label $d.fixed.l "Frozen volume:" {0 0}
	form_frame $d.fixed.sel ridge 2 {3 0}

	form_checkbutton $d.remove "Remove interface shells after merge" \
		remove_interface { 2 0 -cols 2 }
	
	form_finish +300+300
    }
    
    set d .merge_meshes.main
    check_box $d.fams.sel $opts_fam 6 merge_family
    check_box $d.fixed.sel $opts_fixed 6 merge_fixed
    
    if ![form_wait .merge_meshes] return
    
    set merge_f ""
    foreach f [array names merge_family] {
	if $merge_family($f) { lappend merge_f $f }
    }
    set fixed_f ""
    foreach f [array names merge_fixed] {
	if $merge_fixed($f) { lappend fixed_f $f }
    }
    
    mess "Merging meshes...\n"
    ic_merge_meshes $merge_f $fixed_f $remove_interface
    mess "Done.\n"
}

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

proc warn_if_periodic {name} {
    if [ic_uns_subset_nodes_are_periodic $name] {
	set mess "Some of the nodes you selected are periodic.  If you\
		modify them the mesh will not be correctly periodic any more."
	return [tk_dialog .nodes_per "Periodic nodes" \
		    $mess "" -1 "Cancel" Modify]
    } else {
	return 1
    }
}

proc unstruct_move_node {allow_invert} {
    global options
    
    while 1 {
	ic_newop
	if $options(edit_wait) {
	    set sel_map [select_unstruct node 0 visible ""]
	    set xypos ""
	} else {
	    set ss [select_unstruct node 0 visible 0 "" 1 1]
	    set sel_map [lindex $ss 0]
	    set xypos [lindex $ss 1]
	}
	if {$sel_map == ""} return
	
	if ![warn_if_periodic $sel_map] continue
	
	ic_uns_subset_configure $sel_map -visible 1
	select_move_uns_map $sel_map 0 $allow_invert $xypos
	ic_uns_subset_delete $sel_map
    }
}

proc unstruct_merge_node {how} {
    global unstruct_merge
    
    if {$how != "inter"} {
	set t [question_box .mergetol "Tolerance" \
		   "Minimum node distance" $unstruct_merge(tol)]
	if {$t == ""} return
	set unstruct_merge(tol) $t
    }
    
    set mess "Would you like collapsed edges to propagate through the\
	    mesh, or terminate in adjacent elements?"
    set askto_prop [expr { (2 == [ic_uns_dimension]) && \
	    ([lsearch -regexp [ic_uns_list_types] QUAD_+] >= 0)}]
    if $askto_prop { set propagate -1 } else { set propagate 0 }
    
    set ok 1
    ic_undo_group_begin
    while {$ok} {
	set cur visible
	switch $how {
	    inter {
		set sel_map [select_unstruct node 0 $cur "" \
				 "nodes to merge (first is kept)" merge 0 1]
		if {$sel_map == ""} { set ok 0; break }
		if { ($askto_prop) > 0 && ($propagate < 0) } {
		    set newregion  [ic_uns_subset_create]
		    ic_uns_add_near_node $newregion $sel_map
		    if {[lsearch -regexp [ic_uns_subset_list_types $newregion] QUAD_+] >= 0} {
			set propagate [tk_dialog .split_edge_prop "Node merging" \
					   $mess "" -1 Terminate Propagate]
		    }
		    ic_uns_subset_delete $newregion
		}
		set n [ic_uns_merge_nodes $sel_map "" "0 0 0" "0 0 0" $propagate 1]
		ic_uns_subset_delete $sel_map
	    }
	    active_tol {
		set n [ic_uns_merge_nodes visible $unstruct_merge(tol) "0 0 0" "0 0 0" 0 1]
		set ok 0
	    }
	    select_tol {
		set sel_map [select_unstruct node 0 $cur "" \
				 "nodes to merge" merge]
		if {$sel_map == ""} { set ok 0; break }
		set n [ic_uns_merge_nodes $sel_map $unstruct_merge(tol) "0 0 0" "0 0 0" 0 1]
	        ic_uns_subset_delete $sel_map
	    }
	    all {
		set n [ic_uns_merge_nodes all $unstruct_merge(tol) "0 0 0" "0 0 0" 0 1]
		set ok 0
	    }
	}
        ic_undo_group_end
	set want [lindex $n 3]
	set elim [lindex $n 2]
	mess "[lindex $n 2] merged nodes were eliminated\n"
	if {$elim != $want &&  \
		( $how == "select_tol" || $how == "inter" ) } {
	    mess "Not all nodes ($want selected) could be merged.\n"
	    #because the volume mesh would have become invalid.\n"
	}

	if [lindex $n 0] {
	    mess "[lindex $n 0] elements became degenerated and were deleted\n" red
	}
	if [lindex $n 1] {
	    mess "[lindex $n 1] surface elements became internal faces and were deleted\n" red
	}
    }
}

proc unstruct_move_exact {} {
    global unstruct_move_node
    
    set buts {{Apply unstruct_move_node_exact_doit} dismiss}
    set d [form_init .unstruct_move_node "Move nodes" "" $buts]
    if {$d != ""} {
	form_radiobutton $d.setp "Set position" \
	    unstruct_move_node(set_pos) 1 {10 0 -cols 2}
	form_radiobutton $d.incr "Increment position" \
	    unstruct_move_node(set_pos) 0 {11 0 -cols 2}
	# must change if we support non-cart systems
	form_checkbutton $d.sx "X value" unstruct_move_node(dox) {12 0}
	form_checkbutton $d.sy "Y value" unstruct_move_node(doy) {13 0}
	form_checkbutton $d.sz "Z value" unstruct_move_node(doz) {14 0}
	form_entry $d.vx unstruct_move_node(xv) float {12 1} \
	    unstruct_move_node(dox)
	form_entry $d.vy unstruct_move_node(yv) float {13 1} \
	    unstruct_move_node(doy)
	form_entry $d.vz unstruct_move_node(zv) float {14 1} \
	    unstruct_move_node(doz)
	
	form_finish bot
    }
}

proc unstruct_move_node_exact_doit {} {
    global unstruct_move_node
    
    set sel_map [select_unstruct node 0 visible ""]
    if {$sel_map == ""} return
    
    if ![warn_if_periodic $sel_map] return
    
    set pos "$unstruct_move_node(dox) $unstruct_move_node(doy) $unstruct_move_node(doz)"
    if $unstruct_move_node(set_pos) {
	set dir [ic_coords_into_global "$unstruct_move_node(xv) $unstruct_move_node(yv) $unstruct_move_node(zv)"]
    } else {
	set dir [ic_coords_dir_into_global "$unstruct_move_node(xv) $unstruct_move_node(yv) $unstruct_move_node(zv)"]
    }
    
    set amt [ic_uns_move_nodes_exact $sel_map $unstruct_move_node(set_pos) \
		 $pos $dir]
    
    if [lindex $amt 3] {
	mess "[lindex $amt 3] nodes moved, min [lindex $amt 0],\
		max [lindex $amt 1],\
		mean [expr {[lindex $amt 2] / ([lindex $amt 3] + 0.0)}]\n"
    } else {
	mess "0 nodes moved\n"
    }
    
    ic_uns_subset_delete $sel_map
}

proc unstruct_delete_node {} {
    while 1 {
	set sel_map [select_unstruct node 0 visible ""]
	if {$sel_map == ""} return
	ic_uns_delete_nodes $sel_map
	ic_uns_subset_delete $sel_map
    }
}

# How is surface, curve (surface_curve), point (surface_point), or none.

proc unstruct_project_node {how} {
    global explicit_location_value unstruct_project
    
    if {$how == "surface_curve" || $how == "surface_point"} {
        if ![ic_geo_is_loaded] {
            mess "Please load a geometry file.\n" red
            return
        }
    } 
    while 1 {
	set sel_map [select_unstruct node 0 visible ""]
	if {$sel_map == ""} return
	
	if {$how == "point"} {
	    if {[ic_uns_subset_count_nodes $sel_map] > 32} {
		error "Can only set 32 nodes to prescribed at one time"
	    }
	    set opts [ic_uns_get_node_positions $sel_map]
	    if ![ic_geo_is_loaded] {
		set i 1
		set arglist ""
		foreach op $opts {
		    lappend arglist [list "Point $i" $op get_graphics_loc]
		    incr i
		}
		set npts [question_box_mult .node_positions Positions \
			      "New node positions" $arglist]
		if {$npts == ""} return
		ic_uns_set_node_positions $sel_map $npts
		
	    } else {
		set explicit_location_value [lindex $opts 0]
		set ptobj [geo_select point 1 "the point to project to" 1]
		if {$ptobj != ""} {
		    set pt [ic_geo_get_point_location $ptobj]
		    ic_uns_set_node_positions $sel_map [list $pt]
		}
	    }
	} elseif {$how == "surface_curve"} {
            set nodes [ic_uns_subset_list_elements $sel_map]
            set i 0; set opts ""
            catch { unset ele }
            foreach n $nodes {
                if {[lindex $n 0] == "VERTEX"} {
                    set ele($i) [lindex $n 1]
                    lappend opts [lindex $n 2]
                    incr i
                }
            }
	    set tol [question_box .nodetol "Tolerance" \
		   "Minimum node distance" $unstruct_project(tol)]
	    if {$tol == ""} return
	    set mess "curve(s) to project to"
            set to_proj [geo_select curve 0 "$mess" 0 0 ""] 
            if {$to_proj == ""} return
	    set nodes_map [ic_uns_subset_create]
	    if {$nodes_map == ""} return
            set n 0
	    foreach p1 $opts {
	        set dist 0.0
	        set p2 [ic_geo_project_coords curve $to_proj $p1]
	        foreach i {0 1 2} {
	            set p [expr {[lindex $p2 $i] - [lindex $p1 $i]}]
	            set dist [expr {$dist + $p * $p}]
	        }
	        set distance [expr {sqrt($dist)}]
	        if {$distance <= $tol} {
                    ic_uns_subset_add_node_numbers $nodes_map $ele($n)
	        }
                incr n
	    }
            ic_uns_subset_delete $sel_map
            set sel_map $nodes_map
	    ic_uns_set_node_dimension $sel_map curve
	    ic_uns_subset_delete $sel_map
	    display_update unstruct
	    return
	} elseif {$how == "surface_point"} {
            set nodes [ic_uns_subset_list_elements $sel_map]
            set i 0; set opts ""
            catch { unset ele }
            foreach n $nodes {
                if {[lindex $n 0] == "VERTEX"} {
                    set ele($i) [lindex $n 1]
                    lappend opts [lindex $n 2]
                    incr i
                }
            }
	    set tol [question_box .nodetol "Tolerance" \
		   "Minimum node distance" $unstruct_project(tol)]
	    if {$tol == ""} return
	    set mess "point(s) to project to"
            set to_proj [geo_select point 0 "$mess" 0 0 ""] 
            if {$to_proj == ""} return
            set pts ""
            foreach p $to_proj {
                lappend pts [list $p [ic_geo_get_point_location $p]]
            }
            foreach pp $pts {
	        set nodes_map [ic_uns_subset_create]
	        if {$nodes_map == ""} return
                set n 0
                set p2 [lindex $pp 1]
	        foreach p1 $opts {
	            set dist 0.0
	            foreach i {0 1 2} {
	                set p [expr {[lindex $p2 $i] - [lindex $p1 $i]}]
	                set dist [expr {$dist + $p * $p}]
	            }
	            set distance [expr {sqrt($dist)}]
	            if {$distance <= $tol} {
                        ic_uns_subset_add_node_numbers $nodes_map $ele($n)
	            }
                    incr n
                }
                if {[ic_uns_subset_count_nodes $nodes_map] > 32} {
		    error "Can only set 32 nodes to prescribed at one time"
	        }
	        ic_uns_set_node_positions $nodes_map [list $p2]
	        ic_uns_set_node_dimension $nodes_map point
	        ic_uns_subset_delete $nodes_map
	    }
	    ic_uns_subset_delete $sel_map
	    display_update unstruct
	    return
	}
	ic_uns_set_node_dimension $sel_map $how
	ic_uns_subset_delete $sel_map
	display_update unstruct
    }
}

proc unstruct_project_node_reset {} {
    switch [tk_dialog .reset "Reset nodes" \
		"Add bar elements on boundaries?" "" -1 Yes No Cancel] {
		    0 { set bars 1 }
		    1 { set bars 0 }
		    2 { return }
		}
    ic_uns_set_node_dimension visible reset $bars
}

proc unstruct_split_node_man {} {
    while 1 {
	ic_newop
	set sel_map [select_unstruct node 0 visible ""]
	if {$sel_map == ""} return
	
	ic_uns_subset_configure $sel_map -visible 1
	select_move_uns_map $sel_map 1 0 ""
	ic_uns_subset_delete $sel_map
    }
}

proc check_ok_fix_nonman {map what} {
    set adj_all [ic_uns_subset_create ""]
    ic_uns_add_adjacent_tetras $adj_all $map
    foreach f [ic_uns_subset_list_families $adj_all] t \
	[ic_uns_subset_list_types $adj_all] {
	if ![lmember $t {NODE BAR_2 BAR_3 LINE_2 LINE_3 TRI_3 TRI_6 QUAD_4 QUAD_9}] {
	    set got($f) 1
	}
    }
    set nf [llength [array names got]]
    ic_uns_subset_delete $adj_all
    if {$nf > 2} {
	mess "That node is adjacent to $nf volume families\
		([lsort [array names got]]) so it can't be $what\n" red
	return 0
    } else {
	return 1
    }
}

proc unstruct_split_node_nonman {} {
    global selmap tmp_uns_type_visible
    
    while 1 {
	set sel_map [select_unstruct node 1 visible ""]
	if {$sel_map == ""} return
	
	if ![check_ok_fix_nonman $sel_map split] {
	    ic_uns_subset_delete $sel_map
	    return
	}
	
	ic_uns_subset_visible $sel_map 1
	
	set adj [ic_uns_subset_create "" 1]
	ic_uns_add_near_node $adj $sel_map
	
	ic_uns_update_family_type $adj __same__ "1d 2d" restrict_to
	
	ic_uns_subset_visible visible 0
	
	set move_map [select_unstruct element 0 $adj 0 \
			 "elements to go with the moved node"]
	ic_uns_subset_delete $adj
	ic_uns_subset_visible visible 1
	
	if {$move_map != ""} {
	    set na [ic_uns_add_adjacent_tetras $move_map $sel_map]
	    if {![lindex $na 0] || ([lindex $na 0] == [lindex $na 1])} {
		set mess "[lindex $na 0] out of [lindex $na 1] tetras will be\
			moved with the node.  Continue?"
		if [tk_dialog .nonmanmove "Non-manifold" $mess "" -1 Yes No] {
		    ic_uns_subset_delete $move_map
		    ic_uns_subset_delete $sel_map
		    return
		}
	    }
	    ic_uns_subset_visible $move_map 1
	    ic_uns_split_node_non_man $sel_map $move_map
	    select_move_uns_map $sel_map 0 0 ""
	    ic_uns_subset_delete $move_map
	}
	
	ic_uns_subset_delete $sel_map
    }
}

proc unstruct_fix_node_nonman {} {
    
    while 1 {
	set sel_map [select_unstruct node 0 visible ""]
	if {$sel_map == ""} return
	ic_uns_fix_non_man $sel_map
	ic_uns_subset_delete $sel_map
    }
}

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

proc unstruct_create_element {} {
    global uns_type_visible fam_visible unstruct_create options
    
    set d [form_init .create_elem "Create element" "" \
	       {{Create unstruct_do_create_element} dismiss}]
    if {$d != ""} {
	form_label $d.typel "Element type" {0 0}
	form_label $d.faml "Family" {0 1}
	form_frame $d.typef ridge 2 {1 0}
	form_frame $d.famf ridge 2 {1 1}
	form_button $d.types "Screen select" \
	    "unstruct_screen_select_type unstruct_create(type)" {2 0}
	form_button $d.fams "Screen select" \
	    "unstruct_screen_select_family unstruct_create(family)" {2 1}
	form_button $d.famn "New family" \
	    "unstruct_select_new_family unstruct_create(family) $d.famf" {3 1}
	form_checkbutton $d.mcons "Make volume consistent" \
	    unstruct_create(do_make_consistent) {5 0 -cols 2}
	form_finish bot
    }
    
    set types [ic_uns_list_possible_types]
    #set families [ic_uns_list_families] by JKA for
    set families [lsort -command "family_name_compare -1" [ic_uns_list_families]]
    check_box .create_elem.main.typef $types 8 unstruct_create(type) 0
    check_box .create_elem.main.famf $families 8  unstruct_create(family) 0
    
    if {!$options(edit_wait) && ($unstruct_create(type) != "") && \
	    ($unstruct_create(family) != "")} {
	unstruct_do_create_element
    }
}

proc unstruct_do_create_element {} {
    global uns_type_visible fam_visible unstruct_create options
    
    set type $unstruct_create(type)
    if {$type == ""} { error "No type is selected" }
    set fam $unstruct_create(family)
    if {$fam == ""} { error "No family is selected" }
    
    set reset 0
    if {[lsearch [ic_uns_list_types] $type] < 0} {
	set uns_type_visible($type) 1
	set reset 1
    }
    if {[lsearch [ic_uns_list_families] $fam] < 0} {
	ic_uns_new_family $fam
	set reset 1
    }
    
    set nv [ic_uns_num_verts_in_type $type]
    while 1 {
	set sel_map [select_unstruct node $nv visible "" "" create]
	if {$sel_map == ""} break
	if {[ic_uns_subset_count_nodes $sel_map] < $nv} break
	set mess [ic_uns_create_element $type $fam $sel_map \
		      $unstruct_create(do_make_consistent)]
	if {$mess != ""} {
	    mess "$mess\n" red
	    return
	}
	ic_uns_subset_delete $sel_map
    }
    if $reset {
	update_uns_available
    }
}

proc unstruct_delete_element {} {
    global selmap
    
    while 1 {
	set sel_map [select_unstruct element 0 visible ""]
	if {$sel_map == ""} return
	ic_delete_elements subset $sel_map
	ic_uns_subset_delete $sel_map
    }
}


proc unstruct_delete_orphan {} {
    if [tk_dialog .del_blanked "Delete orphan" \
	    "Delete all orphaned tetras?" \
	    "" -1 Yes No] return
    set sub [ ic_uns_subset_create "orphaned_tets" ]
    ic_uns_subset_add_families_and_types orphaned_tets ORFN TETRA_4
    set ne [ic_uns_subset_count_elements $sub]
    ic_delete_elements subset $sub
    ic_uns_subset_delete $sub
 
    mess "$ne elements deleted\n"
}

# We assume this is a big op ...
proc unstruct_delete_blanked {} {
    if [tk_dialog .del_blanked "Delete blanked" \
	    "Delete all elements except for the visible ones?" \
	    "" -1 Yes No] return
    
    set sub [ic_uns_subset_create ""]
    ic_uns_subset_copy $sub visible
    ic_uns_invert_subset $sub
    set ne [ic_uns_subset_count_elements $sub]
    ic_delete_elements subset $sub
    ic_uns_subset_delete $sub
    
    mess "$ne elements deleted\n"
}

proc erase_flood_fill_lines {} {
	global ff_lines
# erase the existing lines
	if { [ info exists ff_lines ] } {
		foreach l $ff_lines {
			$l delete
		}
	}
	set ff_lines ""
}

proc unstruct_flood_fill { { args "" } } {
        global tdv_default

	erase_flood_fill_lines
        
	set path [ eval ic_flood_fill $args ]
	set path [ split $path "\n" ] 
	set first_line [ split [ lindex $path 0 ] ]
	set nlines [ lindex $first_line 0 ] 

	global ff_lines
	set count 0
	set line ""
	set last_pos ""
	foreach l $path {
		if { [ llength $l ]  == 6 } {
		    set p1 "[ lindex $l 0 ] [ lindex $l 1 ] [ lindex $l 2 ]"
		    set p2 "[ lindex $l 3 ] [ lindex $l 4 ] [ lindex $l 5 ]"
		    if { $last_pos != "" && $last_pos != $p1 } {
			set line ""
		    }
		    if { $line == "" } {
			set line [tdv_poly_line_im -color red -draw_dots 0]
			$tdv_default add_image $line
			lappend ff_lines $line
			set last_pos ""
		    }
		    if { $last_pos == "" } {
			$line add_point $p1
			$line add_point $p2
		    } elseif { $last_pos == $p1 } {
			$line add_point $p1
		    } else {
			mess "we shouldn't be able to get here\n"
			break
		    }
		    set last_pos $p2
		}
		incr count
	}
    return $count
}


proc unstruct_flood_fill_checkfix {} {
    global disp_options tdv_default
    set count [unstruct_flood_fill]
    if $count {
	switch [ tk_dialog .flood_fill "Flood fill" \
		     "Your mesh has leakage, do you want to repair it?" \
		     "" -1 Yes No ] {
	     0 {
		 # turn on single  multiple
		 set disp_options(uns_single_surfaces) 1
		 set disp_options(uns_multiple_surfaces) 1
		 ic_uns_subset_set_current Subset0
		 ic_uns_update_family_type visible __same__ TRI_3 update 1
		 ic_uns_subset_remove_manifold_elements visible
		 set uns_use_subset 1
		 update_uns_disp
		 
		 tdv_active 1

		 # bring up repair form.
		 set remesh(how) 2
		 set remesh(make_consistent) 1
		 unstruct_remesh
	    }
	}
    }
}

proc unstruct_auto_orphan { } {
	ic_auto_orphan
}


proc unstruct_family_element {{what sel}} {
    
    while 1 {
	if {$what == "sel"} {
	    set sel_map [select_unstruct element 0 visible ""]
	    if {$sel_map == ""} return
	} elseif {$what == "fam"} {
	    set sel_map [ic_uns_create_selection_subset 0]
	    if {$sel_map == ""} return
	    set fam_old [select_families 0 0 0]
	    if {$fam_old == ""} {
	        ic_uns_subset_delete $sel_map
	        return
	    }
	    ic_uns_subset_make_families $sel_map $fam_old
	    set num [ic_uns_subset_count_elements $sel_map]
	    if {$num == 0} {
	        ic_uns_subset_delete $sel_map
	        mess "Family $fam_old contains no element(s).\n"
	        return
	    } else {
	        mess "Selected all $num element(s) in family: $fam_old\n"
	    }
	}	
	set fam [select_family]
	if {$fam != ""} {
	    ic_uns_change_family $sel_map $fam
	}
	ic_uns_subset_delete $sel_map
    }
}

proc unstruct_reorient_element {} {
    set d [form_init .reorient "Reorient elements" "" dismiss]
    if {$d != ""} {
	form_button $d.howd "Direction" "unstruct_do_reorient dir" \
	    {0 0}
	form_button $d.howa "Reverse all" "unstruct_do_reorient all" \
	    {5 0}
	form_button $d.how1 "Reverse selected" "unstruct_do_reorient selected" \
	    {5 1 -cols 2}
	form_button $d.howv "Volume" "unstruct_do_reorient vol" \
	    {10 0}
	form_button $d.howo "Consistent with one element" "unstruct_do_reorient cons" \
	    {20 0 -cols 3}
	form_button $d.howi "Internal wall families" "unstruct_do_reorient int_wall" \
	    {30 0 -cols 3}
	form_colwidth $d 1 4 M
	
	form_label $d.dirxl "X" {0 1} {{reorient(how) dir}}
	form_label $d.diryl "Y" {1 1} {{reorient(how) dir}}
	form_label $d.dirzl "Z" {2 1} {{reorient(how) dir}}
	form_entry $d.dirx reorient(dirx) float {0 2} {{reorient(how) dir}}
	form_entry $d.diry reorient(diry) float {1 2} {{reorient(how) dir}}
	form_entry $d.dirz reorient(dirz) float {2 2} {{reorient(how) dir}}
	
	form_radiobutton $d.vol_in "Inwards" reorient(vol_in) 1 {10 1 -cols 2}
	form_radiobutton $d.vol_out "Outwards" reorient(vol_in) 0 {11 1 -cols 2}
	
	form_finish bot
    }
}

proc unstruct_do_reorient {how} {
    global reorient reorient_family
    
    switch $how {
	dir {
	    set n [ic_uns_reorient visible dir [list $reorient(dirx) \
						    $reorient(diry) \
						    $reorient(dirz)]]
	}
	all {
	    set n [ic_uns_reorient visible flip]
	}
	selected {
	    set sel_map [select_unstruct element 0 visible ""]
	    if {$sel_map == ""} return
	    set n [ic_uns_reorient $sel_map flip]
	    ic_uns_subset_delete $sel_map
	}
	vol {
	    set n [ic_uns_reorient visible vol $reorient(vol_in)]
	}
	cons {
	    set sel_map [select_unstruct element 1 visible "" \
			     "the reference element"]
	    if {$sel_map == ""} return
	    set n [ic_uns_reorient visible consistent $sel_map]
	    ic_uns_subset_delete $sel_map
	}
	int_wall {
	    set opts_fam [unstruct_internal_faces_options_get reorient_family]
	    if {$opts_fam == ""} {
		mess "There are no internal faces\n" red
		return
	    }
	    set d [form_init .reorient_internal "Reorient internal faces"]
	    if {$d != ""} {
		form_frame $d.fams ridge 2 {1 0 -cols 2}
		form_label $d.fams.l "Internal wall families:" {0 0 -cols 2}		
		form_frame $d.fams.sel ridge 2 {3 0}

		form_finish +300+300
	    }
	    set d .reorient_internal.main
	    catch { unset reorient_family }
	    check_box $d.fams.sel $opts_fam 6 reorient_family
	    
	    set ret [form_wait .reorient_internal]
	    ic_uns_reset_selected
	    if !$ret return
	    
	    set reorient_f ""
	    foreach f [array names reorient_family] {
		if $reorient_family($f) { lappend reorient_f $f }
	    }
	    set n [ic_uns_internal_wall_families_reorient $reorient_f]	    
	    display_update unstruct
	}
    }
    mess "$n element orientations modified.\n"
}

proc unstruct_reorder_element {} {
    set d [form_init .reorder "Reorder elements" "" dismiss]
    if {$d != ""} {
	form_button $d.howd "Direction" "unstruct_do_reorder dir" \
	    {0 0}
	form_colwidth $d 1 4 M
	
	form_label $d.dirxl "X" {0 1} {{reorder(how) dir}}
	form_label $d.diryl "Y" {1 1} {{reorder(how) dir}}
	form_label $d.dirzl "Z" {2 1} {{reorder(how) dir}}
	form_entry $d.dirx reorder(dirx) float {0 2} {{reorder(how) dir}}
	form_entry $d.diry reorder(diry) float {1 2} {{reorder(how) dir}}
	form_entry $d.dirz reorder(dirz) float {2 2} {{reorder(how) dir}}
	
	form_finish bot
    }
}

proc unstruct_do_reorder {how} {
    global reorder
    
    switch $how {
	dir {
	    if {!$reorder(dirx) && !$reorder(diry) && !$reorder(dirz)} {
		mess "Error: the direction must be non-zero\n" red
		return
	    }
	    set n [ic_uns_reorder visible dir [list $reorder(dirx) \
						   $reorder(diry) \
						   $reorder(dirz)]]
	}
    }
    mess "$n elements reordered.\n"
}

proc unstruct_split_element {} {
    global selmap
    
    mess "This function splits triangles into 3.  To split into 4 use the Refine function.  To split into 2 use the Split edge function.\n"
   
    while 1 {
	set sel_map [select_unstruct element 0 visible ""]
	if {$sel_map == ""} return
	ic_uns_split_elements $sel_map
	ic_uns_subset_delete $sel_map
    } 
}

proc unstruct_split_spanning { { args "" } } {
    ic_uns_split_spanning_edges visible $args
}

proc unstruct_split_edge {} {
    set mess "Would you like split edges to propagate through the\
		mesh (maintains element types), or terminate in adjacent\
		elements (may create tris)?"
    set askto_prop [expr { (2 == [ic_uns_dimension]) && \
			       ([lsearch -regexp [ic_uns_list_types] QUAD_+] >= 0)}]
    if $askto_prop { set propagate -1 } else { set propagate 0 }
    
    while 1 {
	set sel_map [select_unstruct edge 0 visible ""]
	if {$sel_map == ""} return
        if {[lsearch [ic_uns_subset_list_types $sel_map] BAR_2] >= 0} {
            set node_map [ic_uns_create_selection_subset 0]
            if {$node_map == ""} return
            set the_nodes ""
            foreach e [ic_uns_subset_list_elements $sel_map] {
                if {[lindex $e 0]== "BAR_2"} {
                    lappend the_nodes [lindex $e 3]
                }
            }
            set uni_pairs [unstruct_uniquify_pairs $the_nodes]
            foreach n $uni_pairs {
                ic_uns_subset_add_node_numbers $node_map $n
            }
            ic_uns_subset_delete $sel_map
            set sel_map $node_map
        }
	if { ($askto_prop) > 0 && ($propagate < 0) } {
	    set newregion  [ic_uns_subset_create]
	    ic_uns_add_near_node $newregion $sel_map
	    if {[lsearch -regexp [ic_uns_subset_list_types $newregion] QUAD_+] >= 0} {
		set propagate [tk_dialog .split_edge_prop "Node merging" \
				   $mess "" -1 Terminate Propagate]
	    }
	    ic_uns_subset_delete $newregion
	}
	ic_uns_split_edges $sel_map $propagate
	ic_uns_subset_delete $sel_map
    }
}

proc unstruct_swap_edge {try_harder} {
    while 1 {
	set sel_map [select_unstruct edge 0 visible ""]
	if {$sel_map == ""} return
        if {[lsearch [ic_uns_subset_list_types $sel_map] BAR_2] >= 0} {
            set node_map [ic_uns_create_selection_subset 0]
            if {$node_map == ""} return
            set the_nodes ""
            foreach e [ic_uns_subset_list_elements $sel_map] {
                if {[lindex $e 0]== "BAR_2"} {
                    lappend the_nodes [lindex $e 3]
                }
            }
            set uni_pairs [unstruct_uniquify_pairs $the_nodes]
            foreach n $uni_pairs {
                ic_uns_subset_add_node_numbers $node_map $n
            }
            ic_uns_subset_delete $sel_map
            set sel_map $node_map
        }
	set n [ic_uns_swap_edges $sel_map $try_harder]
	if $n {
	    mess "$n edges could not be swapped\n"
	}
	ic_uns_subset_delete $sel_map
    }
}

proc unstruct_uniquify_pairs {pairs} {
    set segs ""
    foreach ss $pairs {
	eval lappend segs $ss
    }
    foreach {i j} $segs {
	if {$i == $j} continue
	if {$i > $j} {
	    set k $i
	    set i $j
	    set j $k
	}
	set "found($i $j)" 1
    }
    set ret ""
    foreach ff [array names found] {
	eval lappend ret $ff
    }
    return $ret
}

proc unstruct_swap_auto {} {
    global swap_edges
    
    set d [form_init .swap_auto "Swap automatic"]
    if {$d != ""} {
	form_label $d.aspl "Min aspect ratio" {0 0}
	form_label $d.iterl "Num iterations" {1 0}
	form_entry $d.asp swap_edges(min_aspect) float {0 1}
	form_entry $d.iter swap_edges(num_iter) int {1 1}
	form_finish bot
    }
    if ![form_wait .swap_auto] return
    
    mess "Swapping edges ...\n"
    ic_uns_swap_edges_auto visible $swap_edges(min_aspect) \
	$swap_edges(num_iter)
    mess "Done.\n"
}

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

proc unstruct_chtype {from to ask_nnode allow_some} {
    global selmap uns_type_visible
    
    if $allow_some {
	set cur visible
	set sel_map [select_unstruct element 0 visible ""]
	if {$sel_map == ""} return
    } else {
	set sel_map all
	mess "All elements in the mesh will be changed.\n"
    }
    
    foreach p [ic_uns_list_types] {
	set has_type($p) 1
    }
    set proj 0
    if $ask_nnode {
	switch [tk_dialog .proj_new "Project" \
		    "Project new nodes?" "" -1 Yes No Cancel] {
			0 { set proj 1 }
			2 { return }
		    }
    }
    ic_uns_change_type $sel_map $from $to $proj
    
    if $allow_some {
	ic_uns_subset_delete $sel_map
    }
    foreach p [ic_uns_list_types] {
	if ![info exists has_type($p)] {
	    switch $p {
		BAR_2 - LINE_2 - QUAD_4 - TRI_3 {
		    set uns_type_visible($p) 1
		}
		default {
		    set uns_type_visible($p) 0
		}
	    }
	}
    }
    update_uns_available
}

proc unstruct_linear_to_quadratic {} {
    global uns_type_visible linear_to_quadratic
    global unstruct_linear_to_quadratic_warning
    
    if ![info exists unstruct_linear_to_quadratic_warning] {
	mess "All elements in the mesh will be changed to quadratic.\n"
	set unstruct_linear_to_quadratic_warning 1
    }
    
    set d [form_init .lin_quad "Linear to quadratic"]
    if {$d != ""} {
	form_checkbutton $d.face "Create midface nodes" \
	    linear_to_quadratic(midface) {0 0}
	form_checkbutton $d.all "All elements" \
	    linear_to_quadratic(all_elem) {1 0}
	form_button $d.adv_opt "Advanced options" \
	    unstruct_linear_to_quadratic_advopts {2 0}
	form_finish bot
    }
    
    if ![form_wait .lin_quad] return
    if [winfo exists .lin_quad_adv] { form_delete .lin_quad_adv }
    
    set sel_map ""
    if !$linear_to_quadratic(all_elem) {
	set sel_map [select_unstruct element 0 visible ""]
	if {$sel_map == ""} return
    }
    
    ic_change_linear_quadratic \
	iters $linear_to_quadratic(iters) \
        project $linear_to_quadratic(project) \
	max_dev_half $linear_to_quadratic(max_dev_half) \
	check_max_dev_half $linear_to_quadratic(check_max_dev_half) \
	max_dev_nproj $linear_to_quadratic(max_dev_nproj) \
	check_max_dev_nproj $linear_to_quadratic(check_max_dev_nproj) \
	max_dev_chord $linear_to_quadratic(max_dev_chord) \
	check_max_dev_chord $linear_to_quadratic(check_max_dev_chord) \
	check_tet10_standard $linear_to_quadratic(tetra10_ele_on1) \
	check_tet10_strong $linear_to_quadratic(tetra10_ele_on2) \
	check_proj $linear_to_quadratic(check_proj) \
	max_leap $linear_to_quadratic(max_leap) \
	midface $linear_to_quadratic(midface) \
	refine $linear_to_quadratic(refine) \
	smooth_refine $linear_to_quadratic(smooth_refine) \
	all_elem $linear_to_quadratic(all_elem) \
	name $sel_map
}    

proc unstruct_linear_to_quadratic_advopts {} {
    set d [form_init .lin_quad_adv "Linear to quadratic advanced options"]
    if {$d != ""} {
	form_checkbutton $d.proj "Project new nodes" \
		linear_to_quadratic(project) {4 0}
	form_frame $d.1 flat 3 "5 0"
	form_label $d.1.devhl "Max.Mid Point Deviation" {0 0} \
		{ linear_to_quadratic(project) }
	form_entry $d.1.devh linear_to_quadratic(max_dev_half) float {0 1} \
		{ linear_to_quadratic(project) }
	form_checkbutton $d.1.devhc "Check" \
		linear_to_quadratic(check_max_dev_half) {0 2} \
		{ linear_to_quadratic(project) }
	form_label $d.1.devpl "Max.Angle out of Line" {1 0} \
		{ linear_to_quadratic(project) }
	form_entry $d.1.devp linear_to_quadratic(max_dev_nproj) float {1 1} \
		{ linear_to_quadratic(project) }
	form_checkbutton $d.1.devpc "Check" \
		linear_to_quadratic(check_max_dev_nproj) {1 2} \
		{ linear_to_quadratic(project) }		
	form_label $d.1.devfl "Max deviation from chord in %" {2 0} \
		{ linear_to_quadratic(project) }
	form_entry $d.1.devf linear_to_quadratic(max_dev_chord) float {2 1} \
		{ linear_to_quadratic(project) }
	form_checkbutton $d.1.devfc "Check" \
		linear_to_quadratic(check_max_dev_chord) {2 2} \
		{ linear_to_quadratic(project) }	
	form_label $d.1.devml "Tetra 10 elements" {3 0} \
		{ linear_to_quadratic(project) }
	set com "unstruct_linear_to_quadratic_check 1"
	form_checkbutton $d.1.devmc1 "Standard check" \
		linear_to_quadratic(tetra10_ele_on1) {3 1} \
		{ linear_to_quadratic(project) } "$com"
	set com "unstruct_linear_to_quadratic_check 2"
	form_checkbutton $d.1.devmc2 "Strong check  " \
		linear_to_quadratic(tetra10_ele_on2) {4 1} \
		{ linear_to_quadratic(project) } "$com"
	form_checkbutton $d.refine "Automatic refinement" \
	    linear_to_quadratic(refine) {6 0}
	form_frame $d.2 flat 3 "7 0"
	form_checkbutton $d.2.srefine "Smooth refinement" \
	    linear_to_quadratic(smooth_refine) {0 0 -fill x} { linear_to_quadratic(refine) }
	$d.2.srefine configure -anchor nw
	form_finish bot
    }
}

proc unstruct_linear_to_quadratic_check {on} {
    global linear_to_quadratic
    if {$linear_to_quadratic(tetra10_ele_on1)} {
        if {$on == "2"} {
            set linear_to_quadratic(tetra10_ele_on1) 0
        } elseif {$on == "1"} {
            set linear_to_quadratic(tetra10_ele_on2) 0
        }
    } elseif {$linear_to_quadratic(tetra10_ele_on2)} {
        if {$on == "2"} {
            set linear_to_quadratic(tetra10_ele_on1) 0
        } elseif {$on == "1"} {
            set linear_to_quadratic(tetra10_ele_on2) 0
        }
    }
}

proc unstruct_quadratic_to_linear {} {
    global uns_type_visible
    
    set mess "You can convert from quadratic to linear in two ways:\n1.\
    Keep the quadratic nodes and create new linear elements (refinement)\n2.\
    Keep the same number of elements but remove the quadratic nodes."
    switch [tk_dialog .q_to_l "Quadratic to linear" $mess "" -1 \
		Refine Remove Cancel] {
		    0 { set refine 1 }
		    1 { set refine 0 }
		    2 { return }
		}
    
    ic_change_quadratic_linear $refine
}

proc unstruct_convert_hexas {} {
    set asp [question "Minimum quality\nfor a hexa element?" .2]
    if {$asp == ""} return
    ic_uns_convert_to_hexas $asp
}

proc unstruct_prism_to_3hexa {} {
    global uns_type_visible
    if ![ic_uns_is_loaded] {
      mess "There is no current mesh: please load one\n"
      return
    }
    if ![ic_geo_is_loaded] {
      mess "Please load a geometry file.\n"
      return
    }
    if {[lsearch [ic_uns_list_types] PENTA_6] < 0} {
      mess "Element type not found: <PENTA_6>.\n"
      return
    }
    set mess "Display only prism elements?"
    if ![tk_dialog .show_penta_6 "PENTA_6" $mess "" -1 Yes No] {
      foreach types [ic_uns_list_types] {
        foreach type $types {
          if {$type != "PENTA_6"} {
            set uns_type_visible($type) 0
          }
        }
      }  
      set uns_type_visible(PENTA_6) 1
      update_uns_available
    }
    set mess " prism element(s) "
    set sel_map [select_unstruct element 0 visible "" $mess]
    if {$sel_map == ""} return   
    if {[lsearch [ic_uns_subset_list_types $sel_map] PENTA_6] < 0} {
      mess "Wrong selection. Type <PENTA_6> is not selected.\n"
      ic_uns_subset_delete $sel_map
      return
    }
    foreach types [ic_uns_subset_list_types $sel_map] {
      foreach type $types {
        if {$type != "PENTA_6"} {
          if ![info exists tmp($type)] {
            mess "Wrong selection. Type <$type> also selected.\n"
            set tmp($type) 1
          }
        }
      }
    }
    if [info exists tmp] {
      ic_uns_subset_delete $sel_map
      return
    }    
    set fam [ic_uns_subset_list_families $sel_map]
    if {$fam == ""} {
      ic_uns_subset_delete $sel_map
      return
    }
    if {[llength $fam] > 1} { set fam [lindex $fam 0] }
    set positions [ic_uns_get_element_vertex_positions $sel_map 1]
    set count [ic_uns_subset_count_elements $sel_map]
    set add 0
    busy 1
    for {set elem 0} {$elem < $count} {incr elem} {
      set i 1
      set pos [lrange $positions $add end]
      set add [expr $add + 6]
      foreach {one two three} $pos {
        append tmp($i,pos) [list $one $two $three]
        foreach v {0 1 2} {
          set c1_$v [expr ([lindex $one $v] + [lindex $two $v]) / 2.0]
          set c2_$v [expr ([lindex $one $v] + [lindex $three $v]) / 2.0]
          set c3_$v [expr ([lindex $two $v] + [lindex $three $v]) / 2.0]
          set c4_$v [expr ([lindex $one $v] + [lindex $two $v] + [lindex $three $v]) / 3.0]
        }
        lappend tmp($i,mid) "$c1_0 $c1_1 $c1_2"
        lappend tmp($i,mid) "$c2_0 $c2_1 $c2_2"
        lappend tmp($i,mid) "$c3_0 $c3_1 $c3_2"
        lappend tmp($i,mid2) "$c4_0 $c4_1 $c4_2"
        incr i
      }
      set hexa(1) [list [lindex $tmp(1,pos) 0] [lindex $tmp(2,pos) 0] \
		[lindex $tmp(1,mid) 0] [lindex $tmp(2,mid) 0] \
		[lindex $tmp(1,mid) 1] [lindex $tmp(2,mid) 1] \
		[lindex $tmp(1,mid2) 0] [lindex $tmp(2,mid2) 0]]
      set hexa(2) [list [lindex $tmp(1,pos) 2] [lindex $tmp(2,pos) 2] \
                [lindex $tmp(1,mid) 1] [lindex $tmp(2,mid) 1] \
	        [lindex $tmp(1,mid) 2] [lindex $tmp(2,mid) 2] \
		[lindex $tmp(1,mid2) 0] [lindex $tmp(2,mid2) 0]]
      set hexa(3) [list [lindex $tmp(1,pos) 1] [lindex $tmp(2,pos) 1] \
		[lindex $tmp(1,mid) 2] [lindex $tmp(2,mid) 2] \
		[lindex $tmp(1,mid) 0] [lindex $tmp(2,mid) 0] \
		[lindex $tmp(1,mid2) 0] [lindex $tmp(2,mid2) 0]]
      foreach v {1 2 3} {
        set sel_map$v [ic_uns_create_selection_subset 0]
        set map [set sel_map$v]
        if {$map == ""} {
          ic_uns_subset_delete $sel_map
          busy 0
          return
        }
        foreach pt $hexa($v) { ic_uns_create_vertex $map $pt 2 }
        set err [ic_uns_create_element HEXA_8 $fam $map 1]
        if {$err != ""} {
          mess "$err\n" red
          ic_uns_subset_delete $sel_map
          busy 0
          return
        }
        ic_uns_subset_delete $map
      }
      unset tmp
    }
    busy 0
    ic_uns_merge_nodes all 0.0 "0 0 0" "0 0 0" 0 1
    ic_delete_elements subset $sel_map type PENTA_6
    ic_uns_subset_delete $sel_map
    ic_uns_set_modified 1
    ic_delete_disconnected_vertices
    set uns_type_visible(HEXA_8) 1
    update_uns_available
    mess "$count prism element(s) converted to [expr $count * 3] hexa element(s).\n"
}

proc unstruct_print_info {how} {
    global load_bal_array
    switch $how {
        summary - domain {
            if {[ic_uns_is_loaded] || [ic_str_is_loaded]} {
                if [ic_uns_is_loaded] {
                    ic_uns_print_info $how
                } else {
                    set buttons {
                        {accept}
                        {cancel}
                    }
                    set load_bal_array(np) 2
                    set load_bal_array(crit) 2
                    set load_bal_array(info) 1
                    set load_bal_array(ctype) 0
                    set load_bal_array(gnum) 6000
                    set load_bal_array(gpow) 0.9
                    set load_bal_array(wg) 0.875
                    set load_bal_array(ws) 0.125
                    set load_bal_array(shw) 1.0
                    set load_bal_array(snum) 256
                    set w [form_init .load_balancing "Load Balancing Check" "" $buttons]
                    if {$w != ""} {
                        form_frame $w.1 ridge 3 "0 0 -cols -"
                        form_label $w.1.1 "Number of processors" "0 0"
                        form_entry $w.1.2 load_bal_array(np) int "0 1" ""
                        form_label $w.2 "Criterion" "1 0"
                        form_radiobutton $w.3 "Process Load" \
                                        load_bal_array(crit) 2 "1 1" "" ""
                        form_radiobutton $w.4 "Equiv. Surface" \
                                        load_bal_array(crit) 1 "1 2" "" ""
                        form_checkbutton $w.5 "All info" load_bal_array(info) \
                                        "2 0" "" "" "nonbool"
                        form_label $w.6 "Computer Type" "3 0"
                        form_radiobutton $w.7 "Scalar" load_bal_array(ctype) \
                                        0 "3 1" "" ""
                        form_radiobutton $w.8 "Vector" load_bal_array(ctype) \
                                        1 "3 2" "" ""
                        form_finish +200+200
                    }
                    if ![form_wait .load_balancing] return
                    ic_str_calc_load_balancing $load_bal_array(np) $load_bal_array(ctype) \
                                          $load_bal_array(crit) $load_bal_array(info) \
                                          $load_bal_array(gnum) $load_bal_array(gpow) \
                                          $load_bal_array(wg) $load_bal_array(ws) \
                                          $load_bal_array(shw) $load_bal_array(snum)
		}
	     }
	}
        element - node {
            set sel_map [select_unstruct $how 0 visible 1]
            if {$sel_map == ""} return
            ic_uns_print_info $how $sel_map
            ic_uns_subset_delete $sel_map
        }
        volume - area - length {
            switch $how {
                length {
                    set el_how 1d
                }
                area {
                    set el_how 2d
                }
                volume {
                    set el_how 3d
                }
            }
            set sel_map [select_unstruct $el_how 0 visible 1]
            if {$sel_map == ""} return
            set vol ["ic_uns_$how" $sel_map]
            ic_mess "total $how = $vol\n"
            ic_uns_subset_delete $sel_map
        }
    }
}

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

proc unstruct_copymove {} {
    set buts {{Apply unstruct_do_copymove} dismiss}
    set d [form_init .unstruct_copymove "Move/copy elements" edit $buts]
    if {$d != ""} {
	form_frame $d.fr sunken 2 {0 0}; set d $d.fr
	
	form_frame $d.whatf flat 0 {0 0 -cols -}
	form_label $d.whatf.l Operation {0 0}
	form_radiobutton $d.whatf.m Move unstruct_move(what) move {0 1}
	form_radiobutton $d.whatf.c Copy unstruct_move(what) copy {0 2}
	form_label $d.whatf.wl "Elements" {1 0}
	form_radiobutton $d.whatf.wa All unstruct_move(select_elements) 0 {1 1}
	form_radiobutton $d.whatf.ws Selected unstruct_move(select_elements) 1 {1 2}
	form_radiobutton $d.whatf.wv Visible unstruct_move(select_elements) 2 {1 3}
	
	form_label $d.ncopiesl "Num copies:" {2 1} \
		{{unstruct_move(what) copy}}
	form_entry $d.ncopys unstruct_move(numcopies) int {2 2 -cols 2} \
		{{unstruct_move(what) copy}}
        form_checkbutton $d.onlyf "Merge nodes after copy" \
		unstruct_move(merge_nodes) {3 0 -cols 23} \
		{{unstruct_move(what) copy}}
	
	form_colwidth $d 0 4 M
	
	form_checkbutton $d.translate Translate unstruct_move(do_translate) \
		{10 0 -cols 2}
	form_checkbutton $d.rotate "Rotate (degrees)" unstruct_move(do_rotate)\
		{20 0 -cols 2}
	form_checkbutton $d.scale Scale unstruct_move(do_scale) \
		{30 0 -cols 2}
	form_checkbutton $d.mirror Mirror unstruct_move(do_mirror) \
		{40 0 -cols 2}
	
	form_label $d.about "Transform about" {60 0 -cols 2}
	form_radiobutton $d.origin Origin unstruct_move(about) origin \
		{60 2 -cols 2}
	form_radiobutton $d.centr Centroid unstruct_move(about) centroid \
		{61 2 -cols 2}
	form_radiobutton $d.point Point unstruct_move(about) point \
		{62 2}
	
	form_entry $d.transamount unstruct_move(translate) coords \
		{10 2 -cols 2} unstruct_move(do_translate)
	
	form_entry $d.rotamount unstruct_move(rotate) string {20 2 -cols 2} \
		unstruct_move(do_rotate)
	form_frame $d.rotf flat 0 {21 2 -cols 2}
	form_radiobutton $d.rotf.x X unstruct_move(rotaxis) "1 0 0" {0 0} \
		unstruct_move(do_rotate)
	form_radiobutton $d.rotf.y Y unstruct_move(rotaxis) "0 1 0" {0 1} \
		unstruct_move(do_rotate)
	form_radiobutton $d.rotf.z Z unstruct_move(rotaxis) "0 0 1" {0 2} \
		unstruct_move(do_rotate)
	form_radiobutton $d.rotf.o Other unstruct_move(rotaxis) other \
	    {1 0 -cols 2} unstruct_move(do_rotate)
	form_entry $d.rotf.oe unstruct_move(rotaxis_other) float \
	    {1 2 -cols 2} \
	    {unstruct_move(do_rotate) {unstruct_move(rotaxis) other}}
	form_button $d.rotf.os "Select line" "med_get_line_2pts \
		unstruct_move(about_point) unstruct_move(rotaxis_other) \
		unstruct_move(about) point" {2 0 -cols 4} \
	    {unstruct_move(do_rotate) {unstruct_move(rotaxis) other}}
	
	form_entry $d.scaleamount unstruct_move(scale) coords_float \
		{30 2 -cols 2} unstruct_move(do_scale)
	
	form_label $d.mirrnml "Norm" {41 1}
	form_entry $d.mirnmt unstruct_move(mirrornorm) coords \
		{41 2 -cols 2} unstruct_move(do_mirror)
	
	form_entry $d.centpoint unstruct_move(about_point) coords \
	    {62 3} {{unstruct_move(about) point}}
	form_button $d.centp_set "Select" \
	    "disp_get_location unstruct_move(about_point)" \
	    {63 3} {{unstruct_move(about) point}}
	form_finish bot
    }
}

proc unstruct_do_copymove {} {
    global unstruct_move
    
    if {!$unstruct_move(do_translate) && \
	    !$unstruct_move(do_rotate) && \
	    !$unstruct_move(do_mirror) && \
	    !$unstruct_move(do_scale)} {
	mess "No operations were selected.\n" red
	return
    }
    
    set sel_map ""
    switch $unstruct_move(select_elements) {
	0 {
	    set use_map all
	    set sel_map ""
	}
	1 {
	    set sel_map [select_unstruct element 0 visible ""]
	    if {$sel_map == ""} return
	    set use_map $sel_map
	}
	2 {
	    set use_map visible
	    set sel_map ""
	}
    }
    
    # Save the full mesh only once
    ic_start_bigunsop
    unstruct_do_copymove_1 $use_map $sel_map
    ic_finish_bigunsop
}

proc unstruct_do_copymove_1 {use_map sel_map} {
    global unstruct_move selmap
    
    if {$unstruct_move(what) == "move"} {
	unstruct_move_apply_params $use_map
    } else {
	if {$unstruct_move(numcopies) > 1} {
	    # This is to make sure that when we add new stuff, that doesn't
	    # implicitly go into the map that is getting copied multiple
	    # times.
	    set exp [ic_uns_subset_copy_if_not_explicit $use_map]
	    if {$exp != ""} {
		if {$sel_map != ""} { ic_uns_subset_delete $sel_map }
		set sel_map $exp
		set use_map $exp
	    }
	}
	set otr $unstruct_move(translate)
	set orot $unstruct_move(rotate)
	for {set i 0} {$i < $unstruct_move(numcopies)} {incr i} {
	    set nmap [ic_uns_subset_create ""]
	    set nn [ic_uns_duplicate_elements $use_map $nmap]
	    
	    unstruct_move_apply_params $nmap
	    
	    if $unstruct_move(do_translate) {
		set tt ""
		set tr $unstruct_move(translate)
		foreach j {0 1 2} {
		    lappend tt [expr {[lindex $tr $j] + [lindex $otr $j]}]
		}
		set unstruct_move(translate) $tt
	    }
	    if $unstruct_move(do_rotate) {
		set unstruct_move(rotate) \
		    [expr {$unstruct_move(rotate) + $orot}]
	    }
	    
	    if {$unstruct_move(numcopies) > 1} {
		mess "Stage [expr $i + 1]: "
	    }
	    mess "[lindex $nn 0] new elements, [lindex $nn 1] new nodes\n"
	    
	    ic_uns_subset_delete $nmap
	}
	set unstruct_move(translate) $otr
	set unstruct_move(rotate) $orot
    }
    if {$unstruct_move(merge_nodes) && \
	    ( ($unstruct_move(select_elements) != 0) || \
	    ($unstruct_move(what) == "copy") )} {
	if { $unstruct_move(do_mirror) }  {
		set pos $unstruct_move(about_point)
		set norm $unstruct_move(mirrornorm)
	} else {
		set pos "0 0 0"
		set norm "0 0 0"
	}
	ic_uns_merge_nodes all by_min_edge $pos $norm 0 1
    }
    if {$sel_map != ""} { ic_uns_subset_delete $sel_map }
    update_uns_available
}

proc unstruct_move_apply_params {map} {
    global unstruct_move
    
    switch $unstruct_move(about) {
	origin   { set cent "0 0 0" }
	centroid { set cent "centroid" } ;#[$map get_centroid]
	point    { set cent $unstruct_move(about_point) }
    }
    
    set cmd [list ic_uns_move_elements $map]
    if $unstruct_move(do_translate) {
	lappend cmd translate $unstruct_move(translate)
    }
    if $unstruct_move(do_rotate) {
	set axis $unstruct_move(rotaxis)
	if {$axis == "other"} { set axis $unstruct_move(rotaxis_other) }
	lappend cmd rotate $unstruct_move(rotate) rotate_axis $axis cent $cent
    }
    if $unstruct_move(do_scale) {
	set ms $unstruct_move(scale)
	if {[llength $ms] == 1} { set ms "$ms $ms $ms" }
	lappend cmd scale $ms cent $cent
    }
    if $unstruct_move(do_mirror) {
	lappend cmd mirror $unstruct_move(mirrornorm) cent $cent
    }
    eval $cmd
}

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

proc unstruct_extrude {} {
    global unstruct_extrude
    
    set unstruct_extrude(map) [ic_uns_subset_get_current]
    set unstruct_extrude(all) 0
    set unstruct_extrude(sides) bars
    set unstruct_extrude(copy_top) 1
    set unstruct_extrude(method) dir
    
    set d [form_init .uns_extrude "Extrude elements" "" \
	       {{Select unstruct_extrude_select}
		   {Apply unstruct_extrude_apply}
		   done}]
    if {$d != ""} {
	
	mess "Note that this function cannot extrude into the volume, only\
		into areas where there is no mesh.  Also, it does not\
		provide layer-by-layer smoothing or quality\
		control.  For these applications you\
		should use ICEM CFD Prism.\n" red	
	#
	form_frame $d.lay  flat   0 {0 0}
	form_frame $d.meth flat   2 {1 0}
	form_frame $d.sub  sunken 1 {2 0}
	form_frame $d.glb  flat   2 {3 0}
	#
	# num layers: $d.lay-------------------------------
	#
	form_label $d.lay.numl "Number of layers to extrude" {1 0}
	form_entry $d.lay.num unstruct_extrude(numl) int {1 1}
	#
	# method of extr radio button row: $d.meth---------
	#
	form_frame $d.meth.style flat 0 {0 0 -cols -}
	form_colwidth $d.meth.style 0 3 M
	form_label $d.meth.style.l "Method of extrusion" {0 0 -cols 3}
	form_radiobutton $d.meth.style.dir  "Vector"      unstruct_extrude(method) dir  {1 0}
	form_radiobutton $d.meth.style.curv "Along curve" unstruct_extrude(method) curv {1 1}
	form_radiobutton $d.meth.style.rot  "Rotation"    unstruct_extrude(method) rot  {1 2}	
	#
	# choiceframe direction panel $d.sub.dir: ---------------------
	#
	set cc $d.sub.dir
	form_choiceframe $cc
	form_label $cc.vecl "Direction" {0 0}
	form_radiobutton $cc.dnrm "Normal" unstruct_extrude(dir_fixed) 2 {0 1}
	form_radiobutton $cc.dfix "Fixed"  unstruct_extrude(dir_fixed) 1 {1 1}	
	form_entry $cc.dirf unstruct_extrude(fix_dir) coords {1 2} \
		{{unstruct_extrude(dir_fixed) 1}}
	form_radiobutton $cc.dfun "Function" unstruct_extrude(dir_fixed) 0 {2 1}
	set act {{unstruct_extrude(dir_fixed) 0}}
	# Eventually this will have to change when we support non-cart systems
	form_label $cc.xl "    X" {3 1} $act
	form_label $cc.yl "    Y" {4 1} $act
	form_label $cc.zl "    Z" {5 1} $act
	form_entry $cc.x unstruct_extrude(fun_dirx) string {3 2} $act
	form_entry $cc.y unstruct_extrude(fun_diry) string {4 2} $act
	form_entry $cc.z unstruct_extrude(fun_dirz) string {5 2} $act	
	form_label $cc.spl "Spacing" {6 0}
	form_radiobutton $cc.sfix "Fixed" unstruct_extrude(sp_fixed) 1 \
		{6 1}
	form_entry $cc.spf unstruct_extrude(fix_space) float {6 2} \
		{{unstruct_extrude(sp_fixed) 1}}
	form_radiobutton $cc.sfun "Function" unstruct_extrude(sp_fixed) 0 \
		{7 1}
	form_entry $cc.spfun unstruct_extrude(fun_space) string {7 2} \
		{{unstruct_extrude(sp_fixed) 0}}
	#
	# choiceframe curve panel: $d.sub.curv ------------------------
	#
	set cc $d.sub.curv
	form_choiceframe $cc
	form_label $cc.spl "Orientation:" {0 0}
	form_radiobutton $cc.dcuraxl "Axial" \
		unstruct_extrude(dir_fixed) 5 {0 1}
	form_radiobutton $cc.dcurnor "Normal" \
		unstruct_extrude(dir_fixed) 6 {1 1}
	form_checkbutton $cc.curdir "Reverse" unstruct_extrude(curvedir) {2 0}
	set act {{unstruct_extrude(dir_fixed) 5 6}}
	form_button $cc.curvname Select \
		{ set unstruct_extrude(curvename) [geo_select curve] } {3 0}
	#
	# choiceframe rotate panel: $d.sub.rot -------------------------
	#
	set cc $d.sub.rot
	form_choiceframe $cc
	form_label $cc.rpl "Point" {0 0}
	form_label $cc.rdl "Dir"   {1 0}
	form_label $cc.ral "Angle" {2 0}
	form_entry $cc.rp unstruct_extrude(rpoint) coords {0 1}
	form_entry $cc.rd unstruct_extrude(rdir) coords   {1 1}
	form_entry $cc.ra unstruct_extrude(rangle) float  {2 1}
	form_checkbutton $cc.drm "Merge" unstruct_extrude(rmerge) {3 0}
	#
	#
	futil_setup_switch $d.sub unstruct_extrude(method) "" ""
	#
	# choiceframe end
	#
	#
	form_label $d.glb.vfaml "Volume family" {32 0}
	form_label $d.glb.sfaml "Side family" {33 0}
	form_label $d.glb.tfaml "Top family" {34 0}
	form_entry $d.glb.vfam unstruct_extrude(vol_fam) string {32 1}
	form_entry $d.glb.sfam unstruct_extrude(side_fam) string {33 1}
	form_entry $d.glb.tfam unstruct_extrude(top_fam) string {34 1}
	form_button $d.glb.vfams Select \
		{select_family "" unstruct_extrude(vol_fam)} {32 2}
	form_button $d.glb.sfams Select \
		{select_family "" unstruct_extrude(side_fam)} {33 2}
	form_button $d.glb.tfams Select \
		{select_family "" unstruct_extrude(top_fam)} {34 2}
	
	form_checkbutton $d.glb.delorig "Delete original surface" \
		unstruct_extrude(del_orig) {42 0 -cols -}
	form_checkbutton $d.glb.savev "Save data for another extrusion" \
		unstruct_extrude(save_verts) {44 0 -cols -}
	
	form_finish bot
    }
    set unstruct_extrude(map) ""
    unstruct_extrude_select
    
    form_wait .uns_extrude
    if {$unstruct_extrude(map) != ""} {
	ic_uns_subset_delete $unstruct_extrude(map)
	set unstruct_extrude(map) ""
    }    
}

proc unstruct_extrude_select {} {
    global unstruct_extrude
    
    set m [select_unstruct element]
    if {$m == ""} return
    ic_uns_subset_visible $m 1
    if {$unstruct_extrude(map) != ""} {
	ic_uns_subset_delete $unstruct_extrude(map)
    }
    set unstruct_extrude(map) $m
}

proc unstruct_extrude_apply {} {
    global unstruct_extrude select_unstruct_option
    
    switch [lindex $select_unstruct_option 0] {
	all {
	    set map1 all_elements
	    set map2 1
	}
	families {
	    set map1 families
	    set map2 [lindex $select_unstruct_option 1]
	}
	default {
	    if $unstruct_extrude(all) {
		set map1 all_elements
		set map2 1
	    } else {
		set map1 map
		set map2 $unstruct_extrude(map)
		if {$map2 == ""} { error "No elements are selected" }
	    }
	}
    }
    if {"rot" == $unstruct_extrude(method)} { set unstruct_extrude(dir_fixed) 3 }
    switch $unstruct_extrude(dir_fixed) {
	0 { set dir func }
	1 { set dir $unstruct_extrude(fix_dir) }
	2 { set dir normal }
	3 {
	    set dir rotate
	    if !$unstruct_extrude(rmerge) { append dir _nomerge }
	}
	5 { set dir curve_axial }
	6 { set dir curve_normal }
    }
    switch $unstruct_extrude(sp_fixed) {
	0 { set space func }
	1 { set space $unstruct_extrude(fix_space) }
    }
    
    if ![info exists unstruct_extrude(curvename)] { set unstruct_extrude(curvename) "" }
    
    if {"normal" == $dir && (3 == [ic_uns_dimension])} {
	unstruct_diag_check vol_orient
	#unstruct_diag_check surf_orient ; doesn't this diagnostic work?
	set n [ic_uns_reorient visible vol 0]
	mess "$n face orientations modified\n"
    }
    
    if {($dir == "curve_axial" || $dir == "curve_normal") && \
	    $unstruct_extrude(curvename) == ""} {
	error "Please select the curve for extrusion"
    }

    ic_extrude $map1 $map2 \
	numlayers $unstruct_extrude(numl) \
	dir $dir space $space \
	dirx_func $unstruct_extrude(fun_dirx) \
	diry_func $unstruct_extrude(fun_diry) \
	dirz_func $unstruct_extrude(fun_dirz) \
	rpoint [ic_coords_into_global $unstruct_extrude(rpoint)] \
	rdir [ic_coords_dir_into_global $unstruct_extrude(rdir)] \
	space_func $unstruct_extrude(fun_space) \
	rangle $unstruct_extrude(rangle) \
	volf $unstruct_extrude(vol_fam) \
	sidef $unstruct_extrude(side_fam) \
	topf $unstruct_extrude(top_fam) \
	save_verts $unstruct_extrude(save_verts) \
	curve $unstruct_extrude(curvename) \
	curvedir $unstruct_extrude(curvedir) \
	del_orig $unstruct_extrude(del_orig)
    
    if {$map1 == "map"} {
	ic_uns_subset_delete $map2 ;#delete -JKA Bug 3439
	set unstruct_extrude(map) ""
    }
}

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

proc unstruct_create_coupling {} {
    set side1 [select_unstruct element 0 "" "" "the first side"]
    if {$side1 == ""} return
    ic_uns_subset_configure $side1 -visible 1 -color red
    set side2 [select_unstruct element 0 "" "" "the second side"]
    if {$side2 == ""} return
    ic_uns_coupling create $side1 $side2
    ic_uns_subset_delete $side1
    ic_uns_subset_delete $side2
}

proc unstruct_clear_coupling {} {
    ic_uns_coupling clear
}

proc unstruct_create_thickness {} {
    ic_uns_thickness create
}

proc unstruct_clear_thickness {} {
    ic_uns_thickness clear
}

proc unstruct_create_thickness_at_node {} {
	set t [question_box .thicknode "Thickness" \
		   "Enter thickness at nodes" 0.0]
	if {$t == ""} return
    set sel_map [select_unstruct node 0 visible 1]
    if {$sel_map == ""} return
    ic_uns_thickness_at_node  $sel_map $t
}
# ------------------------------------------------------------

proc unstruct_edit_props {} {
    global uns_prop_values uns_prop_new_name uns_prop_new_value
    global uns_prop_scr
    
    catch {unset uns_prop_values}
    set uns_prop_new_name ""
    set uns_prop_new_value ""
    form_kill .edit_prop
    set d [form_init .edit_prop "Domain properties"]
    set scr [form_scroller $d.scr 350 {0 0 -cols 3 -sticky news} 1]
    
    form_label $scr.namel Name {0 0}
    form_label $scr.valuel Value {0 1}
    
    set i 1
    foreach {name value} [ic_uns_list_strings] {
	set uns_prop_values($name) $value
	form_label $scr.name$i $name "$i 0"
	form_entry $scr.value$i uns_prop_values($name) string "$i 1"
	incr i
    }
    form_button $d.newc Create: "unstruct_edit_props_new $scr" {1 0}
    form_entry $d.newn uns_prop_new_name string {1 1}
    form_entry $d.newv uns_prop_new_value string {1 2}
    bind $d.newn <Key-Return> "unstruct_edit_props_new $scr"
    bind $d.newv <Key-Return> "unstruct_edit_props_new $scr"
    form_finish bot
    form_scroller_hack $d.scr
    if ![form_wait .edit_prop] return
    
    foreach n [array names uns_prop_values] {
	ic_uns_set_string $n $uns_prop_values($n)
    }
}

proc unstruct_edit_props_new {scr} {
    global uns_prop_values uns_prop_new_name uns_prop_new_value
    
    if {$uns_prop_new_name == ""} return
    if [info exists uns_prop_values(uns_prop_new_name)] {
	set $uns_prop_values(uns_prop_new_name) $uns_prop_new_value
    } else {
	set nv [expr [llength [array names uns_prop_values]] + 1]
	set uns_prop_values($uns_prop_new_name) $uns_prop_new_value
	form_label $scr.name$nv $uns_prop_new_name "$nv 0"
	form_entry $scr.value$nv uns_prop_values($uns_prop_new_name) \
	    string "$nv 1"
    }
    set uns_prop_new_name ""
    set uns_prop_new_value ""
}

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

proc unstruct_make_periodic {} {
    while 1 {
	set sel_map [select_unstruct node 2 visible "" "2 nodes"]
	if {$sel_map == ""} return
	if {[ic_uns_subset_count_nodes $sel_map] != 2} return
	ic_uns_make_periodic $sel_map
	ic_uns_subset_delete $sel_map
    }
}

proc unstruct_remove_periodic {} {
    while 1 {
	set sel_map [select_unstruct node 0 visible ""]
	if {$sel_map == ""} return
	ic_uns_remove_periodic $sel_map
	ic_uns_subset_delete $sel_map
    }
}

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

proc unstruct_delete_bars {} {
    set angle 0   
    set buts {{Apply "ic_uns_build_mesh_topo all -remove_bars -angle $angle"} \
	    dismiss}
    set d [form_init .delbars "Delete bars by feature angle" "" $buts]
    if {$d != ""} {
	form_label $d.anglel "Angle (degrees) between normals of surface elements:" "0 0"
	form_entry $d.anglev angle float "0 1"	
	form_finish +300+300
    }
}

proc unstruct_spectral_elements {} {
    global spectral
    if ![info exists spectral(bunch_law)] {
      set spectral(bunch_law) 8
    }
    if ![info exists spectral(order)] {
      set spectral(order) 2
    }
    set buttons {
      {"Apply" "unstruct_spectral_elements_apply"}
      {dismiss}
    }
    set d [form_init .spectral_elements "Spectral elements" "" $buttons]
    if {$d != ""} {
        form_frame $d.spec ridge 3 {0 0}
        form_frame $d.spec.order flat 1 {1 0}
        form_label $d.spec.order.elel "Order" "0 0"
        form_entry $d.spec.order.ele spectral(order) int "0 1"
        form_frame $d.spec.law flat 1 {2 0}
        form_label $d.spec.law.bl "Bunching law:" "0 0 -pady 5"
        set menu $d.spec.law.menu
        set m $d.spec.law.menu.m
        form_menubutton_regular $menu "Gauss-Lobatto-Legendre" $m {1 0} ""
        menu $m
        $m add command -label "Gauss-Lobatto-Legendre" -command "set spectral(bunch_law) 8;\
        	$menu configure -text \"Gauss-Lobatto-Legendre\""
        $m add command -label "Legendre" -command "set spectral(bunch_law) 9;\
        	$menu configure -text \"Legendre\""
        $menu configure -width 24
        form_finish +300+300
    }
}

proc unstruct_spectral_elements_apply {} {
   global spectral file_name
   top_destroy .spectral_elements
   set file $file_name(mesh_dir)/spectral_elem_file
   busy 1
   ic_uns_spectral_elements $file $spectral(order) $spectral(bunch_law)
   busy 0
}

proc unstruct_get_thickness {} {
    set sel_map [select_unstruct element 0 visible 1]
    if {$sel_map == ""} return
    foreach val [ic_uns_get_thickness $sel_map] {
	set th [format "Element %6d :" [lindex $val 0]]
	foreach t [lrange $val 1 end] {
	    append th " [format %e $t]"
	}
	mess $th\n
    }
    ic_uns_subset_delete $sel_map
}

proc unstruct_calculate_targets {} {
    global unstruct_targets

#    set sel_map [select_unstruct element 0 visible 1]
#    if {$sel_map == ""} return
    
    set d [form_init .unstruct_targets "Target options"]
    if {$d != ""} {
        set ln 0
        form_label $d.distl "Max. contact distance" "$ln 0"
        form_entry $d.dist unstruct_targets(dist) float "$ln 1"
        form_finish bot
    }
    if ![form_wait .unstruct_targets] return
    ic_calculate_targets $unstruct_targets(dist) $unstruct_targets(debug)
}

proc unstruct_create_immutable {} {
    set sel_map [select_unstruct element 0 visible 1]
    if {$sel_map == ""} return
    ic_uns_immutable $sel_map "create"
}

proc unstruct_clear_immutable {} {
    set sel_map [select_unstruct element 0 visible 1]
    if {$sel_map == ""} return
    ic_uns_immutable $sel_map "clear"
}

proc unstruct_test_smooth {} {
    global test_smooth
    foreach item [array names test_smooth backup1,*] { unset test_smooth($item) }
    foreach item [array names test_smooth backup2,*] { unset test_smooth($item) }    
    if [winfo exists .unstruct_test_smooth] { form_delete .unstruct_test_smooth }
    set d [form_init .unstruct_test_smooth "Smooth options"]
    if {$d != ""} {
        set ln 0
        set test_smooth(iter_sf) 10
        set test_smooth(iter_vl) 10
        set test_smooth(exprate_sf) 3.0
        set test_smooth(exprate_vl) 5.0
        set test_smooth(stabilize_sf) 1.0
        set test_smooth(stabilize_vl) 2.0
        set test_smooth(stype_sf) 2
        set test_smooth(stype_vl) 2
        set test_smooth(stype) 202
#       set test_smooth(stype_sf) [expr {$test_smooth(stype) % 100}]
#       set test_smooth(stype_vl) [expr {$test_smooth(stype) / 100}]
        set test_smooth(fix_surfaces) 0
        set test_smooth(fix) 0
        set test_smooth(rebunch_edges) 0
        set test_smooth(n_fix_layer) 0
        set test_smooth(fams_attr) ""
        set test_smooth(family_edges) ""
        form_label $d.iterl "# of iterations on surface" "$ln 0"
        form_entry $d.iter test_smooth(iter_sf) int "$ln 1"
        incr ln
        form_label $d.iterl2 "# of iterations in volume" "$ln 0"
        form_entry $d.iter2 test_smooth(iter_vl) int "$ln 1"
        incr ln
        form_label $d.gexprl "Grid expansion rate on surface" "$ln 0"
        form_entry $d.gexpr test_smooth(exprate_sf) float "$ln 1"
        incr ln
        form_label $d.gexpr2l "Grid expansion rate in volume" "$ln 0"
        form_entry $d.gexpr2 test_smooth(exprate_vl) float "$ln 1"
        incr ln
        form_label $d.stypesf "Smoothing type Faces:" "$ln 0"
        incr ln
#       form_radiobutton $d.stypesf1 "Smooth Orthogonality" test_smooth(stype_sf) 1 "$ln 0"
#       form_radiobutton $d.stypesf2 "Real Orthogonality" test_smooth(stype_sf) 2 "$ln 1"
#       form_radiobutton $d.stypesf3 "Elliptical Laplace" test_smooth(stype_sf) 3 "$ln 2"
#       form_radiobutton $d.stypesf4 "Geometric Laplace" test_smooth(stype_sf) 4 "$ln 3"
        form_radiobutton $d.stypesf2 "Orthogonality" test_smooth(stype_sf) 2 "$ln 0"
        form_radiobutton $d.stypesf3 "Laplace" test_smooth(stype_sf) 3 "$ln 1"
        incr ln
        form_label $d.stypevl "Smoothing type Volume:" "$ln 0"
        incr ln
#       form_radiobutton $d.stypevl1 "Smooth Orthogonality" test_smooth(stype_vl) 1 "$ln 0"
#       form_radiobutton $d.stypevl2 "Real Orthogonality" test_smooth(stype_vl) 2 "$ln 1"
#       form_radiobutton $d.stypevl3 "Elliptical Laplace" test_smooth(stype_vl) 3 "$ln 2"
#       form_radiobutton $d.stypevl4 "Geometric Laplace" test_smooth(stype_vl) 4 "$ln 3"
        form_radiobutton $d.stypevl1 "Orthogonality" test_smooth(stype_vl) 2 "$ln 0"
        form_radiobutton $d.stypevl2 "Laplace" test_smooth(stype_vl) 3 "$ln 1"
        incr ln
        form_checkbutton $d.fix "Freeze surface boundary" test_smooth(fix_surfaces) "$ln 0"
        incr ln
        form_label $d.n_fix "Number of layers to freeze:" "$ln 0"
        form_entry $d.n_fix2 test_smooth(n_fix_layer) int "$ln 1"
        incr ln
        form_label $d.fam_fix "Freeze by family" "$ln 0"
        form_button $d.fams_fix "Select" "unstruct_test_smooth_select_families fix_layers" "$ln 1"
        incr ln
        form_label $d.fam_dist1 "Release orthogonality /" "$ln 0"
        incr ln
        form_label $d.fam_dist "First layer distance by family" "$ln 0"
        form_button $d.fams_dist "Select" "unstruct_test_smooth_select_families layer_distance" "$ln 1"
        incr ln
        form_label $d.fam_edge "Define edges on family border" "$ln 0"
        form_button $d.fams_edge "Select" "unstruct_test_smooth_select_families_edge" "$ln 1"
        incr ln
        form_checkbutton $d.rebunch "Rebunch edges" test_smooth(rebunch_edges) "$ln 0"
        form_finish bot
    }
    if [form_wait .unstruct_test_smooth] {
        for { set i 0 } {$i <= 1} { incr i } {
          foreach item [array names test_smooth fams_attr,$i,*] {
            set fam [lindex [split $item ,] 2]
            set val $test_smooth(fams_attr,$i,$fam)
            if { $i == "1" } {
              set idx_srf freeze_surfaces
            } else {
              set idx_srf release_ortho
            }
            if !$test_smooth($idx_srf,$fam) {
              set val 0
            } else {
              if { $val <= 0 } {
                set val -1
              }
            }
            append test_smooth(fams_attr) "$fam $i $val "
          } 
        } 
        set test_smooth(stype) [expr {$test_smooth(stype_sf) + 100 * $test_smooth(stype_vl)}]
        if { $test_smooth(n_fix_layer) <= 0 } {
          if $test_smooth(fix_surfaces) {
            set test_smooth(n_fix_layer) 0
          } else {
            set test_smooth(n_fix_layer) -1
          }
        }
        ic_unstruct_elliptical_smooth $test_smooth(iter_sf) \
           $test_smooth(iter_vl) $test_smooth(exprate_sf) \
           $test_smooth(exprate_vl) $test_smooth(stabilize_sf) \
           $test_smooth(stabilize_vl) $test_smooth(stype) \
           $test_smooth(fix) $test_smooth(n_fix_layer) \
           $test_smooth(fams_attr) $test_smooth(rebunch_edges) \
           $test_smooth(family_edges)
        beep
    }    
}

proc unstruct_test_smooth_select_families { what } {
    global test_smooth
    set sel_map [ic_uns_create_selection_subset 0]
    if {$sel_map == ""} return
    set fams [select_families 0 1 0]
    if {$fams == ""} {
        ic_uns_subset_delete $sel_map
        return
    }
    ic_uns_subset_make_families $sel_map $fams
    set num [ic_uns_subset_count_elements $sel_map]
    if {$num == 0} {
        ic_uns_subset_delete $sel_map
	mess "Family $fams contains no element(s).\n"
	return
    } else {
        mess "Selected all $num element(s) in family: $fams.\n"
    }
    if [winfo exists .unstruct_test_smooth_family] { form_delete .unstruct_test_smooth_family }
    if { $what == "layer_distance" } {
      set text  "First layer distance"
      set default -1
      set type_attr 0
      set type float
      set idx_srf release_ortho
      set text_srf "Release orthogonality and layer distance"
    } else {
      set text  "Freeze layers"
      set default 0
      set type_attr 1
      set type int
      set idx_srf freeze_surfaces
      set text_srf "Freeze surface boundary"
    }
    set idx fams_attr
    set d [form_init .unstruct_test_smooth_family "$text"]
    foreach item [array names test_smooth backup1,$idx_srf,*] {
      set fam [lindex [split $item ,] 2]
      if {[lsearch $fams $fam] < 0} {
        append fams " $fam"
      }
    }
    if {$d != ""} {
        form_label $d.fld "$text" "0 0"
        set i 1
        foreach fam $fams {
          form_label $d.name$i "$fam" "$i 0"
          if ![info exists test_smooth($idx,$type_attr,$fam)] {
            set test_smooth($idx,$type_attr,$fam) $default
          }
          if ![info exists test_smooth($idx_srf,$fam)] {
            set test_smooth($idx_srf,$fam) 0
          }
          form_checkbutton $d.fix$i "$text_srf" test_smooth($idx_srf,$fam) "$i 1"
          $d.fix$i configure -onvalue 0 -offvalue 1
          set filter "test_smooth($idx_srf,$fam) 0"
          form_entry $d.value$i test_smooth($idx,$type_attr,$fam) $type "$i 2" $filter
          incr i
        }
        form_reset .unstruct_test_smooth_family
        form_finish bot
    }
    if [form_wait .unstruct_test_smooth_family] {
       foreach fam $fams {
         if [info exists test_smooth($idx_srf,$fam)] {
           set test_smooth(backup1,$idx_srf,$fam) $test_smooth($idx_srf,$fam)
         }
         if [info exists test_smooth($idx,$type_attr,$fam)] {
           set test_smooth(backup2,$idx,$type_attr,$fam) $test_smooth($idx,$type_attr,$fam)
         }
       }
    }
    ic_uns_subset_delete $sel_map    
}

proc unstruct_test_smooth_select_families_edge {} {
    global test_smooth
    set sel_map [ic_uns_create_selection_subset 0]
    if {$sel_map == ""} return
    set fams [select_families 0 1 0]
    if {$fams == ""} {
        ic_uns_subset_delete $sel_map
        return
    }
    ic_uns_subset_make_families $sel_map $fams
    set num [ic_uns_subset_count_elements $sel_map]
    if {$num == 0} {
        ic_uns_subset_delete $sel_map
	mess "Family $fams contains no element(s).\n"
	return
    } else {
        mess "Selected all $num element(s) in family: $fams.\n"
    }
    set test_smooth(family_edges) ""
    foreach fam $fams {
        append test_smooth(family_edges) "$fam "
    }    
    ic_uns_subset_delete $sel_map    
}
