
# 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

proc uniquify_pairs {pairs} {
    set segs ""
    foreach ss $pairs {
	eval lappend segs $ss
    }
    foreach {i j} $segs {
	if {$i == $j} continue
	if {$i > $j} {
	    set k $i
		set i $j
	    set j $k
	}
	set "found($i $j)" 1
    }
    set ret ""
    foreach ff [array names found] {
	eval lappend ret $ff
    }
    
    return $ret
}

proc present_geometry {objs mess answers {center_objs ""}} {
    global projlib
    foreach {type num} $objs {
	lappend got($type) [$projlib get_name $type $num]
    }
    set obj_list ""
    foreach g [array names got] {
	lappend obj_list $g $got($g)
    }
    # objects in $center_obj will be displayed in yellow (used for midsurface)
    foreach {type num} $center_objs {
	lappend got2($type) [$projlib get_name $type $num]
    }
    set center_list ""
    foreach g [array names got2] {
	lappend center_list $g $got2($g)
    }
    return [gui_present_geometry $obj_list $mess $answers $center_list]
}

proc center_geometry {objs} {
    global projlib
    foreach {type num} $objs {
	lappend got($type) [$projlib get_name $type $num]
    }
    set obj_list ""
    foreach g [array names got] {
	lappend obj_list $g $got($g)
    }
    return [gui_center_geometry $obj_list]
}

proc geo_import_from_uns {uns no_seg no_merge} {
    global projlib
    if ![ic_undo_suspended] {
            ic_save_model_for_undo
    ic_undo_suspend
            set resume 1
 } else {
  set resume 0
 }
    if {($projlib != "") && [$projlib num_objects all]} {
	mess "Warning: geometry data already exists: some curves and surfaces\
		may be duplicated.\n" red
    }
    
    if $no_seg {
	set fams [list ""]
    } else {
	set fams [$uns list_families]
    }
    
    if {$projlib == ""} { 
	ic_empty_tetin
    } else {
	foreach ff [$projlib list_families 0] { set got_fam($ff) 1 }
    }
    
    set nsurf 0; set ncurve 0; set npoint 0; set nmat 0
    foreach fam $fams {
	set famname $fam
	# Bugzilla 2579: fix: only append the number if using "FAM" default
	if {$famname == ""} {
	    set famname FAM
	    set nn 1
	    while {[info exists got_fam($famname.$nn)]} { incr nn }
	    set famname $famname.$nn
	}
	set basename $famname/
	set got_fam($famname) 1
	
	$projlib new_family $famname
	add_new_family $famname 1
	set stuff [$uns export_tris $fam 1]
	if {$stuff != ""} {
	    set name [$projlib new_name surface $basename 0]
	    set new [eval $projlib create_unstruct_surface $name $famname $stuff $no_merge]
	    set bsp [define_geom_object surface $new]
	    update_geom_visible_obj $bsp
	    incr nsurf
	}
	set stuff [$uns export_bars $fam 1]
	if {$stuff != ""} {
	    set name [$projlib new_name curve $basename 0]
	    set new [eval $projlib create_unstruct_curve $name $famname $stuff]
	    set bsp [define_geom_object curve $new]
	    update_geom_visible_obj $bsp
	    incr ncurve
	}
	set stuff [$uns export_points $fam]
	foreach pt $stuff {
	    set name [$projlib new_name point $basename 0]
	    set new [$projlib create_point $name $famname $pt]
	    set bsp [define_geom_object point $new]
	    update_geom_visible_obj $bsp
	    incr npoint
	}
	set stuff [$uns export_materials $fam]
	foreach pt $stuff {
	    set name [$projlib new_name material $basename 0]
	    set new [$projlib create_material $name $famname $pt]
	    set bsp [define_geom_object material $new]
	    update_geom_visible_obj $bsp
	    incr nmat
	}
    }
    if $nsurf {
	$projlib mark_mesh_facets
    }
    if $resume ic_undo_resume
    return [list $nsurf $ncurve $npoint $nmat]
}

proc geo_export_to_uns {uns no_merge {fams ""}} {
    global projlib
    
    if {$fams == ""} {
	set fams [ic_geo_list_families]
    }
    foreach f $fams {
	set convert($f) 1
    }
    if !$no_merge {
	foreach f [$projlib list_families 0] {
	    #set p [$projlib lookup_family_pid $f]  this is not necessary
	    $uns create_family $f -1
	}
    }
    
    set nsurf 0; set ncurve 0; set npoint 0; set nmat 0
    foreach surf [$projlib list_objects surface only_mesh] {
	set sfam [$projlib get_family surface $surf]
	if ![info exists convert($sfam)] {
	    continue
	}
	if $no_merge {
	    set fam [$projlib get_name surface $surf]
	} else {
	    set fam $sfam
	}
	set stuff [$projlib export_tris $surf]
	eval $uns import_tris \"$fam\" $stuff
	incr nsurf
    }
    foreach curve [$projlib list_objects curve only_mesh] {
	set cfam [$projlib get_family curve $curve]
	if ![info exists convert($cfam)] {
	    continue
	}
	if $no_merge {
	    set fam [$projlib get_name curve $curve]
	} else {
	    set fam $cfam 
	}
	set stuff [$projlib export_bars $curve]
	eval $uns import_bars \"$fam\" $stuff
	incr ncurve
    }
    foreach point [$projlib list_objects point] {
	set pfam [$projlib get_family point $point]
	if ![info exists convert($pfam)] {
	    continue
	}
	if $no_merge {
	    set fam [$projlib get_name point $point]
	} else {
	    set fam $pfam
	}
	set loc [$projlib get_point_loc $point]
	$uns import_point $fam $loc
	incr npoint
    }
    # do not create tetra from the mat point: cf. Bug 3445 --->
    if 0 {
	foreach material [$projlib list_objects material] {
	    if $no_merge {
		set fam [$projlib get_name material $material]
	    } else {
		set fam [$projlib get_family material $material]
	    }
	    set loc [$projlib get_material_loc $material]
	    foreach {n v} [$projlib set_meshing_params global 0] { set $n $v }
	    $uns import_material $fam $loc $gmax
	    incr nmat
	}
    }
    # <---
    set idmap [$uns get_map All]
    if {"" == $idmap} {
	make_standard_maps $uns
	set idmap [$uns get_map All]
    }
    if {"" != $idmap} {
	set tol [expr [$idmap min_edge_length] * 0.1]
	$idmap merge_nodes_tol $tol 0 "0 0 0" "0 0 0" 0 0 0
    }
    $uns reset_dimension
    return [list $nsurf $ncurve $npoint $nmat]
}

proc update_geom_visible_obj {obj} {
    global batch_mode

    if $batch_mode { return }

    if { $obj == "" } return
    set type [$obj get -type]
    set fam [$obj get -family]
    if {$fam == ""} {
	set vis [get_geom_visible $type]
    } else {
	set vis [expr [get_fam_visible $fam] && [get_geom_visible $type]]
    }
    set type [$obj get -type]
    switch [get_str_option $type,dtype] {
	simplest { set simp 5 }
	simpler  { set simp 3 }
	simple   { set simp 1 }
	detailed { set simp 0 }
	default  { 
	    error "unknown display type [get_str_option $type,dtype] for $type"
	}
    }
    set shade [get_str_option $type,stype]
    
    set st 0; set sp 0; set sh 0
    switch [get_str_option $type,sizes] {
	none  {}
	tetra { set st 1 }
	prism { set sp 1 }
	hexa  { set sh 1 }
    }

    set colcnt 0; set s0 0; set s1 0; set s2 0; set s3 0;
    if { $type == "curve" } {
	set colcnt [get_str_option $type,count]
	set s0 [get_str_option $type,show0]
	set s1 [get_str_option $type,show1]
	set s2 [get_str_option $type,show2]
	set s3 [get_str_option $type,show3]
    }
    
    set scomp 0;
    if { $type == "curve" } {
        set scomp [get_str_option $type,show_composite]
    }

    set lele 0; set lfull 0; set lsq 0; set ls0 0; set ls1 0; set ls2 0
    if { $type == "loop" } {
	set lele [get_quad_option element]
	set lfull [get_str_option $type,lfull]
	set lsq [get_str_option $type,lsizes]
	set ls0 [get_str_option $type,lshow0]
	set ls1 [get_str_option $type,lshow1]
	set ls2 [get_str_option $type,lshow2]
    }
    
    $obj configure -visible $vis -simple $simp -shade $shade \
	-draw_tetra_size $st -draw_prism_size $sp -draw_hexa_size $sh \
	-draw_name [get_str_option $type,names] \
	-draw_norm [get_str_option $type,norms] \
	-color_by_count $colcnt \
	-show0 $s0 -show1 $s1 -show2 $s2 -show3 $s3 \
	-width [expr 1 + 2 * [get_str_option $type,wide]] \
	-lfull $lfull -show_points $ls0 -show_surfaces $ls1 \
	-show_corners $ls2 -lsq $lsq -element $lele \
	-show_composite $scomp
}

