
# This code creates the user interface for the mesh editor.
#
# Copyright (c) 1993 - 1995 Pacific Marketing and Consulting, Inc,
#       and ICEM Systems, GmbH.  All rights reserved.
# Author:  Wayne A. Christopher, wayne@icemcfd.com

# Here is the new code that selects geometry.

# what is surface, curve, point, material, or entity, or a list thereof
# mult is 0 or 1 depending on whether a single one or multiple are wanted

proc select_geometry {what {max_num 0} {mess ""} {create_new 0} \
			  {only_facet 0} {not_these ""} {inc_switch 0} {pre_select ""} \
			  {require_tags ""} {only_if_dormant 0}} {
    global select_action options tdv_mouse_bindings geom_visible projlib
    global fam_visible select_geometry_start_time select_option
    global tdv_default med_selection_mode ai_environment 
    # July 13, 2006: return empty line if other "select_geometry" was called after current
    # return "all" "visible" "blanked" if $med_selection_mode == "allow_all_visible_blanked"

    if ![info exists med_selection_mode] {set med_selection_mode 1}
    set local_start [clock clicks]
    set select_geometry_start_time $local_start

    geom_get_objects reset option
    
    set compcurves 0
    if {$what == "curve_or_compcurve"} { set what curve; set compcurves 1 }
    
    if {($what != "entity") && ([llength $what] == 1) && [info exists geom_visible($what)] && !$geom_visible($what)} {
	    mess "Warning: you can't pick ${what}s from the screen because\
		they are not turned on in the Display panel.\
		You can still select them with Select-All (key = a) or\
		Select-Blanked (key = b).\n" red
    }
    
    if {$max_num == 1} { set s "" } else { set s s }

    set do_onm ::vam_events(do_onMotion)
	if ![info exists $do_onm] {set $do_onm 0}
	set onm select_option(onMotionEvent)
	if [info exists $onm] {
		set onmcmd [set $onm]
		if [llength $onmcmd] {
			set onMotion $onmcmd
			set whatonMotion $what
		}
	}
	
    if {$what == "entity"} {
	    set inc_dim 1
	    set what ""
	    foreach d {0 1 2 3} {
	        if {[info exists select_option($d)] && $select_option($d)} {
		        switch $d {
		        0 { lappend what point }
		        1 { lappend what curve }
		        2 { lappend what surface }
		        3 { lappend what body density }
		    }
	    }
	}

	if {$what == ""} { set what entity }
	    set whats entities
    } elseif {[llength $what] > 1} {
        set whats entities
        set inc_dim 1
    } elseif $compcurves {
        set whats "curves or composite curves"
        set inc_dim 0
    } else {
        set whats ${what}$s
        set inc_dim 0
    }
    
    if {$mess == ""} {
	    if $max_num {
	        set mess "$max_num $whats"
	    } else {
	        if {[string match *ys $whats]} {
		        set mess "[string trimright $whats ys]ies"
	        } else {
		        set mess "$whats"
	        }
	    }
    }
    
    foreach s { select done cancel } {
	    set b_$s [lindex {"" left middle right} $tdv_mouse_bindings($s)]
    }
    
    if $create_new {
	    set crnew ", 'n' = create new"
	    tdv_push_key_command n "set select_action create_new"
    } else {
	    set crnew ""
    }
    banner "Select $mess with the $b_select button; $b_done = done, $b_cancel = back up / cancel$crnew, Shift-$b_select = deselect, '?' = list options."
    if {$what != "density"} {
        select_set_bindings 1 1 $inc_dim $inc_switch "Select geometry"
    } else {
        select_set_bindings 1-2 1 $inc_dim $inc_switch "Select densities"
    }
    
    set finished 0
    set switch 0
    set waiting_for_circle 0
    
    set stuff ""
    set nstuff 0
    
    set n 0
    set images ""
    if {$what == "entity"} {
	    foreach {type obj} $pre_select {
	        lappend images [get_object_by_name $type $obj]
	    }
        } else {
	    foreach obj $pre_select {
	        lappend images [get_object_by_name $what $obj]
	    }
    }
    foreach im $images {
	    if [info exists config($im)] continue
	    set config($im) 1
	    if {[info exists ai_environment] && $ai_environment} {
	        object_show_geo_selected $im 1
	    }
	    lappend stuff $im
	    incr nstuff
	    incr n
    }
    
    if $n {
	    mess "$n $whats already selected\n"
    }
    
    while {!$finished} {
	tkwait variable select_action
	if {$select_geometry_start_time > $local_start} return
	set the_action [lindex $select_action 0]
	#
	# Next block has been added to use preselection on simple pick
	# No modifications on other pick options.
	# preselection must be the only object, highlighted with ic_highlight  
	#   
	# ic_highlight restores previous color of temporary highlighted entity  
	if {[info exists onMotion] && $the_action != "nb_move"} {
		set ret [ic_highlight]
		ic_image delete preview
		if {[llength $ret] == 1} {
			set maybe_picked $ret
		}
	}
	#
	switch $the_action {
	    done {
		if [info exists pline] {
		    set poly ""
		    if {[$pline get -npts] > 2} {
			for {set i 0} {$i < [$pline get -npts]} {incr i} {
			    set p [lindex [$pline get_point $i] 0]
			    lappend poly [list [lindex $p 0] [lindex $p 1]]
			}
			
			set tags $require_tags
			foreach wha $what { lappend tags geom_$wha }
			foreach im $stuff { lappend tags !$im }
			foreach im $not_these { lappend tags !$im }
			set ims [$tdv_default pick_polygon $tags $poly \
				     $options(select_mode)]
			foreach im $ims {
			    if $only_if_dormant {
			        if ![object_get_geo_dormant $im] continue
			    }
			    if [info exists config($im)] continue
			    set config($im) 1
			    object_show_geo_selected $im 1
			    lappend stuff $im
			    incr nstuff
			    set last_xy ""
			}
		    }
		    $pline delete
		    unset pline
		    tdv_cur $tdv_default pick
		} else {
		    set finished 1
		}
	    }
	    back {
		if [info exists pline] {
		    set n [$pline get -npts]
		    incr n -1
		    if {$n < 2} {
			$pline delete
			unset pline
			tdv_cur $tdv_default pick
		    } else {
			$pline delete_point $n
		    }
		} else {
		    if !$nstuff {
			set finished 1
		    } else {
			incr nstuff -1
			set im [lindex $stuff $nstuff]
			set stuff [lrange $stuff 0 [expr $nstuff - 1]]
			object_show_geo_selected $im 0
			unset config($im)
		    }
		}
	    }
	    cancel {
		if [info exists pline] {
		    $pline delete
		    unset pline
		}
		set finished -1
	    }
	    select_mesh {
		if [info exists pline] {
		    $pline delete
		    unset pline
		}
		set switch 1
		set finished 1
		set med_selection_mode 1
	    }
	    press {
		if {$max_num && ($nstuff >= $max_num)} {
		    set finished 1
		} else {
		    set startx [lindex $select_action 1]
		    set starty [lindex $select_action 2]
		    if [info exists pline] {
			    set n [$pline get -npts]
			    $pline set_point $n "$startx $starty 0" "0 0 0" "0 0 0"
			    if !$n {
			        $pline set_point 1 "$startx $starty 0" "0 0 0" "0 0 0"
			    }
		    } elseif $waiting_for_circle {
			    set circle [select_circle $startx $starty $startx $starty]
		    }
		}
	    }
	    circle {
		if ![info exists pline] {
		    set waiting_for_circle 1
		    tdv_cur $tdv_default circlepick
		}
	    }
	    polygon {
		if {$max_num && ($nstuff >= $max_num)} {
		    set finished 1
		} else {
		    #set startx [lindex $select_action 1]
		    #set starty [lindex $select_action 2]
		    if ![info exists pline] {
			set pline [select_pline]
		    }
		}
		tdv_cur $tdv_default polypick
	    }
	    move {
		set x [lindex $select_action 1]
		set y [lindex $select_action 2]
		
		if [info exists circle] {
		    $circle configure -x2 $x -y2 $y
		} elseif [info exists rbox] {
		    $rbox configure -x2 $x -y2 $y
		} elseif {[info exists startx] && [info exists starty] && ![info exists pline] && ![info exists rbox] && ![info exists circle]} {
		    set dx [expr {abs($x - $startx)}]
		    set dy [expr {abs($y - $starty)}]
		    if {($dx > 3) || ($dy > 3)} {
			set rbox [select_rbox $startx $starty $x $y]
		    }
		}
	    }
	    nb_move {
		set x [lindex $select_action 1]
		set y [lindex $select_action 2]
		if [info exists pline] {
		    set n [$pline get -npts]
		    if $n {
			$pline set_point [expr $n - 1] "$x $y 0" "0 0 0" "0 0 0"
		    }
		}
		# VG 03/21/05 optional proc on motion
		# 04/11/05 optional tags parameter added
		if {[set $do_onm] && [info exists onMotion]} {
			set tags $require_tags
			foreach wha $what { lappend tags geom_$wha }
			foreach im $stuff { lappend tags !$im }
			foreach im $not_these { lappend tags !$im }
			$onMotion $x $y $whatonMotion $tags
		}
				
	    }
	    release - shiftrelease {
		set picked ""
		set shift [expr {[lindex $select_action 0] == "shiftrelease"}]
		if {$max_num && ($nstuff >= $max_num) && !$shift} {
		    set finished 1
		} else {
		    set x [lindex $select_action 1]
		    set y [lindex $select_action 2]
		    set new_im ""
		    set last_xy ""
		    if $shift {
			set tags $stuff
		    } else {
			set tags $require_tags
			foreach wha $what { lappend tags geom_$wha }
			foreach im $stuff { lappend tags !$im }
			foreach im $not_these { lappend tags !$im }
		    }
		    if [info exists circle] {
			set centv [$tdv_default screen2world [$circle get -x1] [$circle get -y1]]
			set radv [$tdv_default screen2world [$circle get -x2] [$circle get -y2]]
			
			set picked ""
			foreach xx [$tdv_default pick_circle $tags [lindex $centv 1] \
					[lindex $centv 0] [lindex $radv 0] $options(select_mode)] {
			    if !$only_if_dormant {
			        lappend picked [lindex $xx 0]
			    } else {
			        if [object_get_geo_dormant [lindex $xx 0]] {
			            lappend picked [lindex $xx 0]
			        }
			    }
			}
			$circle delete
			unset circle
			set waiting_for_circle 0
			tdv_cur $tdv_default pick
		    } elseif [info exists rbox] {
			set n 0
			foreach p [list "[$rbox get -x1] [$rbox get -y1]" \
				       "[$rbox get -x1] $y" \
				       "$x $y" \
				       "$x [$rbox get -y1]"] {
			    set v [$tdv_default screen2world [lindex $p 0] [lindex $p 1]]
			    set vect [lindex $v 1]
			    set pt$n [lindex $v 0]
			    incr n
			}
			
			#puts [list $tdv_default pick_region $tags $vect $pt0 $pt1 $pt2 $pt3 $options(select_mode)]
			if !$only_if_dormant {
			    set picked [$tdv_default pick_region $tags $vect $pt0 $pt1 $pt2 $pt3 $options(select_mode)]
			} else {
			    set picked ""
			    foreach im [$tdv_default pick_region $tags $vect $pt0 $pt1 $pt2 $pt3 $options(select_mode)] {
			        if [object_get_geo_dormant $im] {
			            lappend picked $im
			        }
			    }
			}
			#puts "--->  $picked"
			$rbox delete
			unset rbox
		    } elseif ![info exists pline] {
			#puts [list x1 $tdv_default pick $x $y $tags "" 0]
			# 10/26/05 if preselection is On, use only preselection!
			if {$the_action == "release" && [set $do_onm] && [info exists onMotion]} {
				if [info exists maybe_picked] {
			    set picked $maybe_picked
					unset maybe_picked
			}
			} else {
			    set picked [lindex [$tdv_default pick $x $y $tags "" 0] 0]
			}
			if {$picked != ""} {
			    set last_xy [list $x $y $picked]
			}
			#puts "picked $picked"
		    }
		}
		if $compcurves {
		    catch {unset got_ims}
		    foreach im $picked { set got_ims($im) 1 }
		    # For each curve, add the others in the compcurve it's in
		    foreach im $picked {
			set name [ic_geo_get_name_of_internal_object $im] ;# not kosher
			set cname [ic_hex_find_comp_curve $name]
			foreach oname [ic_hex_get_proj_curves $cname] {
			    set oim [ic_geo_get_internal_object curve $oname]
			    if ![info exists got_ims($oim)] {
				lappend picked $oim
				set got_ims($oim) 1
			    }
			}
		    }
		}
		
		if $shift {
		    foreach im $picked {
			if [info exists config($im)] {
			    incr nstuff -1
			    set stuff [ldelete $stuff $im]
			    object_show_geo_selected $im 0
			    unset config($im)
			}
		    }
		} else {
		    foreach im $picked {
			if ![info exists config($im)] {
			    set config($im) 1
			    object_show_geo_selected $im 1
			    lappend stuff $im
			    incr nstuff
			}
		    }
		}
		if {$max_num && ($nstuff >= $max_num) && !$shift} {
		    set finished 1
		}
	    }
	    goto_next {
		set im [lindex $stuff end]
		if {([info exists last_xy] && ($last_xy == "")) || ($im == "")} {
		    mess "Warning: goto next only available for single selections\n" red
		} else {
		    incr nstuff -1
		    set stuff [ldelete $stuff $im]
		    object_show_geo_selected $im 0
		    unset config($im)
		    
		    set tags $require_tags
		    foreach wha $what { lappend tags geom_$wha }
		    foreach im $stuff { lappend tags !$im }
		    foreach im $not_these { lappend tags !$im }
		    set tags1 $tags
		    foreach im [lrange $last_xy 2 end] { lappend tags !$im }
		    set x [lindex $last_xy 0]
		    set y [lindex $last_xy 1]
		    set picked [lindex [$tdv_default pick $x $y $tags "" 0] 0]
		    if {$picked == ""} {
			set picked [lindex [$tdv_default pick $x $y $tags1 "" 0] 0]
			set last_xy [lrange $last_xy 0 1]
		    }
		    foreach im $picked {
			if ![info exists config($im)] {
			    set config($im) 1
			    object_show_geo_selected $im 1
			    lappend stuff $im
			    incr nstuff
			    lappend last_xy $im
			}
		    }
		}
	    }
	    create_new {
		if $create_new {
		    switch $what {
			point {
			    set ob [banner_get]
			    set pt [med_get_location]
			    banner $ob
			    set fam [select_families 0 0 1]
			    if {$fam != ""} {
				set im [geo_create_point_create $fam $pt]
			    }
			}
			curve {
			    if {$create_new == 1} {
				set ob [banner ""]
				set bar_map [select_bar_segments]
				banner $ob
				select_set_bindings 1 1 $inc_dim $inc_switch "Select geometry"
				tdv_push_key_command n "set select_action create_new"
				
				set binfo [$bar_map export_bars 1]
				if {$binfo != ""} {
				    set fam [select_families 0 0 1]
				    $projlib new_family $fam
				    
				    set new [eval $projlib create_unstruct_curve $fam $fam $binfo]
				    set im [define_geom_object curve $new]
				}
				$bar_map delete
			    } else {
				set fam [select_families 0 0 1]
				set nf [$projlib new_family $fam]
				set new [eval $projlib create_unstruct_curve $fam $fam 0 0 0 0]
				set im [define_geom_object curve $new]
				if $nf update_fam_window
				$im configure -visible \
				    $fam_visible([$im get -family])
			    }
			}
			surface {
			    if {$create_new == 1} {
			    } else {
				set fam [select_families 0 0 1]
				set nf [$projlib new_family $fam]
				set new [eval $projlib create_unstruct_surface $fam $fam 0 0 0 0]
				set im [define_geom_object surface $new]
				if $nf update_fam_window
				
				show_visible_if_family $im
			    }
			}
			default {
			    user_error "Can't create new $what objects right now"
			}
		    }
		    
		    set config($im) 1
		    object_show_geo_selected $im 1
		    lappend stuff $im
		    incr nstuff
		    set last_xy ""
		    if {$max_num && ($nstuff >= $max_num)} {
			set finished 1
		    }
		} else {
		    error "Can't create new object -- internal error"
		}
	    }
	    all - visible - blanked - family - color - name - number - part - subset {
		if {$med_selection_mode == "allow_all_visible_blanked"} {
		    # must reset med_selection_mode for each usage
		    set med_selection_mode 1				
		    if {($the_action == "all" || $the_action == "visible" || $the_action == "blanked")} {
			# Return keyword instead of list for point/curve/surface:
			select_unset_bindings 1
			tdv_pop_key_command n
			banner ""
			mess "$the_action ${what} selected\n"
			return $the_action
		    }			
		}			
		set how [lindex $select_action 0]
		set n 0
		set images ""
		if {$how == "name" && $what != "family" && $what != "entity"} {
		    set names [question_box .selnames Name \
			    "Enter the $what names to select,\nor patterns to match the names." "" ]
		    if !$only_if_dormant {
		        foreach name $names {
			    eval lappend images [get_object_by_name $what $name]
			    if ![regexp -all {\*} $name] {
			        if {[ic_geo_check_objects_exist $what $name] == ""} {
			            mess "No such $what $name\n" red
			        }
			    }
		        }
		    } else {
		        foreach name $names {
			    eval lappend images [get_dormant_object_by_name $what $name]
			    if ![regexp -all {\*} $name] {
			        if {[ic_geo_check_objects_exist $what $name] == ""} {
			            mess "No such $what $name\n" red
			        }
			    }
		        }
		    }
		} else {
		    if !$only_if_dormant {
		        set images [geom_get_objects $what $select_action]
		    } else {
		        set images [geom_get_objects $what $select_action 1]
		    }
		    if [llength $images] {
			set select_action done
		    } else {
			set select_action cancel
		    }
		}
		set too_many 0
		foreach im $images {
		    set not_this 0
		    foreach nim $not_these {
			if {$im == $nim} {
			    set not_this 1
			    set not_these [ldelete $not_these $nim]
			    break
			}
		    }
		    if $not_this continue

		    if [info exists config($im)] continue
		    
		    if {$too_many == 1} { set too_many 2; break }
		    
		    set config($im) 1
		    if {[info exists ai_environment] && $ai_environment} {
			object_show_geo_selected $im 1
		    }
		    lappend stuff $im
		    incr nstuff
		    incr n
		    if {$max_num == $nstuff} {
			set too_many 1
		    }
		}
		if {$too_many == 2} {
		    mess "Warning: selected only $max_num $whats via $how\n" red
		} else {
		    mess "Selected $how $whats ($n)\n"
		}
		#if $n { set finished 1 }
		set finished 1
	    }
	    only_dimensions {
		set what_d [lrange $select_action 1 end]
		if {$what_d == ""} {
		    mess "Warning: can't select any elements now, all types are off\n"
		} else {
		    mess "Selecting elements: $what_d\n"
		    set what ""
		    foreach d $what_d {
			switch $d {
			    0d { lappend what point }
			    1d { lappend what curve }
			    2d { lappend what surface }
			    3d { lappend what body density }
			}
		    }
		}
	    }
	    region_type {
		if {$options(select_mode) == "some"} {
		    set options(select_mode) all
		    mess "Objects entirely in region will be selected\n"
		} else {
		    set options(select_mode) some
		    mess "Objects partially in region will be selected\n"
		}
	    }
	    boundary_type_unused__ {
		if { $what == "surface" } { 
		    if {$options(boundary_mode) == "outer"} {
			set options(boundary_mode) all
			mess "All boundary curves will be selected\n"
		    } else {
			set options(boundary_mode) outer
			mess "Only outer boundary curves will be selected\n"
		    }
		} else {
		    mess "Warning: boundary toggle only for surface flood fill.\n" blue
		}
	    }

	    feature_angle {
		    set a [question "Flood fill\nfeature angle?" $options(flood_select_angle) ]
		    if {$a != ""} {
		        set options(flood_select_angle) $a
		    }
	    }

	    flood - flood_one {
		set sel_what $what
		if {[llength $what] > 1} {
		    set sel_what "entity"
		}
		set all [expr {[lindex $select_action 0] == "flood"}]
		set tents ""
		foreach ent $stuff {
		    lappend tents [object_geotype_of_image $ent] [object_name_of_image $ent]
		}
		
		# If we have picked a single or multiple edge curve and hit
		# "flood" let's get only the attached single edged
		# curves
		set num_curve_edges 0
		if {($what == "curve") && [llength $stuff]} {
		    set ni [llength [ic_geo_incident curve [object_name_of_image $ent]]]
		    if {($ni == 1) || ($ni == 3)} {
			    set num_curve_edges $ni
		    }
		}
		
		set nn 0
		foreach {rtype rname} [ic_geo_flood_fill $sel_what $tents $all $options(flood_select_angle) $options(boundary_mode) $num_curve_edges] {
		    #set im [object_get_image $rtype $rname]
		    set im [ic_geo_get_internal_object $rtype $rname]
		    if [info exists config($im)] continue
		    if {($rtype == $sel_what) || ($sel_what == "entity")} {
			    set config($im) 1			    
			    object_show_geo_selected $im 1
			    lappend stuff $im
			    incr nstuff
			    incr nn
		    }
		}
		switch $nn {
		    0 { mess "No more attached $whats\n" }
		    1 { mess "1 more attached $what\n" }
		    default { mess "$nn more attached $whats\n" }
		}
	    }
	}
    }
    select_unset_bindings 1
    tdv_pop_key_command n
    banner ""
    set objects ""
    set nsk 0
    foreach im $stuff {
	    if {$finished > 0} {
	        if {$only_facet && ($what != "density") && ([object_type_of_image $im] != "mesh")} {
		        incr nsk
		        continue
	        }
	        lappend objects $im
	    }
# object_show_geo_selected $im 1
	    if {!([info exists ai_environment] && $ai_environment) } {
	        object_show_geo_selected $im 0
	    }
    }
	if {[set $do_onm] && [info exists onMotion]} "catch onMotionEventEndProc" 
    if [info exists pline] {catch "$pline delete"}
    if $switch {
	    return switch_selection_type
    }
    if $nsk {
	    mess "Warning: skipped $nsk non-facet $whats - this command requires faceted $whats only.\n" red
    }
    mess "[llength $objects] $whats\n"
    return $objects
}

