
# Form construction routines for individual object types.

# Copyright (c) 1993, 1994 Pacific Marketing and Consulting
# Author:  Wayne A. Christopher, wayne@pmac.com
#          Pacific Marketing and Consulting, Berkeley, California

proc family_listentry_all {face} {
    global additional_families auto_fam_type

    set fams1 [auto_list_families ""]
    set fams ""
    foreach f $fams1 {
	set f [lindex $f 0]
	if [info exists auto_fam_type($f)] {
	    switch $auto_fam_type($f) {
		solid { if {$face == 0} { lappend fams $f } }
		face  { if {$face == 1} { lappend fams $f } }
		edge  { if {$face == 2} { lappend fams $f } }
	    }
	}
    }

    if [info exists additional_families($face)] {
	set fams [concat $fams $additional_families($face)]
    }
    foreach f $fams { set found($f) 1 }
    set fams [lsort [array names found]]

    return $fams
}

proc family_listentry {d name title row what flag {allow_change 1}} {
    global tk_entry_use_uppercase

    form_label $d.faml_$name $title "$row 0"
    if $allow_change {
	futil_listentry $d.fam_$name model_data(fam_$name) \
	    "family_listentry_all $flag" "$row 1" "" "" 1
	set ent $d.fam_$name.e
    } else {
	form_entry $d.fam_$name model_data(fam_$name) string "$row 1"
	$d.fam_$name configure -state disabled
	set ent $d.fam_$name
    }
    $d.fam_$name configure -width 20
    bind $d.fam_$name <FocusIn> "set_current_highlight $what"
    bind $d.fam_$name <FocusOut> "set_current_highlight {}"
    bind $d.fam_$name <Visibility> {
	if ![winfo ismapped %W] { set_current_highlight {} }
    }
    # We should create some more general way to say "this entry is upper case
    # only
    set tk_entry_use_uppercase($ent) 1
}

proc set_current_highlight {what} {
    global current_shape current_object

    if {$current_object != ""} {
        set proc app_set_highlight_[$current_object getval obtype]
        if {[info commands $proc] != ""} {
            $proc $what
            return
        }
    }
    if {$current_shape != ""} {
	eval $current_shape set_highlight $what
    }
}

array set summary_family_names {
    int   "Interior"
    minx  "Min X"
    maxx  "Max X"
    miny  "Min Y"
    maxy  "Max Y"
    minz  "Min Z"
    maxz  "Max Z"
    bot   "Bottom"
    top   "Top"
    sides "Sides"
    face  "Face"
}

proc summary_families {obj prefs} {
    global summary_family_names

    set lines ""
    foreach pref $prefs {
	set fam [$obj getval fam_$pref]
	if {$fam != ""} {
	    lappend lines [list "$summary_family_names($pref) family" $fam]
	}
    }
    return $lines
}

proc assign_face_families {} {
    global default_side_family

    mess "Automatically changing all $default_side_family families to\
	the names of the objects they're on.\n"
    foreach obj [db_list_objects] {
	set ff face_[$obj getval name]
	foreach val [$obj list_values] {
	    if [string match fam_* [lindex $val 0]] {
		if {[lindex $val 1] == $default_side_family} {
		    $obj setval [lindex $val 0] $ff
		}
	    }
	}
    }
    db_dirty model
}

proc volume_types_form {d geo} {
    global volume_types

    form_frame $d.type flat 2 $geo
    form_label $d.type.lab "Type:" {0 0}
    set c 1
    foreach t $volume_types {
	form_radiobutton $d.type.$t [string totitle $t] model_data(type) \
	    $t "0 $c"
	incr c
    }
}

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

proc app_summary_domain_brief {obj} {
    return [summary_shapeinfo $obj brief]
}

proc app_summary_domain_detailed {obj} {
    return [summary_shapeinfo $obj detailed]
}

proc app_verify_domain {obj} {
    global grid_type

    set sht [[$obj getval body_shape] get -shtype]
    if {($grid_type == "auto") && (($sht != "hexa") && ($sht != "none"))} {
	return "Non-prism domains can't be used with the Auto Mesher."
    } else {
	return ""
    }
}

proc app_make_form_domain {d} {
    global disable_edit_domain_families

    set allow [expr ![info exists disable_edit_domain_families]]
    
    family_listentry $d minx "Min X family" 2 1 1 $allow
    family_listentry $d maxx "Max X family" 3 2 1 $allow
    family_listentry $d miny "Min Y family" 4 3 1 $allow
    family_listentry $d maxy "Max Y family" 5 4 1 $allow
    family_listentry $d minz "Min Z family" 6 5 1 $allow
    family_listentry $d maxz "Max Z family" 7 6 1 $allow
    form_label $d.coll "Object color" {20 0}
    futil_colorentry $d.col model_data(obj_color) {20 1}
}

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