# This is a utility function primarily used by the scripting functions.
# It's actually just like the one above.

proc geo_lookup {types how objects {report_err 1} {even_if_dormant 0}} {
    global projlib
    #puts [list geo_lookup $types $how $objects $report_err $even_if_dormant]
    if {$projlib == ""} { return "" }
    
    if {$types == "all"} {
	set types "surface curve point material density loop body"
    }

    if ($even_if_dormant) {
        set dormant "even_if_dormant"
    } else {
        set dormant ""
    }
    
    set objs ""
    switch $how {
	objects {
	    set objs $objects
	}
	names {
	    foreach type $types {
		foreach n $objects {
		    set num [$projlib get_number $type $n]
		    if {$num == -1} {
			if $report_err {
			    error "no such $type $n"
			} else {
			    continue
			}
		    }
		    set obj [$projlib get_object $type $num]
		    if {$obj == ""} {
			if $report_err {
			    error "No $type with number $n"
			} else {
			    continue
			}
		    }
		    if {[$obj is_dormant] && !$even_if_dormant} continue
			if ![info exists found($obj)] {
				lappend objs $obj
				set found($obj) 1
			} 
		}
	    }
	}
	type_names {
	    foreach pair $objects {
		set type [lindex $pair 0]; set n [lindex $pair 1]
		set num [$projlib get_number $type $n]
		if {$num == -1} {
		    if $report_err {
			error "no such $type $n"
		    } else {
			continue
		    }
		}
		set obj [$projlib get_object $type $num]
		if {$obj == ""} {
		    if $report_err {
			error "No $type with number $n"
		    } else {
			continue
		    }
		}
		lappend objs $obj
	    }
	}
	numbers {
	    foreach type $types {
		foreach n $objects {
		    set obj [$projlib get_object $type $n]
		    if {$obj == ""} {
			if $report_err {
			    error "No $type with number $n"
			} else {
			    continue
			}
		    }
		    lappend objs $obj
		}
	    }
	}
	families {
	    foreach type $types {
		foreach n $objects {
		    set pid [$projlib lookup_family_pid $n]
		    if {$pid == ""} continue
		    foreach m [$projlib get_objects_in_family $type $pid $dormant] {
			set obj [$projlib get_object $type $m]
			lappend objs $obj
		    }
		}
	    }
	    
	}
	all - patterns {
	    if {$how == "all"} { set objects * }
            if $even_if_dormant {
                set dormant "even_if_dormant"
            } else {
                set dormant ""
            }
	    foreach type $types {
		foreach num [$projlib list_objects $type $dormant] {
		    set name [$projlib get_name $type $num]
		    foreach p $objects {
			if [string match $p $name] {
			    lappend objs [$projlib get_object $type $num]
			    break
			}
		    }
		}
	    }
	}
	visible - blanked {
	    if {$how == "visible"} { set flag 1 } else { set flag 0 }
	    foreach type $types {
		foreach num [$projlib list_objects $type $dormant] {
		    set obj [$projlib get_object $type $num]
		    if {[$obj get -visible] == $flag} {
			lappend objs $obj
		    }
		}
	    }
	}
    }
    return $objs
}

proc bbox_of_images {ims} {
    if {$ims == ""} { return "" }
    
    foreach im $ims {
	set bb [$im get_bbox]
	if {$bb == ""} continue
	foreach c {0 1 2} {
	    set v1 [lindex [lindex $bb 0] $c]
	    set v2 [lindex [lindex $bb 1] $c]
	    if {![info exists minv($c)] || ($minv($c) > $v1)} {
		set minv($c) $v1
	    }
	    if {![info exists maxv($c)] || ($maxv($c) < $v2)} {
		set maxv($c) $v2
	    }
	}
    }
    return [list "$minv(0) $minv(1) $minv(2)" "$maxv(0) $maxv(1) $maxv(2)"]
}

proc bbox_of_images2 {ims} {
    if {$ims == ""} { return "" }
    
    foreach im $ims {
	set bb [$im get_bbox2]
	if {$bb == ""} continue
	foreach c {0 1 2} {
	    set v1 [lindex [lindex $bb 0] $c]
	    set v2 [lindex [lindex $bb 1] $c]
	    if {![info exists minv($c)] || ($minv($c) > $v1)} {
		set minv($c) $v1
	    }
	    if {![info exists maxv($c)] || ($maxv($c) < $v2)} {
		set maxv($c) $v2
	    }
	}
    }
    return [list "$minv(0) $minv(1) $minv(2)" "$maxv(0) $maxv(1) $maxv(2)"]
}

proc create_empty_tetin_if_needed {} {
    if ![ic_geo_is_loaded] { ic_empty_tetin }
}

proc incident_objects {obj} {
    global projlib
    
    set t [$obj get -type]
    switch $t {
	point { set t2 curve }
	curve { set t2 surface }
	loop  { set t2 surface }
	default { return "" }
    }
    set ret ""
    foreach name [$obj incident] {
	lappend ret [$projlib get_object_by_name $t2 $name]
    }
    return $ret
}

proc boundary_objects {obj outer} {
    global projlib
    
    if $outer {
	set names [$obj outer_boundary]
    } else {
	set names [$obj boundary even_if_dormant]
    }
    
    set t [$obj get -type]
    switch $t {
	curve { set t2 point }
	loop  { set t2 curve }
	surface { set t2 curve }
	default { return "" }
    }
    set ret ""
    foreach name $names {
	lappend ret [$projlib get_object_by_name $t2 $name]
    }
    return $ret
}

proc boundary_of_image {im {outer 0} {even_if_dormant 0} {embedded 0}} {
    global projlib
    if ($even_if_dormant) {
        set dormant "even_if_dormant"
    } else {
        set dormant ""
    }
    if ($embedded) {
        set embedded "embedded"
    } else {
        set embedded ""
    }
    if $outer {
	return [$im outer_boundary]
    } else {
	return [$im boundary $dormant $embedded]
    }
}


proc after_create_geom_object {type family no} {
    set new_fam [ic_geo_new_family $family]
    set nb [define_geom_object $type $no]
    update_geom_visible_obj $nb
    display_update geo $new_fam
    $projlib configure -modified 1
}

