# Library functions for the scripting library (scrib)
#
# File: scrib/lib/welding.tcl
#
# $Revision$ on $Date$
# 
# Copyright (c) 1993-2003 ICEM CFD Engineering
#
#--------------------------------------------------------------------
#
# --> if the name of the main proc already exists in interp, return
#
if {"" != [info commands scrib_lib_welding_spot_script]} { return }
#
# --> procs in this file depend on the following scrib/lib/ files--source them
#     I guess we could do this by proc, too, not sure waht's best
#
if {"" != [info commands scrib_lib_setup_source_files]} {
    set required_files "assembly"
    scrib_lib_setup_source_files $required_files
}
#

#--------------------------------------------------------------------------
#
# (B I) W A S M    F I L E   P R O C S
#
#--------------------------------------------------------------------------
#

## return the coords from the given string <em>line</em> in a BIWASM file

proc scrib_lib_welding_line_parse_coords_biwasm {line} {
    set coords ""
    set n 3
    foreach val {x y z} {
	set val [lindex $line $n]
	set val [string range $val 0 [expr [string last . $val]  + 2]]
	lappend  coords $val
	incr n
    }
    if ![scrib_lib_math_is_point $coords] {
	mess "WELD_READ_INFO: coords from biwasm file line do not look correct: $coords\n"
    }
    return $coords
}

## return the list of components from the given string <em>line</em> in a BIWASM file
## NOT IMPLEMENTED

proc scrib_lib_welding_line_parse_components_biwasm {line} {
    mess "scrib_lib_welding_line_parse_components_biwasm NOT IMPLEMENTED!\n"
    return ""
}

## parse and make appropriate settings for the given string <em>line</em>
## from a BIWASM file. The open file pointer <em>fp</em> is also passed
## in case extra lines need to be read for the settings.

proc scrib_lib_welding_line_parse_biwasm {fp line} {
    global welding_nwspots welding_directives_found welding_result_fam
    #
    # get the tag from the line
    #
    set tag [lindex $line 1]
    if { ($tag != "2T" ) && ( $tag != "gum") } {
	# this is a normal return
	return 0
    }
    
    set data 0
    switch -- $tag {
	2T {
	    #
	    # 2T: this spec...xxxxx add info xxxxxx
	    #
	    set fam $welding_result_fam
	    #
	    # get coords
	    #
	    set coords [scrib_lib_welding_line_parse_coords_biwasm $line]
	    if {"-1" == $coords} {
		return -1 
	    }
	    
	    set ppname "$fam$welding_nwspots(npts)"
	    
	    set family1 [scrib_lib_assembly_famname_get [lindex [string trim [gets $fp]] 1]]
	    set family2 [scrib_lib_assembly_famname_get [lindex [string trim [gets $fp]] 1]]
	    set compfams "$family1 $family2"
	    
	    set data [list $tag $ppname $coords $compfams $fam]
	}
	gum {
	    #
	    # gum: this spec...xxxxx add info xxxxxx
	    #
	    set fam GUMDROP
	    set ppname "$fam$welding_nwspots(npts)"
	    #
	    # get coords
	    #
	    set coords [scrib_lib_welding_line_parse_coords_biwasm $line]
	    if {"-1" == $coords} { return -1 }
	    
	    set diameter [string trim [gets $fp]]
	    set family1  [scrib_lib_assembly_famname_get [lindex [string trim [gets $fp]] 1]]
	    set family2  [scrib_lib_assembly_famname_get [lindex [string trim [gets $fp]] 1]]
	    set compfams "$family1 $family2"
	    
	    if [scrib_lib_math_is_int_real $diameter] { set radius [expr $diameter / 2] } else { set radius "" }
	    set data [list $tag $ppname $coords $compfams $fam $radius]
	}
	default {
	    mess "WELD_READ_INFO: cannot parse biwasm line with tag: $tag\n" red
	    return -1
	}
    }
    #
    # data should be of the form: [list $ppname $coords $compfams]
    #
    return $data
}

##

proc scrib_lib_welding_shadow_family_name {naspid} {
    return "WELD_SHADOWS_[string toupper $naspid]"
}

##

proc scrib_lib_welding_execute_one_weld_shadow {import_type ppname coords compfamnames} {
    #
    global welding_proj_max welding_shadow_naspid welding_nwspots
    #
    # --> check input
    #
    if {("" == $ppname) || ("" == $coords) || ("" == $compfamnames)} {
	return -1
    }
    #
    # --> figure out which of the compfamnames is the source, and which are targets
    #
    set targ_families [scrib_lib_welding_weld_targets_get $coords $compfamnames]
    if {0 >= [llength $targ_families]} {
	#mess "WELD_READ_ERROR: could not get any valid components for weld definition at: $coords\n" red
	return 0
    }
    set pt_family          [scrib_lib_welding_shadow_family_name $welding_shadow_naspid]    
    set interesting_target [scrib_lib_assembly_famname_get $welding_shadow_naspid]
    #
    # --> do stuff
    #
    foreach targ_family $targ_families {
	#
	# if the coords are being connected to this target part, then 
	# project it now and create a point there
	#
	if [string equal $targ_family $interesting_target] {
	    #
	    # --> check validity of the weld
	    #
	    if ![scrib_lib_welding_weld_is_invalid $coords $targ_family] {		
		#mess "creating point at $coords in family $pt_family\n" blue
		set point [scrib_lib_welding_prepoint_create $ppname $targ_family $coords $pt_family]

		#now check location of new point, and if it is too close to curve boundaries delete.
		set trg_curves [scrib_lib_geo_get_single_curves [ic_geo_get_objects curve ""]]
		if {"" == $trg_curves} {
		    return 0
		}
		set new_coords [ic_geo_get_point_location $point]
		set dist_c [scrib_lib_geo_distance_from_curves "" $new_coords $trg_curves]
		set welding_edge_dist_limit 2
		if {$dist_c < $welding_edge_dist_limit} {
		    mess "WELD_READ_ERROR: point originally at $coords projected to $new_coords onto family $targ_family \n"
		    mess " (length: $dist_c; max: $welding_edge_dist_limit)\n"
		    ic_delete_geometry point names $point
		    incr welding_nwspots(ntoolong)
		    return -1
		}
	    } else {
		
		mess "WELD_READ_ERROR: weld at $coords for target part $targ_family seems to be invalid\n" red
	    }
	}
    }
    
    return 0 ;# fixme
}

