
# Deal with bocos
#
# Copyright (c) 1995 ICEM CFD Engineering
# Author:  Wayne A. Christopher, wayne@pmac.com
#          Pacific Marketing and Consulting, Berkeley, California
#

proc auto_bocos_edit {} {
    auto_bocos_families
    famboco_edit
}

proc auto_bocos_save {} {
    auto_bocos_families
    famboco_save [directory tetin]/family_boco
}

proc auto_list_families {add_flag} {
    global auto_fam_type boco_data default_fluid_family default_side_family

    catch {unset auto_fam_type}

    foreach f {DEF_SURF DEF_CURV DEF_PNT} { set found($f) 1 }

    if [info exists default_fluid_family] {
	set found($default_fluid_family) 1
    }
    if [info exists default_side_family] {
	set found($default_side_family) 1
    }
    foreach obj [db_list_objects_recursive] {
      foreach sect [$obj getval section_list] {
	set sh [$obj getval ${sect}_shape]
	if {($sh == "") || ([$sh get -type] == "shape_none")} continue
	foreach vv [$obj list_values] {
	    if [string match fam_* [lindex $vv 0]] {
		set is_vol [expr {[lindex $vv 0] == "fam_int"}]
		set is_wire [expr {[lindex $vv 0] == "fam_edge"}]
		set is_curve [expr {[lindex $vv 0] == "fam_curve"}]

		set fams [string toupper [lindex $vv 1]]
		if ![llength $fams] {
		    set fams [list {}]
		}

		foreach ff $fams {
		    if {($ff == "") && $is_vol} {
			set ff [string toupper [$obj getval name]]
			set found($ff) 0
		    } elseif {$ff == ""} {
			set ff $default_side_family
			set found($ff) 1
		    } else {
			set found($ff) 1
		    }
		    if $is_vol {
			set ftype [$obj si_value type]
		    } elseif $is_wire {
			if {![catch {$sh get -nverts} nv] && $nv < 2} {
			    set ftype point
			} else {
			    set ftype edge
			}
		    } elseif $is_curve {
			set ftype curve
		    } else {
			set ftype face
		    }
		    switch $ftype {
			non-meshed continue
			meshed { set ftype solid }
		    }

		    if 0 {
			this is not a useful comment
			if {[info exists auto_fam_type($ff)] && \
				($auto_fam_type($ff) != $ftype)} {
			    mess "Warning: family $ff is used for both\
			$ftype and $auto_fam_type($ff) families\n" red
			}
		    }
		    set auto_fam_type($ff) $ftype

		    if {[info exists boco_data($ff)] && \
			    [string match +* $boco_data($ff)]} {
			set mf [string range [lindex $boco_data($ff) 0] 1 end]
			set mf [string toupper [string trim $mf]]
			if {$mf != ""} {
			    set found($mf) 1
			    set auto_fam_type($mf) solid
			}
		    }
		}
	    }
	}
      }
    }
    set ret ""
    foreach f [lsort [array names found]] {
	if {$f == ""} continue
	if {$add_flag == ""} {
	    lappend ret [list $f $found($f)]
	} elseif {$add_flag == $found($f)} {
	    lappend ret $f
	}
    }
    if ![info exists auto_fam_type($default_fluid_family)] {
	set auto_fam_type($default_fluid_family) solid
    }
    return $ret
}

proc auto_bocos_families {} {
    global reduced_group full_element_set famboco_data
    global tetin_surface_fams

    array set odata [array get famboco_data]
    catch {unset famboco_data}

    set fams [auto_list_families ""]
    set retfams ""
    foreach ff $fams {
	set f [lindex $ff 0]
	if [info exists odata($f)] {
	    set famboco_data($f) $odata($f)
	} else {
	    set famboco_data($f) ""
	}
	if {[lsearch {DEF_SURF DEF_CURV DEF_PNT ""} $f] < 0} {
	    lappend retfams $ff
	}
    }
    if [info exists tetin_surface_fams] {
	foreach f $tetin_surface_fams {
	    lappend famboco_data($f) "1 INT"
	}
    }
    return $retfams
}