proc comak_isoparametric {fam name srf pnt dir} {
		# the only purpose of this command is to simulate comak command
		# format is wierd, not consistent with other commands
		# format: surface point +/-X|Y|Z
		# a) project point on surface (psrf)
		# b) get u-v parameters
		# c) check which of 4 edge [surface] with that u|v has max/min X|Y|Z coord
		# d) create iso crv with the u|v
		# e) split crv at psrf
		# f) delete "wrong" part of crv
		# all done in geometry_subs.tcl comak_isoparametric 
#
		set err [catch "ic_geo_find_nearest_srf_pnt $srf $pnt" uv]
		if $err {
			ic_mess "Err: isoparametric $srf projection $pnt\n"
			return
		}	
		foreach "u v" $uv ""
		set p0 [lindex [ic_geo_get_srf_pos $u 0 $srf] 0]
		set iso 0
		set end 0
		foreach "uu vv is en junk" "$u 1 0 1 , 0 $v 1 0 , 1 $v 1 1" {
			set pp [lindex [ic_geo_get_srf_pos $uu $vv $srf] 0]
			if {$dir == "+X"} {
				if {[lindex $pp 0] < [lindex $p0 0]} continue
			} elseif {$dir == "-X"} {
				if {[lindex $pp 0] > [lindex $p0 0]} continue
			} elseif {$dir == "+Y"} {
				if {[lindex $pp 1] < [lindex $p0 1]} continue
			} elseif {$dir == "-Y"} {
				if {[lindex $pp 1] > [lindex $p0 1]} continue
			} elseif {$dir == "+Z"} {
				if {[lindex $pp 2] < [lindex $p0 2]} continue
			} elseif {$dir == "-Z"} {
				if {[lindex $pp 2] > [lindex $p0 2]} continue
			}
			set p0 $pp
			set iso $is
			set end $en
		}
#
		set par [lindex $uv $iso]
		ic_geo_cre_crv_iso_crv $fam $name $srf $par $iso
		set err [catch "ic_geo_split_curve $name $pnt" splits]
		# sometimes it does not split
		if {$err || [llength $splits] != 2} {
			return $name
		}
		foreach "c1 c2" $splits ""

		# keep curve which has end at p0
		set p10 [lindex [ic_geo_get_crv_pos 0 $c1] 0]
		set p11 [lindex [ic_geo_get_crv_pos 1 $c1] 0]
		set p20 [lindex [ic_geo_get_crv_pos 0 $c2] 0]
		set p21 [lindex [ic_geo_get_crv_pos 1 $c2] 0]
		set d(0) [ic_vcalc distance $p10 $p0]
		set d(1) [ic_vcalc distance $p11 $p0]
		set d(2) [ic_vcalc distance $p20 $p0]
		set d(3) [ic_vcalc distance $p21 $p0]
		set dd 1e9
		foreach i {0 1 2 3} {
			if {$d($i) < $dd} {
				set dd $d($i)
				set ii $i

			}
		}
		if {$ii < 2} {
			set keep $c1
			ic_delete_geometry curve names $c2 0
		} else {
			set keep $c2
			ic_delete_geometry curve names $c1 0
		}
		if {$keep != $name} {
			ic_geo_set_name curve $keep $name
		}
	return $name
}
proc comak_matching_curve_tangent {part name c1 e1 c2 e2} {
# the only purpose of this command is to simulate comak command
# first curve may be not connected with second curve:
# function just uses vector at the $e2 end of $c2
# may be removed or created as projlib command
# do not use (except ic_curve)
	set xyz1 [ic_geo_get_crv_end_generic $c1 $e1]
	set par1 [ic_geo_find_nearest_crv_pnt $c1 $xyz1]
	set xyz2 [ic_geo_get_crv_end_generic $c2 $e2]
	set par2 [ic_geo_find_nearest_crv_pnt $c2 $xyz2]
	set tan2 [ic_geo_get_crv_tan $par2 $c2]
	# in med this vector is from start to end curve direction
	# in comak it's a vector "inside" curve, but this function use opposite...
	# it's wierd
	if {$par2 < 0.5} {
		set tan2 [ic_vcalc smult $tan2 -1]
	}
	# normalize vector
	set crvlen [ic_geo_crv_length $c1]
	set off [expr $crvlen*0.01] 
	set tan2 [ic_vcalc nrm $tan2]
	set v [ic_vcalc smult $tan2 $off]
	# now change curve c1 to match this vector at $xyz1
	# temporary: just create from points on curve, replacing 1-2 points
	for {set i 0} {$i <= 10} {incr i} {
		set par [expr 0.1*$i]
		set p($i) [lindex [ic_geo_get_crv_pos $par $c1] 0]
	}
	if {$par1 < 0.5} {
		set p(1) [ic_vcalc sum $p(0) $v]
	} else {
		set p(9) [ic_vcalc sum $p(10) $v]
	}
	set pts ""
	for {set i 0} {$i <= 10} {incr i} {
		lappend pts $p($i)
	}
	 return [ic_geo_cre_bsp_crv_n_pnts $part $name $pts]
}
#=======================================		
proc comak_curve_end_position {part name c1 e1 pnt} {
	set xyz1 [ic_geo_get_crv_end_generic $c1 $e1]
	set par1 [ic_geo_find_nearest_crv_pnt $c1 $xyz1]

	for {set i 0} {$i <= 10} {incr i} {
		set par [expr 0.1*$i]
		set p($i) [lindex [ic_geo_get_crv_pos $par $c1] 0]
	}
	if {$par1 < 0.5} {
		set p(0) $pnt
	} else {
		set p(10) $pnt
	}
	set pts ""
	for {set i 0} {$i <= 10} {incr i} {
		lappend pts $p($i)
	}
	 return [ic_geo_cre_bsp_crv_n_pnts $part $name $pts]
}
proc comak_curve_end_tangent {part name c1 e1 vec} {
	set xyz1 [ic_geo_get_crv_end_generic $c1 $e1]
	set par1 [ic_geo_find_nearest_crv_pnt $c1 $xyz1]
	# normalize vector
	set crvlen [ic_geo_crv_length $c1]
	set off [expr $crvlen*0.01] 
	set vec [ic_vcalc nrm $vec]
	set v [ic_vcalc smult $vec $off]

	for {set i 0} {$i <= 10} {incr i} {
		set par [expr 0.1*$i]
		set p($i) [lindex [ic_geo_get_crv_pos $par $c1] 0]
	}
	if {$par1 < 0.5} {
		set p(1) [ic_vcalc sum $p(0) $v]
	} else {
		set p(9) [ic_vcalc sum $p(10) $v]
	}
	set pts ""
	for {set i 0} {$i <= 10} {incr i} {
		lappend pts $p($i)
	}
	 return [ic_geo_cre_bsp_crv_n_pnts $part $name $pts]
}

proc comak_offset_within_surf {part name crv srf pnt end ds de} {
	# get nearest point on curve from pnt "crvpnt"
	# calc vector "vec" for offset direction as pnt->crvpnt
	# offset ends in "vec" direction as defined in ds de
	# define curve with ??? offset for intermidiate points
	# - probably offset will depend on u-value for curve points
	# project curve to surface
	set prjpnt [ic_geo_project_point surface $srf $pnt {0 0 0} 1]
	set crvpnt [ic_geo_project_point curve $crv $prjpnt {0 0 0} 1]
	set vec [ic_vcalc dir $prjpnt $crvpnt]

	if {([string range $ds 0 2] != "ds=") || \
	   ([string range $de 0 2] != "de=")} {
		ic_mess "Err: comak_offset_within_surf offset: $ds , $de\n" red
		return    
	}
	set ds [string range $ds 3 end]
	set de [string range $de 3 end]

# end (e.g. "xmax") shows for which end offset = $ds. For other end offset is $de 
	set xyz1 [ic_geo_get_crv_end_generic $crv $end]
	set par1 [ic_geo_find_nearest_crv_pnt $crv $xyz1]
	if {$par1 < 0.5} {
		set off_0 $ds
		set off_1 $de
	} else {
		set off_0 $de
		set off_1 $ds		
	}	
	set pts ""
	for {set i 0} {$i <= 10} {incr i} {
		set par [expr 0.1*$i]
		# offset changes with param:
		set p [lindex [ic_geo_get_crv_pos $par $crv] 0]
		set poff [expr -1.0*($off_0+($off_1-($off_0)))*$par]
		set vecoff [ic_vcalc smult $vec $poff]
		lappend pts [ic_vcalc sum $p $vecoff]
	}
	ic_delete_geometry curve names tmpcrv 0
	set tmp [ic_geo_cre_bsp_crv_n_pnts $part tmpcrv $pts]
	set crv [ic_geo_project_curve_to_surface $tmp $srf $name $part]
	ic_delete_geometry curve names $tmp 0			
	return $crv
}

