
# This is the projlib stuff that is shared between med and autohexa.
#
# Copyright (c) 1997 Pacific Marketing and Consulting, Inc,
#       and ICEM Systems, GmbH.  All rights reserved.
# Author:  Wayne A. Christopher, wayne@icemcfd.com

proc make_projlib {file {l_material 1} {l_surface 1} {l_curve 1} 
		   {l_point 1} {l_loop 1} {l_density 1} {l_quiet 0}} {
    global projlib load_tetin_triangle_tolerance tetin_try_binary
    global tetin_keep_model_params batch_mode fam_visible 
    global proj_last_loaded_objects
    global errorInfo projlib_no_read_boco_file tdv_default
    
    if ![info exists projlib] { set projlib "" }
    
    if ![check_geom_functions_enabled] {
	license_unavailable_warning
	return 0
    }
    
    if {($projlib != "") && [info exists tetin_keep_model_params]} {
	set keepr $tetin_keep_model_params
    } else {
	set keepr 0
    }
    
    set mod 1
    if {$projlib == ""} {
	set projlib [projlib_interface]
	if !$batch_mode {
	    $tdv_default add_image $projlib
	    
	    # The projlib has to have all these tags so we can pick stuff that
	    # is visible only in subsets
	    foreach t {entity point curve surface body material loop} {
		$tdv_default add_tag $projlib geom_$t
	    }
	}
	set mod 0
    }
    if [info exists projlib_no_read_boco_file] {
	$projlib configure -ignore_boco_files $projlib_no_read_boco_file
    }
    catch {unset proj_last_loaded_objects}
    if {$file != ""} {
	foreach t {curve surface point material} {
	    foreach p [$projlib list_objects $t even_if_dormant] {
		set was_there($t,$p) 1
	    }
	}
	busy 1
	if [catch {
	    set ofile [$projlib get -surface_file]
	    set args ""
	    foreach t {material surface curve point loop density} {
		if { [ set l_$t ] == 0 } {
			append args " -skip_$t"
		}
	    }
	    if {$l_quiet} {
	        append args " -quiet"
	    }
	    eval $projlib load_model \"$file\" $load_tetin_triangle_tolerance \
		$tetin_try_binary $keepr $args
	    
	    if {$ofile != ""} { $projlib configure -surface_file "" }
	} err] {
	    mess "$err\n" red
	    puts $errorInfo
	    $projlib delete
	    set projlib ""
	    busy 0
	    return 0
	}
	foreach t {curve surface point material} {
	    set proj_last_loaded_objects($t) ""
	    foreach p [$projlib list_objects $t] {
		if ![info exists was_there($t,$p)] {
		    lappend proj_last_loaded_objects($t) $p
		}
	    }
	}
	foreach fam [$projlib list_families 0] {
	    if ![info exists fam_visible($fam)] {
		set fam_visible($fam) 1
	    }
	}
	if [info exists fam_visible(ORFN)] {
	    set fam_visible(ORFN) 0
	}
	define_geom_objects
	$projlib configure -modified $mod
	$projlib signal_change 1
	busy 0
    } else {
	$projlib initialize
    }
    return 1
}

proc reinit_geom_objects {} {
    global projlib
    
    busy 1
    clear_geom_objects
    define_geom_objects
    busy 0
}

proc delete_projlib {} {
    global projlib uns_cur str_cur
    
    if {$projlib == ""} return
    # must delete bsp images before unload model
    clear_geom_objects    
    $projlib unload_model
    if {(![info exists uns_cur] || ($uns_cur == "")) &&
	(![info exists str_cur] || ($str_cur == ""))} {
	$projlib delete_all_families
    }
    $projlib delete
    set projlib ""
}

proc update_bsp_consistency {} {
    # 05/23/07 VG:
    # Some Undo crashes may be avoided keeping old object numbers.
    # For SP11 some functions with big geometry may be slow now.

    reinit_geom_objects
    return

    # Keep function: May be used if Undo will be updated. 
    # This function is a replacement for clear/define_geom_objects
    # e.g. in ic_build_topo
    # Clear/define are too slow when there are many [invisible] objects
    # Methods:
    # Delete bsp only if NO geometry with this number
    # Create bsp only if there is geometry with this number   
    #
    global projlib batch_mode 

    if {$projlib == ""} return
    #
    if !$batch_mode {
        set pa [tdv_active 0]
        busy 1
    }
    foreach type {surface curve point} {
	set bsps [$projlib check_bsp_consistency $type delete]
	foreach bsp $bsps {
	    $bsp delete
	}
	set nums [$projlib check_bsp_consistency $type create]
	foreach num $nums {
	    set bsp [define_geom_object $type $num]			
	}
	# temporary fix- update color [for dormant]
	foreach bsp [$projlib list_bsp_objects $type only_check_image even_if_dormant] {
	    $bsp configure -only_to_change_color 1
	}		
    }
    foreach type {material loop density body} {
	clear_geom_objects $type
	define_geom_objects $type
    }
    if !$batch_mode {
        busy 0
	update_fam_window
	update_geom_visible all a
 	tdv_active $pa
    }
    $projlib signal_change 1
}