## 

proc scrib_lib_welding_execute_one_weld {import_type ppname coords compfamnames result_fam {radius ""}} {
    #
    global welding_directives_found welding_nwspots welding_element_splitting welding_proj_max
    global welding_shadow_naspid
    
    set wmethod [scrib_lib_welding_icem_weld_type $import_type]
    #
    # --> if there is no mesh loaded, then try creating "shadow" welds and return
    #
    if {("standard" == $wmethod) && ![ic_uns_is_loaded] && [info exists welding_shadow_naspid]} {
	return [scrib_lib_welding_execute_one_weld_shadow $import_type $ppname $coords $compfamnames]
    }
    #
    # --> check input
    #
    if {("" == $ppname) || ("" == $coords) || ("" == $compfamnames)} {
	return -1
    }
    #
    # --> figure out which of the compfamnames is the source, and which are targets
    #
    set sorted_parts [scrib_lib_welding_weld_targets_get $coords $compfamnames]
    if {0 >= [llength $sorted_parts]} {
	mess "WELD_READ_ERROR: could not get any valid components for weld definition at: $coords\n" red
	return -1
    }
    set src_family [lindex $sorted_parts 0]
    set targ_families [lrange $sorted_parts 1 end]
    if {[ic_uns_is_loaded] && (1 > [llength $targ_families])} {
	mess "WELD_READ_ERROR: could not get any valid target components for weld definition at: $coords\n" red
	return -1
    }
    #
    # --> foreach target family, create the weld, then store it in the tetin file
    #
    set wmethod [scrib_lib_welding_icem_weld_type $import_type]
    #
    # --> if there is no mesh loaded, then create "shadow" welds
    #
    if {("standard" == $wmethod) && ![ic_uns_is_loaded] && [info exists welding_shadow_naspid]} {
	set wmethod "shadow"
	set pt_family [scrib_lib_welding_shadow_family_name $welding_shadow_naspid]
    } else { set pt_family "" }
    #
    # --> do stuff
    #
    set local_nwelds 0
    set status_by_partpairs ""
    foreach targ_family $targ_families {
	#
	# --> check validity of the weld
	#
	if [scrib_lib_welding_weld_is_invalid $coords $targ_family] {
	    mess "WELD_READ_ERROR: weld at $coords from $src_family to target part $targ_family seems to be invalid\n" red
	    lappend status_by_partpairs "-1 {$src_family $targ_family}"
	    continue
	}	
	#
	# --> collect the parameters in the tetin file so that user can run it later without re-importing
	#
	set extra_args "method $wmethod"
	if {"" != $radius} {
	    append extra_args " radius $radius"
	}
	#
	# --> create a a prepoint for the source of the weld in the tetin file
	# 
	scrib_lib_welding_prepoint_create $ppname $src_family $coords
	#
	# --> create the single weld
	#
	set rbe3_fam [scrib_lib_welding_rbe3_family_name $result_fam]
	set args "-prepoint $ppname -source_family $src_family -target_family $targ_family \
                      -spotweld_family $result_fam -method $wmethod -rbe3_family $rbe3_fam \
                      -maxprojection $welding_proj_max"
	if {"" != $radius} {
	    append args " -radius $radius"
	}
	if {[info exists welding_element_splitting] && ("" != $welding_element_splitting)} {
	    append args " -element_splitting $welding_element_splitting"
	}
	set stat [eval ic_meshdirect_spot_weld $args]   
	#
	# --> tally up
	#
	lappend status_by_partpairs "$stat {$src_family $targ_family}"
	incr local_nwelds [expr {0 == $stat}]
	#
	# --> set the parameters in the tetin file so that user can run it later without re-importing
	#
	scrib_lib_welding_spot_params_set $src_family $ppname $targ_family $result_fam $extra_args
    }
    
    incr welding_nwspots(total_welds) $local_nwelds
    set welding_directives_found(spotweld) 1
    
    return $status_by_partpairs
}

##

proc scrib_lib_welding_icem_weld_type {import_type} {
    
    set upper_type [string toupper $import_type]
    
    switch -- $upper_type {
	MASTIC     { return "meshless_hex" }
	WSPOT - 2T { return "standard" }
	GUM        { return "area_weld" }
	default    {
	    mess "Warning: not sure what to do with weld import type $import_type\n" red
	    return "standard" 
	}
    }
}