proc vid_exist {txt args} {
# This function check names and return 0  
	foreach {type name} $args {
		# 
		if {$type == "vector"} {
			set xyz [ic_vset -vec - $name]
			if {$xyz == ""} {
				ic_mess "Error:$txt : expected vector/point; got $name\n"
				return 1
			}
		} 			 
		set types [string trim [ic_vset -med_entity $name]]
		if {$types == ""} {
			ic_mess "Error:$txt : not found $type $name\n"
			return 1
		} 
		if {$types != $type} {
			ic_mess "Error:$txt : expected :$type: for $name; got :$types:\n"
			return 1
		} 
	}
	return 0
}
proc comak_intersect_curve_surface {part name crv srf} {			
#
# create point as crv-srf intersection
#
	set crvlen [ic_geo_crv_length $crv]
	set tol [expr 0.001*$crvlen]
	set p0 [lindex [ic_geo_get_crv_pos 0 $crv] 0]
	set p1 [lindex [ic_geo_get_crv_pos 1 $crv] 0]
	set xyz [lindex [ic_geo_get_crv_pos 0.5 $crv] 0]
	set dir [ic_vcalc dir $p0 $p1]
	set prjpnt [ic_geo_project_point surface $srf $xyz $dir]
	if {$prjpnt == ""} {
		set d $crvlen
	} else {
		set xyz [ic_geo_project_point curve $crv $prjpnt]
		set d [ic_vcalc distance $prjpnt $xyz]
	}
	if {$d < $tol} {
		return $xyz
	}
	# not more than 10 iterations 
	for {set i 0} {$i < 10} {incr i} {
		set par [ic_geo_find_nearest_crv_pnt $crv $xyz]	
		set dir [ic_geo_get_crv_tan $par $crv]
		set prjpnt [ic_geo_project_point surface $srf $xyz $dir]
		if {$prjpnt == ""} break
		set xyz [ic_geo_project_point curve $crv $prjpnt]
		set d [ic_vcalc distance $prjpnt $xyz]
		if {$d < $tol} {
			return $xyz
		}								 
	}
	return
}
proc vid_extend_trim_curves {crv1 crv2 end1 tan_ext} {
	# Development version. Final version may be moved in C 
	# if $tan_ext - allow tan extention of crv2 (if projection is there)
	# Convert to bsp using global tolerance: 
	global projlib
	set gttol 0.001
	foreach {n v} [ic_set_meshing_params global 0] {
		if {$n == "gttol"} {set gttol $v}
	}
	foreach c "$crv1 $crv2" {
	set num [$projlib get_number curve $c]
    if [catch {geoclean_reappr_curve $c $num $gttol vid_dummy_pre vid_dummy_pre} crv_id] {
		status_message "No intersection" red
        return
    }
    if {$crv_id == ""} {
        status_message "No intersection" red
        return
    }
    if {$num != $crv_id} {
		set nname [$projlib get_name curve $crv_id]
		ic_geo_set_name curve $nname $c
	}
    }

	ic_delete_geometry curve families TMP
	ic_delete_geometry point families TMP			
	set nnames ""
	if {$end1 == ""} {
		foreach "p0 vt0 vc0 vz0" [ic_geo_get_crv_data_at_par 0 $crv1] ""
		foreach "p1 vt1 vc1 vz1" [ic_geo_get_crv_data_at_par 1 $crv1] ""		
		set pp0 [ic_geo_project_coords curve $crv2 $p0 "0 0 0" $tan_ext]
		set pp1 [ic_geo_project_coords curve $crv2 $p1 "0 0 0" $tan_ext]
		if {[ic_vcalc distance $p0 $pp0] < [ic_vcalc distance $p1 $pp1]} {
			set p_end $p0; set vt $vt0; set vc $vc0; set end1 0
		} else {
			set p_end $p1; set vt $vt1; set vc $vc1; set end1 1
		}
	} else {
		foreach "p_end vt vc vz" [ic_geo_get_crv_data_at_par $end1 $crv1] ""
	}
	if !$end1 {
		# reverse direction : outside curve
		set vt [ic_vcalc smult $vt -1]
	}
	set bbox [ic_geo_bounding_box "curve $crv2"]
	set md 0 
	foreach p $bbox {
		set d [ic_vcalc distance $p_end $p]
		if {$d > $md} {set md $d}
	} 
	# do not use nearest curve point. 	
	set vec [ic_vcalc smult $vt $md]
	set e_2 [ic_vcalc sum $p_end $vec]
	set tmpcrv [ic_geo_cre_line TMP tmp_crv $p_end $e_2]
	set p_near [ic_geo_create_points_curveinter "$tmpcrv $crv2" $md TMP]
	set p_on [ic_geo_project_point curve $crv2 $p_near "0 0 0" 0]					
	if $tan_ext {
		set p_onE [ic_geo_project_point curve $crv2 $p_near "0 0 0" 1]
		# SAme point tol. Check if batch
		if {[ic_vcalc distance $p_on $p_onE] > [ic_gui_set vid_options(same_pnt_tol)]} {

			set par [ic_geo_find_nearest_crv_pnt $crv2 $p_on]
			if {$par < 0.5} {set par 0} else {set par 1}
			foreach "c2_end c2_vt c2_vc c2_vz" [ic_geo_get_crv_data_at_par $par $crv2] ""
			if !$par {
				set c2_vt [ic_vcalc smult $c2_vt -1]
			}	
			# case: was tan_ext; both curves modified		
			set vec [ic_vcalc smult $c2_vt $md]
			set e_22 [ic_vcalc sum $c2_end $vec]
			set tmpcrv2 [ic_geo_cre_line TMP tmp_crv2 $c2_end $e_22]

			set p_F [ic_geo_create_points_curveinter "$tmpcrv $tmpcrv2" $md TMP]					 								
			lappend nnames [vid_extend_crv_to_xyz $crv2 $p_F $c2_end $c2_vt $c2_vc]
			lappend nnames [vid_extend_crv_to_xyz $crv1 $p_F $p_end $vt $vc]			
		} else {
			# case: allow tan_ext, but it was no extension
			lappend nnames [vid_extend_crv_to_xyz $crv1 $p_on $p_end $vt $vc]		
		}
	} else {
		# case: not allow tan_ext
		lappend nnames [vid_extend_crv_to_xyz $crv1 $p_on $p_end $vt $vc]
	}
	ic_delete_geometry curve families TMP
	ic_delete_geometry point families TMP
	return $nnames			
}
proc vid_extend_crv_to_xyz {crv xyz p_end v_tan v_cen} {
	set part [ic_geo_get_family curve $crv]
	set pp_dir [ic_vcalc dir $p_end $xyz]
	set pp_angle [ic_vcalc angle $pp_dir $v_tan]
	set err 0
	if {$pp_angle > 75} {
			status_message "No intersection" red
		return
	}
	if {$pp_angle < 1.0} {
		# extend with line for anggle < 1 deg.
		set err [catch {ic_geo_cre_line $part tmp_ext $p_end $xyz} add_crv]
	} else {
		if {$v_cen == "0 0 0"} {
			set nz [ic_vcalc product $pp_dir $v_tan]
			set v_cen [ic_vcalc nrm [ic_vcalc product $pp_dir $nz]]
		}
		set angle [expr 90-$pp_angle]	
		set pp_len [ic_vcalc distance $p_end $xyz]
		set rad [ic_vset - $pp_len/2.0/cos($angle)]
		set v_cen [ic_vcalc smult $v_cen $rad]
		set cen [ic_vcalc sum $p_end $v_cen]
		set err [catch {ic_curve arc_ctr_rad $part tmp_ext [list $cen $p_end $xyz $rad]} add_crv]		
	}
	if $err {
		status_message "No intersection" red
		return
	}
	set err [catch {ic_geo_cre_crv_concat $part tmp 0.001 "$add_crv $crv"} nname]
	ic_delete_geometry curve names $add_crv 0
	if $err {
		status_message "No intersection" red
		return
	}
	ic_delete_geometry curve names $crv	0
	ic_geo_set_name curve $nname $crv
	return $crv
}
#================================
proc comak_bsinterp_srf_from_crvs {part name crvs} {
# build topo from curves (may be intersections)
if ![ic_undo_suspended] {
            ic_save_model_for_undo
            ic_undo_suspend
            set resume 1
 } else {
  set resume 0
 }
set tmp_fam TMP_BSP_FAM
foreach type "point curve surface" {
	ic_delete_geometry $type families $tmp_fam 0
}  
# create 1 loop 
# create 1 surface ic_geo_gap_repair 
#toler 0.01 new_family $fam curves $crvs do 3 partial 0 yellow 0 quiet 1
	set n [llength $crvs]
	if !$n return
	# set tol as 1% of min curve length
	set minlen 1e8
	foreach len [ic_geo_crv_length $crvs] {
		if {$minlen > $len} {set minlen $len}
	}
	set tol [expr $minlen * 0.01]
	set new_crvs "" 
	foreach crv $crvs {
		lappend new_crvs [ic_geo_duplicate curve $crv]
	}
	ic_geo_set_family curve $tmp_fam names $new_crvs 0
	ic_build_topo $tol -curves $new_crvs -quiet -no_concat
	set crvs [ic_geo_get_objects curve $tmp_fam]
	set do 0
	# next loop make short connection; not more than 100 connections 
	while {$do < 100} {
	# check for loop
	foreach "loop_crvs crvs_ends" [vid_find_curves_loop $crvs] ""
	if [llength $loop_crvs] {
	ic_geo_gap_repair toler $tol new_family $tmp_fam new_name $name curves $loop_crvs do 3 partial 0 yellow 0 quiet 1 db -1
# always break on function
	break
	} else {
	# Connect disconnected ends: noself, start from shortest 
			set ncon [llength $crvs_ends]	
		# special case: 4 ends (any number of curves, 2 groups) 
		if {$ncon == 4} {
			set 4pts [vid_reorder_pts_using_topo $crvs_ends $crvs]
			foreach {ps pe} $4pts {
				set k [lsearch $crvs_ends $ps]
				set n [lsearch $crvs_ends $pe]
				set aux $name.auxC.$k.$n
				ic_geo_cre_line $tmp_fam $aux $ps $pe
				lappend crvs $aux
			}											
			ic_geo_gap_repair toler $tol new_family $tmp_fam new_name $name curves $crvs do 3 partial 0 yellow 0 quiet 1 db -1
			# always break on function
			break			
		} else {
			set mindis 1e8
			set creline 0	
			for {set k 0} {$k < $ncon} {incr k} {
				for {set n $k; incr n} {$n < $ncon} {incr n} {
					set d [ic_vcalc distance [lindex $crvs_ends $k] [lindex $crvs_ends $n]]
					if {$d < $mindis} {
						set mindis $d
						set mink $k
						set minn $n
						incr creline
					}
				}
			} 
			# wierd: must be 2 ends: all combinations checked:
			if !$creline break
			incr do				
			set aux $name.auxC.$k.$n	
			ic_geo_cre_line $tmp_fam $aux [lindex $crvs_ends $mink] [lindex $crvs_ends $minn]
			lappend crvs $aux
		}
	}
	}
	ic_geo_set_family surface $part names $name 0
	foreach type "point curve surface" {
 		ic_delete_geometry $type families $tmp_fam 0
	} 
   if $resume ic_undo_resume
	return $name
}
#===================================
proc vid_reorder_pts_using_topo {end_pts crvs} {
	# reorder 4 end_pts for correct connection: 1-2 3-4 using incident & boundary for $end_pts and $crvs.
	# Constraint: ignore incident curves which are not in $crvs list
	# Curve list $crvs may have extra (unused) curves
	# each end_point has 1 and only 1 curve from $crvs  
	global projlib
	set p0 [lindex $end_pts 0]
	# break loop on end found
	set p_current $p0
	set c_current ""
	for {set i 0} {$i < 100} {incr i} {
		set pobj [$projlib get_object_by_name point $p_current]
		foreach crv [$pobj incident] {
			if {$crv == $c_current} continue
			if {[lsearch $crvs $crv] >= 0} break
		}
		set cobj [$projlib get_object_by_name curve $crv]
		foreach p_end [$cobj boundary] {
			if {$p_end != $p_current} break
		}
		if {[lsearch $end_pts $p_end] >= 0} break
		set p_current $p_end
		set c_current $crv
	}
	# point $p_end is from list $end_pts. It connected with point $p0 via crvs from $crvs
	# calculate min distance from $p0 to two remaining points and make connections
	set dmin 1e8
	foreach pnt [lrange $end_pts 1 3] {
		if {$pnt == $p_end} continue
		set d [ic_vcalc distance $p0 $pnt]
		if {$d < $dmin} {
			set dmin $d
			set p0_pair $pnt
		}
	}
	set res [list $p0 $p0_pair]
	foreach pnt [lrange $end_pts 1 3] {	
		if {$pnt == $p0_pair} continue
		lappend res $pnt
	} 				
	return $res	
} 
#========================================== 
proc vid_find_curves_loop {crvs} {
# find subset of topological curves which produces closed loop
# Return: 2 lists: curves in loop (may be empty); disconnected ends (may be empty)
# One of the lists always not empty 
# return only one loop if it's from 1 curve (like circle) even if several loops are possible
# do topology outside: 
# topo may split/delete curves, but this proc must keep curves "as is"
# boundary command may return the same name twice if curve is closed
global projlib
	set nc 0	
	foreach crv $crvs {
	set obj [$projlib get_object_by_name curve $crv]
	foreach "p0 p1" [$obj boundary] ""
	if {$p1 == $p0} {
		return [list $crv ""]
	}
	set arr_ends($crv) "$p0 $p1"
	lappend arr_crv($p0) $crv
	lappend arr_crv($p1) $crv
		incr nc
	}
	set ends ""
	foreach p [array names arr_crv] {
		if {[llength $arr_crv($p)] == 1} {
			lappend ends $p
		}
	}	
# delete tails (restrict tail length to 100 curves)
	for {set i 0} {$i < 100} {incr i} {
		set tail 0
		foreach p [array names arr_crv] {
			if {[llength $arr_crv($p)] == 1} {
				set crv $arr_crv($p)
				foreach p2 $arr_ends($crv) {
					if {$p2 != $p} break
				}
				set new_list ""
				foreach c $arr_crv($p2) {
					if {$c == $crv} continue
					lappend new_list $c
				}
				set arr_crv($p2) $new_list
				unset arr_crv($p)
				set tail 1
				break
			}
		}
		if !$tail break
	}
	# If something still in arr_crv - it's points which are connected in 1 or more loops  		
	set res [array names arr_crv]
	if ![llength $res] {

		return [list "" $ends]
	}
	foreach p $res {
		foreach c $arr_crv($p) {
			set loop_crvs($c) 1
		}
	}
	return [list [array names loop_crvs] $ends] 
}	 
# === --- === === --- === === --- === ===-- ===-- ===

