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

# The slack values are associated with the shape.

set object_params(part) {
    { "Part project name"
      part_job "string" ""
      {} {}
      "" {} {}
    }
    { "Loaded name"
      part_job_loaded "string" ""
      {} {}
      "" {} {}
    }
    { "Part type"
      part_type "string" "internal"
      {} {}
      "" {} {}
    }
    { "X offset"
      xp "float" "0"
      {} {}
      "" {} {}
    }
    { "Y offset"
      yp "float" "0"
      {} {}
      "" {} {}
    }
    { "Z offset"
      zp "float" "0"
      {} {}
      "" {} {}
    }
    { "Rotation axis"
      rot_axis "int" "0"
      {} {}
      "" {} {}
    }
    { "Rotation degrees"
      rot_degrees "float" "0"
      {} {}
      "" {} {}
    }
    { "Mirror plane"
      mirror "int" "-1"
      {} {}
      "" {} {}
    }
    { "Scale"
      scale "float" "1"
      {} {}
      "" {} {}
    }
    { "Grid type"
      grid_type "string" ""
      {} {"" auto tetra}
      "" {} {}
    }
    { "Mesh separate"
      mesh_separate "int" "0"
      {} {}
      "" {} {}
    }
    { "Include intersecting"
      mesh_sep_others "int" "1"
      {} {}
      "" {} {}
    }
    { "X min object sep"
      grid_sep_x "float" "0"
      length {}
      "" {} {}
    }
    { "Y min object sep"
      grid_sep_y "float" "0"
      length {}
      "" {} {}
    }
    { "Z min object sep"
      grid_sep_z "float" "0"
      length {}
      "" {} {}
    }
    { "X min size active"
      grid_usesize_x "int" "0"
      {} {}
      "" {} {}
    }
    { "Y min size active"
      grid_usesize_y "int" "0"
      {} {}
      "" {} {}
    }
    { "Z min size active"
      grid_usesize_z "int" "0"
      {} {}
      "" {} {}
    }
    { "X min size"
      grid_size_x "float" "0"
      length {}
      "" {} {}
    }
    { "Y min size"
      grid_size_y "float" "0"
      length {}
      "" {} {}
    }
    { "Z min size"
      grid_size_z "float" "0"
      length {}
      "" {} {}
    }
}

if ![info exists object_type_title(part)] {
    set object_type_title(part) "Assemblies"
}
if ![info exists type_name(part)] {
    set type_name(part) part
}
if {([info command temperature_limit_params] != "") && $is_iceboard} {
    set object_params(part) [concat $object_params(part) [temperature_limit_params]]
}

set object_notebook_pages(part) {
    definition Definition meshing Meshing
}

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

proc app_make_form_part_definition {d} {
    global type_name
    
    form_frame $d.def ridge 2 {0 0 -cols 2}
    form_frame $d.trans ridge 2 {1 0 -cols 2}
    
    form_radiobutton $d.def.p_ext "External $type_name(part)" model_data(part_type) \
	external {0 0 -cols -}
    set extp {{model_data(part_type) external}}
    form_label $d.def.filel "Project definition" {1 1} $extp
    
    form_entry $d.def.file  model_data(part_job) path_tail {1 2} $extp 6 1
    
    set cmd {set model_data(part_job) [file_select_job read] }
    form_button $d.def.fileb "Browse" $cmd {1 3} $extp
    
    form_radiobutton $d.def.p_int "Internal $type_name(part)" model_data(part_type) \
	internal {10 0 -cols -}
    set intp {{model_data(part_type) internal}}
    form_button $d.def.fromg "Define using group" part_def_from_group \
	{11 1} $intp
    
    form_colwidth $d.def 0 4 M
    
    form_label $d.trans.xil "X offset" {20 2 -cols 2}
    form_label $d.trans.yil "Y offset" {21 2 -cols 2}
    form_label $d.trans.zil "Z offset" {22 2 -cols 2}
    model_unitentry $d.trans.xi shape_data(xp) length {20 4 -cols 3}
    model_unitentry $d.trans.yi shape_data(yp) length {21 4 -cols 3}
    model_unitentry $d.trans.zi shape_data(zp) length {22 4 -cols 3}
}

