# Grid refinement study application.  Use init.tcl to start

namespace eval ::Refinement {}

proc ::Refinement::CreateApp {} {
    variable data
    variable appdata

    wm title . "ICEM CFD Refinement Application"
    wm protocol . WM_DELETE_WINDOW {exit 0}
    # strange bug on windows 64 machines, missing icemcfd title bar icon
    if {$::tcl_platform(platform) == "windows" && [info exists ::env(ProgramFiles(x86))]} {
        if [file exists $::env(ICEM_ACN)/icemcfd.ico] {
            wm iconbitmap . -default $::env(ICEM_ACN)/icemcfd.ico
        }
    }
    # wm geometry . +300+300

    menu .options -type menubar
    .options add cascade -label File -menu .options.file
    .options add cascade -label Settings -menu .options.settings
    .options add command -label Help -command ::Refinement::StartHelp
    . configure -menu .options
    menu .options.file -tearoff 0
    .options.file add command -label "Set working directory" -command "::Refinement::SetWorkingDir ."
    .options.file add command -label "Save application parameters" -command "::Refinement::SaveParams ."
    .options.file add command -label "Exit" -command {exit 0}
    menu .options.settings -tearoff 0
    .options.settings add command -label "Number of processors" -command "::Refinement::SetNumProcessors ."

    frame .divider1 -bd 2 -relief sunken -height 2
    grid .divider1 - -sticky nwe -padx 2

    label .geomtext -text "Geometry file:"
    set geom [frame .geom -bd 1 -relief raised]
    entry $geom.file -textvariable [namespace current]::data(geomfile)
    set openimg [image create photo -file $appdata(appdir)/icons/openfold.gif]
    Button $geom.browse -image $openimg -relief link -bd 1 -command "::Refinement::SetGeom ."
    pack $geom.file $geom.browse -side left -padx 2 -pady 2
    pack $geom.file -expand yes -fill x

    label .tetratext -text "Tetrahedral mesh:"
    set tetra [frame .tetra -bd 1 -relief raised]
    label $tetra.refinefactlab -text "Refinement factor:"
    entry $tetra.refinefact -textvariable [namespace current]::data(refinefact)
    label $tetra.numrefineslab -text "Number of refinements:"
    entry $tetra.numrefines -textvariable [namespace current]::data(numrefines)
    checkbutton $tetra.docoarsemesh -text "Compute initial coarse mesh" -variable [namespace current]::data(docoarsemesh)
    checkbutton $tetra.savepresmoothed -text "Save pre-smoothed tetrahedral mesh" -variable [namespace current]::data(savetetraunsmoothed)
    checkbutton $tetra.smooth -text "Smooth mesh" -variable [namespace current]::data(tetsmooth)
    label $tetra.iterlab -text "Iterations:"
    SpinBox $tetra.iter -range {1 50 1} -textvariable [namespace current]::data(tetsmoothiter)
#    $tetra.iter.e configure -disabledbackground ""
    label $tetra.qualitylab -text "Min quality:"
    entry $tetra.quality -textvariable [namespace current]::data(tetsmoothquality)
    checkbutton $tetra.nodemerge -text "Allow node merging" -variable [namespace current]::data(tetnodemerge)
    checkbutton $tetra.savesmoothed -text "Save smoothed tetrahedral mesh" -variable [namespace current]::data(savetetrasmoothed)
    set smoothwidgets "$tetra.iterlab $tetra.iter $tetra.qualitylab $tetra.quality $tetra.nodemerge $tetra.savesmoothed"
    $tetra.smooth configure -command [list ::Refinement::ActivateItems $smoothwidgets tetsmooth]
    ActivateItems $smoothwidgets tetsmooth
    grid $tetra.refinefactlab $tetra.refinefact -sticky nw -padx 2 -pady 2
    grid $tetra.numrefineslab $tetra.numrefines -sticky nw -padx 2 -pady 2
    grid $tetra.docoarsemesh  -sticky nw -padx 2 -pady 2
    grid $tetra.savepresmoothed  -sticky nw -padx 2 -pady 2
    grid $tetra.smooth  -sticky nw -padx 2 -pady 2
    grid $tetra.iterlab $tetra.iter -sticky nw -padx 2 -pady 2; grid $tetra.iterlab -sticky ne
    grid $tetra.qualitylab $tetra.quality -sticky nw -padx 2 -pady 2; grid $tetra.qualitylab -sticky ne
    grid x $tetra.nodemerge -sticky nw -padx 2 -pady 2
    grid x $tetra.savesmoothed -sticky nw -padx 2 -pady 2
    grid columnconfigure $tetra 1 -weight 1
    set col1width [expr {[winfo reqwidth $tetra.savepresmoothed] + 4}]

    checkbutton .prismtext -text "Prism mesh:" -variable [namespace current]::data(runprism)
    set prism [frame .prism -bd 1 -relief raised]
    set prismfileframe [frame $prism.frame]
    label $prismfileframe.text -text "Prism parameters file:"
    entry $prismfileframe.file -textvariable [namespace current]::data(prismparamsfile)
    Button $prismfileframe.browse -image $openimg -relief link -bd 1 -command "::Refinement::SetPrismParamsFile ."
    pack $prismfileframe.text $prismfileframe.file $prismfileframe.browse -side left -padx 2 -pady 2
    pack $prismfileframe.file -expand yes -fill x
    checkbutton $prism.adjhgts -text "Adjust prism heights with refinement factor" -variable [namespace current]::data(adjhgts)
    checkbutton $prism.adjlayers -text "Adjust number of layers for total thickness less than 0.25 max tet size" -variable [namespace current]::data(adjlayers)
    checkbutton $prism.smooth -text "Smooth mesh" -variable [namespace current]::data(prismsmooth)
    label $prism.iterlab -text "Iterations:"
    SpinBox $prism.iter -range {1 50 1} -textvariable [namespace current]::data(prismsmoothiter)
    label $prism.qualitylab -text "Min quality:"
    entry $prism.quality -textvariable [namespace current]::data(prismsmoothquality)
    checkbutton $prism.nodemerge -text "Allow node merging" -variable [namespace current]::data(prismnodemerge)
    set smoothwidgets "$prism.iterlab $prism.iter $prism.qualitylab $prism.quality $prism.nodemerge"
    $prism.smooth configure -command [list ::Refinement::ActivateItems $smoothwidgets prismsmooth]
    ActivateItems $smoothwidgets prismsmooth
    set prismwidgets "$prismfileframe.text $prismfileframe.file $prismfileframe.browse $prism.adjhgts $prism.adjlayers $prism.smooth \
			$prism.iterlab $prism.iter $prism.qualitylab $prism.quality $prism.nodemerge"
    .prismtext configure -command [list ::Refinement::ActivateItems $prismwidgets runprism $prism.smooth]
    ActivateItems $prismwidgets runprism $prism.smooth
    grid $prismfileframe - -sticky nwe -padx 2 -pady 2
    grid $prism.adjhgts - -sticky nw -padx 2 -pady 2
    grid $prism.adjlayers - -sticky nw -padx 2 -pady 2
    grid $prism.smooth  -sticky nw -padx 2 -pady 2
    grid $prism.iterlab $prism.iter -sticky nw -padx 2 -pady 2; grid $prism.iterlab -sticky ne
    grid $prism.qualitylab $prism.quality -sticky nw -padx 2 -pady 2; grid $prism.qualitylab -sticky ne
    grid x $prism.nodemerge -sticky nw -padx 2 -pady 2
    grid columnconfigure $prism 1 -weight 1
    grid columnconfigure $prism 0 -minsize $col1width

    label .addcheckstext -text "Additional checks:"
    set addchecks [frame .addchecks -bd 1 -relief raised]
    set perframe [frame $addchecks.perframe]
    checkbutton $perframe.periodicity -variable [namespace current]::data(doperiodiccheck) \
	-command "::Refinement::PeriodicityMenu" -bd 0 -highlightthickness 0 -padx 0
    if {$::tcl_platform(platform) == "unix"} {
	$perframe.periodicity configure -bd 2
    }
    Button $perframe.periodicitybutton -text Periodicity -relief link -bd 1 -command "::Refinement::PeriodicityMenu"
    pack $perframe.periodicity $perframe.periodicitybutton -side left -padx 0 -pady 0
    grid $perframe -sticky nw -padx 6 -pady 2
    grid columnconfigure $addchecks 0 -weight 1

    label .solvetext -text "Solution files:"
    set solve [frame .solve -bd 1 -relief raised]
    label $solve.formatlab -text "Solver format:"
    ComboBox $solve.format -editable 0 -height 0 -entrybg white -exportselection 0 \
	-textvariable [namespace current]::data(solveformat) \
	-values $appdata(solvetypes)
    label $solve.acusolvetypelab -text "Acusolve solution type:"
    ComboBox $solve.acusolvetype -editable 0 -height 0 -entrybg white -exportselection 0 \
	-textvariable [namespace current]::data(acusolveflow) \
	-values $appdata(acusolvetypes)
    $solve.format configure -modifycmd [list ::Refinement::SelectSolveType $solve]
    set solvedirframe [frame $solve.frame]
    label $solvedirframe.text -text "Solver files location:"
    entry $solvedirframe.dir -textvariable [namespace current]::data(solvedir)
    Button $solvedirframe.browse -image $openimg -relief link -bd 1 -command "::Refinement::SetSolverDir ."
    pack $solvedirframe.text $solvedirframe.dir $solvedirframe.browse -side left -padx 2 -pady 2
    pack $solvedirframe.dir -expand yes -fill x
    grid $solve.formatlab $solve.format -sticky nw -padx 2 -pady 2
    grid $solvedirframe - -sticky nwe -padx 2 -pady 2
    grid $solve.acusolvetypelab $solve.acusolvetype -sticky nw -padx 2 -pady 2
    grid $solve.acusolvetype -sticky nwe
    grid columnconfigure $solve 1 -weight 1
    grid columnconfigure $solve 0 -minsize $col1width
    SelectSolveType $solve

    set compute [canvas .compute -relief raised -bd 2 -highlightthickness 0]
    set exe [image create photo -file $appdata(appdir)/icons/update.gif]
    set ximg [image width $exe]
    set yimg [image height $exe]
    $compute create image 5 5 -image $exe -anchor nw
    set rec [$compute create text [expr {$ximg + 9}] 4 -text Compute -anchor nw]
    foreach {x1 y1 x2 y2} [$compute bbox $rec] break
    set xtxt [expr {$x2 - $x1}]
    set ytxt [expr {$y2 - $y1}]
    if {$yimg > $ytxt} {
	set hgt [expr {$yimg + 6}]
    } else {
	set hgt [expr {$ytxt + 6}]
    }
    set wid [expr {$ximg + $xtxt + 12}]
    $compute configure -width $wid -height $hgt
    bind $compute <ButtonPress-1> [list ::Refinement::ComputePress $compute]
    bind $compute <ButtonRelease-1> [list ::Refinement::ComputeRelease $compute]

    set mess_buttons [frame .messbuttons]
    set stopimg [image create photo -file $appdata(appdir)/icons/stop.gif]
    set appdata(stopbutton) [Button $mess_buttons.stop -image $stopimg -relief link -bd 1 -command "interrupt set 1"]
    checkbutton $mess_buttons.quality -text "Write quality to file" -variable [namespace current]::data(quality2file)
    checkbutton $mess_buttons.log -text Log -variable ::log_messages -command message_log_reopen
    button $mess_buttons.save -text "Save" -padx 0 -pady 2 -command message_save
    button $mess_buttons.clear -text "Clear" -padx 0 -pady 2 -command ".textframe.text delete 0.0 end"
    pack $mess_buttons.clear $mess_buttons.save $mess_buttons.log $mess_buttons.quality -side right -padx 2 -pady 0

    grid .geomtext $geom -sticky nwe -padx 2 -pady 2; grid .geomtext -sticky w
    grid .tetratext $tetra -sticky nwe -padx 2 -pady 2; grid .tetratext -sticky nw -pady 4
    grid .prismtext $prism -sticky nwe -padx 2 -pady 2; grid .prismtext -sticky nw -pady 4
    grid .addcheckstext $addchecks -sticky nwe -padx 2 -pady 2; grid .addcheckstext -sticky nw -pady 4
    grid .solvetext $solve -sticky nwe -padx 2 -pady 2; grid .solvetext -sticky nw -pady 4
    grid $compute $mess_buttons -sticky nw -padx 10 -pady 2
    grid $mess_buttons -sticky new -padx 2
    set txt [CreateConsole .textframe]
    grid $txt - -sticky nswe -padx 2 -pady 2
    grid columnconfigure . 1 -weight 1
    grid rowconfigure . 7 -weight 1
    wm deiconify .
    raise .

    set appdata(newgeom) 1
}

