
# Stuff for unstructured mesh smoothing.
#
# Copyright (c) 1997 Pacific Marketing and Consulting, Inc,
#       and ICEM Systems, GmbH.  All rights reserved.
# Author:  Wayne A. Christopher, wayne@icemcfd.com

proc unstruct_smooth {} {
    global smooth fam_visible uns_type_visible
    
    if [winfo exists .smoother] {
	form_kill .smoother
	ic_uns_subset_delete smooth_do_map
	ic_uns_subset_delete smooth_show_map
    }
    
    ic_uns_subset_create smooth_do_map 0
    ic_uns_subset_create smooth_show_map 1
    ic_uns_subset_configure smooth_do_map -list_type 1
    ic_uns_subset_configure smooth_show_map -shade flat_wire -color white
    
    set smooth(use_post) [ ic_smooth_decide_post_smoother ]
    smooth_something_changed 0
    smooth_something_changed 1
    
    trace variable fam_visible w "smooth_something_changed 2; list"
    
# There might be different element types available since last time
    form_kill .smoother
    set d [form_init .smoother "Smooth elements" "" \
	       [list {Histogram {smooth_update_histogram}} \
		    {Smooth smooth_apply} done]]
    
    form_frame $d.histo ridge 2 {0 0 -cols 3}
    form_frame $d.par ridge 2 {2 0 -rows 3}
    form_frame $d.sel ridge 2 {2 1}
    form_frame $d.how ridge 2 {3 1}
    
    set rn 1
    if { ! [ info exists smooth(sel_method) ] } {
	set smooth(sel_method)  select
    }

    form_frame $d.subset flat 0 "$rn 0"
    form_label $d.subset.what_to_smooth "What to smooth" "$rn 0"
    form_radiobutton $d.subset.subset "Displayed subset" \
			smooth(sel_method)  subset "$rn 1"
    form_radiobutton $d.select "Selection below" \
			smooth(sel_method) select "$rn 1"



    # -------------------------
    
    form_frame $d.sel.f flat 0 {0 0}

    form_radiobutton $d.sel.f.all "All families" \
			smooth(sel_what) all {1 0 -cols 2} \
			{ { smooth(sel_method) select } }
    form_radiobutton $d.sel.f.act "Active families" \
			smooth(sel_what) active {2 0 -cols 2} \
			{ { smooth(sel_method) select } }
    foreach b {all act} { ;# sub 
	$d.sel.f.$b configure -command "smooth_something_changed 0"
    }
    
    form_frame $d.sel.spfams flat 0 {0 1}
    form_frame $d.sel.sptypes flat 0 {0 2}
    
    # -------------------------
    
    form_label $d.how.typel "Type" {0 0} { { smooth(sel_method) select } }
    form_label $d.how.sml "Smooth" {0 1} { { smooth(sel_method) select } }
    form_label $d.how.frl "Freeze" {0 2} { { smooth(sel_method) select } }
    form_label $d.how.fll "Float" {0 3} { { smooth(sel_method) select } }
    if $smooth(use_post) {
        $d.how.frl configure -fg grey
        $d.how.fll configure -fg grey
        set smooth(refine) 0
        set smooth(collapse) 1
        set smooth(not_just_worst) 0
        set smooth(violate) 0
    }
    set r 2
    foreach t [ic_uns_list_types] {
	if {($t == "NODE") || ($t == "BAR_2") || ($t == "LINE_2")} continue
	# if { $t == "PYRA_5" } continue
        form_label $d.how.t$t $t "$r 0" { { smooth(sel_method) select } }
        if !$smooth(use_post) {
	    if ![info exists smooth(how_$t)] { set smooth(how_$t) smooth }
	    form_radiobutton $d.how.sm$t "" smooth(how_$t) smooth "$r 1" \
				{ { smooth(sel_method) select } }
	    form_radiobutton $d.how.fr$t "" smooth(how_$t) freeze "$r 2" \
				{ { smooth(sel_method) select } }
	    form_radiobutton $d.how.pa$t "" smooth(how_$t) float "$r 3" \
				{ { smooth(sel_method) select } }
	} else {
	    form_radiobutton $d.how.sm$t "" smooth(post_which) $t "$r 1" \
				{ { smooth(sel_method) select } }
	    
	    if ![info exists smooth(how_$t)] { set smooth(how_$t) none }
	    form_radiobutton $d.how.fr$t "" smooth(how_$t) freeze "$r 2"
            $d.how.fr$t configure -state disabled
	    form_radiobutton $d.how.pa$t "" smooth(how_$t) float "$r 3"
            $d.how.pa$t configure -state disabled
        }
        foreach p {sm fr pa} {
            $d.how.$p$t configure -command "smooth_something_changed 0"
        }
	incr r
    }
    
    # -------------------------
    
    if ![info exists smooth(criterion)] {
	set smooth(criterion) Quality
    }
    set crit_opts {
	{ Quality }
	{ "Quality (4.3 version)" }
	{ "Aspect ratio" }
	{ Determinant  }
	{ "Min angle" }
	{ "Max orthogls" }
	{ "Max warp" }
	{ "Max warpgls" }
	{ Skew }
	{ "Custom quality" }
    }
    
    form_label $d.par.metl "Quality metric:" {0 0}
    form_optionmenu $d.par.met smooth(criterion) $crit_opts {0 1} "" \
	"smooth_something_changed 1"
    
    form_label $d.par.itersl "Smoothing iterations" {10 0}
    form_entry $d.par.iters smooth(iters) int {10 1}
    form_label $d.par.max_vall "Up to quality" {11 0}
    form_entry $d.par.max_val smooth(max_val) float {11 1}
    form_button $d.par.adv "Advanced options" \
	"unstruct_smooth_advanced $smooth(use_post)" {12 0 -cols -}
    
    # -------------------------
    
    set smooth(histo_win) $d.histo
    
    smooth_update_histogram
    
    form_finish bot
    
    form_wait .smoother
    
    form_kill .smoother
    ic_uns_subset_delete smooth_do_map
    ic_uns_subset_delete smooth_show_map
    
    trace vdelete fam_visible w "smooth_something_changed 2; list"
}