#
#--------------------------------------------------------------------------
#
# V I F   F I L E   P R O C S
#
# e.g.
# ?WSPOT?   id     x    y   z    part1    part2    ...    partn
# MASTIC    id     x    y   z    part1    part2    ...            diameter
#
# (for BOLT & SEAM, cf. Bug#:	6551:
#   The spider (RBE2s) should form within the nearest parallel "hole" curves of 
#   all surfaces listed and should also form with the nodes of the first quad ring 
#   as a "washer."  Then an RBE2 should connect the spider centers to form 
#   the "bolt."
#   Seam welds could form similarly;)
# BOLT      id     x    y   z    part1    part2    ...  fixme
# SEAM      id     x    y   z    part1    part2    ...  fixme
#
#--------------------------------------------------------------------------
#

## return whether or not the <em>token</em> is a known VIF file tag

proc scrib_lib_welding_token_is_tag_vif {token} {
    set vif_tags {WSPOT MASTIC BOLT}
    return [expr {0 <= [lsearch $vif_tags $token]}]
}

## 

proc scrib_lib_welding_weld_type_vif {line} {
    if { ![scrib_lib_welding_token_is_tag_vif [lindex $line 0]] } {
	set type WSPOT
    } else {
	set type [string toupper [lindex $line 0]]
    }
    return $type
}

## return the index of the weld id from the given string <em>line</em> in a VIF file

proc scrib_lib_welding_line_parse_id_index_vif {line} {
    #set idoffset [expr {"WSPOT" == [lindex $line 0]} ? 1 : 0]
    set idoffset [expr {[scrib_lib_welding_token_is_tag_vif [lindex $line 0]] ? 1 : 0}]
    if ![string is integer [lindex $line $idoffset]] { return -1 }
    return $idoffset
}

## return the beginning index of the coords from the given string <em>line</em> in a VIF file

proc scrib_lib_welding_line_parse_coords_index_vif {line} {
    return [expr [scrib_lib_welding_line_parse_id_index_vif $line] + 1]
}

## return the coords from the given string <em>line</em> in a VIF file

proc scrib_lib_welding_line_parse_coords_vif {line} {
    set coordind [scrib_lib_welding_line_parse_coords_index_vif $line]
    return [lrange $line [expr $coordind] [expr $coordind + 2]]
}

## return the beginning index of the components from the given string <em>line</em> in a VIF file

proc scrib_lib_welding_line_parse_components_index_vif {line} {
    return [expr [scrib_lib_welding_line_parse_coords_index_vif $line] + 3]
}

## return the list of components from the given string <em>line</em> in a VIF file

proc scrib_lib_welding_line_parse_components_vif {line} {
    set endmark [expr {[string equal "WSPOT" [scrib_lib_welding_weld_type_vif $line]] ? "end" : "end-1"}]
    set compind [scrib_lib_welding_line_parse_components_index_vif $line]
    return [lrange $line [expr $compind] $endmark]
}

##

proc scrib_lib_welding_line_is_comment_vif {line} {
    set first_char [string range $line 0 0]
    if {[string equal "$" $first_char] || [string equal "\#" $first_char]} {
	return 1
    }
    return 0
}

## parse and make appropriate settings for the given string <em>line</em>
## from a VIF file. The open file pointer <em>fp</em> is also passed
## in case extra lines need to be read for the settings.

proc scrib_lib_welding_line_parse_vif {fp line} {
    global welding_nwspots welding_directives_found welding_result_fam
    
    # given a line, e.g.:
    # ?WSPOT?  131  456.38 -520.10  160.38   75135   75135
    
    # check for comment
    
    if [scrib_lib_welding_line_is_comment_vif $line] {
	return 0
    }
    
    # base the family on the tag used
    
    if [scrib_lib_welding_token_is_tag_vif [lindex $line 0]] {
	set result_fam [string toupper [lindex $line 0]]
	if {![info exists welding_result_fam] || ("" == $welding_result_fam)} {
	    set welding_result_fam $result_fam
	}
    } else {
	set result_fam $welding_result_fam
    }
    
    # --> get the coords from the line
    
    set type [scrib_lib_welding_weld_type_vif $line]
    
    set coords [scrib_lib_welding_line_parse_coords_vif $line]
    if ![scrib_lib_math_is_point $coords] {
	mess "\nWELD_READ_INFO: could not get proper coords: $coords\n" red
	return -1
    }
    
    # --> get the components from the line

    set components [scrib_lib_welding_line_parse_components_vif $line]
    if {("" == $components) || (0 == [llength $components])} {
	mess "\nWELD_READ_INFO: could not get proper componenents for at $coords: $components\n" red
	return -1
    }
    
    # --> get the componentfamilies corresponding to the $components list wrt $coords
    
    set componentfamilies [scrib_lib_welding_component_lookup_by_coords $coords $components]
    if {-1 == $componentfamilies} {
	mess "WELD_READ_INFO: could not get componenent families of VIF file line: $line\n" red
	return -1
    }
    set radius ""
    switch -- $type {
	MASTIC - BOLT {
	    set diameter [lindex $line end]
	    if ![scrib_lib_math_is_int_real $diameter] {
		mess "WELD_READ_INFO: got supsect value for diameter of $mode weld\n" red
	    } else { set radius [expr $diameter / 2] }
	}
    }
    #
    # --> create the name for the prescribed point at coords
    #
    set ppname "${result_fam}_${type}$welding_nwspots(npts)"
    
    #--> indices 0     1       2       3                  4           5
    return [list $type $ppname $coords $componentfamilies $result_fam $radius]
}

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