proc app_make_form_part_meshing {d} {
    global type_name
    
    form_frame $d.slack flat 0 {30 0 -cols -}
    form_checkbutton $d.slack.ms "Mesh separately" model_data(mesh_separate) \
	{0 0 -cols 3} "" "db_dirty mesh"
    #form_checkbutton $d.slack.1mso "Include other objects" model_data(mesh_sep_others) {0 3 -cols 3} model_data(mesh_separate)
    form_label $d.slack.l "Slack:" {1 0} model_data(mesh_separate)
    bubble_define_image $d.slack.l slack
    foreach side {minx miny minz maxx maxy maxz} lab \
	{"Min X" "Min Y" "Min Z" "Max X" "Max Y" "Max Z"} \
	r {1 2 3 1 2 3} c {1 1 1 3 3 3} dir {0 1 2 0 1 2} sign {-1 -1 -1 1 1 1} {
	    form_button $d.slack.l$side $lab [list part_slack_align ${side}_slack $dir $lab $sign] "$r $c" model_data(mesh_separate)
	    $d.slack.l$side configure -borderwidth 0 -relief flat -background #ffc090 \
		-activebackground #ffa070
	    incr c
	    model_unitentry $d.slack.$side shape_data(${side}_slack) length \
		"$r $c" model_data(mesh_separate)
	}
    
    form_frame $d.tt flat 0 {40 0 -cols 2}
    form_label $d.tt.l "Minimum gap (0 = global values):" {0 0 -cols -}
    form_label $d.tt.xl "X" {1 1 -anchor e} "" 1 r
    form_label $d.tt.yl "Y" {2 1 -anchor e} "" 1 r
    form_label $d.tt.zl "Z" {3 1 -anchor e} "" 1 r
    
    model_unitentry $d.tt.sx model_data(grid_sep_x) length {1 2} model_data(mesh_separate)
    model_unitentry $d.tt.sy model_data(grid_sep_y) length {2 2} model_data(mesh_separate)
    model_unitentry $d.tt.sz model_data(grid_sep_z) length {3 2} model_data(mesh_separate)
    
    form_label $d.tt.gtypel "Mesh type" {10 0 -cols 2}
    futil_menuentry_labels $d.tt.gtypem model_data(grid_type) \
	{list {"" Default} {hexa_uns "Hexa unstructured"} {hexa_cart "Hexa cartesian"} \
	     {tetra "Tetra"}} {10 2} model_data(mesh_separate)
    
    set act1 [list model_data(mesh_separate)]
    set act2 {and model_data(mesh_separate) {or {model_data(grid_type) hexa_uns hexa_cart} {and {model_data(grid_type) ""} {grid_type_specific hexa_uns hexa_cart}}}}
    form_checkbutton $d.tt.minxl "Max X" model_data(grid_usesize_x) {11 1} $act1
    form_checkbutton $d.tt.minyl "Max Y" model_data(grid_usesize_y) {12 1} $act2
    form_checkbutton $d.tt.minzl "Max Z" model_data(grid_usesize_z) {13 1} $act2
    form_entry $d.tt.x model_data(grid_size_x) float {11 2} \
	[concat model_data(grid_usesize_x) $act1]
    form_entry $d.tt.y model_data(grid_size_y) float {12 2} \
	[list and model_data(grid_usesize_y) $act2]
    form_entry $d.tt.z model_data(grid_size_z) float {13 2} \
	[list and model_data(grid_usesize_z) $act2]
    
    form_colwidth $d.tt 0 2 M
}

proc part_slack_align {var dir lab sign} {
    global current_shape
    
    set bb [$current_shape get_bbox]
    if {$sign == -1} {
	set offsetval [lindex [$current_shape transform_coords_inverse [lindex $bb 0]] $dir]
    } else {
	set offsetval [lindex [$current_shape transform_coords_inverse [lindex $bb 1]] $dir]
    }
    edit_win_align $var $dir shape_data "the $lab slack" $offsetval $sign
}