proc ::Refinement::CreateConsole {w} {
    global mess_frame

    set mess_frame [frame $w]
    set scr [scrollbar $mess_frame.scr -orient vertical]
    set txt [text $mess_frame.text -exportselection 1 -wrap word -padx 4 -pady 4 \
		      -relief sunken -borderwidth 2 -foreground black -background white -height 10]
    bind $txt <Key-Return> "message_send_line $txt"
    $scr configure -command [list $txt yview]
    $txt configure -yscrollcommand [list ::Refinement::ConfigureConsole $scr]
    grid $txt $scr -sticky nswe
    grid columnconfigure $mess_frame 0 -weight 1
    grid rowconfigure $mess_frame 0 -weight 1
    return $mess_frame
}

proc ::Refinement::ConfigureConsole {w first last} {
    if {$first <= 0 && $last >= 1} {
	grid remove $w
    } else {
	grid $w
	$w set $first $last
    }
}

proc ::Refinement::ActivateItems {items var {subcheckbutton ""}} {
    variable data

    set state [expr {$data($var) ? "normal" : "disabled"}]
    foreach w $items {
	$w configure -state $state
    }
    if {$subcheckbutton != "" && $state == "normal"} {
	eval [$subcheckbutton cget -command]
    }
}

proc ::Refinement::SelectSolveType {frame} {
    variable data

    if {$data(solveformat) == "AcuSolve"} {
	grid $frame.acusolvetypelab $frame.acusolvetype
    } else {
	grid remove $frame.acusolvetypelab $frame.acusolvetype
    }
}