## read a "line" from file_pointer "fp"
##      --mode can be one of: { biwasm, vif }
##      --the file pointer must be specified so that if it's a certain kind
##        of line, additional lines can be read

proc scrib_lib_welding_line_parse {mode fp line} {
    
    if {("" == $line) || ("#" == [string range $line 0 0])} {
	# this is a normal return
	return 0
    }
    #
    # create the call for the mode-specific parsing command
    #
    set cmd "scrib_lib_welding_line_parse_${mode}"
    
    if {"" == [info commands $cmd]} {
	mess "WELD_READ_INFO: could not get command $cmd...returning without parsing line\n" red
	return -1
    }
    
    # this is returning the data from the cmd
    
    return [$cmd $fp $line]
}

## read the given "filename" for spotwelding parameters
##      o -mode can be one of: { biwasm, vif }
##      o -projection_max controls projection dist in scrib_lib_welding_prepoint_create
##      o -shadow $naspid

proc scrib_lib_welding_spot_import_exec {mode filename {args ""}} {
    #
    global welding_proj_max welding_nwspots welding_nwspots_by_fam
    global welding_report_filename welding_result_fam welding_element_splitting
    global welding_shadow_naspid
    #
    # --> parse the given args
    #
    #puts "args: $args\n"
    foreach {n v} [lrange $args 0 end] {
	#puts "n: $n; v: $v\n"
	if {"-" == [string range $n 0 0]} {
	    set [string range $n 1 end] $v
	}
    }
    #
    # --> this is setting the global variables, since i'm too lazy to pass it around
    #
    if [info exists report_file] {
	set welding_report_filename $report_file
    } else { set welding_report_filename "" }    
    #
    if [info exists maxprojection] {
	if {("" == $maxprojection) || (0 >= $maxprojection)} {
	    set welding_proj_max [scrib_lib_math_dbl_max]
	} else {
	    set welding_proj_max $maxprojection
	}
    } else { set welding_proj_max [scrib_lib_math_dbl_max] }
    
    if [info exists spotweld_family] {
	set welding_result_fam $spotweld_family
    } else { set welding_result_fam "" }
    
    if [info exists element_splitting] {
	set welding_element_splitting $element_splitting
    } else { set welding_element_splitting "" }

    if [info exists shadow] {
	set welding_shadow_naspid $shadow
    } else { set welding_shadow_naspid "" }
    
    
    #
    # --> keep track of the number of spotwelds *per family*
    #
    set welding_nwspots(total_lines) 0
    set welding_nwspots(total_welds) 0
    set welding_nwspots(ntoolong) 0
    set welding_nwspots(nbadpartrefs) 0
    set welding_nwspots(npts) 0
    set welding_nwspots(nlineerrors) 0
    set welding_nwspots(filename) $filename
    #
    # --> open the file and read each line in file...
    #    
    set fstat [catch {open $filename r} fp]
    if $fstat {
	mess "WELD_READ_ERROR: cannot open file $filename...returning.\n" red
	return -1
    }
    #
    # --> make sure the parsing command exists
    #
    set cmd "scrib_lib_welding_line_parse_${mode}"
    if {"" == [info commands $cmd]} {
	mess "WELD_READ_INFO: could not get command $cmd for parsing $mode data file $filename\n" red
	return -1
    }
    
    mess "\n\nBeginning to import $mode spotweld data from $filename\n"
    mess "\tmaximum weld projection is $welding_proj_max\n\n"
    #
    # --> get all the lines from the file
    #
    while { ![eof $fp] } {
	#
	# --> get a line from the file
	#
	set line [string trim [gets $fp]]
	#
	# --> and parse it based on the mode (biwasm, vif, ...)
	#
	set no_report 0
	set read_error 0
	set exec_status ""
	set data [scrib_lib_welding_line_parse $mode $fp $line]
	switch -- $data {
	    0 {
		# this is fine--it could have been a comment, blank line or something
		set no_report 1
	    }
	    -1 {
		# something went horribly wrong
		set read_error 1
		set exec_status -1
	    }
	    default {
		# best case scenario; obviously this list order and integrity is CRUCIAL
		set itype      [lindex $data 0]
		set ppname     [lindex $data 1]
		set coords     [lindex $data 2]
		set compfams   [lindex $data 3]
		set result_fam [lindex $data 4]
		set radius     [lindex $data 5]
		set exec_status [scrib_lib_welding_execute_one_weld $itype $ppname $coords $compfams $result_fam $radius]
	    }
	}
	if {"" != $exec_status} {	    	
	    foreach res $exec_status {
		incr read_error [expr {"-1" == [lindex $res 0]}]
	    }
	    if $read_error {
		# something went (horribly) wrong
		mess "WELD_READ_ERROR: unsuccessful importing the weld: $line\n***\n" red
		incr welding_nwspots(nlineerrors) $read_error
	    }
	    if !$no_report {
		scrib_lib_welding_report_line_status $mode $line $exec_status
		incr welding_nwspots(total_lines)
	    }
	}
    }
    
    scrib_lib_welding_report_summary
    
    # --> Create boundary conditions for RBE2 and RBE3 elements

    scrib_lib_welding_set_nastran_properties $welding_result_fam
    
    return 0
}

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


## returns the list of parts in the given partlist in the order
## such that the source part is the 0th index.