proc part_def_from_group {} {
    global group_container current_object type_name
    
    set groups [lsort [array names group_container]]
    if {$groups == ""} { 
	user_error "There are no groups defined." 
	return
    }
    
    set ch [choose_one "Select a group for the $type_name(part)." $groups]
    if {$ch == ""} return
    group_to_part $group_container($ch) $current_object
}

proc group_to_part {cont part} {
    #objects_to_part [$cont list_contents] $part
    part_move_object_into $part [$cont list_contents] [tree_part_is_open $part]
}

proc objects_to_part {objects part} {
    global type_name

    busy 1
    set part_is_open [tree_part_is_open $part]
    set psh [$part getval body_shape]
    set objects2 ""
    foreach c $objects {
	if {$c == $part} continue
	if {([$c getval obtype] == "domain") || \
		[$c getval no_geometry_modify 0]} {
	    mess "Warning: you can't put \"[$c getval name]\" into an $type_name(part)\n" red
	    continue
	}
	set obn [$c getval name]
	set ocon [$c get -model_container] 
	if {($ocon != "") && ($ocon != "NULL")} {
	    $ocon remove $obn
	}
	#tree_remove_object $c
	coll_out_without_selection all $c
	$c configure -model_container $part
	$part add $obn $c
	foreach sh [db_shapes $c] {
	    set ocon [$sh get -container]
	    if {($ocon != "") && ($ocon != "NULL")} {
		$ocon remove $sh
	    }
	    $psh add $sh
	    $sh configure -container $psh
	    update_decorations $sh
	}
	reconfigure_object $c
	#tree_add_object $c 1
	lappend objects2 $c
    }
    
    tree_reparent_objects $objects2
    $psh signal_change 1
    busy 0
    undo_record_move_to_part $part $objects2
}

proc part_save_to_job {{obj ""}} {
    global current_object job_name
    
    if {$obj == ""} { set obj $current_object }
    set def_name [file dirname $job_name]/[$obj getval name]
    
    file_save 1 "" $obj 1 $def_name
}

proc part_list_libraries {} {
    global library_path env is_airpak
    
    set ret ""
    foreach lib $library_path {
	if {[info exists is_airpak] && $is_airpak && \
		[info exists env(AIRPAK_ROOT)]} {
	    set lib [replace_string $lib \$AIRPAK_ROOT $env(AIRPAK_ROOT)]
	} elseif {[info exists env(ICEPAK_ROOT)]} {
	    set lib [replace_string $lib \$ICEPAK_ROOT $env(ICEPAK_ROOT)]
	}
	if [file exists $lib/parts] {
	    lappend ret $lib/parts
	}
    }
    return $ret
}

proc part_load {obj {sort_below 1}} {
    global model_container model_read_extra_container dont_load_groups
    global loading_part_contents
    
    part_unload $obj
    set model_container $obj
    # not sure why this code was here but it's wrong
#    set prev_dont_load_groups [info exists dont_load_groups]
#    set dont_load_groups 1
    if {[$obj getval contents_string] != ""} {
	set base [directory]/tmp_part; set n 0
	while {[file exists $base.$n]} { incr n }
	set fp [open $base.$n w]
	foreach c [$obj getval contents_string] {
	    puts $fp $c
	}
	close $fp
	set fp [open $base.$n r]

	# In case we are saving up objects being read in, don't worry about
	# these since they are subparts of an existing one that's already
	# recorded
	if [info exists model_read_extra_container] {
	    set extra $model_read_extra_container
	    unset model_read_extra_container
	}
	set lpc [info exists loading_part_contents]
	set loading_part_contents 1
	if ![regular_model_read $fp 1 0] return
	if !$lpc { unset loading_part_contents }
	
	if [info exists extra] {
	    set model_read_extra_container $extra
	}

	close $fp
	file delete $base.$n
	$obj unset contents_string
	$obj setval part_type internal

    } else {
	set pn [$obj getval part_job]
	if {$pn != ""} {
            set pf [$obj getval part_file]
            if {$pf == ""} {set pf $pn/model}
	    model_read $pf 1
	    $obj setval part_type external part_job_loaded $pn
	}
    }
#    if !$prev_dont_load_groups { unset dont_load_groups }
    set model_container [$obj get -model_container]
    if $sort_below {
	tree_sort_below $obj
    }
}