proc ::Refinement::ComputePress {w} {
    $w configure -relief sunken
    $w move all 1 1
}

proc ::Refinement::ComputeRelease {w} {
    $w configure -relief raised
    $w move all -1 -1
    set x [winfo pointerx .]
    set y [winfo pointery .]
    if {[winfo containing $x $y] == $w} {
	interrupt init2
	Mesh
	interrupt finish2
    }
}

proc ::Refinement::Mesh {} {
    variable data
    global interrupt_pending

    if ![file exists $data(geomfile)] {
	mess "Geometry file \"$data(geomfile)\" doesn't exist\n" red
	return
    }
    if {$data(runprism) && ![file exists $data(prismparamsfile)]} {
	mess "Prism parameter file \"$data(prismparamsfile)\" doesn't exist\n" blue
	mess "Using default global prism settings in init.tcl and part settings found in geometry\n" blue
    }

    catch {unset interrupt_pending}
    ic_unload_mesh
    ic_unload_tetin
    ic_boco_unload
    ic_load_tetin [list $data(geomfile)]
    set found_live 0
    foreach mat [ic_geo_get_objects body] {
	if {[ic_geo_get_family body $mat] != "ORFN"} {
	    incr found_live
	}
    }

    set name [file rootname [file tail $data(geomfile)]]
    foreach {p v} [ic_get_meshing_params global 0] {
	switch $p {
	    gref - gmax - gnat {
		set ${p}_org $v
	    }
	}
    }

    set scale 1.0
    set relscale 1.0
    if $data(runprism) ReadPrismParams
    if $data(docoarsemesh) {
	set iter 1
    } else {
	set iter 2
    }
    for {} {$iter <= ($data(numrefines) + 1)} {incr iter} {

	if {$iter > 1} {
	    set prevscale $scale
	    switch $data(refinelaw) {
		linear {
		    set scale [expr {1 / ($data(refinefact) * ($iter - 1.0))}]
		}
		exponential {
		    set scale [expr {1 / pow($data(refinefact),$iter - 1)}]
		}
		default {
		    return
		}
	    }
	    set relscale [expr {$scale / $prevscale}]
	    # parameters scaled by reference size: max size (global and local), min size limit (global and local), max deviation
	    set gref [expr {$gref_org * $scale}]
	    set gmax [expr {$gmax_org * $scale}]
	    set gnat [expr {$gnat_org * $scale}]
	    ic_geo_scale_meshing_params all $gref; # only scales max sizes on all entities, not height
	    ic_set_meshing_params global 0 gref $gref gmax $gmax gnat $gnat
	}

	catch {unset delete_tetra_mesh}
	set logfile [file join $data(dir) $name-$iter-tetra_cmd.log]
	set cmd "ic_run_tetra tin uns run_cutter 1 delete_auto 1 run_smoother 0 fix_holes 1 n_processors $data(nproc) in_process 1 log {$logfile}"
	if {$found_live == 0} {
	    append cmd " auto_vol 1"
	}
	if [info exists interrupt_pending] return
	eval $cmd
	if [info exists interrupt_pending] return
	set tetra_mesh_unsmoothed [file join $data(dir) $name-$iter-unsmoothed.uns]
	set tetra_mesh_smoothed [file join $data(dir) $name-$iter-smoothed.uns]
	if {$data(savetetraunsmoothed) || !$data(tetsmooth)} {
	    ic_save_unstruct $tetra_mesh_unsmoothed
	    set tetra_mesh $tetra_mesh_unsmoothed
	    if !$data(savetetraunsmoothed) {
		set delete_tetra_mesh 1
	    }
	}

	set criterion Quality
	if {$data(tetsmooth) && $data(tetsmoothiter) > 0} {
	    set tetcollapse [expr !$data(tetnodemerge)]
	    ic_smooth_elements map all upto $data(tetsmoothquality) iterations $data(tetsmoothiter) fix_families {} smooth TRI_3 float TETRA_4 laplace 1 no_collapse $tetcollapse
	    if [info exists interrupt_pending] return
	    ic_smooth_elements map all upto $data(tetsmoothquality) iterations $data(tetsmoothiter) prism_warp_weight 0.5 fix_families {} metric $criterion smooth TETRA_4 freeze TRI_3 no_collapse $tetcollapse
	    if [info exists interrupt_pending] return
	    ic_smooth_elements map all upto $data(tetsmoothquality) iterations $data(tetsmoothiter) prism_warp_weight 0.5 fix_families {} metric $criterion smooth TETRA_4 smooth TRI_3 no_collapse $tetcollapse
	    if [info exists interrupt_pending] return
	}
	foreach {problems fatal} [CheckElements] break
	if [info exists interrupt_pending] return
	if $problems {
	    mess "Problems found.  Saving subsets\n" blue
	    ic_save_unstruct [file join $data(dir) $name-$iter-problemsubsets.uns]
	    if $fatal {
		mess "Fatal problems found which need to be addressed\n" red
		return
	    }
	}
	set qfile ""
	if $data(quality2file) {
	    if {$data(tetsmooth) && $data(tetsmoothiter) > 0} {
		set qfile [file rootname [file tail $tetra_mesh_smoothed]]-quality.txt
	    } else {
		set qfile [file rootname [file tail $tetra_mesh_unsmoothed]]-quality.txt
	    }
	}
	ReportQuality [lindex $data(qualitymetrics) 0] $qfile
	foreach metric [lrange $data(qualitymetrics) 1 end] {
	    ReportQuality $metric $qfile a
	}
	if $data(tetsmooth) {
	    ic_save_unstruct $tetra_mesh_smoothed
	    set tetra_mesh $tetra_mesh_smoothed
	    if !$data(savetetrasmoothed) {
		set delete_tetra_mesh 1
	    }
	}

	if $data(runprism) {
	    set prism_mesh [file join $data(dir) $name-$iter-prism-unsmoothed.uns]
	    set ret [WritePrismParams $tetra_mesh $prism_mesh $scale $relscale]
	    set paramsfile [lindex $ret 0]
	    set adjusted_geom [lindex $ret 1]
	    ic_unload_mesh
	    if [info exists interrupt_pending] return
	    mess "Running prism on $tetra_mesh\n" blue
	    set plog [file join $data(dir) $name-$iter-prism.log]
	    set ret [batch_interp eval [list run_application_batch_exec_direct icemcfd/prism PRISM_BIN [list $paramsfile] $plog]]
	    if [info exists interrupt_pending] return
#	    file delete -- $paramsfile
	    set ok [CheckPrismReturn $ret $plog $prism_mesh]
	    if !$ok return
	    if {$adjusted_geom != ""} {file delete -- $adjusted_geom}
	    if [info exists delete_tetra_mesh] {
		ic_rm $tetra_mesh
	    }
	    ic_uns_load [list $prism_mesh] 3 0 {} 2
	    if [info exists interrupt_pending] return
	    foreach {problems fatal} [CheckElements] break
	    if [info exists interrupt_pending] return
	    if $problems {
		mess "Problems found.  Saving subsets\n" blue
		ic_save_unstruct [file join $data(dir) $name-$iter-prism-problemsubsets.uns]
		if $fatal {
		    mess "Fatal problems found which need to be addressed\n" red
		    return
		}
	    }
	    if $data(quality2file) {
		set qfile [file rootname [file tail $prism_mesh]]-quality.txt
	    }
	    ReportQuality [lindex $data(qualitymetrics) 0] $qfile
	    foreach metric [lrange $data(qualitymetrics) 1 end] {
		ReportQuality $metric $qfile a
	    }

# For some reason, putting the smooth/freeze/float in {} gives slightly better quality
	    if {$data(prismsmooth) && $data(prismsmoothiter) > 0} {
		set prismcollapse [expr !$data(prismnodemerge)]
		ic_smooth_elements map all upto $data(tetsmoothquality) iterations $data(prismsmoothiter) prism_warp_weight 0.5 fix_families {} \
			metric Quality {smooth TETRA_4 smooth TRI_3 freeze PENTA_6 freeze QUAD_4 freeze PYRA_5} no_collapse $prismcollapse
		if [info exists interrupt_pending] return
		ic_smooth_elements map all upto $data(prismsmoothquality) iterations $data(prismsmoothiter) prism_warp_weight 0.5 fix_families {} \
			metric Quality {smooth TETRA_4 smooth TRI_3 smooth PENTA_6 smooth QUAD_4 smooth PYRA_5} no_collapse $prismcollapse
		if [info exists interrupt_pending] return

		foreach {problems fatal} [CheckElements] break
		if [info exists interrupt_pending] return
		if $problems {
		     mess "Problems found.  Saving subsets\n" blue
		    ic_save_unstruct [file join $data(dir) $name-$iter-prism-smoothed-problemsubsets.uns]
		    if $fatal {
			mess "Fatal problems found which need to be addressed\n" red
			return
		    }
		}
		set prism_mesh_smoothed [file join $data(dir) $name-$iter-prism-smoothed.uns]
		if $data(quality2file) {
		    set qfile [file rootname [file tail $prism_mesh_smoothed]]-quality.txt
		}
		ReportQuality [lindex $data(qualitymetrics) 0] $qfile
		foreach metric [lrange $data(qualitymetrics) 1 end] {
		    ReportQuality $metric $qfile a
		}
		ic_save_unstruct $prism_mesh_smoothed
		set final_mesh $prism_mesh_smoothed
	    } else {
		set final_mesh $prism_mesh
	    }
	} else {
	    set final_mesh $tetra_mesh
	}

	set bc [file join $data(dir) $name.fbc]
	ic_boco_save $bc
	file delete -- [file join $data(dir) $name.fbc_old]
	if ![file isdirectory $data(solvedir)] {
	    file mkdir $data(solvedir)
	}
	if [info exists interrupt_pending] return
	WriteToSolver_$data(solveformat) $final_mesh $name-$iter $bc
	if [info exists interrupt_pending] return
	if {!$data(runprism) && [info exists delete_tetra_mesh]} {
	    ic_rm $tetra_mesh
	}

	if {$iter > 1} {
	    mess "Mesh refinement [expr {$iter - 1}] done at scale $scale\n" blue
	} else {
	    mess "Initial coarse mesh done\n" blue
	}
    }
    mess "All refinement meshes done\n" green
}