proc clear_geom_objects {{type ""}} {
    global projlib
    
    if {$type == ""} {
	foreach type {surface curve point material density loop body} {
	    clear_geom_objects $type
	}
    } else {
	foreach bsp [$projlib list_bsp_objects $type only_check_image even_if_dormant] {
	    $bsp delete
	}
	clear_fam_visible_prev $type
    }
}

# Clear the fam_visible_prev list so that it objects can be added
# in define_geom_object. This is called from clear_objects.

proc clear_fam_visible_prev { what } {
    global fam_visible fam_visible_prev

    foreach f [array names fam_visible] {
        if [info exists fam_visible_prev($what,$f)]  {
            unset fam_visible_prev($what,$f)
        }
    }
}

proc define_geom_objects {{type ""}} {
    global projlib batch_mode
    
    if {$projlib == ""} return
    if !$batch_mode {set pa [tdv_active 0]}
    if {$type == ""} {
	foreach type {surface curve point material loop density body} {
	    define_geom_objects $type
	}
	if !$batch_mode {
	    catch {
	        # this could also get called from autohex
	        update_fam_window
	        update_geom_visible all a
	    }
	}
    } else {
	if {$type == "body"} {
	    set nums [$projlib list_objects body]
	    foreach num $nums {
	    	define_geom_object body $num
	    }
	    if !$batch_mode {tdv_active $pa}
	    return	
	}
	set nums [$projlib list_objects $type even_if_dormant]
	# first create object with max number 	    
	if [llength $nums] {	    
	    define_geom_object $type [lindex $nums end]
	    foreach num $nums {
	    	define_geom_object $type $num
	    }
    	}
    }
    if !$batch_mode {tdv_active $pa}
}

proc define_geom_objects2 {type new_obj_names} {
    global projlib
    if { $type != "curve" && $type != "point" && $type != "surface" } {
        error "invalid type $type"
    }
    foreach i $new_obj_names {
        set num [$projlib get_number $type $i]
        if { $num < 0 } {
            mess "$num returned from projlib get_number $type $i\n"
            continue
        }
        set obj [$projlib get_object $type $num]
        if {$obj == ""} {
            set obj [define_geom_object $type $num]
        }
        $obj configure -visible 1 -pickable 1
        update_geom_visible_obj $obj
    }
}

proc define_geom_object {type num} {
    global tdv_default
    global projlib fam_visible blank_family_color
    global data_available tetin_load_rename_family batch_mode
    
    if { $num < 0 } {
	error "num = $num < 0"
    }
    set bsp [$projlib get_object $type $num]
    if {$bsp != ""} {return $bsp}
    
    set fam [$projlib get_family $type $num]
    if [info exists tetin_load_rename_family($fam)] {
	set fam $tetin_load_rename_family($fam)
	$projlib set_family $type $num $fam
    }
    if {$fam == ""} {
	# must be a density
	set col $blank_family_color
	set vis [get_geom_visible $type]
    } else {
	if ![info exists fam_visible($fam)] {
	    set fam_visible($fam) 1
	}
	set vis [expr $fam_visible($fam) && [get_geom_visible $type]]
	set col [family_color_for_name $fam]
    }
    set name [$projlib get_name $type $num]
    set bsp [bspline_object -family $fam -name $name -type $type \
		 -visible $vis -color $col -number $num -priority 2]
    $bsp set_object_num $type $num
    $projlib set_bspline_object $type $num $bsp
    $bsp signal_change 1
    $projlib signal_change 1
    
    if {[$projlib get_object_type $type $num] == "mesh"} {
	set data_available(geom_facet) 1
    }
    
    if !$batch_mode {
	$tdv_default add_image $bsp
	$tdv_default add_tag $bsp geom_$type
	$tdv_default add_tag $bsp geom_entity
    }
    
    return $bsp
}

proc geometry_change {type num} {
      global projlib
 	set bsp [$projlib get_object $type $num]
	if {$bsp != ""} {
	update_geom_object $bsp
	$bsp signal_change 1
    } else {
	define_geom_object $type $num
    }
}