proc app_make_form_hexa {d} {
    volume_types_form $d {0 0 -cols -}
    
    family_listentry $d int "Interior family" 1 0 0
    family_listentry $d minx "Min X family" 2 1 1
    family_listentry $d maxx "Max X family" 3 2 1
    family_listentry $d miny "Min Y family" 4 3 1
    family_listentry $d maxy "Max Y family" 5 4 1
    family_listentry $d minz "Min Z family" 6 5 1
    family_listentry $d maxz "Max Z family" 7 6 1
    form_label $d.coll "Object color" {20 0}
    futil_colorentry $d.col model_data(obj_color) {20 1}
}

proc app_clean_up_hexa {obj} {
    switch [$obj getval type] {
	hollow - conductor - non-meshed { [db_shapes $obj 0] setval volume_flag 0 }
	solid - meshed { [db_shapes $obj 0] setval volume_flag 1 }
	fluid - air  { [db_shapes $obj 0] setval volume_flag 2 }
    }
}

proc app_summary_hexa_brief {obj} {
    return [summary_shapeinfo $obj brief]
}

proc app_summary_hexa_detailed {obj} {
    return [concat [summary_shapeinfo $obj detailed] \
		[list [summary_get $obj type] ""] \
		[summary_families $obj "int minx maxx miny maxy minz maxz"]]
}

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

proc app_make_form_cyl {d} {
    volume_types_form $d {0 0 -cols -}
    
    family_listentry $d int   "Interior family" 1 0 0
    family_listentry $d bot   "Bottom family"   2 1 1
    family_listentry $d top   "Top family"      3 2 1
    family_listentry $d sides "Sides family"    4 3 1
    form_label $d.coll "Object color" {20 0}
    futil_colorentry $d.col model_data(obj_color) {20 1}
}

proc app_clean_up_cyl {obj} {
    switch [$obj getval type] {
	hollow - conductor - non-meshed { [db_shapes $obj 0] setval volume_flag 0 }
	solid - meshed { [db_shapes $obj 0] setval volume_flag 1 }
	fluid - air  { [db_shapes $obj 0] setval volume_flag 2 }
    }
}

proc app_summary_cyl_brief {obj} {
    return [summary_shapeinfo $obj brief]
}

proc app_summary_cyl_detailed {obj} {
    return [concat [summary_shapeinfo $obj detailed] \
		[list [summary_get $obj type] ""] \
		[summary_families $obj "int bot top sides"]]
}

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

proc app_make_form_polygon {d} {
    global polygon_property_form_list
    
    volume_types_form $d {0 0 -cols -}
    
    set sw [ScrolledWindow $d.f]
    grid $d.f -row 1 -column 0 -columnspan 2 -sticky news
    set sf [ScrollableFrame $sw.f -height 300]
    $sw setwidget $sf
    set subf [$sf getframe]
    
    family_listentry $subf int   "Interior family" 1 0 0
    family_listentry $subf bot   "Bottom family"   2 1 1
    family_listentry $subf top   "Top family"      3 2 1
    #family_listentry $subf side1 "Side 1 family"   4 3 1
    #family_listentry $subf side2 "Side 2 family"   5 4 1
    #family_listentry $subf side3 "Side 3 family"   6 5 1
    
    form_label $d.coll "Object color" {100 0}
    futil_colorentry $d.col model_data(obj_color) {100 1}
    
    lappend polygon_property_form_list $subf
}

proc app_after_change_polygon_num_sides {} {
    global polygon_property_form_list shape_data
    
    if [info exists polygon_property_form_list] {
	foreach d $polygon_property_form_list {
	    if [winfo exists $d] {
		set found {}
		foreach c [winfo children $d] {
		    set n [lindex [split $c .] end]
		    if {[string match fam_side* $n] ||
			[string match faml_side* $n]} {
			lappend found $c
		    }
		}
		set ns $shape_data(nverts)
		if {$ns != [llength $found] / 2} {
		    foreach c $found { destroy $c }
		    for {set n 1} {$n <= $ns} {incr n} {
			family_listentry $d side$n "Side $n family" \
			    [expr $n + 3] [expr $n + 2] 1
		    }
		}
		
		# There is some bug where these widgets disappear.  I don't 
		# know what causes it but this fixes it (yuck) -Wayne
		destroy $d.fam_int
		destroy $d.fam_bot
		destroy $d.fam_top
		destroy $d.faml_int
		destroy $d.faml_bot
		destroy $d.faml_top
		family_listentry $d int   "Interior family" 1 0 0
		family_listentry $d bot   "Bottom family"   2 1 1
		family_listentry $d top   "Top family"      3 2 1
	    }
	}
    }
}