proc ::Refinement::ReportQuality {{metric Quality} {tofile ""} {ftype w} {parts ""} {types ""} {nbars 20}} {
    if ![ic_uns_is_loaded] return
    if {$tofile != ""} {
	set wfile [open $tofile $ftype]
    }
    if {$parts == ""} {
        set parts [ic_uns_list_families]
    }
    if {$types == ""} {
        foreach typ [ic_uns_list_types] {
            if {![string equal NODE $typ] && ![string match LINE_* $typ]} {
                lappend types $typ
            }
        }
    }
    ic_uns_subset_delete smooth_do_map
    ic_uns_subset_create smooth_do_map 0
    ic_uns_update_family_type smooth_do_map $parts $types update 1
    set ret [ic_uns_metric smooth_do_map $metric]

    set smooth(actual_min) [lindex $ret 3]
    set smooth(actual_max) [lindex $ret 4] 

    if {[expr abs($smooth(actual_min))] < 1.0e-08} {
        set smooth(actual_min) 0
    }

    set min 0.0
    set max [aie_get_max_possible_colorband]
    if {$max == "1.0e38"} {
	set max $smooth(actual_max)
    }
#    if {$max < $smooth(actual_max)} {
#	set max $smooth(actual_max)
#    }

    if {$min > $max} {
        mess "Max value can not be less than min value; resetting the histogram values to defaults\n" red
        set min 0.0; set max 1.0
    }
    if {$min == $max} {
        if {$max < 0 } {
            set max 0
        } elseif {$max > 0} {
            set min 0
        } else {
            set max 1
        }
    }

    if {($nbars < 1) || ($nbars > 500)} {
        msg ERROR "Num. bars not in valid range {1,500}; Resetting the histogram values to defaults"
        set nbars 20
    }

    set histo [ic_uns_histogram smooth_do_map $min $max $nbars]
    if {$tofile != ""} {
        puts $wfile "Histogram of $metric values"
        puts $wfile "Min = $smooth(actual_min), Max = $smooth(actual_max)"
    }
    mess "Histogram of $metric values\n" blue
    mess "Min = $smooth(actual_min), Max = $smooth(actual_max)\n"
    set ntotal [ic_uns_subset_count_elements smooth_do_map]
    set scale [expr $max - $min]
    for {set i [expr $nbars - 1]} {$i >= 0} {incr i -1} {
        set n [lindex $histo [expr $i + 1]]
        set low [expr {$min + $scale * $i / ($nbars + 0.0)}]
        set hi [expr {$min + $scale * ($i + 1.0) / ($nbars + 0.0)}]
        set percent [format %.3f [expr $n * 100.0 / $ntotal]]
        if {$tofile != ""} {
            puts $wfile "$low -> $hi : $n ($percent%)"
        }
        mess "$low -> $hi : $n ($percent%)\n" blue
    }
    if {$tofile != ""} {puts $wfile ""}
    mess \n
    ic_uns_subset_delete smooth_do_map
    if {$tofile != ""} {close $wfile}
}