proc update_geom_object {bsp} {
    global projlib fam_visible geom_visible blank_family_color
    
    if {$bsp == "all"} {
	foreach t {surface curve point material loop density} {
	    set bsps [$projlib list_bsp_objects $t even_if_dormant]
	    foreach bsp $bsps {
		update_geom_object $bsp
	    }
	}
	return
    }
    
    set fam [$projlib get_family [$bsp get -type] [$bsp get -bspline]]
    if {$fam != ""} {	
	if ![info exists fam_visible($fam)] {
	    set fam_visible($fam) 0
	}
	set vis [expr [get_fam_visible $fam] && [get_geom_visible [$bsp get -type]]]
	set col [family_color_for_name $fam]
    } else {
	#set vis $geom_visible([$bsp get -type])
	set col $blank_family_color
	set vis 1
    }
    $bsp configure -family $fam -color $col -visible $vis 
}

proc delete_geom_object {objs} {
    global projlib
    
    if {$objs == ""} return
    
    foreach obj $objs {
	set type [$obj get -type]
	lappend nums($type) [$obj get -number]
	$obj delete
    }
    foreach type [array names nums] {
	eval $projlib delete_bspline_objects $type $nums($type)
    }
}

proc geo_delete_if_empty {args} {
    global projlib
    
    foreach s $args {
	if [$projlib delete_[$s get -type]_if_empty [$s get -number]] {
	    delete_geom_object $s }
    }
}

proc geom_summary {{pl ""}} {
    global projlib
    
    if {$pl == ""} {
	set pl $projlib
        if { $pl == "" } {
		mess "no model defined\n"
		return
	}
    }
    foreach {type name} {
	surface surfaces curve curves point "prescribed points"
	material "material points" loop loops body bodies family families 
    } {
	set n [$pl num_objects $type]
	if $n { mess "$n $name\n" }
    }
}

proc geo_highlight {objs {show_names 0} {diff_colors 0} {force_visible 1}} {
    global geo_highlight

    set diffc {cyan magenta yellow pink orange}
    
    set i 0
    set nvis 0
    foreach im $objs {
	if $diff_colors {
	    set p [expr $i % [llength $diffc]]; incr i
	    set col [lindex $diffc $p]
	    set ncol [lindex $diffc $p]
	} else {
	    set col white
	    set ncol white
	}
	if [info exists geo_highlight($im)] continue
	set geo_highlight($im) [list -width [$im get -width] \
				    -color [$im get -color] \
				    -visible [$im get -visible] \
				    -draw_name [$im get -draw_name] \
				    -name_color [$im get -name_color]]
	$im configure -width 2 -color $col -draw_name $show_names \
	    -name_color $ncol 
	if $force_visible {
	    $im configure -visible 1
	} else {
	    incr nvis [expr ![$im get -visible]]
	}
    }
    if $nvis {
	mess "Note: $nvis object[expr {($nvis == 1) ? "" : "s"}] are selected but not visible\n" orange
    }
}

proc geo_unhighlight {objs} {
    global geo_highlight
    
    if {$objs == ""} {
	foreach im [array names geo_highlight] {
	    catch {   ;# it might have been deleted already
		# ??? set v [$im get -visible]
		eval $im configure $geo_highlight($im)
		# ??? $im configure -visible $v
	    }
	}
	catch {unset geo_highlight}
    } else {
	foreach im $objs {
	    # ??? set v [$im get -visible]
	    catch {eval $im configure $geo_highlight($im)}
	    catch {unset geo_highlight($im)}
	    # ??? $im configure -visible $v
	}
    }
}

proc geo_highlight_ents {ents} {
    global projlib
    
    set objs ""
    foreach e $ents {
	set et [lindex [split $e :] 0]; set en [lindex [split $e :] 1]
	set obj [$projlib get_object $et $en]
	if {$obj != ""} {
		lappend objs $obj
	}
    }
    geo_highlight $objs 0 0 0
}

proc geo_unhighlight_ents {ents} {
    global projlib
    
    set objs ""
    foreach e $ents {
	set et [lindex [split $e :] 0]; set en [lindex [split $e :] 1]
	set obj [$projlib get_object $et $en]
	if {$obj != ""} {
		lappend objs $obj
	}
    }
    geo_unhighlight $objs
}

proc geo_highlight_nums {type nums} {
    global projlib
    
    set objs ""
    foreach n $nums {
	set obj [$projlib get_object $type $n]
	if {$obj != ""} {
		lappend objs $obj
	}
    }
    geo_highlight $objs 0 0 0
}