proc app_after_form_post_polygon {} {
    global polygon_form_hack current_object

    # This is a big pain.
    if {[$current_object getval current_stype] == "polygon"} {
	if [info exists polygon_form_hack] {
	    foreach w $polygon_form_hack {
		edit_poly_win_populate $w
	    }
	}
    }
}

proc app_clean_up_polygon {obj} {
    global new_polygon_sides_get_family

    switch [$obj getval type] {
	hollow - conductor - non-meshed { [db_shapes $obj 0] setval volume_flag 0 }
	solid - meshed { [db_shapes $obj 0] setval volume_flag 1 }
	fluid - air  { [db_shapes $obj 0] setval volume_flag 2 }
    }
    if [info exists new_polygon_sides_get_family] {
	set ns [[db_shapes $obj 0] getval nverts]
	for {set i 1} {$i <= $ns} {incr i} {
	    if ![$obj checkval fam_side$i] {
		$obj setval fam_side$i $new_polygon_sides_get_family
	    }
	}
    }
}

proc app_summary_polygon_brief {obj} {
    return [summary_shapeinfo $obj brief]
}

proc app_summary_polygon_detailed {obj} {
    return [concat [summary_shapeinfo $obj detailed] \
		[list [summary_get $obj type] ""] \
		[summary_families $obj "int bot top sides"]]
}

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

proc app_make_form_incline {d} {
    volume_types_form $d {1 0 -cols -}

    family_listentry $d int   "Interior family" 10 0 0
    family_listentry $d bot   "Bottom family"   11 1 1
    family_listentry $d top   "Top family"      12 2 1
    family_listentry $d sides "Sides family"    13 3 1
    form_label $d.coll "Object color" {20 0}
    futil_colorentry $d.col model_data(obj_color) {20 1}
}

proc app_clean_up_incline {obj} {
    switch [$obj getval type] {
	hollow - conductor - non-meshed { [db_shapes $obj 0] setval volume_flag 0 }
	solid - meshed { [db_shapes $obj 0] setval volume_flag 1 }
	fluid - air  { [db_shapes $obj 0] setval volume_flag 2 }
    }
}

proc app_summary_incline_brief {obj} {
    return [summary_shapeinfo $obj brief]
}

proc app_summary_incline_detailed {obj} {
    return [concat [summary_shapeinfo $obj detailed] \
		[list [summary_get $obj type] ""] \
		[summary_families $obj "int bot top sides"]]
}

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

proc app_make_form_quad {d} {
    family_listentry $d face "Face family" 1 0 1
    form_label $d.coll "Object color" {20 0}
    futil_colorentry $d.col model_data(obj_color) {20 1}
}

proc app_summary_quad_brief {obj} {
    return [summary_shapeinfo $obj brief]
}

proc app_summary_quad_detailed {obj} {
    return [concat [summary_shapeinfo $obj detailed] [list ""] \
		[summary_families $obj "face"]]
}

proc app_clean_up_quad {obj} { }

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

proc app_make_form_circ {d} {
    family_listentry $d face "Face family" 1 0 1
    form_label $d.coll "Object color" {20 0}
    futil_colorentry $d.col model_data(obj_color) {20 1}
}

proc app_summary_circ_brief {obj} {
    return [summary_shapeinfo $obj brief]
}

proc app_summary_circ_detailed {obj} {
    return [concat [summary_shapeinfo $obj detailed] [list ""] \
		[summary_families $obj "face"]]
}

proc app_clean_up_circ {obj} { }

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

proc app_make_form_sphere {d} {
    global sphere_property_form_list
    
    volume_types_form $d {0 0 -cols -}
    
    family_listentry $d int "Interior family" 1 0 0
    family_listentry $d sides "Outside family" 2 1 1
    #family_listentry $d inner "Inner surface family" 3 2 1
    form_label $d.coll "Object color" {20 0}
    futil_colorentry $d.col model_data(obj_color) {20 1}
    
    # HACK
    lappend sphere_property_form_list $d
    app_after_change_sphere_num_sides
}

