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

# Stuff for graphical interaction.  ----------------------------------

set snap_object_list ""

proc tdv_select_action {w button double shape spec geopos pos x y} {
    global tdv_default domain starting_location_for_move
    global selected_shape object_select_command shape_data shape_data_undo
    global current_mtype shape_movegroup current_object
    global current_shape selected_anno job_ctrlkey tdv_setloc_exclude
    global is_modelbuilder model_phases screen_select_all_types
    global tdv_interact_only_shape interact_start_x interact_start_y
    global dont_move_sections_individually tdv_interact_only_shape_callback

    catch {unset selected_shape}

    if [info exists tdv_interact_only_shape] {
	set which [lindex $spec 0]
	set num [lindex $spec 1]
	if {$shape != ""} {
	    $shape configure -selected_$which $num -selected_loc $geopos
	    eval $tdv_interact_only_shape_callback $shape
	    set selected_shape $shape
	}
	return
    }


#puts "tdv_select_action $w $button $double $shape $spec $geopos $pos $x $y"

    if {$job_ctrlkey == "Shift"} {
	if [anno_select_action $w $button $double $x $y] {
	    set selected_anno 1
	    return
	}
    }

    if {($shape != "") && [$tdv_default check_tag $shape post_pickable]} {
	post_select_action $button $shape $spec $geopos $pos
	return
    }

    if [info exists object_select_command($button)] {
	eval $object_select_command($button) $shape
	return
    }

    set interact_start_x $x
    set interact_start_y $y

    if {$shape == ""} return
    if [catch {$shape get -object} obj] return
    if {$obj == ""} return
    set obtype [$obj getval obtype]

    if [$obj getval no_geometry_modify 0] {
	set obj $domain
	set shape [$obj getval body_shape]
    }

    if [info exists dont_move_sections_individually($obtype)] {
	set shape [lindex [db_shapes $obj] 0]
    }

    if [info exists screen_select_all_types] {
	if {[$obj getval obtype] != $current_mtype} {
	    set current_mtype [$obj getval obtype]
#	    update_mtype
	}
    }

    if {$obj != $current_object} {
	tree_see $obj
	tree_single_click $obj
	#model_set_current $obj
    }
    if {$shape != $current_shape} {
	# This after idle is here because if the edit_set_category calls
	# update then some move events might get lost
	after idle "edit_set_category section [$shape get -name]"
    }
    set selected_shape $shape
    set tdv_setloc_exclude($tdv_default) $shape

    set which [lindex $spec 0]
    set num [lindex $spec 1]

    if {$button == 3} {
	set obj [$shape cget -object]
	if {[$obj checkval fix_shapes] && \
		![string compare [$obj getval fix_shapes] 1]} {
	    unset selected_shape
	    user_error "That object can't be interactively resized."
	    return
	}
	$shape configure -selected_$which $num
    }
    $shape configure -selected_loc $geopos

    set c [info commands edit_screen_select_[$shape get -shtype]]
    if {$c != ""} { $c $shape }

    set shapes_moving $shape

    if {$button == 2} {
	if $shape_movegroup {
	    set others [db_objects_in_group_of_object $obj]
	    if {$others != $obj} {
		set shh ""
		foreach ob $others {
		    foreach sh [db_shapes $ob] {
			lappend shh [list $sh configure \
					 -color [$sh get -color]]
			$sh configure -color red
			if {$sh != $shape} { lappend shapes_moving $sh }
		    }
		}
		$tdv_default redraw
		foreach sh $shh { eval $sh }
	    }
	}
	if [$obj getval move_sections_together 0] {
	    foreach sh [db_shapes $obj] {
		if {$sh != $shape} { lappend shapes_moving $sh }
	    }
	}
    }
    if {$button != 1} {
	# Now put in the undo stuff.
	catch {unset shape_data_undo}

	foreach sh $shapes_moving {
	    foreach v [$sh list_values canset nooffset] {
		set "shape_data_undo($sh [lindex $v 0])" [lindex $v 1]
	    }
	}
        set starting_location_for_move $geopos
    }
}