proc ::Refinement::CheckElements {} {
    variable data
    global interrupt_pending

    if ![ic_uns_is_loaded] return

    array set checks {
	duplicate			{"Duplicate elements"					ic_uns_delete_contents							}
	uncovered			{"Uncovered faces"					FixUncovered							}
	missing_internal			{"Missing internal faces"					FixMissingInternal							}
	vol_orient			{"Volume orientations"					ic_uns_fix_volume_orientation							}
	surf_orient			{"Surface orientations"					subset						fatal	}
	hanging			{"Hanging elements"					ic_uns_delete_contents							}
	disconnbars			{"Disconnected bar elements"			ic_uns_delete_contents									}
	multiple			{"Multiple edges"					subset							}
	triangle_box			{"Triangle boxes"					subset							}
	single			{"Single edges"					CheckSingle						fatal	}
	nmanvert			{"Non-manifold vertices"					subset							}
	periodic_problem			{"Periodic problems"					subset						fatal	}
    }
	
    set ret 0
    set fatal 0
    foreach subset [ic_uns_subset_list] {
        ic_uns_subset_delete $subset
    }
    foreach chk [array names checks] {
        set text [lindex $checks($chk) 0]
        set proc [lindex $checks($chk) 1]
        set nchks 1
        if {$chk == "periodic_problem"} {
            set nchks [llength $data(periodicparts)]
        } else {
            set nchks 1
        }
        for {set i 0} {$i < $nchks} {incr i} {
            if {$chk == "periodic_problem"} {
                if !$data(doperiodiccheck) break
                set fams [lindex $data(periodicparts) $i]
                mess "Checking periodicity between parts [lindex $fams 0] and [lindex $fams 1]\n"
            } else {
                set fams ""
            }
            set tmp_map [ic_uns_create_diagnostic_subset]
            ic_uns_create_diagnostic_edgelist 1
            set diag [ic_uns_diagnostic subset all diag_type $chk disp_subset $tmp_map diag_verb $text fams $fams busy_off 1]
            if [info exists interrupt_pending] return
            set nprobs [lindex $diag 0]
            if {$nprobs > 0 && $proc != ""} {
	        if {$proc == "subset"} {
		    set ret 1
		    if {[lindex $checks($chk) 2] == "fatal"} {set fatal 1}
		    if ![ic_uns_subset_exists $text] {
		        ic_uns_subset_create $text
		    }
		    ic_uns_subset_add_from $text $tmp_map
		    #ic_uns_subset_copy clears out the current contents first
		    #ic_uns_subset_copy $text $tmp_map
	        } else {
		    if {[info commands [namespace current]::$proc] == ""} {set text ""}
		    if [eval $proc $tmp_map {$text}] {
		        set ret 1
		        if {[lindex $checks($chk) 2] == "fatal"} {set fatal 1}
		    }
	        }
            }
            ic_uns_subset_delete $tmp_map
            ic_uns_create_diagnostic_edgelist 0
        }
    }
    mess "Running diagnostics for Unconnected vertices in subset \"all\"\n"
    batch_interp eval unstruct_disconnected_verts 1
    return [list $ret $fatal]
}

proc ::Refinement::FixUncovered {map text} {
    set part [string toupper [string map {" " _} $text]]
    ic_uns_new_family $part
    mess "Creating faces in part $part\n" blue
    ic_uns_fix_uncovered_faces $map $part
    return 0
}

proc ::Refinement::FixMissingInternal {map text} {
    set part [string toupper [string map {" " _} $text]]
    ic_uns_new_family $part
    mess "Creating faces in part $part\n" blue
    ic_uns_fix_missing_internal $map $part 0
    return 0
}

proc ::Refinement::CheckSingle {map text} {
    set prob_fams ""
    foreach fam [ic_uns_subset_list_families $map] {
	if ![ic_geo_get_family_param $fam internal_wall] {
	    lappend prob_fams $fam
	}
    }
    if {$prob_fams != ""} {
	ic_uns_subset_create $text 0 $map
	ic_uns_update_family_type $text $prob_fams __same__ restrict_to
	return 1
    }
    return 0
}

proc ::Refinement::StartHelp {} {
    global is_win
    variable appdata
    
    if $is_win {
        set path [file attributes $appdata(appdir) -shortname]
#        set path [ic_win_shortname $appdata(appdir)]
        if {[catch { exec start "$path/help.htm" &} error_code]} { mess "$error_code\n" red }
    } else {
        set found 0
        foreach p "firefox opera chrome mozilla" {
            set exe [get_path $p]
            if {[file exists $exe] && [file executable $exe]} {
                set found 1
                break
            }
        }
        if $found {
            set path $appdata(appdir)
            if {[catch { exec $exe $path/help.htm &} error_code]} { mess "$error_code\n" red }
        }
    }
}

proc ::Refinement::SetWorkingDir {w} {
    variable data

    set dir [tk_chooseDirectory -initialdir $data(dir) -title "Set working directory" -parent $w]
    if {$dir != ""} {
	cd $dir
	set data(dir) $dir
    }
}

proc ::Refinement::SaveParams {w} {
    variable data

    set file [tk_getSaveFile -initialdir $data(dir) -title "Save parameters" -parent $w \
		-filetypes {{{Text files} .txt} {{All files} *}} \
		-defaultextension .txt]
    if {$file != ""} {
	set pfile [open $file w]
	foreach var [lsort [array names data]] {
	    puts $pfile "$var $data($var)"
	}
	close $pfile
    }
}

proc ::Refinement::SetGeom {w} {
    variable data
    variable appdata

    set file [tk_getOpenFile -initialdir $data(dir) -title "Select geometry" -parent $w \
		-filetypes {{{ICEM CFD Geometry} .tin} {{All files} *}} \
		-defaultextension .tin -initialfile $data(geomfile)]
    if {$file != ""} {
	set data(geomfile) $file
	set params [file rootname $file].prism_params
	if [file exists $params] {
	    set data(prismparamsfile) $params
	} else {
	    set data(prismparamsfile) ""
	}
	set data(doperiodiccheck) 0
	set data(periodicparts) ""
	set appdata(newgeom) 1
    }
}