proc geo_unhighlight_nums {type nums} {
    global projlib
    
    set objs ""
    foreach n $nums {
	set obj [$projlib get_object $type $n]
	if {$obj != ""} {
		lappend objs $obj
	}
    }
    geo_unhighlight $objs
}

proc projlib_list_families {} {
    global projlib
    set fams [$projlib list_families 0]
    lappend fams ""
    return $fams
}

proc geo_run_hull {{surfs ""} {doit 1} {all_types 0}} {
    global projlib med_root
    
    # First get a convex hull for the surfaces.
    
    set hull_prog bin/hull
    
    if {$surfs == ""} {
	if $all_types {
	    set surfs [select_geometry entity]
	} else {
	    set surfs [select_geometry surface]
	}
        if {$surfs == ""} { return "" }
    }
    set hull_in [cmd_tempfile hull_in .tmp]
    set hull_in2d [cmd_tempfile hull_in2d .tmp]
    set hull_out [cmd_tempfile hull_out .tmp]
    set hull_debug [cmd_tempfile hull_debug .tmp]
    
    set nums ""
    set retnums ""
    foreach obj $surfs {
	set n [$obj get -number]
	set t [$obj get -type]
	lappend retnums [list $t $n]
	lappend nums $n
	lappend found($t) $n
    }
    
    ## ***** need to offset so centroid is the origin
    
    set isflat 0 ;# always do a 3d one
    set dist 0; set npt 0
    foreach t {surface curve point} {
	if [info exists found($t)] {
	    set xxx [$projlib write_points_$t $found($t) $hull_in $hull_in2d]
	    incr npt [lindex $xxx 0]
	    if {[lindex $xxx 1] > $dist} { set dist [lindex $xxx 1] }
	    if ![lindex $xxx 2] { set isflat 0 }
	}
    }
    if !$npt { return "" }
    if $doit {
	if {$npt > 100000} {
	    set mess "There are $npt points.  It will take a long time to\
		compute the convex hull."
	    if [tk_dialog .big_job "Convex hull" $mess "" -1 \
		    Ok Cancel] {
		cmd_rm $hull_in
		return ""
	    }
	}
	
	# The hull program works with integers.  So we need to compute a
	# multiplicative factor...  Discretize so that 1 million units = 
	# the distance across the bbox.
	if !$dist {
	    mess "bounding box of surfaces is 0\n" red
	    return ""
	}
	if {$dist > 1e-3} {
	    set mult [expr int(1000000 / $dist)]
	} elseif {$dist > 1e-6} {
	    set mult [expr int(1000 / $dist)]
	} else {
	    set mult 1000000000
	}
	
	if $isflat {
	    set inf $hull_in2d; set dim 2
	} else {
	    set inf $hull_in; set dim 3
	}
	set cmd "-i$inf -oF$hull_out -X$hull_debug -m $mult"
	mess "Running $dim-D convex hull on $npt points\n"
	mess "$hull_prog $cmd\n"
	busy 1
	run_application_batch $hull_prog "" $cmd
	#catch {eval exec $cmd} res
	busy 0
	mess "Done with hull\n"
	if ![file exists $hull_out] { error "hull failed" }
    } else {
	set hull_out ""
    }
    
    rm_tmp_file $hull_debug
    rm_tmp_file $hull_in2d
    
    if $all_types {
	return [list $hull_in $hull_out $retnums]
    } else {
	return [list $hull_in $hull_out $nums]
    }
}