proc auto_bocos_setpids {{full full} {reduced reduced}} {
    global ${full}_unstruct ${reduced}_group ${reduced}_group_extras
    global grid_mapping default_fluid_family default_side_family
    global domain_family_pid domain_pid_family

    catch {unset domain_family_pid}

    set deff WALL
    if [info exists default_side_family] { set deff $default_side_family }

    # This file could be used by sub2fam but actually in autohex
    # it's not.
    set sfp [open [directory]/subset_families w]
    puts $sfp "default 1 \"FLUID\""

    set unstr [set ${full}_unstruct]

    set flpid 1
    set curpid 2
    foreach set [$unstr list_sets] {
	$set set_pids 0 -1 $flpid
	if [info exists default_fluid_family] {
	    set domain_family_pid($default_fluid_family) $flpid
	} else {
	    set domain_family_pid(FLUID) $flpid
	}
    }
    foreach dom [array names ${reduced}_group] {
	set obj [lindex $grid_mapping([lindex $dom 0]) 0]
	if {$obj == ""} continue

	set sh [$obj getval body_shape]
	if {$sh == ""} continue

	set map [set ${reduced}_group($dom)]
	if ![$map count] continue

	set side [lindex $dom 1]
	if {!$side && ([$obj si_value type] == "fluid")} continue

	set fams [family_for_side $obj $sh $side]
	if {$fams == ""} { set fams $deff }
	if {$fams == ""} {
	    # Delete these elements since they have no family.
	    $map delete_with_flag 0 65536
	    continue
	}

	puts $sfp "subset \"$dom\" \"$fams\""

	set fam [lindex $fams 0]
	set others [lrange $fams 1 end]
	if ![info exists domain_family_pid($fam)] {
	    set domain_family_pid($fam) $curpid
	    incr curpid
	}
	$map set_pids $domain_family_pid($fam) -1
	foreach ofam $others {
	    set nn ${reduced}_group_extras($dom,$ofam)
	    if ![info exists $nn] {
		if ![info exists domain_family_pid($ofam)] {
		    set domain_family_pid($ofam) $curpid
		    incr curpid
		}

		set omap [element_map -mesh $unstr]
		$omap copy_create_elements $map
		$omap set_pids $domain_family_pid($ofam) -1
		set $nn $omap
	    }
	}
    }

    # Now, we need to delete all the flat elements that have the fluid pid.
    # HOWEVER, don't delete the bars.  Emax needs them.  Put them in another
    # family called __UNUSED__.
    foreach t {QUAD_4 TRI_3} {
	set ss [$unstr list_type_sets $t]
	if {$ss == ""} continue
	set n 0
	foreach s $ss { incr n [$s delete_with_pid $flpid -1] }
	if $n { puts "Deleted $n stray surface elements with pid $flpid." }
    }
    set maxp 3
    set unused 0
    foreach dd [array names domain_family_pid] {
	if {$dd == "__UNUSED__"} {
	    set unused $domain_family_pid($dd)
	    break
	}
	if {$domain_family_pid($dd) > $maxp} {
	    set maxp $domain_family_pid($dd)
	}
    }
    if !$unused {
	set unused [expr $maxp + 1]
	set domain_family_pid(__UNUSED__) $unused
    }
    foreach t {BAR_2 NODE} {
	set ss [$unstr list_type_sets $t]
	if {$ss == ""} continue
	set n 0
	foreach s $ss { incr n [$s change_pid $flpid $unused -1] }
	if $n { puts "Changed $n $t elements from fluid to __UNUSED__." }
    }

    close $sfp

    catch {unset domain_pid_family}
    foreach f [array names domain_family_pid] {
	if [string match DEF_* $f] continue
	set domain_pid_family($domain_family_pid($f)) $f
    }
}

proc object_family_list_with_bocos {obj} {
    global famboco_data

    set fams ""
    foreach vv [$obj list_values] {
 	if [string match fam_* [lindex $vv 0]] {
 	    set f [string toupper [lindex $vv 1]]
 	    if [info exists famboco_data($f)] {
 		lappend fams $f
 	    }
 	}
    }
    return $fams
}

proc highlight_object_sides_in_family {fam} {
    global prev_object_side_highlight famboco_data

    if [info exists prev_object_side_highlight] {
	foreach sh $prev_object_side_highlight { catch {$sh set_highlight} }
	unset prev_object_side_highlight
    }
    if {$fam == ""} return

    foreach {sh nums} [get_object_sides_in_family $fam -1] {
	eval $sh set_highlight $nums
	lappend prev_object_side_highlight $sh
    }
}

proc get_object_sides_in_family {fam dim} {
    global famboco_data

    set ret ""
    foreach obj [db_list_objects] {
	if ![$obj si_value active] continue

	set sides ""
	foreach vv [$obj list_values] {
	    set pn [lindex $vv 0]
	    if [string match fam_* $pn] {
		if {($dim == 3) && ($pn != "fam_int")} continue
		if {($dim == 2) && ($pn == "fam_int")} continue
		set f [string toupper [lindex $vv 1]]
		if {$f == $fam} {
		    lappend sides [string range [lindex $vv 0] 4 end]
		}
 	    }
 	}
	if {$sides != ""} {
            set proc app_get_sides_in_family_[$obj getval obtype]
            if {[info commands $proc] != ""} {
                catch {unset smap}
                foreach s $sides {
                    foreach {sh nums} [$proc $obj $s] {
                        if {![info exists smap($sh)]} {
                            set smap($sh) ""
                        }
                        eval lappend smap($sh) $nums
                        lappend ret $sh $nums
                    }
                }
                foreach sh [array names smap] {
                    lappend ret $sh $smap($sh)
                }
            } else {
                foreach sh [db_shapes $obj] {
                    catch {unset smap} ; set smap(int) 0

                    if [$obj checkval fam_face] {
                        set sidelist [list [list 0 face]]
                    } else {
                        set sidelist [$sh list_sides 1]
                    }
                    foreach ss $sidelist {
                        set smap([lindex $ss 1]) [lindex $ss 0]
                    }
                    set nums ""
                    foreach s $sides {
                        if [info exists smap($s)] {
                            lappend nums $smap($s)
                        } elseif {([$sh get -shtype] == "polygon") &&
                                  ($s == "sides")} {
                            # This is a special thing.
                            lappend nums 3
                        }
                    }
                    lappend ret $sh $nums
                }
            }
	}
    }
    return $ret
}