proc tdv_move_action {w button pos x y} {
    global tdv_default env
    global selected_shape domain shape_data shape_movegroup
    global selected_anno type_visible shape_snap_message
    global tdv_interact_only_shape tdv_interact_only_shape_callback
    global post_moving_object interact_start_x interact_start_y
    global interact_rubbox
    global shape_snap_objects shape_snap_tol snap_object_list

    if [info exists tdv_interact_only_shape] {
	if [info exists selected_shape] {
	    set stuff [$w screen2world $x $y]
	    set pt [lindex $stuff 0]
	    set vec [lindex $stuff 1]
	    set tol 0
	    switch $button {
		1 { return }
		2 { set op move }
		3 { set op resize }
	    }
	    set res [$selected_shape drag $op $pt $vec $tol 1]
	    eval $tdv_interact_only_shape_callback $selected_shape
	}
	return
    }

    if [info exists selected_anno] {
	anno_move_action $w $button $x $y
	return
    }
    if [info exists post_moving_object] {
	post_move_action $button $pos
	return
    }

    switch $button {
	1 {
	    # Drag open a box for selection ....
	    if [info exists interact_start_x] {
		if {![info exists interact_rubbox] &&
		    (abs($x - $interact_start_x) +
		     abs($y - $interact_start_y) > 10)} {
		    set interact_rubbox [tdv_rubbox_im -color orange \
					     -transform 0 \
					     -x1 $interact_start_x \
					     -y1 $interact_start_y]
		    $tdv_default add_image $interact_rubbox
		    $interact_rubbox configure -overlay \
			[expr ![info exists env(ICEM_NO_OVERLAY)]]
		}
		if [info exists interact_rubbox] {
		    $interact_rubbox configure -x2 $x -y2 $y
		}
	    }
	    return
	}
	2 { set op move; set flag +rigid }
	3 { set op resize; set flag "" }
	default { user_error "button $button pressed??" ; return }
    }

    if {![info exists selected_shape] || ($selected_shape == "")} return

    set ssh $selected_shape

    set stuff [$w screen2world $x $y]
    set pt [lindex $stuff 0]
    set vec [lindex $stuff 1]

    set obj [$ssh get -object]
    set bb [bbox_of_objects $obj]
    if {$bb == ""} return

    set compound 0

    if {$op == "move"} {
	set others $obj
	if $shape_movegroup {
	    set others [db_objects_in_group_of_object $obj]
	    if {$others != $obj} {
		set bb [bbox_of_objects $others $ssh]
		if {$bb == ""} return
		if {$bb != ""} {
		    $ssh configure -ent_usebb 1 \
			-ent_bbmin [lindex $bb 0] -ent_bbmax [lindex $bb 1]
		}
	    }
	} elseif [$obj getval move_sections_together 0] {
	    if {$bb != ""} {
		$ssh configure -ent_usebb 1 \
		    -ent_bbmin [lindex $bb 0] -ent_bbmax [lindex $bb 1]
	    }
	}

	if {[info commands app_transform_[$obj getval obtype]] != ""} {
	    if {[db_shapes $obj] != $ssh || $others != $obj} {
		set compound 1
		#	    set bb [bbox_of_objects $obj $ssh]
		set bb [bbox_of_objects $others]
		if {$bb != ""} {
		    $ssh configure -ent_usebb 1 \
			-ent_bbmin [lindex $bb 0] -ent_bbmax [lindex $bb 1]
		}
	    }
	}
    } else {
	if {[$obj checkval fix_shapes] && \
		![string compare [$obj getval fix_shapes] 1]} {
	    user_error "That object can't be interactively resized."
	    return
	}
    }

    set tol 0
    if {([info exists type_visible(cad_line)] && $type_visible(cad_line)) ||
	([info exists type_visible(cad_point)] && $type_visible(cad_point))} {
	set tol [$tdv_default pixels2dist 10]
    }

    $ssh to_var shape_data shape_data_units
    if {[$ssh get -shtype] == "container"} update_container_bbvars

    if {$shape_snap_objects && $op == "move"} {
        set snap_object_list ""
	set stol [$tdv_default pixels2dist $shape_snap_tol]
	if {$shape_movegroup && $others != $obj} {
            set shapes ""
            foreach ob $others {
                eval lappend shapes [db_shapes $ob]
            }
	} elseif [$obj getval move_sections_together 0] {
            set shapes [db_shapes $obj]
            if {$shapes == $ssh} {set shapes ""}
        } else {
            set shapes ""
        }
        set diff [$ssh snap $pt $vec $stol $shapes]
        if {$diff != ""} {
            set newpt ""
            foreach i {0 1 2} {
                lappend newpt [expr [lindex $pt $i] + [lindex $diff $i]]
            }
            set pt $newpt
            set snap_object_list [lrange $diff 3 5]
        }
    }

    if $compound {

if 1 {
	#puts "$ssh drag $op \{$pt\} \{$vec\} $tol"
	set off [$ssh drag $op $pt $vec $tol 0]
	#puts "$off"
	set sl [$ssh get -selected_loc]
	#$tp $ssh $off
	translate_compound_object $obj $off
	set nsl ""
	foreach i {0 1 2} {
	    lappend nsl [expr [lindex $off $i] + [lindex $sl $i]]
	}
	# app_clean_up_[$obj getval obtype] [$ssh get -object]
	$ssh configure -selected_loc $nsl
} else {
	set off [$ssh drag $op $pt $vec $tol 0]
#        set sl [$tdv_default project $pt [$ssh get -selected_loc]]
#        set off ""
#        foreach i {0 1 2} {
#            lappend off [expr [lindex $pt $i] - [lindex $sl $i]]
#        }
        translate_compound_object $obj $off
    $ssh configure -selected_loc $pt
#    $ssh configure -selected_loc [vec_add [$ssh get -selected_loc] $off]
}
    } else {
        set off [$ssh drag $op $pt $vec $tol 1]
    }

    if {$op == "move"} {
	if $shape_movegroup {
	    foreach oo [db_objects_in_group_of_object $obj] {
		if {$oo != [$ssh get -object]} {
		    if {[info commands app_transform_[$oo getval obtype]] != ""} {
			translate_compound_object $oo $off
		    } else {
			foreach sh [db_shapes $oo] {
			    $sh translate $off
			}
			update_decorations $sh 1 1
		    }
		}
	    }
	}
	if {!$compound && ($shape_movegroup ||
            [$obj getval move_sections_together 0])} {
	    foreach sh [db_shapes $obj] {
		if {$sh != $ssh} {
		    $sh translate $off
		}
		update_decorations $sh 1 1
	    }
	}
    }
    set mess [shape_snap_message]
    if {$mess != ""} {
	mess "$mess\n" green
    }
    if $compound {
	edit_reset_params
	#app_clean_up_[$obj getval obtype] $obj
    }
    if {($obj == $domain) && ([info command domain_update_shape] != "")} {
	domain_update_shape all
    }

    update_decorations $ssh 1 1
    db_dirty mesh
}