proc scrib_lib_welding_weld_targets_get {point partlist} {
    #
    set closestpart ""
    set leastdist [scrib_lib_math_dbl_max]
    #
    foreach part $partlist {
	#
	if ![ic_geo_check_family $part] continue
	#
	# get a distance from the $point to the $part
	#
	set dist_t [scrib_lib_geo_distance_from_surfaces $part $point]
	if ![scrib_lib_math_is_int_real $dist_t] continue
	
	if {$dist_t < $leastdist} {
	    set leastdist $dist_t
	    set closestpart $part
	}
    }
    set returnpartlist $closestpart
    foreach part $partlist {
	if [ic_geo_check_family $part] {
	    if {$closestpart != $part} {
		lappend returnpartlist $part
	    }
	} elseif [ic_uns_is_loaded] {
	    mess "WELD_READ_INFO: target family $part does not exist\n"
	}
    }
    
    #mess "-->DEBUG: returnpartlist : $returnpartlist\n" red
    return $returnpartlist
}

## needs doc.

proc scrib_lib_welding_component_lookup_by_coords {coords components} {
    global welding_nwspots
    
    set compfams ""
    set ncomponents [llength $components]
    foreach c $components {
	#
	# --> standardize string for creating family names from comp nums
	#
	set famname ""
	if [ic_geo_is_loaded] {
	    set famname [scrib_lib_geo_famname_find_bycoords $c $coords]
	}
	if {"" == $famname} { ;# && [ic_uns_is_loaded] <- had this condition too, once
	    set famname [scrib_lib_assembly_famname_get $c]
	}
	if {"" != $famname} {
	    lappend compfams $famname
	} else {	    
	    mess "WELD_READ_INFO: could not get famname from component $c at $coords\n" red
	    incr welding_nwspots(nbadpartrefs)
	}
    }
    if {("" == $compfams) || (0 == [llength $compfams])} {
	return -1
    }
    set ncompfams [llength $compfams]
    if {2 > $ncompfams} {
	mess "WELD_READ_INFO: only got $ncompfams components from \"$components\" being mapped to \"$compfams\"\n" red
	return -1
    }
    if {$ncompfams != $ncomponents} {
	mess "WELD_READ_INFO: only found $ncompfams component families for $ncomponents components specified...trying anyway.\n" red
    }
    
    return $compfams
}

## needs doc.

proc scrib_lib_welding_weld_is_invalid {coords trg_family} {
    global welding_proj_max welding_nwspots
    
    if {("" == $trg_family) || ![ic_geo_is_loaded]} {
	return 0     
    }
    set trg_surfs [ic_geo_get_objects surface $trg_family]
    if {"" == $trg_surfs} {
	return 0
    }
    set dist_t [scrib_lib_geo_distance_from_surfaces $trg_family $coords]
    if {$dist_t > $welding_proj_max} {
	mess "WELD_READ_ERROR: could not project weld from $coords to family $trg_family (length: $dist_t; max: $welding_proj_max)\n"
	incr welding_nwspots(ntoolong)
	return -1
    }
    return 0
}


## create a prescribed point in the current geometry with name <em>ppname</em>
## and in the family <em>src_family</em> with coords <em>coords</em>coords.

proc scrib_lib_welding_prepoint_create {ppname src_family coords {pt_family ""}} {
    global welding_nwspots
    #
    # --> check the distance of the coords project to source_family
    #
    if [scrib_lib_welding_weld_is_invalid $coords $src_family] {
	mess "WELD_READ_ERROR: weld at $coords seems to be invalid for $src_family\n" red
	return -1
    } 
    #
    # --> project the point to the surface family
    #
    set src_surfs [ic_geo_get_objects surface $src_family]
    if {"" == $src_surfs} {
	mess "WELD_READ_ERROR: could not get any surfaces in family $src_family\n" red
	return -1
    }
    set coords_sproj [ic_geo_project_coords surface $src_surfs $coords {0 0 0}]
    if {"" == $pt_family} { set pt_family $src_family }
    
    set point [ic_geo_cre_pnt $pt_family $ppname $coords_sproj]
    
    incr welding_nwspots(npts)
    
    return $point
}

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

## spot welding parameters on the source family <em>srf_family</em>
## for a spot weld for the <em>src_spot_ind</em>th time, starting
## from prescribed point <em>ppname</em>, and projecting to the
## surfaces in family <em>targ_family</em>, creating bar elements
## in family <em>result_fam</em>.