proc geom_get_objects {what how {names 0} {only_if_dormant 0}} {
    global select_geom_by_name select_geometry_option projlib

    if {$what == "reset"} {
	set select_geometry_option ""
	return ""
    }
    switch $how {
	family {
	    set fams [select_families family 1 0]
	    if {$fams == ""} { return "" }
	}
	part {
	    set fams [select_families part 1 0]
	    if {$fams == ""} { return "" }
	}
	color {
	    set fams [select_families color 1 0]
	    if {$fams == ""} { return "" }
	}
    }
    set etypes $what
    if {$what == "entity"} { set etypes {surface curve point material density loop} }
    set all ""
    foreach t $etypes {
	if {($t == "point" || $t == "curve") && $only_if_dormant} {
	    set nums [$projlib list_objects $t only_if_dormant]
	} else {
	    set nums [$projlib list_objects $t]
	} 				
	foreach n $nums {
	    lappend all [$projlib get_object $t $n]
	}
    }

    set sel ""
    switch $how {
	all {
	    set sel $all
	    set select_geometry_option [list all]
	}
	visible {
	    set select_geometry_option [list visible]
	    foreach im $all {
		if [$im get -draw_me] {
		    lappend sel $im
		}
	    }
	}
	blanked  {
	    set select_geometry_option [list blanked]
	    foreach im $all {
		if ![$im get -draw_me] {
		    lappend sel $im
		}
	    }
	}
	family - color - part {
	    set select_geometry_option [list families $fams]
	    foreach im $all {
		if {[lsearch $fams [$im get -family]] >= 0} {
		    lappend sel $im
		}
	    }
	}
	subset {
	    set subs [ic_geo_subset_list]
	    set choices [choose_multiple "Select one or more subsets." $subs +200+200 "Select Geometry Subsets"]
	    if {$choices != ""} {
		set select_geometry_option [list subsets $choices]
		foreach ss $choices {
		    foreach {t n} [$projlib subset_contents $ss] {
				lappend sel [$projlib get_object $t $n]
		    }
		}
	    }
	}
	name {
	    foreach im $all {
		set infam([$im get -name]) $im
	    }
	    
	    set opts ""
	    foreach f [lsort [array names infam]] {
		set col [family_color_for_name [$infam($f) get -family]]
		lappend opts [list $f -text $f \
				  -selectbackground $col -foreground $col]
		set select_geom_by_name($f) 0
	    }
	    set size "10 10"
	    
	    check_box_form .select_by_name "Select names" $opts $size \
		select_geom_by_name
	    
	    foreach f [lsort [array names infam]] {
		if $select_geom_by_name($f) {
		    lappend sel $infam($f)
		}
	    }
	}
    }
    if $names {
	set ret ""
	foreach s $sel { lappend ret [$s get -name] }
	return $ret
    } else {
	return $sel
    }
}

proc process_deletes { deletes } {
    global projlib 
    # delete the specified entities from med's gui
    set ndel 0
    set objs ""
    foreach i [ split $deletes \n ] {
	if {[lindex $i 0] == "deleting"} {
	    set type [ lindex $i 1 ]
	    set name [ lindex $i 2 ]
	    set num  [ lindex $i 3 ]
		set obj [$projlib get_object $type $num]
	    if {$obj != ""} {
		lappend objs $obj
		$projlib delete_${type} $num
		incr ndel
	    }
	}
    }
    delete_geom_object $objs
    return $ndel
}

proc show_geo_selected {im on {color white} {force_visible 0}} {
    global show_geo_selected tdv_default

    if {$im == ""} {
	set pa [tdv_active 0]
	foreach i [array names show_geo_selected] {
	    show_geo_selected $i $on $color
	}
	tdv_active $pa
	return
    }
    if {$on && [info exists show_geo_selected($im)]} return
    if {!$on && ![info exists show_geo_selected($im)]} return
    if $on {
	set ocolor [$im get -color]
	set osh [$im get -shade]
	set show_geo_selected($im) \
	    "-simple [$im get -simple] -color $ocolor -shade $osh \
	     -width [$im get -width] -color_by_count [$im get -color_by_count]  \
	     -visible [$im get -visible] \
	     -show_composite [$im get -show_composite]"
	$im configure -color $color -width 2 -color_by_count 0 -show_composite 0
	# -simple 0
	if {0 != $force_visible} { $im configure -visible 1 }
	if {$osh == "solid"} { $im configure -shade flat_wire }
    } elseif [info exists show_geo_selected($im)] {
	# $im might have already been deleted
	if [catch {eval $im configure $show_geo_selected($im)}] return
	unset show_geo_selected($im)
    }
    if !$force_visible {
        set type [$im get -type]
        if {$type == "density"} {
	    set vis [expr [get_geom_visible density] != 0]
        } else {
	    set vis [expr [get_fam_visible [$im get -family]] && \
		          [get_geom_visible $type]]
        }
	$im configure -visible $vis
    }
    $im signal_change 1
}

proc geo_match_name {type pat} {
    global projlib
    if {$projlib == ""} { return "" }
    set objs ""
    foreach s [$projlib list_objects $type] {
	set name [$projlib get_name $type $s]
	if [string match $pat $name] {
	    lappend objs [$projlib get_object $type $s]
	}
    }
    return $objs
}

proc geo_dormant_match_name {type pat} {
    global projlib
    if {$projlib == ""} { return "" }
    set objs ""
    if {$type != "point" && $type != "curve"} { return "" }
    foreach s [$projlib list_objects $type only_if_dormant] {
	set name [$projlib get_name $type $s]
	if [string match $pat $name] {
	    lappend objs [$projlib get_object $type $s]
	}
    }
    return $objs
}