proc translate_compound_object {obj offset} {
if 0 {
    foreach sh [db_shapes $obj] {
	$sh translate $offset
	update_decorations $sh 1 1
    }
    eval edit_move_object_location_exprs $obj translate $offset
} else {
    set type [$obj getval obtype]
    # We have to be sure to call this for *only one* of the shapes.
    foreach sh [db_shapes $obj 0] {
        app_transform_$type $sh translate $offset
	update_decorations $sh 1 1
    }
    app_clean_up_$type $obj
}
}

# what_mod: 1 == shift, 2 == control

proc tdv_release_action {w button pos x y {what_mod 1}} {
    global tdv_default post_moving_object
    global selected_shape shape_data shape_data_undo
    global selected_anno tdv_setloc_val type_visible
    global tdv_interact_only_shape starting_location_for_move
    global interact_rubbox interact_start_x interact_start_y
    global snap_object_list

    if {$snap_object_list != ""} {
        mess "aligned with" blue
        foreach i {0 1 2} {
            set obj [lindex $snap_object_list $i]
            if {$obj != ""} {
                mess " [lindex {X Y Z} $i]-[$obj getval name]" blue
            }
        }
        mess "\n"
        set snap_object_list ""
    }

    if [info exists tdv_interact_only_shape] {
	if [info exists selected_shape] {
	    $selected_shape configure -selected_point -1 \
		-selected_line -1 -selected_loc "0 0 0"
	    unset selected_shape
	}
	return
    }

    reset_construction_red

    if [info exists selected_anno] {
	anno_release_action $w $button $x $y
	unset selected_anno
	return
    }
    if [info exists post_moving_object] {
	post_release_action $button
	return
    }

    if [info exists interact_rubbox] {
	set x1 [$interact_rubbox get -x1]
	set y1 [$interact_rubbox get -y1]
	$interact_rubbox delete
	unset interact_rubbox
	unset interact_start_x
	unset interact_start_y

	set objects [select_shapes_by_screen_region "$x1 $y1 0" "$x $y 0" 1]
	# Shift == select, Control == add to selection
	switch $what_mod {
	    1 { tree_change_selection $objects 2 }
	    2 { tree_change_selection $objects 1 }
	}
	return
    }

    if {![info exists selected_shape] || ($selected_shape == "")} return

    set dirty 0
    if {($button == 3) && ($tdv_setloc_val($w) != "")} {
	set tol 0
	if {$type_visible(cad_line) || $type_visible(cad_point)} {
	    set tol [$tdv_default pixels2dist 10]
	}
	$selected_shape drag resize $tdv_setloc_val($w) "0 0 0" $tol
	$selected_shape to_var shape_data shape_data_units
	if {[$selected_shape get -shtype] == "container"} update_container_bbvars
	set dirty 1
	update_decorations $selected_shape 1 1
    }

    # Now do the undo stuff.
if 0 {
    foreach v [array names shape_data_undo] {
	set sh [lindex $v 0]

	# It's possible this shape might have gotten deleted somehow.
	if {[info command $sh] == ""} continue

	set n [lindex $v 1]
	set oval $shape_data_undo($v)
	set nval [$sh getval $n]
	if {$nval != $oval} {
	    lappend vals($sh) [list $n $oval $nval]
	}
    }
    foreach sh [array names vals] {
	undo_record_change_shape $sh $vals($sh)
    }
} else {
    set obj [$selected_shape get -object]
    set app app_transform_[$obj getval obtype]
    if {$button == 2 && [info commands $app] != ""} {
        set npos [$selected_shape get -selected_loc]
        set offset ""
        foreach i {0 1 2} {
            lappend offset [expr [lindex $npos $i] - \
                [lindex $starting_location_for_move $i]]
        }
        foreach sh [db_shapes $obj] {
            undo_record_move_shape $sh [list [list translate $offset]]
        }
    } else {
        foreach v [array names shape_data_undo] {
            set sh [lindex $v 0]

            # It's possible this shape might have gotten deleted somehow.
            if {[info command $sh] == ""} continue

            set n [lindex $v 1]
            set oval $shape_data_undo($v)
            set nval [$sh getval $n]
            if {$nval != $oval} {
                lappend vals($sh) [list $n $oval $nval]
            }
        }
        foreach sh [array names vals] {
            undo_record_change_shape $sh $vals($sh)
        }
    }
}

    $selected_shape configure -selected_point -1 -selected_line -1 \
	    -selected_arc -1 -selected_ell -1 -selected_poly -1 -ent_usebb 0
    unset selected_shape

    if $dirty { db_dirty mesh }
}

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