proc scrib_lib_welding_spot_params_set {src_family ppname targ_family result_fam {extra_args}} {
    global welding_nwspots_by_fam welding_nwspots
    #
    # Make sure the family exists in the tetin file, so can set params on it
    #
    if ![ic_geo_check_family $src_family] {
	mess "WELD_READ_ERROR: $src_family does not exist in the tetin file\n" red
	return -1
    }
    #
    # check that the coords of the ppname are not further than the proj_max
    #
    set ppcoords [ic_geo_get_point_location $ppname]
    if [scrib_lib_welding_weld_is_invalid $ppcoords $targ_family] {
	mess "WELD_READ_ERROR: weld at $ppcoords from $src_family to target part $targ_family seems to be invalid\n" red
	return -1
    }
    #
    #
    #
    if ![info exists welding_nwspots_by_fam($src_family)] {
	set welding_nwspots_by_fam($src_family) 1
    } else {
	incr welding_nwspots_by_fam($src_family)
    }
    set src_spot_ind $welding_nwspots_by_fam($src_family)
    set trg_spot_ind $src_spot_ind
    #
    set src_spot_tag "source_ppt${src_spot_ind}"
    set trg_part_tag "target_fam${trg_spot_ind}" 
    if 0 {
	#
	# check, check
	#
	set src_spot_tag ""
	set src_spot_ind 1
	while 1 {
	    set src_spot_tag "source_ppt${src_spot_ind}"
	    set ent [ic_geo_get_family_param $src_family $src_spot_tag]
	    if {"" != $ent} break
	    incr src_spot_ind
	}
	set trg_part_tag target_fam${src_spot_ind}
    }
    #
    # using spotwelds by point
    #
    ic_geo_set_family_params $src_family $src_spot_tag $ppname
    ic_geo_set_family_params $src_family $trg_part_tag $targ_family
    ic_geo_set_family_params $src_family spotweld_fam $result_fam
    
    if {"" != $extra_args} {
	foreach {tag val} $extra_args {
	    if {("" != $tag) && ("" != $val)} {
		ic_meshdirect_directive_set_val_by_tag spotweld $src_family $tag $val
	    }
	}
    }
    
    #incr welding_nwspots(total_welds)
    
    return 0
}

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

## execute the current global welding directives on the current mesh.

proc scrib_lib_welding_directives_exec {} {
    global welding_directives_found
    
    foreach a [array names welding_directives_found]  {
	
	if {("" == $a) || (0 == $welding_directives_found($a))} {
	    mess "cannot run mesh_direct for $a, where $welding_directives_found($a)\n"
	    continue
	}
	#
	# this calls the uns_cur method to the mesh_direct library
	#
	mess "Running meshing directives for $a\n"
	lappend status [ic_run_meshdirect_obj $a]
    }
    
    if ![info exists $status] { set status 0 }
    return $status
}

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

## for the welding format <em>mode</em> (one of <i>{biwasm, vif}</em>,
## read the file <em>weldfile</em> for welding information, save the
## welding settings in the tetin file <em>welded_tin</em>, and do not
## create any welds longer than the scalar <em>projection_max</em>.

proc scrib_lib_welding_spot_main {mode weldfile {args ""}} {
    
    eval scrib_lib_welding_spot_import_exec $mode $weldfile $args
    
    # this will save the settings to the tetin file
    
    # if {"" != $welded_tin} { ic_save_tetin $welded_tin } fixme
}

## scrib_lib_welding_spot_script: run med with the a
##      ~cvs/scrib/scripts/<em>base</em>.tcl script file
## this proc assumes a ScribApp context

proc scrib_lib_welding_spot_script {{base welding}} {
    global proc_scrib_data env
    
    if {![info exists proc_scrib_data(welding_file)] || \
	    ("" == $proc_scrib_data(welding_file))} {
	mess "No welding file has been specified.\n"
	return -1
    }
    set script "${base}.tcl"
    set proc_scrib_data(batch_script) $script

    set job_token $script
    set args ""
    set stat [scrib_lib_exec_medbatch $job_token "$script" $args "" $proc_scrib_data(interactive)]
    
    stdout "\nFinished welding mesh with $base script.\n"    
    return $stat
}

## needs doc.

proc scrib_lib_welding_report_line_status {mode line status} {
    #
    set text ""
    #
    # --> tab-delimit the line we're given
    #
    foreach field $line {
	append text "$field\t"
    }
    #
    # --> then add the status in next columns
    #
    set ngoodwelds_from_line 0
    
    # if we've actually got results to parse...
    
    if {-1 != $status} {
	set specifics ""
	foreach field $status {
	    set tstat [lindex $field 0]
	    if {0 <= $tstat} {
		incr ngoodwelds_from_line
	    }
	    append specifics "$field\t"
	}    
    }
    
    # we should make sure this command exists... --jka xxxxx
    set parts [scrib_lib_welding_line_parse_components_$mode $line]
    set nparts [llength $parts]
    switch -- $nparts {
	2 {
	    set results "\t\t$ngoodwelds_from_line\t0\t"
	}
	3 {
	    set results "\t0\t$ngoodwelds_from_line\t"
	}
	4 {
	    # fixme!!! columns may not match up --jka
	    set results "\t0\t0\t$ngoodwelds_from_line\t"
	}
	default {
	    mess "WELD_REPORT_ERROR: don't know how to report welds with $nparts parts!\n" red
	    set results ""
	}
    }
    append text $results
    # do not append specifics right now
    if 0 { append text "\t$specifics" }
    
    scrib_lib_welding_report_append $text
}

## needs doc.