proc ::Refinement::SetPrismParamsFile {w} {
    variable data

    set file [tk_getOpenFile -initialdir $data(dir) -title "Select prism parameters file" -parent $w \
		-filetypes {{{Prism parameters} .prism_params} {{All files} *}} \
		-defaultextension .prism_params -initialfile $data(prismparamsfile)]
    if {$file != ""} {
	set data(prismparamsfile) $file
    }
}

proc ::Refinement::SetSolverDir {w} {
    variable data

    set dir [tk_chooseDirectory -initialdir $data(dir) -title "Set Solver directory" -parent $w]
    if {$dir != ""} {
	set data(solvedir) $dir
    }
}

proc ::Refinement::SetNumProcessors {w} {
    variable data

    if {$w == "."} {
	set nprocs .nprocs
    } else {
	set nprocs $w.nprocs
    }
    if [winfo exists $nprocs] {
	focus $nprocs
	return
    }
    toplevel $nprocs -height 1 -width 1
    wm withdraw $nprocs
    wm title $nprocs "Number of processors"
    wm resizable $nprocs 0 0
    wm minsize $nprocs 218 68
    set x [expr {[winfo rootx $w] + 100}]
    set y [expr {[winfo rooty $w] + 50}]
    wm geometry $nprocs +$x+$y
    if {$::tcl_platform(platform) == "windows" && [info exists ::env(ProgramFiles(x86))]} {
        if [file exists $::env(ICEM_ACN)/icemcfd.ico] {
            wm iconbitmap $nprocs -default $::env(ICEM_ACN)/icemcfd.ico
        }
    }

    label $nprocs.text -text "Number of processors"
    SpinBox $nprocs.value -range {1 5000 1} -textvariable [namespace current]::data(nprocs) -width 5
    button $nprocs.ok -text OK -command "destroy $nprocs" -padx 10
    grid $nprocs.text $nprocs.value -padx 5 -pady 5
    grid $nprocs.ok - -padx 5 -pady 5
    wm transient $nprocs $w
    wm deiconify $nprocs
    focus $nprocs
}

proc ::Refinement::PeriodicityMenu {} {
    variable data
    variable appdata

    if !$data(doperiodiccheck) {
	destroy .periodicity
	return
    }
    if [winfo exists .periodicity] {
	focus .periodicity
	return
    }
    set per [toplevel .periodicity]
    wm title $per "Periodic pairs"
    set appdata(perlistvar) $data(periodicparts)
    set txt [listbox $per.list -exportselection 1 -relief sunken -borderwidth 2 -foreground black \
	-background white -height 4 -listvariable [namespace current]::appdata(perlistvar)	-height 5 -width 50]
    set vscr [scrollbar $per.vscr -orient vertical]
    set hscr [scrollbar $per.hscr -orient horizontal]
    $vscr configure -command [list $txt yview]
    $hscr configure -command [list $txt xview]
    $txt configure -yscrollcommand [list ::Refinement::ConfigurePeriodicMenu $vscr]
    $txt configure -xscrollcommand [list ::Refinement::ConfigurePeriodicMenu $hscr]
    grid $txt $vscr -sticky nswe -padx 2 -pady 2; grid $vscr -sticky nws
    grid $hscr -sticky swe
    grid columnconfigure $per 0 -weight 1
    grid rowconfigure $per 0 -weight 1

    set fr1 [frame $per.buttons1]
    set add [button $fr1.add -text Add -command "::Refinement::AddPeroidicParts perlistvar; focus $per"]
    set delete [button $fr1.delete -text Delete -command [list $txt delete active]]
    grid $add $delete -sticky nw -padx 2 -pady 2
    grid $fr1 -sticky nw

    set fr2 [frame $per.buttons2]
    set apply [button $fr2.apply -text Apply -command [list ::Refinement::ApplyPeroidicParts perlistvar]]
    set dismiss [button $fr2.dismiss -text Dismiss -command [list destroy $per]]
    grid $apply $dismiss -sticky n -padx 2 -pady 2
    grid $fr2 -sticky nwe

}

proc ::Refinement::ConfigurePeriodicMenu {w first last} {
    if {$first <= 0 && $last >= 1} {
	grid remove $w
    } else {
	grid $w
	$w set $first $last
    }
}

proc ::Refinement::AddPeroidicParts {var} {
    variable data
    variable appdata

    if $appdata(newgeom) {
	set partdata [GetParts $data(geomfile)]
	set appdata(parts) [lindex $partdata 0]
	set appdata(partcolors) [lindex $partdata 1]
	set appdata(newgeom) 0
    }
    if {$appdata(parts) != ""} {
	set f1 [::Refinement::select_families $appdata(parts) $appdata(partcolors) "Select the first part"]
	if {$f1 != ""} {
	    set f2 [::Refinement::select_families $appdata(parts) $appdata(partcolors) "Select the second part"]
	}
	if {($f1 == "") || ($f2 == "") || ($f1 == $f2)} return
	foreach txt $appdata($var) {
	    if {[lsort $txt] == [lsort "$f1 $f2"]} return
	}
	lappend appdata($var) "$f1 $f2"
    }
}

proc ::Refinement::ApplyPeroidicParts {var} {
    variable data
    variable appdata

    set data(periodicparts) $appdata($var)
}

proc ::Refinement::GetParts {geomfile} {
    if {$geomfile == ""} {
	mess "Please select a geometry file first\n" red
	return
    }
    if ![file exists $geomfile] {
	mess "\"$geomfile\" does not exist" red
	return
    }
    set rfile [open $geomfile r]
    set parts ""
    set colors ""
    set found_fam_command 0
    while {[gets $rfile txt] >= 0} {
	if {[lindex $txt 0] == "define_family"} {
	    lappend parts [lindex $txt 1]
	    set i [lsearch $txt "color"]
	    if {$i > 1} {
		set col [lindex $txt [expr {$i+1}]]
		set xcol [format "#%02x%02x%02x" [expr {$col & 0xff}] [expr {($col >> 8) & 0xff}] [expr {($col >> 16) & 0xff}]]
		lappend colors $xcol
	    } else {
		lappend colors ""
	    }
	    set found_fam_command 1
	} elseif {$found_fam_command && ([string trim $txt] != "")} {
	    break
	}
    }
    close $rfile
    return [list $parts $colors]
}