proc app_after_form_post_part {} {
    global job_open
    array set job_open { name "" title "" notes "" version "" }
}

proc part_unload {obj} {
    clear_contents $obj
}

# This has the job of loading in the part data.
# If recursive is 0 then it was probably called from model_read and
# we don't need to clean up sub-objects

proc app_clean_up_part {obj {recursive 1}} {
    global type_name app_has_clean_up
    
    if {([$obj getval part_type] == "external") && \
	    ([$obj getval part_job] == "")} {
	mess "Warning: external $type_name(part) with no project name converted to\
 		internal $type_name(part)\n" red
	$obj setval part_type internal
    }
    set sh [$obj getval body_shape]
    foreach side {minx miny minz maxx maxy maxz} {
	if {[$sh si_value ${side}_slack] < 0} {
	    mess "[$obj getval name] $side slack can't be negative - reset to 0\n" red
	    $sh setval ${side}_slack 0
	}
    }
    set new_job [$obj getval part_job]
    set cur_job [$obj getval part_job_loaded]
    
    if {([$obj getval part_type] == "external") && \
	    ($new_job != "") && ($new_job != $cur_job)} {
	part_load $obj $recursive
    }
    tree_configure_object $obj
    if $recursive {
	foreach sub [$obj list_contents] {
	    set t [$sub getval obtype]
	    if [info exists app_has_clean_up($t)] {
		app_clean_up_$t $sub
	    }
	}
    }
}

proc app_verify_part {obj} {
    global model_container_root domain type_name
    global grid_mesh_parts_separate grid_type
    
    if {![$obj getval mesh_separate] || !$grid_mesh_parts_separate || ($grid_type == "iceboard")} { return "" }
    
    set ttol [grid_get_ttol]
    
    set sh [$obj getval body_shape]
    set bb [$sh get_bbox]
    
    set domsh [$domain getval body_shape]
    foreach s [$sh touches_shape $domsh $ttol] {
	set ignore($s) 1
    }
    set objects_touching ""
    set all_objects [db_list_all "" $model_container_root]
    foreach other $all_objects {
	foreach osh [db_shapes $other] {
	    if {$osh == $sh} continue
	    
	    set tt ""
	    foreach s [$sh touches_shape $osh $ttol] {
		if ![info exists ignore($s)] { lappend tt $s }
	    }
	    
	    if {$tt == ""} continue
	    
	    # Don't worry if this is a domain-side object.  This is guaranteed
	    # to be on the domain boundary.
	    if [$other getval no_geometry_modify 0] continue
	    
	    # NOTE: other quad objects that are on the domain wall are also okay but
	    # it's harder to find those
	    
	    set proc [info command app_can_touch_mesh_interface_[$other getval obtype]]
	    if {$proc != ""} {
		if {[$proc $other] == ""} continue
	    } else {
		if {[$osh get_volume] && ![catch {$osh get -volume_flag} vf] && ($vf == 0)} continue
	    }
	    
	    if {$tt != ""} {
		set tn [$other getval obtype]
		if [info exists type_name($tn)] { set tn $type_name($tn) }
		append objects_touching "\n    bounding box touches\
			$tn [$other getval name]"
	    }
	}
    }
    if 0 {
	# not interesting
	foreach other [db_list_all part $model_container_root] {
	    if {$other == $obj} continue
	    if {[$other getval mesh_separate] && \
		    ([$sh touches_shape [$other getval body_shape] $ttol] != "")} {
		mess "Note: [$obj getval name] touches another meshed-separately assembly: [$other getval name]\n"
	    }
	}
    }
    return $objects_touching
}

proc part_list_all {obj {also_inactive 1} {stop_if_separate 0}} {
    set all {}
    foreach ob [$obj list_contents] {
	if {[$ob si_value active] || $also_inactive} {
	    if {[$ob getval obtype] == "part"} {
		set sh [$obj getval body_shape]
		if {!$stop_if_separate || ![$sh get -editing_separately]} {
		    foreach a [part_list_all $ob 1 $stop_if_separate] {
			lappend all $a
		    }
		}
	    } else {
		lappend all $ob
	    }
	}
    }
    return $all
}