proc scrib_lib_welding_report_summary {} {    
    global welding_nwspots welding_nwspots_by_fam welding_proj_max    
    #
    # --> report what we imported from the file
    #
    scrib_lib_welding_report_append "\n\n\nWelding summary:\n"
    scrib_lib_welding_report_append "Time:\t[clock format [clock seconds]]"
    scrib_lib_welding_report_append "Filename:\t$welding_nwspots(filename)"
    scrib_lib_welding_report_append "Maximum projection distance for weld:\t$welding_proj_max"
    scrib_lib_welding_report_append "Line read successfully:\t$welding_nwspots(total_lines)"
    scrib_lib_welding_report_append "Welds read successfully:\t$welding_nwspots(total_welds)"
    scrib_lib_welding_report_append "Lines with error(s):\t$welding_nwspots(nlineerrors)"
    scrib_lib_welding_report_append "Welds longer than maximum projection distance:\t$welding_nwspots(ntoolong)"
    scrib_lib_welding_report_append "Unresolvable part references:\t$welding_nwspots(nbadpartrefs)"
    
    scrib_lib_welding_report_append "\nWelding summary by family:\n"
    set nweldlines 0
    set npartswithnowelds 0
    set npartswithwelds   0    
    
    set sortedarraykeys [lsort -dictionary [array names welding_nwspots_by_fam]]
    foreach part $sortedarraykeys {
	set weldsonpart $welding_nwspots_by_fam($part)
	scrib_lib_welding_report_append "$part\t$weldsonpart"
	if $weldsonpart {
	    incr nweldlines $weldsonpart
	    incr npartswithwelds
	}
	if ![info exists npartswithweldno($weldsonpart)] {
	    set npartswithweldno($weldsonpart) 1
	} else {
	    incr npartswithweldno($weldsonpart)
	}
    }
    
    scrib_lib_welding_report_append "\nWelding summary by welds on parts:\n"
    set sortedarraykeys [lsort -integer [array names npartswithweldno]]
    foreach weldcount $sortedarraykeys {
	scrib_lib_welding_report_append "No. parts with $weldcount welds:\t$npartswithweldno($weldcount)"
    }
    scrib_lib_welding_report_append "Total no. parts with welds:\t$npartswithwelds"
    set close 1
    set file_closed [scrib_lib_welding_report_append "Total welds:\t$nweldlines" $close]
    if {"" != $file_closed} { mess "Wrote weld summary to $file_closed\n" }
}

## append some text to the welding log, maybe close it.

proc scrib_lib_welding_report_append {text {close 0}} {
    global welding_report_file_handle welding_report_file_opened
    global welding_report_filename
    
    if {"__none__" == $welding_report_filename} { return "" }
    
    if {(![info exists welding_report_filename]) || ("" == $welding_report_filename)} { 
	set welding_report_filename "welding_report.txt"
    }
    
    if {![info exists welding_report_file_opened] || !$welding_report_file_opened} {
	#
	# it's ok just to open it with "append" even if it doesn't exist
	#
	set welding_report_file_handle [open $welding_report_filename "a"]
	if {"" != $welding_report_file_handle} {
	    set welding_report_file_opened 1
	} else {
	    set welding_report_file_opened 0
	}    
    }
    if $welding_report_file_opened {
	puts $welding_report_file_handle $text
    }
    if {$welding_report_file_opened && $close} {
	close $welding_report_file_handle
	set welding_report_file_opened 0
	return $welding_report_filename
    }
    return ""
}

## This is just a way to deal consistently with the hard-coded family-naming
## convention of the RBE3 elements

proc scrib_lib_welding_rbe3_family_name {weld_family} {
    return "[string toupper $weld_family]_RBE3S"
}

#@ NB: to use set nastran SHELL properies, use:
#@   scrib_lib_assembly_set_naspid_on_shell_family $family $naspid
#
#

## Set appropriate NASTRAN properties on the family and all of it's descendants
## Returns 1 if it was able to set the properties, else 0.
# -------------------------(cf. Bug 6496)--------------------------------

proc scrib_lib_welding_set_nastran_properties {root_fam} {
    
    if ![ic_uns_is_loaded] { return 0 }
    
    mess "Setting Nastran welding element properties on family $root_fam\n"

    #
    # --> See if an RBE3 family exists for root_fam; base settings on that
    #
    set num_rbe3s 0
    set rbe3_fam [scrib_lib_welding_rbe3_family_name $root_fam]    
    if [ic_uns_check_family $rbe3_fam] {
	set rbe3_map [ic_uns_subset_create]
	ic_uns_subset_add_families_and_types $rbe3_map $rbe3_fam "MIXED"
	set num_rbe3s [ic_uns_subset_count_elements $rbe3_map]
	ic_uns_subset_delete $rbe3_map
    }
    
    if {0 < $num_rbe3s} {
	
	set stat [scrib_lib_welding_set_nastran_rbe3_properties $root_fam]
	
    } else {
	
	set stat [scrib_lib_welding_set_nastran_rbe2_properties $root_fam]
    }
    
    return $stat
}

## Needs Doc. fixme. Returns 1 if it was able to set the properties, else 0.
# -------------------------(cf. Bug 6496)--------------------------------

proc scrib_lib_welding_set_nastran_rbe2_properties {weld_fam} {
    #
    # Family boco line explanation from Simon:
    #    
    # "WSPOT"
    #("WSPOT" "PART_NAME" "WSPOT")
    # "WSPOT" "ELEMENT_PROP_NAME" "Lines/WSPOT"
    # "WSPOT" "RBE2" 1 0 123456
    #
    # "RBE2" "Not Legged Case (don't ask, just set to 1)" "Grid ID No (set to "0" 
    # and it will figure itself out)"  "Dependent DOF"
    #
    
    if {"" == $weld_fam} {
	mess "Error: cannot set Nastran RBE2 properties on NULL family\n" red
	return 0
    }

    if {0 >= [ic_uns_count_in_families $weld_fam]} {
	mess "Error: there aren't any elements in the weld family \"$weld_fam\"\n" red
	return 0
    }
    
    if ![ic_geo_check_family $weld_fam] {
	ic_geo_new_family $weld_fam
    }
    
    set bc [list [list 1 RBE2 1 0 123456] [list 1 ELEMENT_PROP_NAME "Lines/${weld_fam}"]]
    if [catch {ic_boco_add $weld_fam $bc} res] {
	mess "Error: could not set RBE2 boundary condition on $family: $res\n" red
	return 0
    }    
    
    mess "Have set element properties appropriate to RBE2 configurations on $weld_fam\n"
    return 1
}


