
# 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_diag {} {
    global unstruct_diag unstruct_diag_maps
    
    set buts {{Compute unstruct_do_diag} {Histogram unstruct_do_histo} done}
    set d [form_init .unstruct_diag "Diagnostics" "" $buts]
    if {$d != ""} {
	form_frame $d.fr sunken 2 {0 0}; set d $d.fr
	
	form_label $d.domsl "Domains:" {0 0}
	form_frame $d.doms ridge 2 {1 0}
	
	form_label $d.typel "Types:" {2 0}
	form_frame $d.types ridge 2 {3 0}
	
	form_label $d.famsl "Familes:" {4 0}
	form_frame $d.fams ridge 2 {5 0}
	
	form_checkbutton $d.sell "Selections:" unstruct_diag(use_sel) {0 1}
	form_frame $d.sels ridge 2 {1 1}
	
	form_label $d.whichl "Diagnostic:" {2 1}
	form_frame $d.which ridge 2 {3 1}
	
	form_label $d.histo "Histogram params" {4 1}
	form_frame $d.hfr flat 0 {5 1 -fill x}
	
	form_label $d.hfr.minl "Min value" {0 0}
	form_label $d.hfr.maxl "Max value" {1 0}
	form_label $d.hfr.numl "Num bars" {2 0}
	form_label $d.hfr.hgtl "Max height" {3 0}
	
	# Minv is the actual value, min is what is requested by the user
	form_entry $d.hfr.min unstruct_diag(min) string {0 1}
	form_entry $d.hfr.max unstruct_diag(max) string {1 1}
	form_entry $d.hfr.num unstruct_diag(num) string {2 1}
	form_entry $d.hfr.hgt unstruct_diag(hgt) string {3 1}
	foreach i { min max num hgt } { $d.hfr.$i configure -width 6 }
	
	form_finish -0-0
    }
    
    set fr .unstruct_diag.main.fr
    
    # -----------------
    
    set types [ic_uns_list_types]
    set unstruct_diag(type_list) $types
    set opts ""
    foreach f $types {
	lappend opts [list type_$f -text $f]
	if ![info exists unstruct_diag(type_$f)] {
	    set unstruct_diag(type_$f) 1
	}
    }
    check_box $fr.types [lsort $opts] 4 unstruct_diag
    
    # -----------------
    
    set fams [ic_uns_list_families]
    set unstruct_diag(fam_list) $fams
    set opts ""
    foreach f $fams {
	lappend opts [list fam_$f -text $f]
	if ![info exists unstruct_diag(fam_$f)] {
	    set unstruct_diag(fam_$f) 1
	}
    }
    check_box $fr.fams [lsort $opts] 4 unstruct_diag
    
    # -----------------
    
    set sels [ic_uns_subset_list]
    set unstruct_diag_maps(sel_list) $sels
    set opts ""
    foreach f $sels {
	lappend opts [list $f -text $f]
    }
    check_box $fr.sels $opts 4 unstruct_diag_maps(from) 0
    if ![info exists unstruct_diag_maps(subset)] {
	set unstruct_diag_maps(subset) [lindex $sels 0]
    }
    
    # -----------------
    
    set dnames ""
    foreach d [diagnostic_info] {
	lappend dnames [lindex $d 0]
    }
    set diags ""
    foreach d [lsort $dnames] { lappend diags [list $d -command unstruct_diag_something_changed] }
    check_box $fr.which $diags 4 unstruct_diag(which) 0
    
    # -----------------
    
    set unstruct_diag_maps(highlight_maps) ""
    set unstruct_diag(results) ""
    form_wait .unstruct_diag
    
    unstruct_clear_diag
}

proc unstruct_diag_something_changed {} {
    unstruct_clear_diag
}

proc unstruct_clear_diag {} {
    global unstruct_diag unstruct_diag_maps
    
    if [info exists unstruct_diag_maps(delete_maps)] {
	foreach m $unstruct_diag_maps(delete_maps) {
	    ic_uns_subset_delete $m
	}
	set unstruct_diag_maps(delete_maps) ""
    }
    if [info exists unstruct_diag_maps(highlight_maps)] {
	foreach m $unstruct_diag_maps(highlight_maps) {
	    ic_uns_subset_delete $m
	}
	set unstruct_diag_maps(highlight_maps) ""
    }
    set unstruct_diag_maps(from_maps) ""
    
    unstruct_diag_color 1
}

proc unstruct_do_diag {} {
    global unstruct_diag unstruct_diag_maps
    
    unstruct_clear_diag
    
    if $unstruct_diag(use_sel) {
	set unstruct_diag_maps(from_maps) $unstruct_diag_maps(subset)
	
    } else {
	set types ""; set fams ""
	foreach t $unstruct_diag(type_list) {
	    if [info exists unstruct_diag(type_$t)] {
		if $unstruct_diag(type_$t) { lappend types $t }
	    }
	}
	foreach t $unstruct_diag(fam_list) {
	    if [info exists unstruct_diag(fam_$t)] {
		if $unstruct_diag(fam_$t) { lappend fams $t }
	    }
	}
	set m [ic_uns_create_diagnostic_subset 0]
	ic_uns_subset_add_families_and_types $m $fams $types

	lappend unstruct_diag_maps(from_maps) $m
	lappend unstruct_diag_maps(delete_maps) $m
    }
    if {$unstruct_diag_maps(from_maps) == ""} {
	error "Can't do diagnostic -- nothing is selected."
    }
    
    busy 1
    unstruct_diag_custom_metric_set $unstruct_diag(which)
    set st [ic_uns_metric $unstruct_diag_maps(from_maps) $unstruct_diag(which)]
    busy 0
    
    set unstruct_diag(minv) [lindex $st 3]
    set unstruct_diag(maxv) [lindex $st 4]
    
    if {$unstruct_diag(minv) >= $unstruct_diag(maxv)} { return }
    
    if {$unstruct_diag_maps(highlight_maps) == ""} {
	set unstruct_diag_maps(highlight_maps) \
		[ic_uns_create_diagnostic_subset]
    }
    
    # update the colors of the elements
    unstruct_diag_color
}