# This returns 1 if it picked something ...

proc anno_select_action {w button double x y} {
    switch $button {
	1 { return 0 }
	2 { return [tdv_begin_anno_move $w $x $y] }
	3 { return [tdv_begin_anno_edit $w $x $y] }
    }
}

proc anno_move_action {w button x y} {
    switch $button {
	2 { tdv_anno_move $w $x $y }
	3 { tdv_anno_edit $w $x $y }
    }
}

proc anno_release_action {w button x y} {
    switch $button {
	2 { tdv_end_anno_move $w }
	3 { tdv_end_anno_edit $w }
    }
}
# --------------------------------------------------------

# Dragging post points should also be done using this API ...

proc tdv_app_pick_annotation {w x y} {
    return [named_point_pick_annotation $x $y]
}

proc tdv_app_move_annotation {im w ox oy nx ny} {
    return [named_point_move_annotation $im $ox $oy $nx $ny]
}

proc tdv_app_release_annotation {im w} {
    return [named_point_release_annotation $im]
}

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

proc graph_highlight {obj on {color red}} {
    global graph_highlight_prevcolor

    set shapes ""
    foreach sh [db_shapes $obj] {
	eval lappend shapes $sh [$sh get_decorations]
    }

    foreach sh $shapes {
	if $on {
	    if ![info exists graph_highlight_prevcolor($sh)] {
		set graph_highlight_prevcolor($sh) [$sh get -color]
	    }
	    $sh configure -color $color
	    catch {$sh configure -group_is_selected 1}
	} else {
	    if [info exists graph_highlight_prevcolor($sh)] {
		$sh configure -color $graph_highlight_prevcolor($sh)
		unset graph_highlight_prevcolor($sh)
		catch {$sh configure -group_is_selected 0}
	    }
	}
    }
}