proc unstruct_smooth_advanced {post_smoother} {
    set d [form_init .smoother_advanced_$post_smoother \
	       "Advanced smoothing parameters"]
    if {$d == ""} return
    
    set ln  0
    form_label $d.prism_warp_weightl "Prism warp weight" "$ln 0"
    form_entry $d.prism_warp_weight smooth(prism_warp_weight) float "$ln 1"

    incr ln
    form_radiobutton $d.vstay "Stay on geometry" smooth(violate) 0 "$ln 0"

    incr ln
    form_radiobutton $d.vabs "Violate geometry absolute distance" \
			smooth(violate) 1 "$ln 0"
    form_entry $d.vabsval smooth(violate_tol) float "$ln 1"  \
			{ { smooth(violate) 1 } }

    incr ln
    form_radiobutton $d.vrel "Violate geometry relative distance" \
			smooth(violate) 2 "$ln 0"
    form_entry $d.vrelval smooth(violate_rel) float "$ln 1"  \
			{ { smooth(violate) 2 } }

    
    incr ln
    form_checkbutton $d.refine "Refine elements" smooth(refine) "$ln 0"
    form_checkbutton $d.laplace "Laplace smoothing" smooth(laplace) "$ln 1"

    incr ln
    form_checkbutton $d.collaps "Collapse elements" smooth(collapse) "$ln 0"
    form_checkbutton $d.not_just_worst "Not just worst 1%" \
	smooth(not_just_worst) "$ln 1"

    incr ln
    form_checkbutton $d.sfit "Surface fitting" smooth(sfit) "$ln 0"
    form_checkbutton $d.ipp "Ignore pre points" smooth(ignore_pp) "$ln 1"
    
    if $post_smoother {
       $d.refine configure -state disabled
       $d.collaps configure -state disabled
       $d.not_just_worst configure -state disabled
       $d.vstay configure -state disabled
       $d.vabsval configure -state disabled
       $d.vabs configure -state disabled
       $d.vrel configure -state disabled
       $d.vrelval configure -state disabled
    } else {
       $d.ipp configure -state disabled
    }
    bind $d.prism_warp_weight <Key> "smooth_something_changed 1"
    form_finish bot
}
    