proc meshing_part_containing_object {obj} {
    global model_container_root grid_mesh_parts_separate
    
    if !$grid_mesh_parts_separate { return "" }
    
    while {$obj != $model_container_root} {
	if {([$obj getval obtype] == "part") && [$obj getval mesh_separate 0]} break
	set obj [$obj get -model_container]
    }
    if {$obj == $model_container_root} {
	return ""
    } else {
	return $obj
    }
}

proc db_copy_part {old {newname ""} {container ""}} {
    global model_container creation_count current_mtype tdv_default
    global type_visible type_name model_container_root
    
    if {$container == ""} { set container $model_container }
    
    if {$newname == ""} {
	#set newname [$container new_name part]
	set oldname [$old getval name]
	set newname [$model_container_root new_name $oldname 1]
    }
    set ocon $model_container
    set model_container $container
    set obj [edit_new part $newname]
    set model_container $ocon
    
    set sh [$obj getval body_shape]
    set osh [$old getval body_shape]
    
    foreach n {part_job units part_type mesh_separate mesh_sep_others} {
	$obj setval $n [$old getval $n]
    }
    
    foreach n {
	xp yp zp rot_degrees rot_axis scale mirror
	minx_slack miny_slack minz_slack maxx_slack maxy_slack maxz_slack
    } {
	$sh setval -noconstr $n [$osh si_value $n]
	set un [$osh getunits $n]
	if {$un != ""} { $sh setunits $n $un }
    }
    
    $tdv_default configure -active 0
    if {[$obj getval part_type] == "internal"} {
	part_copy_tree $old $obj
    } else {
	part_load $obj
    }

    make_visible $obj $type_visible(part)
    
    $tdv_default configure -active 1
    
    db_dirty mesh
    
    return $obj
}

proc part_copy_tree {old new} {
    foreach obj [$old list_contents creation_order int] {
	if {[$obj getval obtype] == "part"} {
	    db_copy_part $obj "" $new
	} else {
	    db_copy $obj "" $new
	}
    }
}

proc part_begin_internal {{newname ""}} {
    global model_container
    
    if {$newname == ""} {
	set newname [$model_container new_name part]
    }
    set model_container [edit_new part $newname]
    return $model_container
}

proc part_end_internal {} {
    global model_container
    set model_container [$model_container get -model_container]
    if {$model_container == ""} { error "one too many part_ends" }
}

# This function sets the current model_container to be $obj
# if obj is "" then it goes back to the toplevel

proc part_switch_model {obj {quiet 0}} {
    global model_container current_object
    
    set prev $model_container
    
    if {$obj == "current"} {
	set obj $current_object
	while {[$obj getval obtype] != "part"} {
	    set obj [$obj get -model_container]
	}
    } elseif {$obj == "top"} {
	set obj [part_get_root]
    }
    if {($obj == "") || ($obj == $model_container)} return
    
    part_do_switch_model $obj $quiet
    
    undo_record_switch_model $obj $prev
}

proc part_do_switch_model {obj {quiet 0}} {
    global model_container current_object
    
    if {[$obj get -model_container] != ""} {
	edit_back_to_top 1
    } else {
	edit_back_to_top 0
    }
    
    set ocon $model_container
    set model_container $obj
    
    foreach sub [$ocon list_contents] {
	reconfigure_object $sub 0
    }
    foreach sub [$model_container list_contents] {
	reconfigure_object $sub 0
    }
    [$model_container getval body_shape] configure -draw_label 0
#    update_mtype
}