proc ::Refinement::ReadPrismParams {} {
    variable data
    variable prism

    SetPrismParams
    set prism(families) ""
    if [file exists $data(prismparamsfile)] {
	set rfile [open $data(prismparamsfile) r]
	while {[gets $rfile txt] >= 0} {
	    set txt [split $txt " "]
	    set var [lindex $txt 0]
	    switch $var {
		surface_file - input_file - output_file - n_processors {}
		family {
		    set fam [lindex $txt 1]
		    if [ic_geo_check_family $fam] {
			lappend prism(families) $txt
		    }
		}
		default {
		    set prism($var) [lindex $txt 1]
		}
	    }
	}
	close $rfile
    }
}

proc ::Refinement::WritePrismParams {input_mesh output_mesh {scale 1.0} {relscale 1.0}} {
    variable data
    variable prism

    set name [file rootname [file tail $output_mesh]]
    set paramsfile [file join $data(dir) $name.prism_params]
    if [file exists $paramsfile] {
	set ext [file extension $paramsfile]
	for {set i 0} {[file exists [set paramsfile $data(dir)/$name$i$ext]]} {incr i} {}
    }
    if $data(adjlayers) {
	set max_size [FindMaxSize]
    }
    set adjusted_geom ""
    # need to scale heights since this is not automatically changed when the reference size is scaled
    if $data(adjhgts) {
	set adjusted_geom $name-temp.tin
	foreach {p v} [ic_get_meshing_params prism 0] {
	    if {$p == "height"} {
		# adjust global height on geometry
		ic_set_meshing_params prism 0 height [expr {$v * $relscale}]
		break
	    }
	}
	# adjust heights on all surfaces and curves
	foreach type {surface curve} {
	    foreach ent [ic_geo_get_objects $type] {
		set prms [ic_get_meshing_params $type $ent]
		set i [lsearch $prms ehgt]
		if {$i > -1} {
		    set ehgt [lindex $prms [expr {$i+1}]]
		    ic_set_meshing_params $type $ent ehgt [expr {$ehgt * $relscale}]
		}
	    }
	}
	# What about family lines in tetin?
	# I think the family params set in the .prism_params file override what is set in the tetin family lines
	# However, if this needs to be corrected, make sure to fix the last part of the procedure also.

	ic_save_tetin $adjusted_geom 0 0 {} {} 0 0 1
    }

    set wfile [open $paramsfile w]
    if {$adjusted_geom == ""} {
	puts $wfile "surface_file \"$data(geomfile)\""
    } else {
	puts $wfile "surface_file $adjusted_geom"
    }
    puts $wfile "input_file [file tail $input_mesh]"
    puts $wfile "output_file [file tail $output_mesh]"
    puts $wfile "n_processors $data(nproc)"
    foreach var [lsort [array names prism]] {
	if {$var == "height" && $data(adjhgts)} {
	    set height [expr {$prism(height) * $scale}]
	    puts $wfile "height $height"
	} elseif {$var == "layers" && $data(adjlayers) && $prism(height) > 0.0 && $prism(ratio) > 0.0} {
	    if ![info exists height] {set height $prism(height)}
	    set layers [AdjustNumLayers $max_size $prism(law) $height $prism(ratio)]
	    if {$layers > $prism(layers)} {set layers $prism(layers)}
	    puts $wfile "layers $layers"
	} elseif {$var == "families"} {
	    # handled later
	} else {
	    puts $wfile "$var $prism($var)"
	}
    }
    if {$prism(families) != ""} {
	foreach txt $prism(families) {
	    set fam [lindex $txt 1]
	    set height 0
	    set ratio 0
	    set n_layers 0
	    foreach {p v} [lrange $txt 2 end] {
		if {![catch {expr double($v) > 0.0} ok] && $ok} {
		    set $p $v
		}
	    }
	    if $data(adjhgts) {
		set height [expr {$height * $scale}]
	    }
	    if $data(adjlayers) {
		set maxlayers [AdjustNumLayers $max_size $prism(law) $height $ratio]
		if {$maxlayers < $n_layers} {set n_layers $maxlayers}
	    }
	    if {$n_layers == 0} continue
	    puts $wfile "family $fam height $height ratio $ratio n_layers $n_layers"
	}
    } else {
	# get prism families from geometry if not in .prism_params file
	set pfams [ic_geo_get_prism_families]
	if {$pfams == ""} {
	    mess "No parts have been tagged for prism\n" red
	}
	foreach fam $pfams {
	    set height 0
	    set ratio 0
	    set n_layers 0
	    foreach {p v} [ic_geo_get_prism_family_params $fam] {
		if {![catch {expr double($v) > 0.0} ok] && $ok} {
		    set $p $v
		}
	    }
	    if $data(adjhgts) {
		set height [expr {$height * $scale}]
	    }
	    if $data(adjlayers) {
		set maxlayers [AdjustNumLayers $max_size $prism(law) $height $ratio]
		if {$maxlayers < $n_layers} {set n_layers $maxlayers}
	    }
	    if {$n_layers == 0} continue
	    puts $wfile "family $fam height $height ratio $ratio n_layers $n_layers"
	}
    }
    close $wfile
    return [list $paramsfile $adjusted_geom]
}

proc ::Refinement::WriteToSolver_AcuSolve {mesh name bc} {
    variable data

    switch $data(acusolveflow) {
	"Steady laminar" {set ext sf }
	"Steady turbulent" {set ext sfe}
	"Steady turbulent thermal" {set ext sfte}
	"Transient laminar" {set ext tf}
	"Transient turbulent" {set ext tfe}
	"Transient turbulent thermal" {set ext tfte}
	default {
	    mess "Unrecognized Acusolve solution type \"$data(acusolveflow)\"" red
	    return
	}
    }
    set output_dir $::env(ICEM_ACN)/icemcfd/output-interfaces
    set paramfile $output_dir/acusolve.$ext.par

    set plfile $data(solvedir)/plfile
    set fp [open $plfile w]

    puts $fp "-b $bc"
    puts $fp "-dom $mesh"
    puts $fp "-par $paramfile"
    puts $fp "-pb $name"
    puts $fp "-dir $data(solvedir)"
    puts $fp "-icm $output_dir/acusolve.icm"
    puts $fp "-geom \"$output_dir/acusolve_geom\""
    puts $fp "-scale 1.0"
    puts $fp "-inp 1"
    puts $fp "-pbc 0"
    puts $fp "-pnt1 0,0,0"
    puts $fp "-pnt2 0,0,1"
    puts $fp "-nic 0"
    puts $fp "-iw 1"
    puts $fp "-v 1"

    close $fp

    ic_exec perl $output_dir/acusolve.pl $plfile
    file delete -- $plfile
}