proc smooth_decide_uns_smoother {} {
    if { [ic_count_elements TETRA_4] || [ic_count_elements PENTA_6] || \
	     [ic_count_elements PYRA_5] || [ic_count_elements TRI_3] } {
	return 1
    }
    return 0
}

proc smooth_update_histogram {{title "Element quality"}
			      {nbars ""} {min ""} {max ""} {ylim ""}
			      {args ""}} {
    global smooth histo_width histo_height smooth_allmap
    global histo_minv histo_maxv histo_minv_limit histo_maxv_limit
    global histo_solid histo_nbars histo_ylim

    set title $smooth(criterion)
    
    if {$nbars == ""} {
	if [info exists histo_nbars] {
	    set nbars $histo_nbars
	} else {
	    set nbars 20
	}
    }
    
    if {$min == ""} {
	if {[info exists histo_minv] && ($histo_minv != "")} {
	    set min $histo_minv
	} else {
	    set min 0
	}
    }
    
    if {$max == ""} {
	if {[info exists histo_maxv] && ($histo_maxv != "")} {
	    set max $histo_maxv
	} else {
	    set max 1.0
	}
    }
    
    if {$ylim == ""} {
	if [info exists histo_ylim] {
	    set ylim $histo_ylim
	} else {
	    set ylim 0
	}
    }
    
    set histo_width 550
    set histo_height 400
    set histo_minv_limit 0
    set histo_maxv_limit 1.0
    set histo_solid 0
    
    if {($nbars < 1) || ($nbars > 500)} { error "Number of bars out of range" }
    
    set xvals ""
    set yvals ""
    set ymax 0
    
    set changed [smooth_update_do_map]
    busy 1
    
    if {$changed || ![info exists smooth(criterion_ok)]} {
	set ret [ic_uns_metric smooth_do_map $smooth(criterion) \
		     prism_warp_weight $smooth(prism_warp_weight)]
	#puts $ret
	set smooth(actual_min) [lindex $ret 3]
	set smooth(actual_max) [lindex $ret 4]
	set smooth(criterion_ok) 1
    }
    
    # Use all rather than smooth_do_map so we see pyramid quality, etc too
    set histo [ic_uns_histogram smooth_do_map $min $max $nbars]
    
    mess "Histogram of $smooth(criterion) values\n" blue
    set ymax 0
    for {set i 0} {$i < $nbars} {incr i} {
	set n [lindex $histo [expr $i + 1]]
	
	# This is sort of wrong but it's what people want (Bugzilla #4770)
	if {$i == 0} { incr n [lindex $histo 0] }
	if {$i == $nbars - 1} { incr n [lindex $histo [expr $nbars + 1]] }
	
	set scale [expr $max - $min]
	set low [expr {$min + $scale * $i / ($nbars + 0.0)}]
	set hi [expr {$min + $scale * ($i + 1.0) / ($nbars + 0.0)}]
	lappend yvals $n
	if {$n > $ymax} { set ymax $n }
	lappend xvals $low
	
	mess "$low -> $hi : $n\n" blue
    }
    lappend xvals $hi 
    
    set extra_buts {
	{ makesel "Select"     "smooth_select_histo 0" }
	{ addsel  "Add select" "smooth_select_histo 1" }
    }
    set labels [list "Min $smooth(actual_min)" "Max $smooth(actual_max)"]
    make_histogram $smooth(histo_win) $title $xvals $yvals \
	$ylim $labels smooth_update_histogram smooth_show_elements "" \
	$extra_buts 2 12 9 1 0 0 0 1 -1
    
    busy 0
}

proc smooth_select_histo {add} {
    
    switch_to_subset Diagnostic
    set map visible
    if $add {
	ic_uns_subset_add_from $map smooth_show_map
    } else {
	ic_uns_subset_copy $map smooth_show_map
    }
}

proc smooth_show_elements {w intervals args solid color_by_quality} {
    
    if $solid {
	ic_uns_subset_configure smooth_show_map -shade flat_wire -color_by_quality $color_by_quality
    } else {
	ic_uns_subset_configure smooth_show_map -shade wire
    }
#   smooth_show_map clear
    set tot [ic_uns_set_with_diagnostic smooth_show_map smooth_do_map \
		 $intervals]
    mess "$tot elements\n"
}