proc vid_find_multiple_loops {fam name {crvs ""} {PartMode 0} {DoNotConcat 0} {Do3 0}} {
global projlib
# find subset of topological curves which produces closed loops
# Return: n loops and arrays upvar(0,1,...): lists of curves for each loop; one_curve_loops; not loops curves;
#   array names for disconnected ends (array names!)
# Last array is a point name(s) as array names - only one point; other have name-numbers and list as a value  
#
# do topology outside: it may add curves. Do here if assuming all (empty)

#mess "Start processing [llength $crvs] curves: see chains arr_crvs_at_pnt arr_ends dir_crv_at_pnt\n" blue
# next arrays are global for debugging only. 
set db_list "arr_ends arr_crvs_at_pnt dir_crv_at_pnt chains surf_created"
foreach db $db_list {
  global $db
  if [info exists $db] {unset $db}
} 

mess "\n\n Development: for each surface control: \nset Verify 1\n\n" 
# Use topology tolerance (not triangulation).
set topotol [ic_gui_set geo_cad(toler)]
if !$topotol {set topotol 0.001}

 set do_topo_locally 0
 if {$crvs != "" && $crvs != "all"} {
    set newfam TMP_FAM
    ic_geo_new_family $newfam
    set first_old_fam ""
    
    foreach crv $crvs {
      if {[ic_geo_check_objects_exist curve $crv] != $crv} continue
      set n [$projlib get_number curve $crv]
      set old_fam($crv) [$projlib get_family curve $n]
      if {$first_old_fam == ""} {
        set first_old_fam $old_fam($crv)
      }
      $projlib set_family curve $n $newfam 
    }
   set crvs ""
   # set family for new curves as first_old_fam
   ic_build_topo $topotol -quiet -no_concat $newfam
   set fid [$projlib lookup_family_pid $newfam]
   set cnns [$projlib get_objects_in_family curve $fid]
   foreach n $cnns {
      set cn [$projlib get_name curve $n]
       set bsp [$projlib get_object curve $n]    
      if [info exists old_fam($cn)] {
        $projlib set_family curve $n $old_fam($cn)
        $bsp configure -family $old_fam($cn)         
      } else {
        $projlib set_family curve $n $first_old_fam
        $bsp configure -family $first_old_fam         
      }
      lappend crvs $cn
    }
    # set the same family for new points
   set cnns [$projlib get_objects_in_family curve $fid] 
   foreach n $cnns {
       $projlib set_family point $n $first_old_fam
       set bsp [$projlib get_object point $n]
       $bsp configure -family $first_old_fam
   }
   ic_geo_delete_family $newfam
  } else {
    # do topo for all curves without family change
    set do_topo_locally 1
    ic_build_topo $topotol -quiet -no_concat
   set crvs [ic_geo_objects curve] 
 }
# 


#

  set NNS 0 
	set MaxCh 10000
	set MaxChLen 10000 
	set part $fam
	if $PartMode {append part _S00} 
	foreach crv $crvs {
	  set obj [$projlib get_object_by_name curve $crv]
  	set ends [$obj boundary]
  	if {$ends == ""} continue
  	foreach "p0 p1" $ends ""
  	# put single-curve-loop in output array and forget it
	  if {$p1 == $p0} {
	    set sname [ic_vset -new_name $name all]
	    ic_geo_create_surface_from_curves $part $sname $topotol $crv 0
		   incr NNS
		   continue
	  }
	  set arr_ends($crv) $ends  
	  lappend arr_crvs_at_pnt($p0) $crv
	  lappend arr_crvs_at_pnt($p1) $crv
		
	}
		# Find disconnected chains (max chains) and forget them
 set N_disconnected 0
	for {set i 0} {$i < $MaxCh} {incr i} {
	 # Find first chain
	 set is_chain 0
	 foreach p [array names arr_crvs_at_pnt] {
	  set crv $arr_crvs_at_pnt($p)
		if {[llength $crv] == 1} {
		  set is_chain 1
		  break
		}
		}	
	  # if no disconnected chains - stop search
		if !$is_chain break
		# unset crvs along chain until end or knot found
		# uses $crv $p
		# formal loop will be interrupted on the end of chain. 
		for {set ii 0} {$ii < $MaxChLen} {incr ii} {	
		  unset arr_crvs_at_pnt($p)
		  foreach "p0 p1" $arr_ends($crv) ""
		  if {$p == $p0} {
		    set p $p1
		  } else {
		    set p $p0
		  }
		  incr N_disconnected
		  unset arr_ends($crv)
		  set crvs_opp ""
		  foreach c $arr_crvs_at_pnt($p) {
		    if {$c == $crv} continue
		    lappend crvs_opp $c
		  }
		  if {$crvs_opp == ""} {
        #end of open chain
		    unset arr_crvs_at_pnt($p)
		    break
		  }
		  set arr_crvs_at_pnt($p) $crvs_opp
		  # check end of chain at knot
		  if {[llength $crvs_opp] != 1} break 
		  set crv $crvs_opp
		  # continue loop
		 }
	
   }
#mess "DB deleted N_disconnected = $N_disconnected\n" red
# 
  # calculate angles for each curve end
	# Assume Z-plane (must calculate angles between curves using atan2)
	#
	# Set angles always directed inside curve. 
	# It make simple analysis, e.g. for several curves at the same point it's
	# not important which end of curve is it. Just direction of curve at point!
	# Set range 0-360 deg. in XY plane

	foreach par {0 1} {
	foreach crv [array names arr_ends] {
	 set cdata [ic_geo_get_crv_data_at_par $par $crv]
	 foreach "x y z" [lindex $cdata 1] "" 
	 set dir [lindex $cdata 1]
	 set pn  [ic_geo_crv_get_end $crv $par]
	 # tangent angle "inside" curve, rad, XY plane, at curve end = $par  
	 set angle [expr 180.0*($par+atan2($y,$x)/3.14159265358979323846)]
	 if {$angle < 0.0} {
	  set angle [expr 360.0+$angle]	
	 }
	  set dir_crv_at_pnt(${crv}_$pn) $angle
	}
	}

   # Replace chains which are part of loop with start-end chains
   # About the same as merge curves 
   # May be option to merge?
   # Find chains and update arr_crvs_at_pnt & arr_ends with chains instead of curves
 	 # Unique name for chains/curves
 	 set ti [string range [clock seconds] 6 end]
 	 set chain_prefix Ch_$ti
  
	for {set i 0} {$i < $MaxCh} {incr i} {
	 # Find first chain  
  
	 set is_chain 0

	 
	 foreach p [array names arr_crvs_at_pnt] {
	  set crv $arr_crvs_at_pnt($p)
		if {[llength $crv] == 2} {
		  # ignore chain with the same start-end points
		  if {[lindex $crv 0] == [lindex $crv 1]} continue
		  set is_chain 1
		  set chain_start $p
		  set this_chain ${chain_prefix}_$i
		  break
		}
		}	
	  # if no chains - stop search
		if !$is_chain break
		set crv [lindex $crv 0]
		# find knot 
		# uses $crv $p
		# next loop will be interrupted on the start of chain. 
		for {set ii 0} {$ii < $MaxChLen} {incr ii} {	
		  foreach "p0 p1" $arr_ends($crv) ""
		  if {$p == $p0} {
		    set p $p1
		  } else {
		    set p $p0
		  }
		  set crvs_opp ""
		  foreach c $arr_crvs_at_pnt($p) {
		    if {$c == $crv} continue
		    lappend crvs_opp $c
		  }
		  if {[llength $crvs_opp] != 1} {
        #end of chain
		    break
		  }
		  set crv $crvs_opp		  
		 }
	   # Now crv is the start curve of the chain at knot $p
	   # Go back along crv, save chain, fix arr_ends & arr_crvs_at_pnt
	   # chain $this_chain
	   
	   set in [lsearch $arr_crvs_at_pnt($p) $crv]
	   set arr_crvs_at_pnt($p) [lreplace $arr_crvs_at_pnt($p) $in $in $this_chain]
	   set dir_crv_at_pnt(${this_chain}_$p) $dir_crv_at_pnt(${crv}_$p)
		 lappend chains($this_chain) $crv	   
	   set arr_ends($this_chain) $p
	   
	   # next loop will be interrupted on the end of chain. 
		for {set ii 0} {$ii < $MaxChLen} {incr ii} {	
		
		  foreach "p0 p1" $arr_ends($crv) ""
			 unset arr_ends($crv)   	  
		  if {$p == $p0} {
		    set p $p1
		  } else {
		    set p $p0
		  }	   
		  set closed_loop 0
		  set crvs_opp ""
		  foreach c $arr_crvs_at_pnt($p) {
		    if {$c == $this_chain} {
		           set closed_loop 1
		           break
		     } 
		    if {$c == $crv} continue
		    lappend crvs_opp $c
		  }
		  if {$closed_loop || ([llength $crvs_opp] > 1)} {
        #end of chain
		    lappend arr_ends($this_chain) $p
		    break
		  }
	
		  set crv $crvs_opp
      lappend chains($this_chain) $crv
		  unset arr_crvs_at_pnt($p)
		 }
		  set in [lsearch $arr_crvs_at_pnt($p) $crv]
		  set arr_crvs_at_pnt($p) [lreplace $arr_crvs_at_pnt($p) $in $in $this_chain]
   # 
	  set dir_crv_at_pnt(${this_chain}_$p) $dir_crv_at_pnt(${crv}_$p)
   }
# end of chains

if {$DoNotConcat != "1"} {
# In some cases must reapproximate new curve!
#   (with current topo tolerance)
# concat chains - replace with single curve 
  foreach ch [array names chains] {
    set res [ic_geo_cre_crv_concat GEOM $ch $topotol $chains($ch)]
    ic_delete_geometry curve names $chains($ch)
    set num [$projlib get_number curve $res]
    if [catch {geoclean_reappr_curve $res $num $topotol vid_dummy_pre vid_dummy_pre} crv_id] {
        mess "Error reapproximation: $crv_id" red
    }
    set chains($ch) $res
  }
}
# End DoConcat

# Special case. Must be done before next level topology
  # Create surface from closed loops (other loops may be connected)
  # Warning: chain will be deleted, each 1-loop surface is "independent"
  # Closed loop may be used only once!
  # This approach does not support surfaces between such loops.
  #   Use build_topo to substruct surfaces.
    set part $fam
    if $PartMode {append part _S0}  
    foreach cc [array names arr_ends] {
    foreach "p0 p1" $arr_ends($cc) ""
    if {$p0 == $p1} {
        if [vid_srf_from_crvs_or_chains $topotol $part S_0_$NNS $cc] return
        incr NNS
        unset arr_ends($cc)
        unset chains($cc)
        set oldcc $arr_crvs_at_pnt($p0)
        unset arr_crvs_at_pnt($p0)
        if {[llength $oldcc] > 2} {
           # reset other (not $cc) ccs to the same point
           foreach c $oldcc {
             if {$c != $cc} {
               lappend arr_crvs_at_pnt($p0) $c
             }
           }
        }
     }
   }
  # 
#
#

if ![llength [array names arr_ends]] {
   return $NNS
}

# Sort curves in each point by angle
  foreach pp [array names arr_crvs_at_pnt] {
      # create lists to sort based on angle at pp
      set list_c_ang ""
      foreach c $arr_crvs_at_pnt($pp) {
        lappend list_c_ang "$c $dir_crv_at_pnt(${c}_$pp)"
      } 
      set list_c_ang [lsort -real -index 1 $list_c_ang]
      set new_list ""
      foreach ca $list_c_ang {
        lappend new_list [lindex $ca 0]
      }
      set arr_crvs_at_pnt($pp) $new_list
  }
 #--- 
  # Find 1-4 "external" cc and mark them as "created" in order
  # to prevent surface creation from "external" ccs
  set valid_crvs ""
  foreach cc [array names arr_ends] {
    if [info exists chains($cc)] {
      foreach c $chains($cc) {
        lappend valid_crvs $c
      }
    } else {
      lappend valid_crvs $cc
    }
  }
  set xmin 1e8
  set ymin 1e8
  set xmax -1e8
  set ymax -1e8
  foreach crv $valid_crvs {
    set bsp [$projlib get_object_by_name curve $crv]
    foreach {xmi ymi zmi xma yma zma} [join [$bsp get_bbox]] ""
    if {$xmin > $xmi} {
      set xmin $xmi
      set cxmin $crv
    }
    if {$ymin > $ymi} {
      set ymin $ymi
      set cymin $crv
    }    
    if {$xmax < $xma} {
      set xmax $xma
      set cxmax $crv
    }  
    if {$ymax < $yma} {
      set ymax $yma
      set cymax $crv
    }  
  }

  # TODO: check ends: some (hope not all) of 4 selected curves may be not external
   
  # 
  # temporary (test) do not create surface which has both $cxmin and $cxmax
  #
    foreach ccc "cxmin cxmax cymin cymax" {
    set cccv [set $ccc]
    if ![info exists arr_ends($cccv)] {
      # must be a chain
      foreach cc [array names chains] {
        if {[lsearch $chains($cc) $cccv] < 0} continue
        set $ccc $cc
        break
      }
    }  
    }
    set not_all_these_cc "$cxmin $cxmax"    

  set DB 0
  set NN 7
 
  for {set Nmax 2} {$Nmax < $NN} {incr Nmax} { 
  foreach turns {1 0} {    
  foreach p [array names arr_crvs_at_pnt] {
  # 
  
    set p_list $arr_crvs_at_pnt($p)
    set n_p [llength $p_list]

    # first curve may be selected somehow else
    # checking all directions from start point $n_p
    for {set i_dir 0} {$i_dir < $n_p} {incr i_dir} {
#    if $start_over break
    #accumulate path in crvs_list
    set crvs_list ""
    set c000 [lindex $p_list $i_dir]
    set p000 $p
    if [info exists m_loops_tmp_used] {
      unset m_loops_tmp_used 
    }
    # create all simple loops before go to next complexity 

    for {set N 0} {$N < $Nmax} {incr N} {
      # interrupt search if curve/chain $c000 from $p000 used
      # u_id may be defined based on curve,point names, numbers, etc.
      set u_id ${c000}_$p000
      if [info exists m_loops_cc_used($u_id)] {
        break 
      } else {
        set m_loops_tmp_used($u_id) 1
      }
      set part $fam
      if $PartMode {append part _S$N}  
      lappend crvs_list $c000
      foreach "p0 p1" $arr_ends($c000) ""
      if {$p000 == $p0} {set pnext $p1} else {set pnext $p0}
     # interrupt search if current list has all curves from not_all_these_cc
       set wrong_set 0
       foreach c $not_all_these_cc {
        if {[lsearch $crvs_list $c] >= 0} {incr wrong_set}
       }
       if {$wrong_set == [llength $not_all_these_cc]} {
        break
       } 
     #   
     
     
      if {$pnext == $p} {     
        set srf_id [join [lsort -ascii $crvs_list] _]
        if ![info exists surf_created($srf_id)] {
        if [vid_srf_from_crvs_or_chains $topotol $part S_${N}_$NNS $crvs_list] return
        foreach u_id [array names m_loops_tmp_used] {
          set m_loops_cc_used($u_id) 1
        }          
        
        set surf_created($srf_id) 1
        incr NNS
        }
        # interrupt search if got start point
        break
      } 
      set pnext_list $arr_crvs_at_pnt($pnext)
      set ind_f_pp [lsearch $pnext_list $c000]
      set next_max [expr [llength $pnext_list] -1]
      # next block select curve "next' to $c000 using sorted by angle list

      if $turns {
        if {$ind_f_pp == 0} {
          set cnext [lindex $pnext_list end]
        } else {
          incr ind_f_pp -1
          set cnext [lindex $pnext_list $ind_f_pp]
        }
      } else {
        if {$ind_f_pp == $next_max} {
          set cnext [lindex $pnext_list 0]
        } else {
          incr ind_f_pp
          set cnext [lindex $pnext_list $ind_f_pp]
        }        
      }
      set c000 $cnext
      set p000 $pnext
 
   }
   # end N loop
     }
  # end i_dir loop     
    } 
 #end p-loop
    }
  # end left_turns loop 
    }
  # end Nmax loop 
 
 # $do_topo_locally DB build topo aplways 
 # DB 
  if 0 { 
    ic_build_topo $topotol -quiet -no_concat -do_v_merge_for_crv
 }
  return	$NNS 
}
	 