proc part_explode {} {
    global current_object current_mtype current_shape
    
    set parent [$current_object get -model_container]
    set psh [$parent getval body_shape]
    set cc [$current_shape get -centroid]
    set pos [$current_shape get -position]
    set sc [$current_shape get -scale]
    
    set shapes ""
    foreach c [$current_object list_contents] {
	set obn [$c getval name]
	tree_remove_object $c
	coll_out all $c
	$current_object remove $obn
	$c configure -model_container $parent
	$parent add $obn $c
	foreach sh [db_shapes $c] {
	    [$sh get -container] remove $sh
	    $sh scale $sc $cc
	    $sh translate $pos
	    $psh add $sh
	    $sh configure -container $psh
	    lappend shapes $sh
	}
	reconfigure_object $c
	tree_add_object $c 1
    }
    
    set group [$current_object getval name]
    if {[coll_contents group $group] != ""} {
	set group [coll_new_name group $group]
    }
    coll_makenew group $group $shapes
    
    edit_delete
    edit_selection_put_type $current_mtype
}

proc part_get_root {} {
    global model_container_root
    return $model_container_root
}

proc object_in_part {obj} {
    global model_container_root
    return [expr {[$obj get -model_container] != $model_container_root}]
}

proc part_make_open {obj open {force 0}} {
    global current_shape model_container_root
    
    set sh [$obj getval body_shape]
#    if {!$force && ([$sh cget -is_open] == !$open)} return
    
    $sh configure -is_open $open
#    update idle
    set shroot [$model_container_root getval body_shape]
    if {!$open && ($current_shape != "")} {
	set sss [$current_shape get -container]
	while {$sss != $shroot} {
	    if {$sss == $sh} {
		model_set_current $obj
		return
	    }
	    set sss [$sss get -container]
	}
    }
}

proc part_move_object_into {part objects part_is_open {rec_undo 1}} {
    global model_container_root current_object type_name
    
    if {[$part getval part_type internal] != "internal"} {
	user_error "It's not possible to move objects into an external $type_name(part).  Please convert it to \"internal\" first."
	return
    }
    
    # Need to translate it out of its current object's coordinate space,
    # and into the new one.
    
    set npsh [$part getval body_shape]
    set npos [$npsh transform_coords [$npsh get -position]]
    
    busy 1
    tdv_active 0
    set used_objects ""
    foreach obj $objects {
	# Got to make sure we are not moving a part inside itself, or inside
	# the part it's already in.
	set bad 0
	for {set par $part} {$par != $model_container_root} \
	    {set par [$par cget -model_container]} {
		if {$par == $obj} { set bad 1; break }
	    }
	if $bad continue
	
	if {$part == [$obj cget -model_container]} {
	    mess "Warning: not moving \"[$obj getval name]\" - it's already in that assembly\n" red
	    continue
	}
	
	if {([$obj getval obtype] == "domain") || \
		[$obj getval no_geometry_modify 0]} {
	    mess "Warning: you can't put \"[$obj getval name]\" into an $type_name(part)\n" red
	    continue
	}
	
	set oparent [$obj get -model_container]
	set obn [$obj getval name]
	if {($oparent != "") && ($oparent != "NULL")} {
	    $oparent remove $obn
	    set opsh [$oparent getval body_shape]
	    set opos [$opsh transform_coords [$opsh get -position]]
	} else {
	    set opos "0 0 0"
	}
	#tree_remove_object $obj
	$obj configure -model_container $part
	$part add $obn $obj
	foreach sh [db_shapes $obj] {
	    set ocon [$sh get -container]
	    if {($ocon != "") && ($ocon != "NULL")} {
		$ocon remove $sh
	    }
	    $npsh add $sh
	    $sh configure -container $npsh
	}
	
	foreach i {0 1 2} {
	    set m$i [expr [lindex $opos $i] - [lindex $npos $i]]
	}
	
	edit_move_apply "" 0 [list objects $obj do_trans 1 xoff \
				  $m0 yoff $m1 zoff $m2 \
				  xoff_units m yoff_units m zoff_units m]
	
	reconfigure_object $obj
	#tree_add_object $obj 1
	foreach sh [db_shapes $obj] {
	    update_decorations $sh
	}
	lappend used_objects $obj
	if {$obj == $current_object} { edit_reset_params }
    }
    $npsh signal_change 1
    tree_reparent_objects $used_objects
    if $rec_undo {
	undo_record_move_to_part $part $used_objects
    }
    db_dirty mesh
    busy 0
    tdv_active 1
}