proc select_geometry_force_done {what} {
    global select_action
    if {[banner_get] != ""} {
        set select_action $what
        return 1
    } else {
        return 0
    }
}

proc select_geometry_segments {from sel_type {max_num 0} {first_diff 0} {also_xyz 0} {show_selected 0} {bindings_already_done 0} {no_unify 0}} {
    global tdv_default select_action options tdv_mouse_bindings projlib

    set all_objects 0    
    set names ""

    switch $from {
	    all_surfaces {
	        set what surface
	        set all_objects 1
	        foreach obj [ic_geo_lookup surface visible] {
		        if {[ic_geo_get_object_type surface [lindex $obj 1]] != "mesh"} continue
		        lappend names [lindex $obj 1]
	        }
	        if {$names == ""} {
		        mess "There are no visible faceted surfaces to select from.\n" red
		        return ""
	        }
	    }
	    all_curves {
	        set what curve
	        set all_objects 1
	        foreach obj [ic_geo_lookup curve visible] {
		        if {[ic_geo_get_object_type curve [lindex $obj 1]] != "mesh"} continue
		        lappend names [lindex $obj 1]
	        }
	        if {$names == ""} {
		        mess "There are no visible faceted curves to select from.\n" red
		        return ""
	        }
	    }
	    default {
	        if {[llength $from] == 2} {
		        set what [lindex $from 0]
		        lappend names [lindex $from 1]
	        } else {
		        error "not implemented"
	        }
	        ic_geo_set_config_param $what [lindex $names 0] draw_first_high_diff $first_diff
	    }
    }
    
    ic_geo_set_tag clear "" geo_select_segment 0
    foreach n $names {
	    ic_geo_set_tag $what $n geo_select_segment 1
    }
    if $show_selected {
	    foreach obj $names {
	        ic_show_geo_selected $what $obj 1
	    }
    }

    set partial [expr {$options(select_mode) == "some"}]
    
    switch $sel_type {
	    node {
	        set mess nodes
	        set mode nodes
	        set hsmode n
	    }
	    edge {
	        switch $what {
		        surface { set mess edges }
		        default { error "can't pick edges from a $what" }
	        }
	        set mode edges
	        set hsmode e
	    }
	    bound_edge {
	        switch $what {
		        surface { set mess "boundary edges" }
		        default { error "can't pick edges from a $what" }
	        }
	        set mode bound_edges
	        set hsmode e
	    }
	    seg {
	        switch $what {
		        surface { set mess triangles }
		        curve { set mess segments }
		        default { error "can't pick segments from a $what" }
	        }
	        set mode subseg
	        set hsmode s
	    }
	    default { error "unknown sel_type $sel_type" }
    }

    if !$bindings_already_done {
        select_geometry_bindings $mess 
    }

    set finished 0   
    set stuff ""
    set nstuff 0
    set remove_highlight 1
    set add_xy ""
    set last_surfs_added ""

    while {!$finished} {
	tkwait variable select_action
	switch [lindex $select_action 0] {
	    done {
		if [info exists pline] {
		    set poly ""
		    if {[$pline get -npts] > 2} {
			for {set i 0} {$i < [$pline get -npts]} {incr i} {
			    set p [lindex [$pline get_point $i] 0]
			    lappend poly [list [lindex $p 0] [lindex $p 1]]
			}
			set info [$tdv_default pick_polygon geo_select_segment $poly ${mode}_$options(select_mode)]
			set sa ""
			foreach inf $info {
			    set im [lindex $inf 0]
                if {$im == ""} continue
			    set n [object_name_of_image $im]
			    incr nstuff [ic_geo_highlight_segments $what $n add $hsmode [lindex $inf 1]]
			    lappend sa $n
			}
			if {$sa != ""} {
			    set last_surfs_added [concat [list $sa] $last_surfs_added]
			}
			if {($sel_type == "node") && ($max_num == 1)} {
			    set finished 1
			    set remove_highlight 0
			    set add_xy "$startx $starty"
			}
		    }
		    $pline delete
		    unset pline
		    tdv_cur $tdv_default pick
		} else {
		    set finished 1
		}
	    }
	    back {
		if [info exists pline] {
		    set n [$pline get -npts]
		    incr n -1
		    if {$n < 2} {
			$pline delete
			unset pline
			tdv_cur $tdv_default pick
		    } else {
			$pline delete_point $n
		    }
		} else {
		    if !$nstuff {
			set finished 1
		    } else {
			foreach im [lindex $last_surfs_added 0] {
			    ic_geo_highlight_segments $what $im remove $hsmode last
			}
			set last_surfs_added [lrange $last_surfs_added 1 end]
			
			set nstuff 0
			foreach n $names {
			    incr nstuff [ic_geo_highlight_segments $what $n count $hsmode ""]
			}
		    }
		}
	    }
	    cancel {
		if [info exists pline] {
		    $pline delete
		    unset pline
		}
		set finished -1
	    }
	    press {
		set hack_press 1
		if {$max_num && ($nstuff >= $max_num)} {
		    set finished 1
		} else {
		    set startx [lindex $select_action 1]
		    set starty [lindex $select_action 2]
		    if [info exists pline] {
			set n [$pline get -npts]
			$pline set_point $n "$startx $starty 0" "0 0 0" "0 0 0"
			if !$n {
			    $pline set_point 1 "$startx $starty 0" "0 0 0" "0 0 0"
			}
		    } elseif {($sel_type == "node") && ($max_num == 1)} {
			set inf [$tdv_default pick $startx $starty geo_select_segment $mode 0]
			set im [lindex $inf 0]
            if {$im == ""} continue
			set n [object_name_of_image $im]
			set nstuff [ic_geo_highlight_segments $what $n add $hsmode [lrange [lindex $inf 1] 0 1]]
			set last_surfs_added [concat [list $n $last_surfs_added]]
			
			set finished 1
			set remove_highlight 0
			set add_xy "$startx $starty"
		    }
		}
	    }
	    polygon {
		if {$max_num && ($nstuff >= $max_num)} {
		    set finished 1
		} else {
		    if ![info exists pline] {
			set pline [select_pline]
		    }
		}
		tdv_cur $tdv_default polypick
	    }
	    move {
		set x [lindex $select_action 1]
		set y [lindex $select_action 2]
		if [info exists rbox] {
		    $rbox configure -x2 $x -y2 $y
		} elseif [info exists startx] {
		    set dx [expr {abs($x - $startx)}]
		    set dy [expr {abs($y - $starty)}]
		    if {($dx > 3) || ($dy > 3)} {
			set rbox [select_rbox $startx $starty $x $y]
		    }
		}
	    }
	    nb_move {
		set x [lindex $select_action 1]
		set y [lindex $select_action 2]
		if [info exists pline] {
		    set n [$pline get -npts]
		    if $n {
			$pline set_point [expr $n - 1] "$x $y 0" "0 0 0" "0 0 0"
		    }
		}
	    }
	    release - shiftrelease {
		if ![info exists hack_press] {
		    continue;
		}
		set shift [expr {[lindex $select_action 0] == "shiftrelease"}]
		if $shift { set add_or_rm remove } else { set add_or_rm add }
		if {![info exists startx] || \
			($max_num && ($nstuff >= $max_num)) && !$shift} {
		    set finished 1
		} else {
		    set x [lindex $select_action 1]
		    set y [lindex $select_action 2]
		    set new_im ""
		    if [info exists rbox] {
			set n 0
			set poly [list "[$rbox get -x1] [$rbox get -y1]" \
				      "[$rbox get -x1] $y" \
				      "$x $y" \
				      "$x [$rbox get -y1]"]
			set info [$tdv_default pick_polygon geo_select_segment $poly ${mode}_$options(select_mode)]
			set sa ""
			foreach inf $info {
			    set im [lindex $inf 0]
                if {$im == ""} continue
			    set n [object_name_of_image $im]
			    incr nstuff [ic_geo_highlight_segments $what $n $add_or_rm $hsmode [lindex $inf 1]]
			    lappend sa $n
			}
			if {!$shift && ($sa != "")} {
			    set last_surfs_added [concat [list $sa] $last_surfs_added]
			}
			$rbox delete
			unset rbox
			
		    } elseif ![info exists pline] {
			set inf [$tdv_default pick $x $y geo_select_segment $mode 0]
			
			if {$inf != ""} {
			    set im [lindex $inf 0]
			    set n [object_name_of_image $im]
			    incr nstuff [ic_geo_highlight_segments \
					     $what $n $add_or_rm $hsmode \
					     [lrange [lindex $inf 1] 0 1]]
			    set last_surfs_added [concat $n $last_surfs_added]
			}
		    }
		}
		if {[info exists startx] && ($sel_type == "node") && \
			($max_num == 1)} {
		    set finished 1
		    set remove_highlight 0
		    set add_xy "$startx $starty"
		}
	    }
	    flood - flood_one - flood_between {
		if {$sel_type != "node"} {
		    switch [lindex $select_action 0] {
			flood         { set all 1 }
			flood_one     { set all 0 }
			flood_between { set all 2 }
		    }
		    set nstuff 0
		    set sa ""
		    foreach n $names {
			set a $options(flood_select_angle)
			set atts [ic_geo_highlight_segments $what $n attached $a $all]
			if {$atts != ""} {
			    ic_geo_highlight_segments $what $n add $hsmode $atts
			    lappend sa $n
			}
			incr nstuff [ic_geo_highlight_segments $what $n count $hsmode ""]
		    }
		    if {$sa != ""} {
			set last_surfs_added [concat [list $sa] $last_surfs_added]
		    }
		}
	    }
	    flood_split2 {
		if {($sel_type == "edge") || ($sel_type == "bound_edge")} {
		    # First we split two edges.  Then we do a flood fill
		    # between them.
		    set ob [banner "Select the two points to split with the left button; right = cancel."]
		    set bad 0
		    set pts ""
		    foreach p {1 2} {
			while 1 {
			    tkwait variable select_action
			    set p1 $select_action
			    switch [lindex $p1 0] {
				release {
				    set inf [$tdv_default pick [lindex $p1 1] \
						 [lindex $p1 2] \
						 geo_select_segment $mode 0]
				    if {$inf == ""} {
					set bad 1
				    } else {
                                        set im [lindex $inf 0]
                                        if {$im == "} continue
					set n [object_name_of_image $im]
					set inf$p [list $n [lindex $inf 1]]
					set pp [tdv_point_im -point [lindex $inf 2] -size 3 -color red]
					$tdv_default add_image $pp
					lappend pts $pp
				    }
				    break
				}
				cancel  { set bad 1; break }
			    }
			}
			if $bad break
		    }
		    banner $ob
		    foreach p $pts { $p delete }
		    
		    if $bad continue
		    
		    if {[lindex $inf1 0] != [lindex $inf2 0]} {
			mess "You can only do this operation on edges of\
				the same surface\n" red
			continue
		    }
		    set name [lindex $inf1 0]
		    set ed1 [lindex $inf1 1]
		    set ed2 [lindex $inf2 1]
		    if {[lindex $ed1 2] <= 0.05} {
			set p1 [lindex $ed1 0]
		    } elseif {[lindex $ed1 2] >= .95} {
			set p1 [lindex $ed1 1]
		    } else {
			set p1 [ic_geo_split_one_edge surface $name $ed1]
		    }
		    if {[lindex $ed2 2] <= 0.05} {
			set p2 [lindex $ed2 0]
		    } elseif {[lindex $ed2 2] >= .95} {
			set p2 [lindex $ed2 1]
		    } else {
			set p2 [ic_geo_split_one_edge surface $name $ed2]
		    }
		    
		    set atts [ic_geo_highlight_segments surface $name between $p1 $p2]
		    set sa ""
		    if {$atts != ""} {
			ic_geo_highlight_segments surface $name add $hsmode $atts
			set last_surfs_added [concat [list [list $name]] $last_surfs_added]
			incr nstuff [ic_geo_highlight_segments surface $name count $hsmode ""]
		    }
		}
	    }
	    region_type {
		if {$options(select_mode) == "some"} {
		    set options(select_mode) all
		    mess "Objects entirely in region will be selected\n"
		} else {
		    set options(select_mode) some
		    mess "Objects partially in region will be selected\n"
		}
	    }
	    feature_angle {
		    set a [question "Flood fill\nfeature angle?" $options(flood_select_angle) ]
		    if {$a != ""} {
		        set options(flood_select_angle) $a
		    }
	    }
	}
    }
    
    if !$bindings_already_done {
        select_geometry_bindings ""
    }
    
    if {$finished < 0} {
	    foreach n $names {
	        ic_geo_highlight_segments $what $n remove $hsmode all
	        if $show_selected {
		        ic_show_geo_selected $what $n 0
	        }
	    }
	    return ""
    } elseif $all_objects {
	    set ret ""
	    foreach n $names {
	        set segs [ic_geo_highlight_segments $what $n get $mode ""]
	        if {$remove_highlight && $segs != ""} {
		        ic_geo_highlight_segments $what $n remove $mode all
	        }
	        if {$segs != ""} {
                if $no_unify {
                    lappend ret [list $n $segs]
                } else {
		            lappend ret [list $n [select_geometry_segments_uniquify $segs]]
		        } 
	        }
	        if {$show_selected  && $segs != ""} {
		        ic_show_geo_selected $what $n 0
	        }
	    }
	    return $ret	
    } else {
	    set n [lindex $names 0]
        set segs [ic_geo_highlight_segments $what $n get $mode ""]
        if {$segs != ""} {
	        set segs [select_geometry_segments_uniquify $segs]
	    }
	    if {$remove_highlight && $segs != ""} {
	        ic_geo_highlight_segments $what $n remove $mode all
	    }
	    if {$show_selected && $segs != ""} {
	        ic_show_geo_selected $what $n 0
	    }
	    if {$add_xy != ""} {
	        return [list $segs $add_xy]
	    } else {
	        return $segs
	    }
    }
}

proc select_geometry_bindings {mess {toolbar 1}} {
    global tdv_mouse_bindings
    if {$mess != ""} {
	    foreach s { select done cancel } {
	        set b_$s [lindex {"" left middle right} $tdv_mouse_bindings($s)]
	    }
	    banner "Select $mess with the $b_select button; $b_done = done, $b_cancel = back up / cancel, Shift-$b_select = deselect, '?' = list options."
	    select_set_bindings 5 $toolbar 0 0 "Select segments"
    } else {
	    select_unset_bindings 1
	    banner ""
    }
}
    
proc select_geometry_segments_uniquify {segs} {
    set usegs ""
    foreach s $segs {
        if [info exists tmp_arr($s)] continue
        set tmp_arr($s) 1
        eval lappend usegs $s
    }
    return $usegs
}

proc select_geometry_segments_via_curves {{names 0}} {
    global projlib
    
    set curves [select_geometry curve]
    if {$curves == ""} return
    
    # Now get all the boundary segments from these curves.
    set got_surfs ""
    foreach cc $curves {
	set isurfs [$cc incident]
	foreach ii $isurfs {
	    set surf [$projlib get_object_by_name surface $ii]
	    set edges [$projlib surface_edges_incident_to_curve \
			   [$surf get -number] [$cc get -number]]
	    lappend segs_surf($surf) $edges
	    lappend got_surfs $surf
	}
    }
    set segs ""
    foreach surf $got_surfs {
	if [info exists segs_surf($surf)] {
	    if $names {
		lappend segs [list [$surf get -name] $segs_surf($surf)]
	    } else {
		lappend segs [list $surf $segs_surf($surf)]
	    }
	    unset segs_surf($surf)
	}
    }
    if {$segs == ""} {
	mess "No surfaces are adjacent to those curves\n" red
    }
    if $names {
	set cc ""
	foreach c $curves { lappend cc [$c get -name] }
	set curves $cc
    }
    
    return [list $segs $curves]
}

proc select_move_geo_points {objs what} {
    global tdv_default
    global select_action tdv_mouse_bindings
    
    foreach s { select done cancel } {
	set b_$s [lindex {"" left middle right} $tdv_mouse_bindings($s)]
    }
    banner "Move all selected with the $b_select button; $b_done = done, $b_cancel = back up / cancel."
    select_set_bindings 0 0 0 0 ""
    set finished 0
    
    set start_pts ""
    foreach obj $objs {
	lappend start_pts [ic_geo_get_${what}_location $obj]
    }
    set start_mouse ""
    
    ic_undo_group_begin
    while {!$finished} {
	tkwait variable select_action
	switch [lindex $select_action 0] {
	    done {
		set finished 1
	    }
	    back {
	    }
	    press {
		catch {
		    set x [lindex $select_action 1]
		    set y [lindex $select_action 2]
		    set v [$tdv_default screen2world $x $y]
		    set start_mouse [lindex $v 0]
		}
	    }
	    move - release {
		if {$start_mouse == ""} continue
		set x [lindex $select_action 1]
		set y [lindex $select_action 2]
		set v [$tdv_default screen2world $x $y]
		
		foreach obj $objs sp $start_pts {
		    ic_geo_drag_$what $obj $sp $start_mouse \
			[lindex $v 0] [lindex $v 1]
		}
		$tdv_default redraw
	    }
	}
    }
    ic_undo_group_end
    select_unset_bindings 1
    banner ""
}

proc select_move_geo_nodes {what sname pts how xypos {dont_reset_bindings 0}} {
    global tdv_default
    global select_action tdv_mouse_bindings
        
    foreach s { select done cancel } {
        set b_$s [lindex {"" left middle right} $tdv_mouse_bindings($s)]
    }

    banner "Move selected with the $b_select button; $b_done = done, $b_cancel = back up / cancel"
    set finished 0
    
    set start_pts ""
    foreach p $pts {
        lappend start_pts [ic_geo_get_node $what $sname $p]
    }  
    # Take the position from the previous click as the first press for the move
    if {$xypos != "" && [llength $xypos] == 2} {
	    set x [lindex $xypos 0]
	    set y [lindex $xypos 1]
	    set v [$tdv_default screen2world $x $y]
	    set start_mouse [lindex $v 0]
    } else {
        set start_mouse ""
    }

    ic_undo_group_begin
    while {!$finished} {
	tkwait variable select_action
	switch [lindex $select_action 0] {
	    done {
		set finished 1
	    }
	    back {
	    }
	    press {
		set x [lindex $select_action 1]
		set y [lindex $select_action 2]
		set v [$tdv_default screen2world $x $y]
		set start_mouse [lindex $v 0]
	    }
	    move - release {
		if {$start_mouse == ""} continue
		set x [lindex $select_action 1]
		set y [lindex $select_action 2]
		set v [$tdv_default screen2world $x $y]
		ic_geo_drag_nodes $what $sname $pts $start_pts $start_mouse [lindex $v 0] [lindex $v 1] $how
		
		$tdv_default redraw
		if {[lindex $select_action 0] == "release"} { set finished 1 }
	    }
	    explicit {
		foreach p $pts {
		    set opt [ic_geo_get_node $what $sname $p]
		    set npt [question_box .newp "Position" "Enter the new position." $opt]
		    if {$npt != "" && [va_is_triplet $npt]} {
			ic_geo_set_node $what $sname $p $npt
			$tdv_default redraw
			set finished 1
		    }
		}
	    }
	    increment {
		foreach p $pts {
		    set opt [ic_geo_get_node $what $sname $p]
		    set dxyz [question_box .incv "Vector" "Enter the increment vector." "0 0 0"]
		    if {$dxyz != ""  && [va_is_triplet $dxyz]} {
			set ptx [expr [lindex $opt 0] + [lindex $dxyz 0]]
			set pty [expr [lindex $opt 1] + [lindex $dxyz 1]]
			set ptz [expr [lindex $opt 2] + [lindex $dxyz 2]]

			ic_geo_set_node $what $sname $p "$ptx $pty $ptz"
			$tdv_default redraw
			set finished 1
		    }
		}
	    }
	    screen {
		foreach p $pts {
		    #set npt [med_get_location "" 0]
            set npt [lindex [va_create_xyz auto 1 0] 0]
		    if {$npt != ""} {
			ic_geo_set_node $what $sname $p $npt
			$tdv_default redraw
			set finished 1
		    }
		}
	    }
	}
    }
    ic_undo_group_end
    
    if !$dont_reset_bindings {
	    select_unset_bindings 1
	    banner ""
    }
}

proc select_geometry_dragpath {from call_edge_cross call_edge_release} {
    global tdv_default
    global select_action options tdv_mouse_bindings
    global crease_project projlib

    set what [$from get -type]
    
    foreach s { select done cancel } {
	set b_$s [lindex {"" left middle right} $tdv_mouse_bindings($s)]
    }
    
    banner "Drag a path with the $b_select button; $b_done = done,\
	$b_cancel = back up / cancel, '?' = list options."
    
    select_set_bindings 6 0 0 0 ""
    set finished 0
    
    array set cpro {
	-1 none
	1 curves
	2 surfaces
    }
    mess "Projecting to $cpro($crease_project)\n"
    
    set startx 0
    set starty 0
    set pline ""
    while {!$finished} {
	tkwait variable select_action
	
	switch [lindex $select_action 0] {
	    done {
		set finished 1
	    }
	    back {
		set finished 1
	    }
	    cancel {
		set finished 1
	    }
	    proj_none {
		set crease_project -1
		mess "Projecting to $cpro($crease_project)\n"
	    }
	    proj_curve {
		set crease_project 1
		mess "Projecting to $cpro($crease_project)\n"
	    }
	    proj_surf {
		set crease_project 2
		mess "Projecting to $cpro($crease_project)\n"
	    }
	    press {
		set startx [lindex $select_action 1]
		set starty [lindex $select_action 2]
		set pline [tdv_poly_line_im -color orange -transform 0 \
			      -draw_dots 0]
		$tdv_default add_image $pline
		$pline add_point "$startx $starty 0"
	    }
	    move {
		if {$pline == ""} continue
		set x [lindex $select_action 1]
		set y [lindex $select_action 2]
		
		set v1 [$tdv_default screen2world $startx $starty]
		set v2 [$tdv_default screen2world $x $y]
		# this is pointing out of the screen but for these purposes
		# we need it pointing inwards
		set vec2 [lindex $v1 1]
		set vec ""; foreach v $vec2 { lappend vec [expr -$v] }
		
		set edges [$projlib select_edges_crossed [$from get -number] \
			       [lindex $v1 0] [lindex $v2 0] $vec 1]

		if {$edges != ""} {
		    $call_edge_cross $from $edges [lindex $v1 0] \
			[lindex $v2 0] $vec
		}
		$pline add_point "$x $y 0"
		set startx $x
		set starty $y
	    }
	    release {
		if {$pline != ""} {
		    $pline delete
		    set pline ""
		    $call_edge_release $from 
		}
	    }
	}
    }
    
    select_unset_bindings 1
    banner ""
}