## Needs Doc. fixme.

proc scrib_lib_welding_mastic_material_id {} { return 1000 }


## Needs Doc. fixme. Returns 1 if it was able to set the properties, else 0.
# -------------------------(cf. Bug 6496)--------------------------------

proc scrib_lib_welding_set_nastran_rbe3_properties {weld_fam} {
   
    # Family boco line explanation from Simon:
    #    
    # "WSPOT"
    #("WSPOT" "PART_NAME" "WSPOT")
    # "WSPOT" "RBE3" 0 123456 1 123456
    # "WSPOT" "ELEMENT_PROP_NAME" "Lines/WSPOT"
    #    
    # "MASTIC"
    #("MASTIC" "PART_NAME" "MASTIC")
    # "MASTIC" "IVOL" 1 0 0 0
    # "MASTIC" "ELEMENT_PROP_NAME" "Volumes/MASTIC"
    #
    # "RBE3"  "Auto Calc weighting factor (set to "0")"  "Dependent DOF"  "Weighting 
    # Factor (Ignored by auto calc, but set to "1")"     "Independent DOF"    
    #
    #
    # --> create the properties on the weld_fam itself...
    #
    if {0 >= [ic_uns_count_in_families $weld_fam]} {
	mess "Error: there aren't any elements in the weld family \"$weld_fam\"\n" red
	return 0
    }
    
    if ![ic_geo_check_family $weld_fam] {
	ic_geo_new_family $weld_fam
    }
    
    set mat_id [scrib_lib_welding_mastic_material_id]
    set bc [list [list 1 PART_NAME $weld_fam] [list 1 "IVOL" $mat_id 0 0 $mat_id] \
		[list 1 ELEMENT_PROP_NAME "Volumes/${weld_fam}"]]
    if [catch {ic_boco_add $weld_fam $bc} res] {
	mess "Error: could not set RBE2 boundary condition on $weld_fam: $res\n" red
	return 0
    }
    #
    # --> create a params_file entry for this material
    #
    set stat [scrib_lib_welding_param_mastic_properties "" $mat_id]    
    #
    # --> ...then create the element type on the "legs" for the RBE3 welds...
    #
    set rbe3_weld_fam [scrib_lib_welding_rbe3_family_name $weld_fam]
    
    if {0 >= [ic_uns_count_in_families $rbe3_weld_fam]} {
	mess "Error: there aren't any elements in the weld family \"$rbe3_weld_fam\"\n" red
	return 0
    }
    
    if ![ic_geo_check_family $rbe3_weld_fam] {
	ic_geo_new_family $rbe3_weld_fam
    }
    
    set bc [list [list 1 PART_NAME $rbe3_weld_fam] [list 1 RBE3 0 123456 1 123456] \
		[list 1 ELEMENT_PROP_NAME "Lines/${rbe3_weld_fam}"]]
    if [catch {ic_boco_add $rbe3_weld_fam $bc} res] {
	mess "Error: could not set RBE3 boundary condition on $rbe3_weld_fam: $res\n" red
    }
    
    if ![ic_geo_check_family $rbe3_weld_fam] {
	ic_geo_new_family $rbe3_weld_fam
    }
    
    mess "Have set element properties appropriate to RBE3 configurations on $weld_fam and $rbe3_weld_fam\n"
    return 1
}

## Needs doc.

proc scrib_lib_welding_param_mastic_properties {param_file mat_id} {
    
    # this would use ic_param_*, but that code is f'd.
    
    if {"" == $param_file} {
	set param_file [scrib_lib_output_nastran_params_local ""]
    }
    
    if ![file exists $param_file] {
	mess "Error: cannot find params file \"$param_file\"...\n" red
    }
    
    set fp [open $param_file a]
    if {"" == $fp} {
	mess "Error: cannot open params file \"$param_file\" for appending...\n" red
	return 0
    }
    
    set mat_name "MAT_MASTIC"
    
    puts $fp "\n"
    puts $fp "begin Isotropic_Material $mat_name"
    puts $fp "     Mass_Density 0"
    puts $fp "     Material_ID $mat_id"
    puts $fp "     Poissons_Ratio 0.28"
    puts $fp "     Reference_Temperature \{\}"
    puts $fp "     Shear_Modulus \{\}"
    puts $fp "     Structural_Damping_Coefficient \{\}"
    puts $fp "     Thermal_Expansion_Coefficient \{\}"
    puts $fp "     Youngs_Modulus 2e+5"
    puts $fp "end Isotropic_Material MAT_MASTIC"
    
    close $fp
}

## 

proc scrib_lib_welding_get_tris_attached_to_welds { weld_family } {
    
    set src_types  "LINE_2 TRI_3 QUAD_4"
    set des_type   "TRI_3"
    set des_family "__same__"
    
    set src_map [ic_uns_subset_create_family_type $welkd_family $src_types]
    if {"" == $src_map} {
	mess "Error: could not get a non-empty source subset for getting \
              attached \"$src_types\" in family \"$src_families\"...\n" red
	return ""
    }

    set tris_on_welds_map [ic_uns_get_elements_attached_to_elements $src_map $des_family $des_type]   
    
    return $tris_on_welds_map
}