proc auto_get_location {{varname ""} {unitvar ""} {only_endpoints 0}
			{mess "the point"}} {
    global tdv_default get_only_endpoints view_panes

    if {$unitvar != ""} {
	set units [uplevel \#0 set $unitvar]
    } else {
	set units ""
    }
    set pt [get_one_location "Select $mess on the screen with the left button;\
	    middle = accept, right = cancel." $only_endpoints]

    set npt ""
    foreach c $pt {
	if {$units != ""} {
	    lappend npt [unit_convert $c $units 1]
	} else {
	    lappend npt $c
	}
    }
    if {($varname != "") && ($npt != "")} {
	uplevel \#0 set $varname \"$npt\"
    }
    set pt2 ""
    foreach p $pt { lappend pt2 [format %.6g $p] }
    return $pt2
}

# part can be face, vert, edge, or object

proc select_shape_feature {type part exclude color} {
    global select_shape_last current_shape
    global tdv_obtain_screen_pos_button view_panes tdv_last_viewer_clicked

    foreach obj [db_list_objects "" [part_get_root]] {
	if [$obj getval no_geometry_modify 0] {
	    foreach sh [db_shapes $obj] {
		lappend exclude $sh
	    }
	}
    }
    if {$part == "object"} { set part "" }

    set got ""
    set seen ""
    set undo ""
    set use_xy ""
    while 1 {
	if {$use_xy == ""} {
	    set xy [tdv_obtain_screen_pos $view_panes(all_viewers)]
	} else {
	    set xy $use_xy
	    set use_xy ""
	}
        if {$xy == ""} {
	    if {$tdv_obtain_screen_pos_button == "3"} {
		if {$got == ""} {
		    break
		} else {
		    eval $undo
		    set undo ""
		    set got ""
		    continue
		}
	    } else {
		break
	    }
	}
	
	set x [lindex $xy 0]; set y [lindex $xy 1]
	
	# ---------------------------
	
	set mode $part
	set tags obtype_$type
	set close 0
	set tags_all $tags
	
	foreach ex $exclude { lappend tags !$ex }
	
	# This is to support multiple-clicking to select objects on top of
	# each other.
	set lastxy [lrange [lindex $seen 0] 0 1]
	if {$lastxy != ""} {
	    set lx [lindex $lastxy 0]; set ly [lindex $lastxy 1]
	    set dist [expr sqrt(($x - $lx) * ($x - $lx) + \
				    ($y - $ly) * ($y - $ly))]
	    if {$dist < 5} { set close 1 }
	    
	}
	if !$close { set seen "" }
	
	set subparts ""
	
	if !$close {
#	    puts " $tdv_last_viewer_clicked pick $x $y $tags $part 10"
	    set stuff [$tdv_last_viewer_clicked pick $x $y $tags $part 10]
#	    puts $stuff
	
	} else {
	    set stuff ""
	    if {$part != ""} {
		set last [lindex $seen end]
		if {[lindex $last 3] != ""} {
		    # Try to select another part of this same object.
		    set last_im [lindex $last 2]
		    set subparts [lindex $last 3]
		    set mode [concat $part $subparts]
		    set stuff [$tdv_last_viewer_clicked pick $x $y $last_im $mode 10]
		    if {$stuff != ""} {
			set seen [lrange $seen 0 end-1]
		    }
		}
	    }
	    if {$stuff == ""} {
		foreach last $seen {
		    lappend tags ![lindex $last 2]
		}
		set subparts ""
		set stuff [$tdv_last_viewer_clicked pick $x $y $tags $part 10]
	    }
	}
	if {$stuff == ""} {
	    if {$seen != ""} {
		set seen ""
		set use_xy $xy
		continue
	    } else {
		break
	    }
	}
	
	set sh [lindex $stuff 0]
	set spec [lindex $stuff 1]
	set geopos [lindex $stuff 2]
	
	if {$part != ""} {
	    lappend subparts [lrange $spec 0 1]
	}
	lappend seen [list $x $y $sh $subparts]
	
	set got [concat $sh $spec]
	
	set which [lindex $spec 0]
	set num [lindex $spec 1]
	
	if {$undo != ""} { eval $undo }
	
	set ocol [$sh cget -color]
	set oscol [$sh cget -selected_color]
	set olw [$sh cget -width]
	if {$part != ""} {
	    $sh configure -selected_$which $num -color \#dddddd -width 0 \
		-selected_arc_solid 1 -selected_color $color
	    set undo "$sh configure -selected_$which -1 -color $ocol \
		-width $olw -selected_arc_solid 0 -selected_color $oscol"
	} else {
	    $sh configure -color $color -width 2 -override_how_drawn 1
	    set undo "$sh configure -color $ocol -width $olw -override_how_drawn 0"
	}
	$sh signal_change 1
    }
    return [list $got $undo]
}

# How can be face, edge, vert, center, or center_face.
# Full is 1 if the whole edge or face should be changed, 0 if just the
# normal directions.  -1 means just move the object and don't resize.

proc edit_alignment {how full} {
    global tdv_mouse_bindings select_shape_last current_shape
    
    set left [lindex {x left middle right} $tdv_mouse_bindings(select)]
    set middle [lindex {x left middle right} $tdv_mouse_bindings(done)]
    set right [lindex {x left middle right} $tdv_mouse_bindings(cancel)]
    
    set partname $how
    switch $how {
	center { set partname object }
	center_face { set partname face }
    }
    
    set dirty 0
    
    while 1 {
	banner "Select the $partname to change with the $left button; \
		$middle = accept, $right = cancel."
	
	set sel [select_shape_feature all $partname "" \#ff4444]
	set undo1 [lindex $sel 1]
	set sel [lindex $sel 0]
	if {$sel == ""} { eval $undo1; break }
	
	set sh [lindex $sel 0]
	set obj [$sh get -object]
	
	if {($full > -1) && ($how != "center") && ($how != "center_face") && \
		[$obj checkval fix_shapes] && \
		![string compare [$obj getval fix_shapes] 1]} {
	    user_error "That object can't be modified with the alignment tools."
	    eval $undo1
	    continue
	}
	
	if {$how == "vert"} {
	    set sel_pt [get_one_location "Select the location to match to with the $left button; $middle = accept, $right = cancel." 1]
	    eval $undo1

	    if {$sel_pt == ""} break

	} else {
	    banner "Select the $partname to match to with the $left button; \
		$middle = accept, $right = cancel."
	    set sel2 [select_shape_feature all $partname [lindex $sel 0] \#ffff44]
	    eval $undo1
	    eval [lindex $sel2 1]
	    set sel2 [lindex $sel2 0]
	    if {$sel2 == ""} break
	}
	
	set sh [lindex $sel 0]
	set obj [$sh get -object]

	if {$how == "center"} {
	    set sh2 [lindex $sel2 0]
	    set obj2 [$sh2 get -object]

	    if [$obj2 getval move_sections_together 0] {
		set ncent [centroid_of_objects $obj2]
	    } else {
		set ncent [$sh2 get_centroid]
	    }
	    if [$obj getval move_sections_together 0] {
		set ocent [centroid_of_objects $obj]
	    } else {
		set ocent [$sh get_centroid]
	    }
	    foreach i {0 1 2} {
		set m$i [expr [lindex $ncent $i] - [lindex $ocent $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]
	    
	} elseif {($how == "center_face") && 
		  ([$sh get -shtype] != "incline")} {
	    set dd [$sh face_dir [lindex $sel 2]]
	    set ocent [lindex $dd 0]

	    switch [$sh get -shtype] {
		circ - cyl - oval {
		    # FIX ME
		    set ocent [$sh transform_coords $ocent]
		}
	    }
	    set dd [[lindex $sel2 0] face_dir [lindex $sel2 2]]
	    set ncent [lindex $dd 0]
	    switch [[lindex $sel2 0] get -shtype] {
		circ - cyl - oval {
		    # FIX ME
		    set ncent [[lindex $sel2 0] transform_coords $ncent]
		}
	    }
	    set norm [lindex $dd 1]
	    set sm ""
	    foreach i {0 1 2} {
		if {($sm == "") || ([lindex $norm $i] < $smv)} {
		    set smv [lindex $norm $i]; set sm $i
		}
	    }
	    foreach i {0 1 2} {
		if {$i == $sm} {
		    set m$i [expr [lindex $ncent $i] - [lindex $ocent $i]]
		} else {
		    set m$i [expr [lindex $ncent $i] - [lindex $ocent $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]
	    
	} else {
	    set pvals [$sh list_values canset nooffset]

	    if {($full == -1) && ([$sh get -shtype] != "incline")} {
		# This one we can do in tcl
		set oldc [$sh feature_centroid [lindex $sel 1] [lindex $sel 2]]

		if {$how == "vert"} {
		    set newc $sel_pt
		} else {
		    set newc [[lindex $sel2 0] feature_centroid [lindex $sel2 1] \
				  [lindex $sel2 2]]
		}

		foreach i {0 1 2} {
		    set m$i [expr [lindex $newc $i] - [lindex $oldc $i]]
		}

		switch [lindex $sel 1] {
		    poly - arc {
			set n [$sh feature_direction [lindex $sel 1] [lindex $sel 2]]
			set d 0
			if {abs([lindex $n 1]) > abs([lindex $n $d])} { set d 1 }
			if {abs([lindex $n 2]) > abs([lindex $n $d])} { set d 2 }
			foreach i {0 1 2} {
			    if {$i != $d} { set m$i 0 }
			}
		    }
		    line {
			set n [$sh feature_direction line [lindex $sel 2]]
			set d 0
			if {abs([lindex $n 1]) > abs([lindex $n $d])} { set d 1 }
			if {abs([lindex $n 2]) > abs([lindex $n $d])} { set d 2 }
			set m$d 0
		    }
		    point {
		    }
		}
		
		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]
		
	    } elseif {$how == "vert"} {
		if {![$sh align_with_point $sel_pt [lindex $sel 2] $full]} {
		    mess "Sorry, can't align those objects in that way\n" red
		}
		
	    } else {
		puts "$sh align_with [lindex $sel2 0] [lindex $sel 1] \
			  [lindex $sel2 1] [lindex $sel 2] [lindex $sel2 2] \
			  $full"
		if {![$sh align_with [lindex $sel2 0] [lindex $sel 1] \
			  [lindex $sel2 1] [lindex $sel 2] [lindex $sel2 2] \
			  $full]} {
		    mess "Sorry, can't align those objects in that way\n" red
		}
	    }
	    
	    set vals ""
	    foreach v $pvals {
		set n [lindex $v 0]
		set ov [lindex $v 1]
		set nv [$sh getval $n]
		if {$nv != $ov} {
		    lappend vals [list $n $ov $nv]
		}
	    }
	    if {$vals != ""} {
		undo_record_change_shape $sh $vals
	    }
	    set dirty 1
	    app_clean_up_[$obj getval obtype] $obj
	    update_decorations $sh 1 1
	    if {$sh == $current_shape} { edit_reset_params }
	}
	edit_check_outside $obj 1
    }
    banner ""
    if $dirty { db_dirty mesh }
}