proc ::Refinement::WriteToSolver_CFD++ {mesh name bc} {
    variable data

    ic_exec $::env(ICEM_ACN)/icemcfd/output-interfaces/cfd++ -b $bc -dom $mesh \
	-nod $data(solvedir)/$name-nodesin.bin -sol $data(solvedir)/$name-cdepsin.bin \
	-cel $data(solvedir)/$name-cellsin.bin -bc $data(solvedir)/$name-exbcsin.bin \
	-ibc $data(solvedir)/$name-inbcsin.bin -mcfd $data(solvedir)/$name-mcfd.bc -cgrp
}

proc ::Refinement::WriteToSolver_CFX {mesh name bc} {
    variable data

    ic_exec $::env(ICEM_ACN)/icemcfd/output-interfaces/cfx5 -dom $mesh \
	-b $bc -ascii -db -internal_faces $data(solvedir)/$name.cfx5
}

proc ::Refinement::WriteToSolver_Fluent {mesh name bc} {
    variable data

    ic_exec $::env(ICEM_ACN)/icemcfd/output-interfaces/fluent6 -dom $mesh \
	-b $bc $data(solvedir)/$name-fluent
}

proc ::Refinement::FindMaxSize {} {
    if ![ic_uns_is_loaded] {return 0}
    ic_uns_subset_delete metric_map
    ic_uns_subset_create metric_map 0
    ic_uns_update_family_type metric_map [ic_uns_list_families] TETRA_4 update 1
    set ret [ic_uns_metric metric_map Volume]
    set max [lindex $ret 4] 
    ic_uns_subset_delete metric_map
    # Max volume element normally occurs interior and is equilateral:  V=(1/12) * (2^(0.5)) * (a^3)
    # solve for "a" which is length of side
    set max_size [expr {2.039648902655505 * pow($max,1 / 3.0)}]
    return $max_size
}

proc ::Refinement::AdjustNumLayers {max_size law height ratio} {
    if {$height == 0 || $height == ""} return
    if {$ratio == 0 || $ratio == ""} return
    set total_hgt [expr {0.25 * $max_size}]
    set hr [expr {$total_hgt / $height}]
    set max_layers_allowed 300
    set reff 0.0
    set ratio_1 [expr {$ratio - 1}]
    for {set n 0} {$n < $max_layers_allowed} {incr n} {
	if {$law == "exponential"} {
	    set reff [expr {$reff + pow($ratio,$n)}]
	} elseif {$law == "linear"} {
	    set reff [expr {$reff + $n * $ratio_1 + 1}]
	} elseif {$law =="wb-exponential"} {
	    mess "Using ICEM CFD exponential for now instead of wb-exponential" blue
	    set reff [expr {$reff + pow($ratio,$n)}]
	}
	if {$reff > $hr} break
    }
    return $n
}

proc ::Refinement::RunBatch {paramfile} {
    variable data

    set pfile [open $paramfile r]
    while {[gets $pfile txt] >= 0} {
	    set var [lindex $txt 0]
	    set data($var) [lrange $txt 1 end]
    }
    close $pfile
    Mesh
}

proc ::Refinement::CheckPrismReturn {ok logfile prism_dom} {
    if !$ok {
	mess "Error: prism exited with a non-zero status\n" red
    } elseif [catch {open $logfile r} fp] {
	mess "Error: $fp\n" red
	set ok 0
    } else {
	set ok 0
	while {[gets $fp line] >= 0} {
	    if {$line == "prism finished"} {
		set ok 1
		break
	    }
	}
	catch {close $fp}
	if !$ok {
	    mess "Error: prism terminated prematurely\n" red
	}
    }
    if {$ok && ![file exists $prism_dom]} {
	mess "Error: prism didn't create $prism_dom\n" red
	set ok 0
    }
    return $ok
}

# procedure taken from lib/guibase/interrupt.tcl and redefined
proc interrupt {what args} {
    global interrupt_pending
    upvar #0 ::Refinement::appdata appdata

    busy reset
    switch $what {
	init {
	    # Called by C code
	}
	init2 {
	    catch {unset interrupt_pending}
	    pack $appdata(stopbutton) -side left -pady 0
	}
	set {
	    if {$args == ""} { set args 1 }
	    set interrupt_pending $args
	    if [batch_interp eval info exists ::application_running] {application_terminated 0}
	}
	finish {
	    # Called by C code
	}
	finish2 {
	    busy 0
	    if [info exists interrupt_pending] {mess "Application stopped by user\n" red}
	    catch {unset interrupt_pending}
	    pack forget $appdata(stopbutton)
	}
	check {
	    # This part is checked by the C code to stop when return nonzero
	    if [info exists interrupt_pending] {
		return $interrupt_pending
	    } else {
		return 0
	    }
	}
    }
}

set ::AIEnv::GUIManagement::GUIDisplayData("LabelFont") "{MS Sans Serif} -12 bold"
set ::small_screen_hack 0
# Taken from procedure select_families except the familes are now an argument and it has been simplified
proc ::Refinement::select_families {parts colors {mess ""} {wpos +300+300} {title ""}} {
    global family_part_select
    
    set family_part_select ""
   
    set batch_mode_current $::batch_mode
    set ::batch_mode 0
    form_kill .family_part_select
    set ::batch_mode $batch_mode_current

    if {$title == ""} {
	set title "Select part"
    }

    set buts [list cancel]

    set d [form_init .family_part_select $title "" $buts]
    set n 0

    if {$mess != ""} {
        form_label $d.mess $mess {0 0}
        $d.mess configure -justify l
    }

    set fams ""
    foreach f $parts {
        lappend fams [lindex [split $f :] 0]
    }

    if {[llength $fams] > 10} {
        set sw [form_scroller $d.stuff 300 {1 0}]
    } else {
        set sw $d.stuff; form_frame $sw ridge 2 {1 0}
    }

    set nfam [llength $fams]
    set nrow [expr ($nfam + 2) / 3]
    foreach fam $fams col $colors {
#        set col [family_color_for_name $fam]
        if {[string length $fam] > 20} {
            set famn "[string range $fam 0 18]..."
            set bubble_create($fam) 1
        } else {
            set famn $fam
        }
        set r [expr $n % $nrow]
        set c [expr $n / $nrow]
        form_button $sw.but$n $famn "set family_part_select \"$fam\"; form_done .family_part_select" "$r $c"
        bubble_clear $sw.but$n
        if [info exists bubble_create($fam)] {
            bubble_define $sw.but$n "$fam"
        }
        $sw.but$n configure -background $col -activebackground $col -width 20
        incr n
    }

    form_finish $wpos
    if [llength $fams] {
        form_scroller_hack $d.stuff
    }
    if ![form_wait .family_part_select] { return "" }
    if {$family_part_select == ""} {
        return ""
    } else {
        return [string toupper $family_part_select]
    }
}

# Used in run_application_batch_exec_direct
proc message_add_button {args} {}
proc message_enable_button {args} {}
proc message_remove_button {args} {}