proc smooth_update_do_map {} {
    global smooth fam_visible
    
    if [info exists smooth(map_opts_ok)] { 
	#mess "smooth_update_do_map returning 0\n"
	return 0 
    }
    
    busy 1
    
    set types ""
    foreach t [ic_uns_list_types] {
	if $smooth(use_post) {
	    if {$smooth(post_which) == $t} { lappend types $t }
	    
	} else {
	    if ![info exists smooth(how_$t)] continue
	    if {[info exists smooth(how_$t)] &&
		($smooth(how_$t) == "smooth")} {
		lappend types $t
	    }
	}
    }
    if { $types == "" } {
	error "no types defined for unstructured smoother"
    }
    set fams ""
    switch $smooth(sel_what) {
	all {
	    foreach f [ic_uns_list_families] { lappend fams $f }
	}
	active {
	    foreach f [array names fam_visible] {
		if $fam_visible($f) { lappend fams $f }
	    }
	}
    }
    ic_uns_update_family_type smooth_do_map $fams $types update 1
    
    set smooth(map_opts_ok) 1
    catch {unset smooth(criterion_ok)}
    busy 0
    return 1
}

proc smooth_something_changed {crit} {
    global smooth histo_minv histo_maxv
    
    if {($crit == 2) && ($smooth(sel_what) == "all")} return
    
    if {$crit == 1} {
	catch {unset smooth(criterion_ok)}
	set histo_minv ""
	set histo_maxv ""
    } else {
	catch {unset smooth(map_opts_ok)}
    }
    if [info exists smooth(histo_win)] {
	foreach i {graph} {
	    if [winfo exists $smooth(histo_win).$i] {
		destroy $smooth(histo_win).$i
	    }
	}
    }
#    smooth_change_crit $smooth(use_post)
}

proc smooth_change_crit {post_sm} {
    global smooth

    if $post_sm {
        set crit $smooth(criterion)
        switch $crit {
            Quality {
                set smooth(criterion) Quality
            }
            "Max warp" {
                set smooth(criterion) "Max warpgls"
            }
            "Min angle" {
                set smooth(criterion) "Max orthogls"
            }
        }
    }
}


proc smooth_apply {} {
    global smooth fam_visible 
    global uns_type_visible histo_maxv unstruct_diag
    
    smooth_update_do_map
    
    mess "Smoothing [ic_uns_subset_count_elements smooth_do_map] elements,\
	$smooth(iters) iterations, up to $smooth(max_val) ...\n"
    
    set cmd ""
    
    lappend cmd upto $smooth(max_val)

    set unstruct_diag(which) $smooth(criterion)

    lappend cmd metric $smooth(criterion)
    lappend cmd iterations $smooth(iters)
    
    lappend cmd prism_warp_weight $smooth(prism_warp_weight)
    if !$smooth(collapse) { lappend cmd no_collapse 1 }
    if { $smooth(violate) == 1 } { 
	lappend cmd violate_geometry $smooth(violate_tol) 
    }
    if { $smooth(violate) == 2 } {
	set val [ expr  -1 * $smooth(violate_rel) ]
	lappend cmd violate_geometry $val
    }
    foreach v {sfit ignore_pp refine laplace} {
	if $smooth($v)    { lappend cmd $v 1 } 
    }
    if $smooth(not_just_worst) { lappend cmd all_elements 1 }
    
    if $smooth(use_post) {
	lappend cmd smooth $smooth(post_which)
	
    } else {
	foreach t [ic_uns_list_types] {
	    if ![info exists smooth(how_$t)] continue
	    lappend cmd $smooth(how_$t) $t
	}
    }
    set fix ""
    foreach f [ic_uns_list_families] {
	if {$f == "ORFN"} continue
	if {$smooth(sel_what) == "active"} {
	    if !$fam_visible($f) { lappend fix $f }
	}
    }
    if {$fix != ""} {
	lappend cmd fix_families $fix
    }
    if { $smooth(sel_method) == "subset" } { lappend cmd subset visible }


    with_view_inactive {
	eval ic_smooth_elements $cmd
    }
    
    smooth_something_changed 0
    smooth_update_histogram
}