proc vid_srf_from_crvs_or_chains {tol fam name ccs} {
   global chains
 set Verify [ic_gui_set Verify]
   set list ""
   foreach cc $ccs {  
        if [info exists chains($cc)] {
          foreach c $chains($cc) {
            lappend list $c
          }
         } else {
           lappend list $cc 
         }
    }
   # does not work for complex geometry: ic_geo_create_surface_from_curves $fam $name $tol $list 0
   
   set sname [ic_vset -new_name $name all]
   set ncrvs [llength $list]
    if {$ncrvs > 1 && $ncrvs < 5} {
     set com [list ic_geo_create_surface_from_curves $fam $sname $tol $list 0]
    } else {
    set com [list ic_geo_gap_repair toler $tol new_family $fam new_name $sname curves $list\
     do 3 partial 0 yellow 0 quiet 1 db -1 build_topo 0]  
    } 
    eval $com
    # Next part for debbuging: create each surface and wait for click
    if $Verify {
      busy reset
      set ban "Press button: left - continue, middle - details on last surface, right - stop, F9 - Dynamic mode"
      while 1 {
        set res [vic_eval aie_wait_for_click 0 1 0 [list $ban]]
        case $res {
         "3" {
          # interrupt calling proc
          return 1
              }
         "2" {
        mess "Surface: $sname , command:\n$com\n" red
        ic_highlight curve $list width 5
            }
         default {    
           ic_highlight
           return 0
         }
        }  
      }
   }
   return 0
}
proc vid_dummy_pre {args} {return 1}
#===---=== ===---=== ===---===