proc app_after_change_sphere_num_sides {} {
    global sphere_property_form_list shape_data current_shape
    
    if [info exists sphere_property_form_list] {
	foreach d $sphere_property_form_list {
	    if [winfo exists $d] {
		foreach c [winfo children $d] {
		    set n [lindex [split $c .] end]
		    if {[string match fam_inner* $n] ||
			[string match faml_inner* $n]} {
			lappend found($n) 1
		    }
		}
		foreach ins [$current_shape list_sides 0] {
		    set n [lindex $ins 0]
		    if {$n < 2} continue
		    set p [expr $n - 2]
		    if [info exists found(fam_inner$p)] {
			unset found(fam_inner$p)
			unset found(faml_inner$p)
			continue
		    }
		    set pn [lindex {
			-x-y +x-y -x+y +x+y
			-y-z +y-z -y+z +y+z
			-z-x +z-x -z+x +z+x
		    } $p]
		    family_listentry $d inner$p "Inner surface $pn family" \
			[expr $n + 1] $n 1
		}
		foreach f [array names found] {
		    destroy $d.$f
		}
	    }
	}
    }
}

proc app_clean_up_sphere {obj} {
    switch [$obj getval type] {
	hollow - conductor - non-meshed { [db_shapes $obj 0] setval volume_flag 0 }
	solid - meshed { [db_shapes $obj 0] setval volume_flag 1 }
	fluid - air  { [db_shapes $obj 0] setval volume_flag 2 }
    }
}

proc app_summary_sphere_brief {obj} {
    return [summary_shapeinfo $obj brief]
}

proc app_summary_sphere_detailed {obj} {
    return [concat [summary_shapeinfo $obj detailed] \
		[list [summary_get $obj type] ""] \
		[summary_families $obj "int c000 c001 c010 c011 c100 c101 c110 c111"]]
}

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

proc app_make_form_oval {d} {
    global oval_property_form_list
    
    volume_types_form $d {0 0 -cols -}
    
    family_listentry $d int   "Interior family" 1 0 0
    family_listentry $d bot   "Bottom family"   2 1 1
    family_listentry $d top   "Top family"      3 2 1
    family_listentry $d sides "Sides family"    4 3 1
    family_listentry $d irad  "Inner radius family" 5 4 1
    form_label $d.coll "Object color" {20 0}
    futil_colorentry $d.col model_data(obj_color) {20 1}

    # HACK
    lappend oval_property_form_list $d
    app_after_change_oval_num_sides
}

proc app_after_change_oval_num_sides {} {
    global oval_property_form_list shape_data current_shape
    
    if [info exists oval_property_form_list] {
	foreach d $oval_property_form_list {
	    if [winfo exists $d] {
		foreach c [winfo children $d] {
		    set n [lindex [split $c .] end]
		    if {[string match fam_inner* $n] ||
			[string match faml_inner* $n]} {
			lappend found($n) 1
		    }
		}
		foreach ins [$current_shape list_sides 0] {
		    set n [lindex $ins 0]
		    if {$n < 5} continue
		    set p [expr $n - 5]
		    if [info exists found(fam_inner$p)] {
			unset found(fam_inner$p)
			unset found(faml_inner$p)
			continue
		    }
		    family_listentry $d inner$p "Inner surface $p family" \
			[expr $n + 1] $n 1
		}
		foreach f [array names found] {
		    destroy $d.$f
		}
	    }
	}
    }
}

proc app_clean_up_oval {obj} {
    switch [$obj getval type] {
	hollow - conductor - non-meshed { [db_shapes $obj 0] setval volume_flag 0 }
	solid - meshed { [db_shapes $obj 0] setval volume_flag 1 }
	fluid - air  { [db_shapes $obj 0] setval volume_flag 2 }
    }
}

proc app_summary_oval_brief {obj} {
    return [summary_shapeinfo $obj brief]
}

proc app_summary_oval_detailed {obj} {
    return [concat [summary_shapeinfo $obj detailed] \
		[list [summary_get $obj type] ""] \
		[summary_families $obj "int bot top sides irad"]]
}

proc app_okay_to_mesh_oval {for_auto_mesher obj} {
    global domain
    
    if !$for_auto_mesher { return "" }
    set sh [$obj getval body_shape]
    if {([$sh getval sflag000] + [$sh getval sflag001] + \
	     [$sh getval sflag010] + [$sh getval sflag011]) == 4} { return "" }
    set domsh [$domain getval body_shape]
    set dbbox [$domsh get_bbox]
    
    if {$dbbox == ""} {
	return "Partial ellipsoidal cylinder \"[$obj getval name]\" can't be used with a non-meshed analysis space and a hexa mesh (for now)."
    }
    set tol [expr [$sh getval shortest] / 1000.0]
    set cent ""
    foreach p1 [$sh si_value center] p2 [$sh si_value center2] {
	lappend cent [expr ($p1 + $p2) / 2.0]
    }
    
    set ok 0
    foreach i {0 1 2} {
	set cv [expr ([lindex [$sh si_value center] $i] + [lindex [$sh si_value center2] $i]) / 2.0]
	foreach s {0 1} {
	    set p [lindex [lindex $dbbox $s] $i]
	    if {abs($cv - $p) < $tol} { set ok 1; break }
	}
    }
    if $ok {
	return ""
    } else {
	return "Partial ellipsoidal cylinder \"[$obj getval name]\" should be next to an symmetry wall for a hexa mesh (for now)."
    }
}

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