proc unstruct_do_histo {{title ""} {nbars ""} {min ""} {max ""}
			{ylim ""} {arguments ""}} {
    global unstruct_diag unstruct_diag_maps
    
    if {![info exists unstruct_diag_maps(from_maps)] || \
	    ($unstruct_diag_maps(from_maps) == "")} { unstruct_do_diag }
    
    if {$min == ""} {
	if {$unstruct_diag(min) != ""} {
	    set min $unstruct_diag(min)
	} else {
	    set min $unstruct_diag(minv)
	}
    }
    if {$max == ""} {
	if {$unstruct_diag(max) != ""} {
	    set max $unstruct_diag(max)
	} else {
	    set max $unstruct_diag(maxv)
	}
    }
    if {$title == ""} { set title $unstruct_diag(which) }
    if {$nbars == ""} { set nbars $unstruct_diag(num) }
    if {$ylim == ""} { set ylim $unstruct_diag(hgt) }
    if {$ylim == ""} { set ylim 0 }
    
    for {set i 0} {$i < $nbars} {incr i} {set histo($i) 0}
    
    set numt 0
    set fm $unstruct_diag_maps(from_maps)
    set hist [ic_uns_histogram $fm $min $max $nbars]
    for {set i 0} {$i < $nbars} {incr i} {
	set n [lindex $hist [expr $i + 1]]
	incr histo($i) $n
	incr numt $n
    }
    
    # This is sort of wrong but it's what people want (Bugzilla #4770)
    incr histo(0) [lindex $hist 0]
    incr histo([expr $nbars - 1]) [lindex $hist [expr $nbars + 1]]
    
    set diff [expr {$max - $min}]
    set vstep [expr {$diff / ($nbars + 0.0)}]

    set xvalues {}
    set yvalues {}
    set total 0
    for {set i 0} {$i < $nbars} {incr i} {
	set x [expr {$min + $i * $vstep}]
	set y $histo($i)
	
	lappend xvalues $x
	lappend yvalues $y
	incr total $y
    }
    lappend xvalues $max
    
    if !$total {
	warningmsg "No values fell within the specified range ($min - $max)"
	return
    }
    
    set extra_buts {
	{ makesel "Select"     "unstruct_select_histo 0" }
	{ addsel  "Add select" "unstruct_select_histo 1" }
    }
    
    make_histogram .histo $title $xvalues $yvalues $ylim \
	[list "Num = $total" "Min = $unstruct_diag(minv)" \
	     "Max = $unstruct_diag(maxv)"] \
	unstruct_do_histo unstruct_plot_histo "" $extra_buts 2
}

proc unstruct_plot_histo {w intervals args solid} {
    global unstruct_diag unstruct_diag_maps
    
    set tot 0
    set fm $unstruct_diag_maps(from_maps)
    set hm $unstruct_diag_maps(highlight_maps)
    
    if $solid {
	ic_uns_subset_configure $hm -shade flat_wire
    } else {
	ic_uns_subset_configure $hm -shade wire
    }
    set tot [ic_uns_set_with_diagnostic $hm $fm $intervals]
    mess "$tot elements highlighted\n"
}

proc unstruct_select_histo {add} {
    global unstruct_diag unstruct_diag_maps uns_use_subset
    
    histo_highlight "" 1 unstruct_plot_histo ""
    set hm $unstruct_diag_maps(highlight_maps)
    switch_to_subset Diagnostic
    set map visible
    if $add {
	ic_uns_subset_add_from $map $hm
    } else {
	ic_uns_subset_copy $map $hm
    }
}

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

array set diag_options {
    duplicate {
	1 duplicate {select fix}
	"deleting the duplicate elements"
	ic_uns_delete_contents
    }
    multiple {
	0 multiple-edge {select}
    }
    triangle_box {
	0 triangle-box {select fix}
	"replacing the triangles with a tetra"
	diag_replace_triangles_with_tetra
    }
    single_2 {
	0 single/2 {delete select}
    }
    single_multiple {
	0 single/multiple {delete select}
    }
    standalone {
	1 standalone {delete select}
    }
    single {
	0 single-edge {delete select}
    }
    delaunay {
	0 Delaunay-violating {select}
    }
    overlap {
	0 overlapping {select}
    }
    3_surface_node_internal_faces {
	0 corner {select}
    }
    uncovered {
	1 uncovered {select fix}
	"covering the exposed faces"
	diag_fix_uncovered_faces
    }
    missing_internal {
	1 missing-internal {select fix}
	"adding the missing faces"
	diag_fix_missing_internal_faces
    }
    periodic_problem {
	0 "bad periodic" {select}
    }
    bound_edge {
	0 "boundary" {select}
    }
    nmanvert {
	1 "non-manifold vertex" {select fix}
	"splitting the vertices in two"
	diag_fix_nmanvert
    }
    spikes {
	0 "spike vertex" {select}
    }
}

proc diag_replace_triangles_with_tetra {map {skip 0}} {
    if !$skip {
        set fam [select_family "Choose a part for the newly created tetras"]
    } else {
        set fam "NEW_TETRAS"
        if ![ic_uns_check_family $fam] {
            ic_uns_new_family $fam
        }
    }
    if {$fam == ""} {
        mess "Error: no part selected for new created tetras\n" red
        return 0
    } else {
        set nn [ic_uns_fix_triangle_boxes $map $fam]
        return $nn
    }
}

proc diag_fix_uncovered_faces {map {skip 0}} {
    if !$skip {
        set fam [select_family "Choose a part for the newly created face elements"]
        if {$fam == ""} {
            mess "Error: no part selected for new face elements\n" red
            return 0
        }
    } else {
        set fam "NEW_SURFS"
        if ![ic_uns_check_family $fam] {
            ic_uns_new_family $fam
        }
    }
    set nn [ic_uns_fix_uncovered_faces $map $fam]
    display_update unstruct
    catch {aie_new_part $fam}
    return $nn
}