proc vid_intersect_with_bbox {part def} {
	global projlib
# Function intersect all N surfaces with all N surfaces (except self)
# Number of curves may be ~ N*N, 
# i.e. for 100 surfaces may be ~ 10000 curves, for 10000 surfaces ~ 1E8 curves
# Next parameter set creation of temporary file if # of surfaces is big
# Note: 
	set N_srfs_tmp_use 100
	set N_crvs_tmp_use [expr $N_srfs_tmp_use * $N_srfs_tmp_use]
#
	set n_crvs_before [ic_geo_num_objects curve]
	set do_intersect_self_part [ic_gui_set vid_options(do_intersect_self_part)]
	if {$def == "" || $def == "all"} {
		set def [ic_geo_get_objects surface]
		set num [ic_geo_num_objects surface]
	} else {
	# may be list of surfaces or list of parts
		if [ic_geo_check_family [lindex $def 0]] {
			set def [ic_geo_get_objects surface $def]
		}	
		set num [llength $def]
	}
	if {$def == ""} return
	set i 0
	set n_perc -1
	set fams [ic_geo_list_families 0 1]
	foreach srf $def {
		set bsp [$projlib get_object_by_name surface $srf]
		foreach "bmin bmax" [bbox_of_images $bsp] ""
		lappend bsize_i "[ic_vcalc distance $bmin $bmax] $i"
		set minmax($i) "$bmin $bmax"
		set sname($i) $srf
		set srffam [ic_geo_get_family surface $srf]
		set family($i) [lsearch $fams $srffam]
		set done($i) 0
		incr i	
		set np [expr $i*100/$num]
		if {$np != $n_perc} {
			set n_perc $np
			status_message "Step 1 of 2 completed $np %"
		}
	}
	if ![ic_undo_suspended] {
            ic_save_model_for_undo
	ic_undo_suspend
            set resume 1
 } else {
  set resume 0
 }
	set Nsrfs $i
	set new_crvs 0
	if {$Nsrfs > $N_srfs_tmp_use} {
		# create temporary tetin file(s); load after all done
		# use temporary part name for curves
		set tmp_file_list ""
		set tmp_file_use [clock seconds]
		set use_part PART_$tmp_file_use		
	} else {
		set tmp_file_use 0
		set use_part $part
	}		
	set bsize_sorted [lsort -real -index 0 $bsize_i]
	set K 0
	set all_crvs ""
	foreach sizeN $bsize_sorted {
		status_message "$K of $Nsrfs"
		incr K
		set N [lindex $sizeN 1]
		foreach "Xmi Ymi Zmi Xma Yma Zma" $minmax($N) ""
#		set srfs_within $sname($N)
		set added 0
		for {set i 0} {$i < $Nsrfs} {incr i} {
			if $done($i) continue
			if {$N == $i} continue
			if !$do_intersect_self_part {
				if {$family($N) == $family($i)} continue
			}
			foreach "xmi ymi zmi xma yma zma" $minmax($i) ""
			if {$Xmi > $xma} continue
			if {$Xma < $xmi} continue
			if {$Ymi > $yma} continue
			if {$Yma < $ymi} continue	
			if {$Zmi > $zma} continue
			if {$Zma < $zmi} continue
					   
			# check 
#			lappend srfs_within $sname($i)
			set crv_name [ $projlib new_name curve ${part} 0 ]
			if [catch {eval $projlib intersect_surfs $crv_name family $use_part\
			"$sname($N) $sname($i)" no_self "" ""} crv_nums] continue
			foreach ii $crv_nums {
				lappend all_nums $ii
				incr new_crvs
			}
			incr added
		}
		if !$added continue
			if {$tmp_file_use && ($new_crvs > $N_crvs_tmp_use)} {
				set new_crvs 0
				set fname [pwd]/tmp_${tmp_file_use}.tin
				ic_save_tetin $fname 0 0 $use_part
				foreach n $all_nums {
					$projlib delete_curve $n
				}
				lappend tmp_file_list $fname	
				incr tmp_file_use
				set res [$projlib compress_records curve]
			}		
		set done($N) 1
	}
		update_bsp_consistency					
	if $tmp_file_use {
		ic_geo_set_family curve $part families $use_part
		foreach fname $tmp_file_list {
			ic_load_tetin $fname
			ic_geo_set_family curve $part families $use_part
#			file delete $fname			
		}
	}

#	
	set n_crvs [expr [ic_geo_num_objects curve] - $n_crvs_before]
	status_message "$n_crvs intersection curves created"
	if $resume ic_undo_resume
	return $n_crvs
}	 
proc comak_reorder_contour_crvs {how_first how_next crvs} {
# how_first may be xmin, xmax, ymin, etc.
# how_next may be +x -z etc -> which end of first curve goes next
# curves are connected, so 2 curves have common curve end
# define first curve as a curve with sum of curve ends
# return curve list	
	set index [string first [string index $how_first 0] "xyz"]
	set minmax [lsearch "min max" [string range $how_first 1 3]]			
	set selected 0
	foreach crv $crvs {
		set	xyz0 [lindex [ic_geo_get_crv_pos 0 $crv] 0]
		set	xyz1 [lindex [ic_geo_get_crv_pos 1 $crv] 0]
		set xyzs [ic_vcalc sum $xyz0 $xyz1]
		set value [lindex $xyzs $index]
		if !$selected {
			set selected 1
			set value_selected $value
			set crv_selected $crv
			continue
		}			 	
		if {($minmax && ($value > $value_selected)) || \
		   (!$minmax && ($value < $value_selected))} {
			set value_selected $value
			set crv_selected $crv
		}
	}
	set crv $crv_selected
	set new_list $crv
	set old_ind [lsearch $crvs $crv]
	set crvs [lreplace $crvs $old_ind $old_ind]
	# find next curve: +x -z etc.
	set index [string first [string index $how_next 1] "xyz"]
	if {[string index $how_next 0] == "-"} {
		set minmax 0
	} else {
		set minmax 1
	}	 
	set xyz0 [lindex [ic_geo_get_crv_pos 0 $crv] 0]
	set	xyz1 [lindex [ic_geo_get_crv_pos 1 $crv] 0]
	set val0 [lindex $xyz0 $index]
	set val1 [lindex $xyz1 $index]
	if $minmax {
		if {$val0 > $val1} {set xyz $xyz0} else {set xyz $xyz1}
	} else {
		if {$val0 < $val1} {set xyz $xyz0} else {set xyz $xyz1}	
	}
	# same proc for the rest
	# find curve from $crvs which has end at $xyz; exclude; use other end as xyz
	set ncrvs [llength $crvs]
	for {set nc 0} {$nc < $ncrvs} {incr nc}  {
		set mindist 1e9
		foreach crv $crvs {
			foreach p {0 1} { 
				set xyzp [lindex [ic_geo_get_crv_pos $p $crv] 0]		 
				set d [ic_vcalc distance $xyz $xyzp]
				if {$d < $mindist} {
					set mindist $d
					set minpar $p
					set crv_selected $crv
				}
			}
		}
		set crv $crv_selected
		lappend new_list $crv
		set old_ind [lsearch $crvs $crv]
		set crvs [lreplace $crvs $old_ind $old_ind]
		set other_end [expr 1-$minpar]
		set xyz [lindex [ic_geo_get_crv_pos $other_end $crv] 0]
	}
	return $new_list
}
proc vid_concat_crvs {fam name crvs {keep_old 0}} {
	global projlib
# concatanate all curves with auto defined tolerance
		set ncrvs 0			
	foreach crv $crvs {
		set p0($ncrvs) [lindex [ic_geo_get_crv_pos 0 $crv] 0]
		set p1($ncrvs) [lindex [ic_geo_get_crv_pos 1 $crv] 0]
		set cname($ncrvs) $crv
		incr ncrvs
	}
	
	set d00 [ic_vcalc distance $p0(0) $p0(1)]
	set d01 [ic_vcalc distance $p0(0) $p1(1)]	
	set d10 [ic_vcalc distance $p1(0) $p0(1)]
	set d11 [ic_vcalc distance $p1(0) $p1(1)]
	set dmax 1e8
	foreach d "d00 d01 d10 d11" {
		if {[set $d] < $dmax} {
			set dname $d
			set dmax [set $d]
		}
	}
	set tol [expr 1.01*$dmax]
	set newc [ic_geo_cre_crv_concat $fam tmPname $tol "$cname(0) $cname(1)"]
	if !$keep_old {
	ic_delete_geometry curve names "$cname(0) $cname(1)"
	}
	ic_geo_set_name curve $newc $name
	set n [string index $dname end]
	set nn [expr 1-$n]		
	for {set i 2} {$i < $ncrvs} {incr i} {
		set prev [expr $i-1]
		if $nn {set from $p1($prev)} else {set from $p0($prev)}
		set d0 [ic_vcalc distance $from $p0($i)] 
		set d1 [ic_vcalc distance $from $p1($i)]
		if {$d0 < $d1} {
			set tol [expr 1.01*$d0]
			set nn 1
		} else {
			set tol [expr 1.01*$d1]
			set nn 0		
		}
		set newc [ic_geo_cre_crv_concat $fam tmPname $tol "$name $cname($i)"]
		if !$keep_old {
			ic_delete_geometry curve names $cname($i)
		}
		ic_delete_geometry curve names $name		
		ic_geo_set_name curve $newc $name
	}	 
	return $name
}
# =================================
# 
# Input: point name, triplet, 3 scalar expressions ( , , ), vector expression
# Output: if any error return "" 
# Create point if $aux;  return triplets in global csystem
#
proc va_set_aux_pnts {fam name pts_list {aux 0} {vid_mode 0}} {
	set res ""
	foreach p $pts_list {
		set newp [ic_coords_into_global [ic_vset -pnt_any $p]]
		if {$newp == ""} {
			set newp [ic_vset -vec - $p]
			if {$newp == ""} return
			# it was an expression or triplet in LCS
			set newp [ic_coords_into_global $newp]			
			if $aux {
				set nname [ic_vset -new_name $name all]
				if $vid_mode {
					ic_vset -vec $nname $p
					ic_image vidpoint_im $nname $newp
				} else {
					ic_geo_cre_pnt $fam $nname $newp 0
				}
				# set newp $nname
			}				
		}
	lappend res $newp	
	}
	return $res
}
#=================================================