if {[info command app_make_form_cad] == ""} {
    # this is overridden in emax
    
proc app_make_form_cad {d} {
    volume_types_form $d {0 0 -cols -}
    
    family_listentry $d point    "Point family"    1 0 0
    family_listentry $d curve    "Curve family"    2 1 1
    family_listentry $d surface  "Surface family"  3 2 1
    family_listentry $d material "Material family" 4 3 1
    form_label $d.coll "Object color" {20 0}
    futil_colorentry $d.col model_data(obj_color) {20 1}
}

proc app_clean_up_cad {obj} {
    switch [$obj getval type] {
	hollow - conductor - non-meshed { [db_shapes $obj 0] setval volume_flag 0 }
	solid - meshed { [db_shapes $obj 0] setval volume_flag 1 }
	fluid - air  { [db_shapes $obj 0] setval volume_flag 2 }
    }
}

proc app_summary_cad_brief {obj} {
    return [summary_shapeinfo $obj brief]
}

proc app_summary_cad_detailed {obj} {
    return [concat [summary_shapeinfo $obj detailed] \
		[list [summary_get $obj type] ""] \
		[summary_families $obj "point curve surface material"]]
}

}

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

proc app_make_form_pipe {d} {
    global object_type_title
    
    # hack
    if {$object_type_title(pipe) == "Pipe"} {
	volume_types_form $d {0 0 -cols -}
	
	family_listentry $d int   "Interior family" 1 0 0
	family_listentry $d bot   "Bottom family"   2 1 1
	family_listentry $d top   "Top family"      3 2 1
	family_listentry $d sides "Sides family"   4 3 1
    
    } else {
	family_listentry $d edge "Edge family" 1 0 2
    }
    form_label $d.coll "Object color" {20 0}
    futil_colorentry $d.col model_data(obj_color) {20 1}
}


proc app_after_form_post_pipe {} {
    global pipe_form_hack current_object
    
    # This is a big pain.
    if {[$current_object getval current_stype] == "pipe"} {
	if [info exists pipe_form_hack] {
	    foreach w $pipe_form_hack {
		edit_pipe_win_populate $w
	    }
	}
    }
}

proc app_clean_up_pipe {obj} {
    switch [$obj getval type] {
	hollow - conductor - non-meshed { [db_shapes $obj 0] setval volume_flag 0 }
	solid - meshed { [db_shapes $obj 0] setval volume_flag 1 }
	fluid - air  { [db_shapes $obj 0] setval volume_flag 2 }
    }
}

proc app_summary_pipe_brief {obj} {
    return [summary_shapeinfo $obj brief]
}

proc app_summary_pipe_detailed {obj} {
    return [concat [summary_shapeinfo $obj detailed] \
		[list [summary_get $obj type] ""] \
		[summary_families $obj "int bot top sides"]]
}

proc app_initialize_pipe {obj sh shname domain} {
    global pipe_cur_vert current_shape shape_data shape_data_units
    
    switch $shname {
	"" { return 0 }
	body {
	    # If the user was previously editing a pipe, just initialize the
	    # new one to extend off the end of the old one.
	    if ![info exists pipe_cur_vert] { return 0 }
	    if {$current_shape == ""} { return 0 }
	    set ch $pipe_cur_vert
	    set ch1 [expr $pipe_cur_vert - 1]
	    if ![info exists shape_data(x$ch1)] { incr ch; incr ch1 }
	    
	    set ipt ""; set ipt2 ""
	    foreach v {x y z} {
		if ![info exists shape_data($v$ch)] { return 0 }
		set v1 [unit_convert $shape_data($v$ch) \
			$shape_data_units($v$ch) 0]
		set v2 [unit_convert $shape_data($v$ch1) \
			$shape_data_units($v$ch1) 0]
		lappend ipt $v1
		lappend ipt2 [expr $v1 * 2 - $v2]
	    }
	    $sh setval -noconstr nverts 2
	    $sh setval -noconstr vert1 $ipt vert2 $ipt2
	}
    }
    return 1
}