proc part_is_ancestor {part sub} {
    while 1 {
	set cont [$sub get -model_container]
	if {$cont == ""} { return 0 }
	if {$cont == $part} { return 1 }
	set sub $cont
    }
}

proc part_num_active_objects {part} {
    set n 0
    foreach c [$part list_contents] {
	incr n [$c si_value active 0]
    }
    return $n
}

proc app_apply_transform_part {obj prefix} {
    global ${prefix}do_rot ${prefix}axis ${prefix}amount ${prefix}other
    global ${prefix}do_mirror ${prefix}mirroraxis

    if [set ${prefix}do_rot] {
	set desc rotate
	set tvals [list [set ${prefix}axis] [set ${prefix}amount]]
    } elseif [set ${prefix}do_mirror] {
	set desc mirror
	set tvals [list [set ${prefix}mirroraxis]]
    } else {
	return
    }
    
    if ![$obj getval mesh_separate 0] return
    set sh [$obj getval body_shape]
    
    set sides {minx maxx miny maxy minx maxz}
    foreach sn $sides {
	set val($sn) [$sh getval ${sn}_slack]
	set unit($sn) [$sh getunits ${sn}_slack]
    }
    
    foreach sn $sides {
	set n1 [transform_side_name $sn $sh $desc $tvals]
	set sn1 [lindex $sides [expr $n1 - 1]]
	$sh setval ${sn1}_slack $val($sn)
	$sh setunits ${sn1}_slack $unit($sn)
    }
}

proc part_view_summary {} {
    
    global tree part_summary_table
    
    if [array exists part_summary_table] {
	unset part_summary_table
    }

    set d [form_init .part_view_summary "Assembly contents" "" done]
    if {$d != ""} {
	if [array exists temperature_limit_table] {
	    unset array part_summary_table
	}
	
	set table_data [create_part_view_summary]
	set row_num [lindex $table_data 0]
	set longest_name [lindex $table_data 1]
	
	form_frame $d.table flat 0 {1 0 -cols 2}
	set tpath $d.table.obform
	table $tpath -cols 2 -colstretchmode all -rowstretchmode unset \
	    -drawmode slow -titlerows 3 \
	    -state disabled \
	    -variable part_summary_table -rows $row_num \
	    -width 0 -height 8 -rowheight 1 -yscrollcommand [list "$d.table.sy" set] 
	$tpath width 0 $longest_name
	$tpath width 1 $longest_name
	scrollbar $d.table.sy -command [list $d.table.obform yview]
	
	pack $d.table.sy -side right -fill y
	pack $d.table.obform -side left
	pack $d.table
	form_finish bot
    }    
    
    set table_data [create_part_view_summary]
    .part_view_summary.main.table.obform config -rows [lindex $table_data 0]
}

proc create_part_view_summary {} {
    global tree part_summary_table object_type_title
    # show how many objects of each obtype are contained in this assembly
    

    set part_contents [part_list_all [$tree(win) selection get] ]
    set part_summary_table(2,0) "Type"
    set part_summary_table(2,1) "Number"

    set part_summary_table(0,0) "Assembly name:"
    set longest_name 25
    set part_summary_table(0,1) [[$tree(win) selection get] getval name]
    if {[string length [[$tree(win) selection get] getval name]] > $longest_name} {
	set longest_name [string length [[$tree(win) selection get] getval name]]
    }
    
    set part_summary_table(1,0) "Total number of objects"
    
    foreach obj $part_contents {
	set obtype [$obj getval obtype]
	if {[info exists part_summary_types($obtype)]} {
	    incr part_summary_types($obtype) 
	} else {
	    set part_summary_types($obtype) 1
	}	
    }
    
    set row 3
    
    set num_objs 0
    foreach {obtype num} [array get part_summary_types] {
	set part_summary_table($row,0) $object_type_title([set obtype])
	set part_summary_table($row,1) $num
	set num_objs [expr $num_objs + $num]
	incr row
    }

    set part_summary_table(1,1) $num_objs
    
    if [array exists part_summary_types] {	
	unset part_summary_types
    }
    return [list $row [expr $longest_name + 2] ]
}