proc diag_fix_missing_internal_faces {map {skip 0}} {
    if !$skip {
        set fam [select_family "Choose a part for the newly created internal face elements"]
    } else {
        set fam "NEW_FACES"
        if ![ic_uns_check_family $fam] {
            ic_uns_new_family $fam
        }
    }
    if {$fam == ""} {
        mess "Error: no part selected for new face elements\n" red
        return 0
    }
    if !$skip {
        set mess "Project new surface nodes to the nearest surface?"
        set pro [expr ![tk_dialog .projn "Project" $mess "" -1 Yes No]]
        if [winfo exists .projn] { destroy .projn; return 0 }
    } else {
        set pro 1
    }
    set nn [ic_uns_fix_missing_internal $map $fam $pro]
    return $nn
}

proc diag_fix_nmanvert {map} {
    set nn [ic_uns_fix_non_man $map]
    if $nn {
        return 0
    } else {
        return 1
    }
}

proc diag_fix_volume_orientation {map} {
    set nn [ic_uns_fix_volume_orientation $map]
    if $nn {
        return 0
    } else {
        return 1
    }
}

proc diag_fix_overlapping_elements {map} { return [ic_uns_fix_overlapping_elements $map] }

proc unstruct_diag_mesh {what {ask_what ""}} {
    global unstruct_diag unstruct_map uns_use_subset
    global options batch_mode diag_options
    
    if {$what == "all"} {
	set probs 0
	foreach opt [array names diag_options] {
	    if [lindex $diag_options($opt) 0] {
		incr probs [unstruct_diag_mesh $opt fix]
	    }
	}
	if !$probs {
	    mess "Everything is fine.\n"
	} else {
	    mess "There were $probs problems with the mesh.\n"
	}
	return $probs
    }
    
    set map [ic_uns_create_diagnostic_subset]
    ic_uns_create_diagnostic_edgelist 1
    
    set which $options(diag_which)
    switch $which {
	all {
	    set allmap all
	    mess "Checking all elements in the mesh\n"
	}
	active {
	    set allmap selected
	    mess "Checking active element types\n"
	}
	subset {
	    if $uns_use_subset {
		set allmap visible
		mess "Checking current visible subset\n"
	    } else {
		set allmap selected
		mess "Checking active element types\n"
	    }
	}
    }
    
    set fix_fam ""
    switch $what {
	bound_edge {
	    set fix_fam [select_families 0 1 0 "Select part with the boundary edges to check."]
	    if {$fix_fam == ""} return
	}
	periodic_problem {
	    set fix_fam [select_families 0 1 0 "Select only the surface part(s)\nwhich contain the periodic faces."]
	    if {$fix_fam == ""} return
	}
    }
    busy 1
    set ret [ic_uns_diagnostic subset $allmap diag_type $what fix_fam $fix_fam disp_subset $map]
    busy 0
    
    set nprobs [lindex $ret 0]
    set nch [lindex $ret 1]
    
    if {$nch < 0} {
	mess "Interrupted -- only partial results obtained\n" red
	set nch [expr -$nch]
    }
    
    if $nch {
	mess "$nprobs $what elements found ($nch checked)\n"
    } else {
	mess "$nprobs $what elements found\n"
    }
    
    set ok 0
    set delmap 1
    if {$nprobs && [info exists diag_options($what)]} {
	set desc [lindex $diag_options($what) 1]
	set opts [lindex $diag_options($what) 2]
	set howfix [lindex $diag_options($what) 3]
	set fixfunc [lindex $diag_options($what) 4]
	
	set mess "You can "
	set n 0
	set buts ""
	foreach opt $opts {
	    switch $opt {
		delete {
		    append mess "delete the $desc elements, "
		    lappend buts Delete
		}
		select {
		    append mess "make them replace the current subset, "
		    lappend buts Select
		}
		addselect {
		    append mess "add them to the current subset, "
		    lappend buts "Add select"
		}
		fix {
		    append mess "fix the problem by $howfix, "
		    lappend buts "Fix"
		}
	    }
	    set pos($n) $opt
	    incr n
	}
	append mess " or not do anything."
	set pos($n) dismiss
	lappend buts "Dismiss"
	
	if {$ask_what == ""} {
	    set ch [eval tk_dialog .mesh_diag \"Diagnostics: $desc\" \"$mess\" \"\" -1 $buts]
	    if {$ch == "-1"} {
	        if [winfo exists .mesh_diag] {
	            destroy .mesh_diag
	        }
	        return 0
	    }
	    set ask_what $pos($ch)
	}
	
	switch $ask_what {
	    delete {
		ic_uns_delete_contents $map
		mess "$n elements deleted\n"
	    }
	    select {
		switch_to_subset Diagnostic
		ic_uns_subset_copy Diagnostic $map
	    }
	    addselect {
		switch_to_subset Diagnostic
		if [ ic_uns_subset_exists $map ]  {
			mess "$map exists\n"
			ic_uns_subset_add_from Diagnostic $map
		} else {
			mess "what happened to map $map ? \n" red
		}
	    }
	    fix {
		if {$fixfunc != ""} {
		    $fixfunc $map
		}
	    }
	    dismiss {
	    }
	}
    }
    ic_uns_subset_delete $map
    ic_uns_create_diagnostic_edgelist 0
    display_update unstruct
    return $nprobs
}

#--------------------------------------------------------------
# The code below is by Jason. The arrays diagnostic_data &
# diagnostic_keys are based on diag_options above, which could
# phased out.
# note that manipulation of existing subsets in "highlight"
# depends on the subsets being named as $what
# diagnostic_keys & diagnostic_data have to do with unstruct diagnostics
# found in diag_med.tcl

set diagnostic_keys {
    duplicate
    multiple
    triangle_box
    single_2
    single_multiple
    standalone
    single
    delaunay
    overlap
    3_surface_node_internal_faces
    uncovered
    missing_internal
    periodic_problem
    bound_edge
    nmanvert
    disconnected_vert
    vol_orient
    surf_orient
    hanging
    penetrating
    disconnbars
    dangling_edges
}

array set diagnostic_data {
    
    dangling_edges,check   1
    dangling_edges,def_check   1
    dangling_edges,desc     dangling
    dangling_edges,opts     {select}
    dangling_edges,howfix   ""
    dangling_edges,fixfunc  ""
    dangling_edges,type     dprob
    dangling_edges,verbose  "Dangling edges"
    
    duplicate,check   1
    duplicate,def_check   1
    duplicate,desc     duplicate
    duplicate,opts     {select fix}
    duplicate,howfix   "deleting the duplicate elements"
    duplicate,fixfunc  ic_uns_delete_contents
    duplicate,type     derror
    duplicate,verbose  "Duplicate elements"
    
    multiple,check    1
    multiple,def_check    1
    multiple,desc     multiple-edge
    multiple,opts     {select}
    multiple,howfix   ""
    multiple,fixfunc  ""
    multiple,type     dprob
    multiple,verbose  "Multiple edges"
    
    triangle_box,check   1
    triangle_box,def_check   1
    triangle_box,desc     triangle-box
    triangle_box,opts     {select fix}
    triangle_box,howfix   "replacing the triangles with a tetra"
    triangle_box,fixfunc  diag_replace_triangles_with_tetra
    triangle_box,type     dprob
    triangle_box,verbose  "Triangle boxes"
    
    single_2,check    0
    single_2,def_check    0
    single_2,desc      single/2
    single_2,opts      {delete select}
    single_2,howfix    ""
    single_2,fixfunc   ""
    single_2,type      dprob
    single_2,verbose   "2-Single edges"
    
    single_multiple,check   0
    single_multiple,def_check   0
    single_multiple,desc     single/multiple,
    single_multiple,opts     {delete select}
    single_multiple,howfix   ""
    single_multiple,fixfunc  ""
    single_multiple,type     dprob
    single_multiple,verbose  "Single-Multiple edges"
    
    standalone,check    0
    standalone,def_check    0
    standalone,desc     standalone
    standalone,opts     {delete select}
    standalone,howfix   ""
    standalone,fixfunc  ""
    standalone,type     dprob
    standalone,verbose  "Stand-alone surface mesh"
    
    single,check    1
    single,def_check    1
    single,desc     single-edge
    single,opts     {delete select}
    single,howfix   ""
    single,fixfunc  ""
    single,type     dprob
    single,verbose  "Single edges"
    
    delaunay,check  0
    delaunay,def_check  0
    delaunay,desc   Delaunay-violating
    delaunay,opts   {select}
    delaunay,howfix   ""
    delaunay,fixfunc  ""
    delaunay,type     dprob
    delaunay,verbose  "Delaunay-violation"
    
    overlap,check    0
    overlap,def_check    0
    overlap,desc     overlapping
    overlap,opts     {select}
    overlap,howfix   "trying to swap edges on the elements"
    overlap,fixfunc  ""
    overlap,type     dprob
    overlap,verbose  "Overlapping elements"
    
    3_surface_node_internal_faces,check  0
    3_surface_node_internal_faces,def_check  0
    3_surface_node_internal_faces,desc   corner
    3_surface_node_internal_faces,opts   {select fix}
    3_surface_node_internal_faces,howfix   ""
    3_surface_node_internal_faces,fixfunc  ""
    3_surface_node_internal_faces,type     ""
    3_surface_node_internal_faces,verbose  ""
    
    uncovered,check    1
    uncovered,def_check    1
    uncovered,desc     uncovered
    uncovered,opts     {select fix}
    uncovered,howfix   "covering the exposed faces"
    uncovered,fixfunc  diag_fix_uncovered_faces
    uncovered,type     derror
    uncovered,verbose  "Uncovered faces"
    
    missing_internal,check    1
    missing_internal,def_check    1
    missing_internal,desc     missing-internal
    missing_internal,opts     {select fix}
    missing_internal,howfix   "adding the missing faces"
    missing_internal,fixfunc  diag_fix_missing_internal_faces
    missing_internal,type     derror
    missing_internal,verbose  "Missing internal faces"
    
    periodic_problem,check    0
    periodic_problem,def_check    0
    periodic_problem,desc     "bad periodic"
    periodic_problem,opts     {select}
    periodic_problem,howfix   ""
    periodic_problem,fixfunc  ""
    periodic_problem,type     derror
    periodic_problem,verbose  "Periodic problems"
    
    bound_edge,check    0
    bound_edge,def_check    0
    bound_edge,desc     "boundary"
    bound_edge,opts     {select}
    bound_edge,howfix   ""
    bound_edge,fixfunc  ""
    bound_edge,type     ""
    bound_edge,verbose  ""
    
    nmanvert,check    1
    nmanvert,def_check    1
    nmanvert,desc     "non-manifold vertex"
    nmanvert,opts     {select fix}
    nmanvert,howfix   "splitting the vertices in two"
    nmanvert,fixfunc  diag_fix_nmanvert
    nmanvert,type     dprob
    nmanvert,verbose  "Non-manifold vertices"
    
    disconnected_vert,check    1
    disconnected_vert,def_check    1
    disconnected_vert,desc     "disconnected vertices"
    disconnected_vert,opts     {delete select}
    disconnected_vert,howfix   ""
    disconnected_vert,fixfunc  ""
    disconnected_vert,type     dprob
    disconnected_vert,verbose  "Unconnected vertices"
    
    vol_orient,check    1
    vol_orient,def_check    1
    vol_orient,desc     "misoriented volume elements"
    vol_orient,opts     {select fix}
    vol_orient,howfix   "reorienting problem elements"
    vol_orient,fixfunc  diag_fix_volume_orientation
    vol_orient,type     derror
    vol_orient,verbose  "Volume orientations"
    
    surf_orient,check    1
    surf_orient,def_check    1
    surf_orient,desc     "surface orientation"
    surf_orient,opts     {select}
    surf_orient,howfix   "modifying the mesh"
    surf_orient,fixfunc  "diag_fix_surf_orient"
    surf_orient,type     derror
    surf_orient,verbose  "Surface orientations" 
    
    hanging,check     1
    hanging,def_check 1
    hanging,desc      "hanging"
    hanging,opts      {select fix}
    hanging,howfix    delete
    hanging,fixfunc   ic_uns_delete_contents
    hanging,type      derror
    hanging,verbose   "Hanging elements"   
    
    penetrating,check     0
    penetrating,def_check 0
    penetrating,desc      "penetrating"
    penetrating,opts      {select}
    penetrating,howfix    ""
    penetrating,fixfunc   ""
    penetrating,type      derror
    penetrating,verbose   "Penetrating elements" 
    
    disconnbars,check     0
    disconnbars,def_check 0
    disconnbars,desc      "disconnected bar"
    disconnbars,opts      {select fix}
    disconnbars,howfix    delete
    disconnbars,fixfunc   ic_uns_delete_contents
    disconnbars,type      derror
    disconnbars,verbose   "Disconnected bar elements"
}

proc unstruct_diag_check {what {mode ""} {busy_off 0} {run_twice 0} {skip 0}} {
    global diagnostic_data options uns_use_subset
    global diag_fix_mode batch_mode ai_environment fam_visible

    set diag_fix_mode ""
    #
    # mode can be "", highlight, or subset
    # *"subset" will only create a subset of the problematic elements
    # *"highlight" will run diagnostics on the existing diagnostic
    #   subset, display edgelist, and prompt user for action
    # *"" will run diagnostics on All, selected, visible or subset,
    #   display edgelist, and prompt user for action
    #
    if ![info exists diagnostic_data($what,check)] { return "" }
    if {1 != $diagnostic_data($what,check)} { return "" }

    if {[info exists diagnostic_data($what,verbose)] && "" != $diagnostic_data($what,verbose)} {
        set err_name $diagnostic_data($what,verbose)
    } else {
        set err_name $what
    }
    if !$busy_off {
        busy 1
    } else {
        busy reset
    }
    #
    set subset2check ""
    #
    # if mode is "highlight" then try to do the
    # diagnostic on the existing subset so as to
    # arrive at an edgelist quickly
    if {"highlight" == $mode} {
        if ![ic_uns_subset_exists $what] {
            mess "Subset \"$what\" does not exist; will have to run diagnostic again\n"
        } else {
            set subset2check $what
            mess "Highlighting diagnostics of subset \"$subset2check\"\n"
        }
    }
    if {"" == $subset2check} {
        set which $options(diag_which)
        switch $which {
            all { set subset2check all }
            active { set subset2check selected }
            subset {
                if {[info exists uns_use_subset] && $uns_use_subset} {
                    set subset2check visible
                } else {
                    set subset2check selected
                }
            }
        }
    }

    set tmp_map [ic_uns_create_diagnostic_subset]
    ic_uns_create_diagnostic_edgelist 1
    set fix_fam FIX_[string toupper $what]
    set fams ""
    if {$which == "active" && $subset2check == "selected" && $what != "periodic_problem"} {
        set non_empty_parts [aie_get_non_empty_parts]
        foreach f [array names fam_visible] {
            if {[lsearch -exact $non_empty_parts $f] < 0} continue
            if $fam_visible($f) {
                if {$f == "ORFN"} continue
                lappend fams $f
            }
        }
        if {$fams == ""} {
            mess "Error: no active part found for diagnostic $err_name\n" red
            busy reset
            return ""
        } else {
            set subset2check ""
        }
    }
    switch $what {
        periodic_problem {
            if !$skip {
                set fams [select_families 0 1 0 "Select only the surface part(s) which contain the periodic faces." fam_visible +300+300 "Periodic problems"]
            } else {
                set fams [ic_uns_get_periodic_parts]
                mess "Checking part(s) $fams\n"
            }
            if {$fams == ""} {
                mess "Error: no part(s) selected for diagnostic $err_name\n" red
                busy reset
                return ""
            }
        }
        default {}
    }

    set ta [tdv_active 0]
    set ret [ic_uns_diagnostic subset $subset2check diag_type $what fix_fam $fix_fam disp_subset $tmp_map diag_verb $err_name fams $fams busy_off $busy_off skip $skip]
    tdv_active $ta
    set nprobs [lindex $ret 0]
    set nch [lindex $ret 1]
    if {$nch < 0} {
        mess "Interrupted -- only partial results obtained\n" red
        set nch [expr -$nch]
    }
    set diag_map_name $diagnostic_data($what,verbose)
    set retval ""
    if {0 < $nprobs} {
        switch $mode {
            subset {
                # if mode is "subset" then just create the subset
                # and return without any query
                if [ic_uns_subset_exists $diag_map_name] {
                    mess "Subset \"$diag_map_name\" exists; using" red
                    set diag_map_name [ic_uns_subset_unused_name $diag_map_name]
                    mess "name $diag_map_name\n" red
                }
                #switch_to_subset $diag_map_name...rather
                ic_uns_subset_create $diag_map_name
                ic_uns_subset_copy $diag_map_name $tmp_map
                mess "Subset \"$diag_map_name\" created for $err_name\n"
                set retval $diag_map_name
            }
            default {
                # default: this includes highlight
                if [ic_uns_subset_exists $diag_map_name] {
                    if {$batch_mode || $subset2check != "all"} {
                        set new 1
                    } else {
                        set new 0
                    }
                    if $new {
                        set diag_map_name [ic_uns_subset_unused_name $diag_map_name]
                    }
                }
                if $run_twice {
                    unstruct_diag_query_forfix $what $tmp_map "fix" $diag_map_name $skip
                } else {
                    unstruct_diag_query_forfix $what $tmp_map "" $diag_map_name $skip
                }
            }
        }
    } else {
        if [ic_uns_subset_exists $diag_map_name] {
            if {$batch_mode || !$ai_environment} {
                ic_uns_subset_delete $diag_map_name
            } else {
                aie_delete_mesh_subset "\"$diag_map_name\""
            }
            mess "Subset \"$diag_map_name\" exists; deleted\n" red
        }
    }
    ic_uns_subset_delete $tmp_map
    ic_uns_create_diagnostic_edgelist 0
    busy 0
    return $retval
}

proc unstruct_diag_check_list {{mode ""}} {
    global diagnostic_data diagnostic_keys
    foreach what $diagnostic_keys { unstruct_diag_check $what $mode }
}

proc unstruct_diag_query_forfix {what map {ask_what ""} {diag_map_name ""} {skip 0}} {
    global diagnostic_data diag_fix_mode ai_environment diag_fix_is_fixed

    if ![info exists diagnostic_data($what,desc)] {
        mess "no diagnostic_data for $what\n" ; return
    }
    set desc    $diagnostic_data($what,desc)
    set opts    $diagnostic_data($what,opts)
    set howfix  $diagnostic_data($what,howfix)
    set fixfunc $diagnostic_data($what,fixfunc)

    set mess "[ic_uns_subset_count_elements $map] problem elements were found.  You can "
    set n 0; set buts ""
    foreach opt $opts {
        switch $opt {
            delete {
                append mess "delete the $desc elements, "
                lappend buts Delete
            }
            select {
                append mess "put them in a new subset \\\"$diag_map_name\\\", "
                lappend buts "Create Subset"
            }
            addselect {
                append mess "add them to the subset \\\"$diag_map_name\\\", "
                lappend buts "Add Subset"
            }
            fix {
                append mess "fix the problem by $howfix, "
                lappend buts "Fix"
            }
        }
        set pos($n) $opt
        incr n
    }
    append mess "or ignore"
    set pos($n) dismiss
    lappend buts "Ignore"
    if {$ask_what == "" && !$skip} {
        set ch [eval tk_dialog .mesh_diag \"Diagnostics: $desc\" \"$mess\" \"\" -1 $buts]
	    if {$ch == "-1"} {
	        if [winfo exists .mesh_diag] {
	            destroy .mesh_diag
	        }
	        return
	    }
        set ask_what $pos($ch)
    } else {
        set ch [expr [llength $buts] - 2]
        set ask_what $pos($ch)
    }
    set diag_fix_is_fixed 1
    switch $ask_what {
        delete {
            set n [ic_uns_subset_count_elements $map]
            ic_uns_delete_contents $map
            mess "$n elements deleted\n"
        }
        select {
            if $ai_environment {
                aie_new_mesh_subset $diag_map_name
            } else {
                ic_uns_subset_create $diag_map_name
            }
            ic_uns_subset_copy $diag_map_name $map
            mess "New subset \"$diag_map_name\" created\n" blue
        }
        addselect {
            switch_to_subset $diag_map_name
            if [ic_uns_subset_exists $map]  {
                mess "$map exists\n"
                ic_uns_subset_add_from $diag_map_name $map
            } else {
                mess "what happened to map $map ? \n" red
            }	
        }
        fix {
            if {$fixfunc == ""} { error "no fix func for $what" }
            if {$skip && ("$fixfunc" == "diag_fix_uncovered_faces" || "$fixfunc" == "diag_replace_triangles_with_tetra" || \
                          "$fixfunc" == "diag_fix_missing_internal_faces")} {
                set fixed [$fixfunc $map $skip]
            } else {
                set fixed [$fixfunc $map]
            }
            if {$fixfunc == "diag_fix_volume_orientation"} {
                set diag_fix_is_fixed $fixed
            }
            if {$fixed != "0" && $fixed != ""} {
                if [ic_uns_subset_exists $diag_map_name] {
                    aie_delete_mesh_subset "\"$diag_map_name\""
                    mess "Subset \"$diag_map_name\" exists; deleted\n" red
                }
            }
        }
        dismiss {}
    }
    if $diag_fix_is_fixed { unset diag_fix_is_fixed }
    set diag_fix_mode $ask_what
}

proc diag_fix_surf_orient {map} {
    ic_uns_check_orientation All "" 1
}

proc unstruct_diag_set_all {dtype on} {
    global diagnostic_data diagnostic_keys
    
    if {(1==$on) || (0==$on)} {
	foreach dk $diagnostic_keys {
	    if ![info exists diagnostic_data($dk,type)] continue
	    if {$dtype != $diagnostic_data($dk,type)} continue
	    set diagnostic_data($dk,check) $on
	}
    } else {
	# non-0|1 sets default
	foreach dk $diagnostic_keys {
	    if ![info exists diagnostic_data($dk,type)] continue
	    if {$dtype != $diagnostic_data($dk,type)} continue
	    set diagnostic_data($dk,check) $diagnostic_data($dk,def_check)
	}	
    }	
}

proc unstruct_diag_form {} {
    global diagnostic_data diagnostic_keys options
    
    set buts {{"Create subsets"   "unstruct_diag_check_list subset"} \
	    {"Check/fix each"     "unstruct_diag_check_list"} \
	    done}
    # this is confusing to people
    #{"Highlight existing" "unstruct_diag_check_list highlight"} \
    
    set d [form_init .diag "Check mesh" "" $buts]
    if {$d != ""} {
	
	form_frame $d.errors flat 0 {0 0 -cols 2}
	form_frame $d.pproblems flat 0 {0 2 -cols 2}
	form_frame $d.subset flat 2 {1 0 -cols 4}
	
	set ln 0
	form_label $d.errors.errl Errors "$ln 0"
	#! make this label bold !!$d.errors.errl -configure -font...
	set coltype "derror"
	incr ln
	foreach dk $diagnostic_keys {
	    if ![info exists diagnostic_data($dk,type)] continue
	    if {$coltype != $diagnostic_data($dk,type)} continue
	    form_checkbutton $d.errors.$dk $diagnostic_data($dk,verbose) \
		    diagnostic_data($dk,check) "$ln 0"
	    incr ln
	}
	form_frame  $d.errors.allnone flat 0 "$ln 0 -cols 3"
	form_button $d.errors.allnone.all   "All"\
		"unstruct_diag_set_all $coltype 1" "0 0"
	form_button $d.errors.allnone.none "None"\
		"unstruct_diag_set_all $coltype 0" "0 1"
	form_button $d.errors.allnone.def "Default"\
		"unstruct_diag_set_all $coltype -1" "0 2"
	
	set ln 0
	form_label $d.pproblems.probl "Possible problems" "$ln 0"
	#! make this label bold !!$d.pproblems.errl -configure -font...
	set coltype "dprob"
	incr ln
	foreach dk $diagnostic_keys {
	    if ![info exists diagnostic_data($dk,type)] continue
	    if {$coltype != $diagnostic_data($dk,type)} continue
	    form_checkbutton $d.pproblems.$dk $diagnostic_data($dk,verbose) \
		    diagnostic_data($dk,check) "$ln 0"
	    incr ln
	}
	form_frame  $d.pproblems.allnone flat 0 "$ln 0 -cols 3"
	form_button $d.pproblems.allnone.all  "All"\
		"unstruct_diag_set_all $coltype 1" "0 0"
	form_button $d.pproblems.allnone.none "None"\
		"unstruct_diag_set_all $coltype 0" "0 1"
	form_button $d.pproblems.allnone.def "Default"\
		"unstruct_diag_set_all $coltype -1" "0 2"
	
	form_label $d.subset.whchl "Which elements:" {0 0}
	form_radiobutton $d.subset.all "All"    options(diag_which) all    {0 1}
	form_radiobutton $d.subset.act "Active" options(diag_which) active {0 2}
	form_radiobutton $d.subset.sub "Subset" options(diag_which) subset {0 3}
	
	form_finish +300+300
    }
}

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

proc unstruct_quality {} {
    global unstruct_diag unstruct_diag_maps    
    
    # Compute the standard Quality of mesh unless some is already
    # specified.
    if ![info exists unstruct_diag(which)] {
	set unstruct_diag(which) Quality
    }
    if ![info exists unstruct_diag(use_colors)] {
	set unstruct_diag(use_colors) 0
    }
    set unstruct_diag_maps(highlight_maps) ""
    
    set fams [ic_uns_list_families]
    set unstruct_diag(fam_list) $fams
    
    set types [ic_uns_list_types]
    set unstruct_diag(type_list) $types
    set unstruct_diag_maps(from) 0
    
    # compute this unconditionally on the whole mesh
    set unstruct_diag_maps(subset) All
    set unstruct_diag(use_sel) 1    
    busy 1
    mess "Computing $unstruct_diag(which) of visible mesh\n"
    unstruct_do_diag
    busy 0    
    set unstruct_diag(use_sel) 0
    
    # Create the window including the histogram    
    set buts {{Recompute unstruct_diag_recompute} done}
    set d [form_init .unstruct_qual "Mesh quality" "" $buts]
    if {$d != ""} {
	
	form_frame $d.histo ridge 2 {0 0 -cols 3}
	
	form_label $d.typel "Types:" {1 0}
	form_frame $d.types ridge 2 {2 0}
	
	form_label $d.famsl "Familes:" {3 0}
	form_frame $d.fams ridge 2 {4 0}
	
	form_checkbutton $d.usecol "Display quality by colors" \
		unstruct_diag(use_colors) {5 0}
	
	form_checkbutton $d.sell "Selections:" unstruct_diag(use_sel) {1 1}
	form_frame $d.sels ridge 2 {2 1}
	
	form_label $d.whichl "Diagnostic:" {3 1}
	form_frame $d.which ridge 2 {4 1}
	
if { 0 } {
# This for doesn't work
	form_button $d.custom "Define custom quality" \
		"unstruct_diag_custom_metric" {5 1}
}
	# -----------------
	set unstruct_diag(histo_path) ${d}.histo
	unstruct_update_histo
	# -----------------
	
	set opts ""
	foreach f $types {
	    lappend opts [list type_$f -text $f]
	    if ![info exists unstruct_diag(type_$f)] {
		set unstruct_diag(type_$f) 1
	    }
	}
	check_box $d.types [lsort $opts] 4 unstruct_diag
	
	# -----------------
	
	set opts ""
	foreach f $fams {
	    lappend opts [list fam_$f -text $f]
	    if ![info exists unstruct_diag(fam_$f)] {
		set unstruct_diag(fam_$f) 1
	    }
	}
	check_box $d.fams [lsort $opts] 4 unstruct_diag
	
	# -----------------
	
	set sels [ic_uns_subset_list]
	set unstruct_diag_maps(sel_list) $sels
	set opts ""
	foreach f $sels {
	    lappend opts [list $f -text $f]
	}
	check_box $d.sels $opts 4 unstruct_diag_maps(from) 0
	if ![info exists unstruct_diag_maps(subset)] {
	    set unstruct_diag_maps(subset) [lindex $sels 0]
	}
	
	# -----------------
	
	set dnames ""
	foreach e [diagnostic_info] {
	    lappend dnames [lindex $e 0]
	}
	set diags ""
	foreach e [lsort $dnames] { lappend diags [list $e -command unstruct_diag_something_changed] }
	check_box $d.which $diags 4 unstruct_diag(which) 0	
	
	form_finish -0-0
    }
    form_wait .unstruct_qual
    # -----------------
    
    set unstruct_diag(results) ""
    
    unstruct_clear_diag
    
    # delete any existing metrics--no, since  smoother may use them
    # ic_uns_set_metric_weight delete_all QUAD_4 ;# QUAD_4 is arbitrary
}

proc unstruct_diag_color {{reset 0}} {
    global unstruct_diag_maps disp_options unstruct_diag
    
    set map visible ;# $unstruct_diag_maps(from_maps)
    if $reset {
	ic_uns_subset_configure $map -shade $disp_options(uns_disp) \
		-color_by_quality 0 -shrink $disp_options(uns_shrink)
    } elseif {[info exists unstruct_diag(use_colors)] && \
	    $unstruct_diag(use_colors)} {
	ic_uns_subset_configure $map -color_by_quality 1
	# \ -shade solid -shrink 90
	ic_uns_print_diagnostic_quality_key $unstruct_diag(which)    
    }
}

proc unstruct_update_histo {{title ""} {nbars ""} \
	{min ""} {max ""} {ylim ""} {arguments ""}} {
    global unstruct_diag unstruct_diag_maps        
    
    if {![info exists unstruct_diag_maps(from_maps)] || \
	    ($unstruct_diag_maps(from_maps) == "")} { unstruct_do_diag }
    
    if {![info exists unstruct_diag(min)] || \
	    ![info exists unstruct_diag(max)]} {
	mess "no histogram information available\n"
	return
    }
    
    if {$min == ""} {
	if {$unstruct_diag(min) != ""} {
	    set min $unstruct_diag(min)
	} else {
	    set min $unstruct_diag(minv)
	}
    }
    if {$max == ""} {
	if {$unstruct_diag(max) != ""} {
	    set max $unstruct_diag(max)
	} else {
	    set max $unstruct_diag(maxv)
	}
    }
    if {$title == ""} { set title $unstruct_diag(which) }
    if {$nbars == ""} { set nbars $unstruct_diag(num) }
    if {$ylim == ""} { set ylim $unstruct_diag(hgt) }
    if {$ylim == ""} { set ylim 0 }
    
    if {$min >= $max} {
	mess "Cannot plot histogram for $title: min=$min and max=$max\n" red
	return
    }
    
    for {set i 0} {$i < $nbars} {incr i} {set histo($i) 0}
    
    set numt 0
    set fm $unstruct_diag_maps(from_maps)
    set hist [ic_uns_histogram $fm $min $max $nbars]
    for {set i 0} {$i < $nbars} {incr i} {
	# For this one we ignore the low and high buckets.
	set n [lindex $hist [expr $i + 1]]
	incr histo($i) $n
	incr numt $n
    }
    
    # This is sort of wrong but it's what people want (Bugzilla #4770)
#    incr histo(0) [lindex $hist 0]
#    incr histo([expr $nbars - 1]) [lindex $hist [expr $nbars + 1]]
    
    set diff [expr {$max - $min}]
    set vstep [expr {$diff / ($nbars + 0.0)}]
    
    set xvalues {}
    set yvalues {}
    set total 0
    for {set i 0} {$i < $nbars} {incr i} {
	set x [expr {$min + $i * $vstep}]
	set y $histo($i)
	
	lappend xvalues $x
	lappend yvalues $y
	incr total $y
    }
    lappend xvalues $max
    
    if !$total {
	warningmsg "No values fell within the specified range ($min - $max)"
	return
    }
    
    set extra_buts {
	{ makesel "Select"     "unstruct_select_histo 0" }
	{ addsel  "Add select" "unstruct_select_histo 1" }
    }
    
    if ![info exists unstruct_diag(histo_path)] {
	set unstruct_diag(histo_path) .histo
    }
    make_histogram $unstruct_diag(histo_path) $title $xvalues \
	    $yvalues $ylim \
	[list "Num = $total" "Min = $unstruct_diag(minv)" \
	      "Max = $unstruct_diag(maxv)"] \
	unstruct_update_histo unstruct_plot_histo "" $extra_buts 2
    
    unstruct_diag_color
}


if { 0 } {
# this code is DOA
proc unstruct_diag_custom_metric {} {
    global custom_metric custom_metric_keys
    
    set buts {done cancel}
    set d [form_init .unstruct_diag_define "Define custom quality metric" "" $buts]
    if {$d != ""} {
	form_label $d.metricl "Metrics" {0 0}
	form_frame $d.metric  flat  0   {1 0}
	form_label $d.metric.b ""        {2 0}
	
	form_label $d.quadl  "Quads"   {0 1}
	form_frame $d.quad   ridge 1   {1 1 -cols 3}
	form_label $d.quad.minl "Min"   {2 1}
	form_label $d.quad.idl  "Ideal" {2 2}
	form_label $d.quad.maxl "Max"   {2 3}
	
	form_label $d.tril   "Tris"    {0 4}
	form_frame $d.tri    ridge 1   {1 4 -cols 3}
	form_label $d.tri.minl "Min"   {2 4}
	form_label $d.tri.idl  "Ideal" {2 5}
	form_label $d.tri.maxl "Max"   {2 6}
	
	foreach f {quad tri} {
	    foreach i { minl idl maxl } { $d.$f.$i configure -width 6 }
	}
	
	set ln 3
	foreach n $custom_metric_keys {
	    mess "n = $n\n"
	    mess "i = $i\n"
	    if ![info exists custom_metric($n,name)] continue
	    
	    form_checkbutton $d.metric.$ln $custom_metric($n,name) \
		    custom_metric($n,active) "$ln 0"
	    set col 1
	    foreach f {quad tri} {
		foreach v {acc_min des_min id des_max acc_max} {
		    if {[info exists custom_metric($n,$f,$i)] && \
			    (-1 != $custom_metric($n,$f,$i))} {
			form_entry $d.$f.${n}${i} custom_metric($n,$f,$i) string "$ln $col"
		    } else {
			form_label $d.$f.${n}${i} "" "$ln $col"
		    }
		    $d.$f.${n}${i} configure -width 6
		    incr col
		}
	    }
	    incr ln
	}
	form_finish -0-0
    }
}

}

proc unstruct_diag_custom_metric_set {{which ""}} {
    global custom_metric custom_metric_keys
    
    # note this string matches DiagnosticInfoTable
    if {"Custom quality" != $which} { return }
    
    set metlist ""
    foreach n $custom_metric_keys {
	if ![info exists custom_metric($n,name)] continue
	if $custom_metric($n,active) {
	    foreach {f g} {quad QUAD_4 tri TRI_3} {
		lappend metlist [list $custom_metric($n,name) $g \
			acc_min $custom_metric($n,$f,acc_min) \
			des_min $custom_metric($n,$f,des_min) \
			ideal   $custom_metric($n,$f,id) \
			des_max $custom_metric($n,$f,des_max) \
			acc_max $custom_metric($n,$f,acc_max)]
	    }
	}
    }
    ic_uns_set_metric_weights $metlist 1
}

proc unstruct_diag_recompute {} {
    unstruct_do_diag
    unstruct_update_histo
}
