
# Compile a bcinfo file 

# If dim is "" that means this was a modification to an existing bc
# The values list is in the order the args appear in the fbc file

proc bcc_on_apply_to_part {bctype parts values} {
    global bcc_data bcc_editing_parts
    
    #puts [list bcc_on_apply $bctype $parts $values]
    
    if {$parts == "__editing__"} {
	set parts $bcc_editing_parts
    } elseif {$parts == ""} {
	mess "No parts selected.\n" red
	return
    }
    
    set bc [concat 1 $bctype $values]
    foreach part $parts {
	set fams [ic_boco_replace_in_part [list $bc] $part [list $bctype]]
	
	foreach f $fams {
	    aie_apply_icons_$bctype $f "" 1 1
	}
	::AIEnv::GUIManagement::Tree::AddPartBC $bctype $part 1
    }
}

proc bcc_on_apply_to_group {bctype bcname desttype dest values} {
    global bcc_data bcc_editing_parts
    
    puts [list bcc_on_apply_to_group $bctype $bcname $desttype $dest $values]
    
    set bcs [list [concat 1 $bctype $values]]
    
    if {$desttype == "existing"} {
	set xname $bcc_editing_parts
    } else {
	set xname ""
    }
    
    aie_apply_attribute $bctype $bcs $bctype $xname $desttype $dest ""
}

proc bcc_edit_attribute {name dezname bc short_title default_vals} {
    global bcc_editing_parts
    
    set bcc_editing_parts [list $name]
    aie_edit_attribute $name $bc _${bc}_
}

proc bcc_update_internal_val {items name1 name2 op} {
    upvar 1 $name1 lname1
    set nxname [string range $name1 0 end-4]
    upvar 1 $nxname lnxname
    
    #puts [list bcc_update_internal_val $items $name1]
    #puts "val $nxname = $lnxname"
    foreach {v n} $items { if {$lname1 == $n} { set lnxname $v; break } }
}

proc bcc_trace_update_widget {widgetname ns act args} {
    #puts [list bcc_trace_update_widget $widgetname $ns $act $args]
    set v [form_checkstate_expr $act]
    ::AIEnv::GUIManagement::ToggleGrey $widgetname [expr !$v]
}

# Make a new node of this type

proc bcc_do_multiple_param_node {pn pncat dezname nodename nodename_style defvals} {
    global aie_param_multiple 
    
    set nodename $aie_param_multiple($pn)
    
    puts "NN $nodename_style"
    
    # Filter out the nodename from the default vals
    set defvals2 ""
    foreach {n v} $defvals {
	if {$n != $nodename} { lappend defvals2 $n $v }
    }
    switch $nodename_style {
	suffix { set defname [ic_param_unused_child_name $pn] }
	number { set defname [ic_param_unused_child_name $pn -] }
    }
    lappend defvals2 $nodename $defname
    ic_param_add_node $pn $defname $defvals2
    bcc_add_param_node_to_tree $pn/$defname $pn $pncat $dezname $defname
    puts [list bcc_edit_param_node $pn $pn/$defname $dezname]
    bcc_edit_param_node $pn $pn/$defname $dezname
}

proc bcc_add_param_node_to_tree {name parent cat dezname pnname} {
    ::AIEnv::GUIManagement::Tree::doInsert end $cat${parent}Node \
	$cat${name}Node -text $pnname -data "$parent $name"
    set ::AIEnv::GUIManagement::Tree::NodeCommand($cat${name}Node) \
	[list bcc_edit_param_node $parent $name $dezname]
}

proc bcc_edit_param_node {type name dezname} {
    global bcc_editing_param_node_vals aie_param_multiple
    catch {unset bcc_editing_param_node_vals}
    array set bcc_editing_param_node_vals [ic_param_get_values $name]
    if [info exists aie_param_multiple($type)] {
	set bcc_editing_param_node_vals($aie_param_multiple($type)) \
	    [lindex [split $name /] end]
    }
    $dezname unload
    $dezname show
}

proc bcc_delete_mult_param {type name} {
    ic_param_delete_node $type/$name
    ::AIEnv::GUIManagement::Tree::deleteMultipleParam $type $name
}

proc bcc_rename_mult_param {type name {nname ""}} {
    global aie_param_multiple
    
    if {$nname == ""} {
	set type1 [lindex [split $type :] end]
	set nname [question_box .newname "New name" "New name for $type1" $name]
    }
    if {$nname != ""} {
	::AIEnv::GUIManagement::Tree::renameMultipleParam $type $name $nname
	ic_param_rename $type/$name $type/$nname
	ic_param_set_values $type/$nname [list $aie_param_multiple($type) $nname]
    }
}

proc bcc_edit_table {__dezname __name __title} {
    # avoid stupid namespace tricks
    bcc_edit_table_1 $__dezname $__name $__title
}

proc bcc_edit_table_1 {dezname name title} {
    global aie_edit_table tdv_default
    
    if [info exists aie_edit_table(currently_editing)] {
	    tk_dialog .confirm Table "Please finish editing the table you have up now before you start editing another one." "" -1 Ok
	    if [winfo exists .confirm] { destroy .confirm }
	    return
    }
    
    set pref ::AIEnv::DEZ::$dezname
    upvar \#0 ${pref}::${name}_type tbl_type
    upvar \#0 ${pref}::${name} tbl_data
    
    catch {unset aie_edit_table}
    set multcurves 0
    switch $tbl_type {
	temp - nonlinear - temp_nonlinear {
	    set multcurves 1
	}
	load - damping {
	    set multcurves 1
	}
	default {
	    error "unknown table type $tbl_type"
	}
    }
    
    set aie_edit_table(data) $tbl_data

    set aie_edit_table(currently_editing) 1
    set par [winfo parent $tdv_default]
    set inf [pack info $tdv_default]
    pack forget $tdv_default
    set top $par.table
    frame $top -relief sunken -borderwidth 3
    eval pack $top $inf
    
    if $multcurves {
	set val [st_edit_curves -curves $aie_edit_table(data) -toplevel $top]
    } else {
	set val [st_edit_curves -curves $aie_edit_table(data) -single -toplevel $top]
    }
    
    eval pack $tdv_default $inf
    unset aie_edit_table(currently_editing)

    if {$val != ""} {
	set tbl_data $val
    }
}

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

proc bcc_can_convert_bcs {fromtype totype} {
    set gvar bcc_translate_${fromtype}_${totype}_data
    global $gvar
    return [info exists $gvar]
}

# If $file is "" just switch it in place
# This returns a list of bcfields that got renamed so we can switch them
# back after the translation is done

proc bcc_convert_bcs {fromtype totype fbc_file atr_file} {
    global whoami famboco_info bcc_solver_title
    
    set gvar bcc_translate_${fromtype}_${totype}_data
    global $gvar
    if ![info exists gvar] { error "No translation data from $fromtype to $totype" }
    upvar \#0 $gvar trans_data
    
    set totitle $bcc_solver_title($totype)
    
    set fbc_fp ""; set atr_fp ""
    if {$fbc_file != ""} {
	set fbc_fp [open $fbc_file w]
	puts $fbc_fp "# family_boco file written by $whoami by [cmd_whoami] on [cmd_date]"
	puts $fbc_fp "## solver $totitle"
    }
    if {$atr_file != ""} {
	set atr_fp [open $atr_file w]
	puts $atr_fp "# attribute file written by $whoami by [cmd_whoami] on [cmd_date]"
    }
    puts [list bcc_convert_bcs $fromtype $totype $fbc_file $atr_file]
    array set convert_dist_vals {}
    foreach fam [lsort [ic_boco_list_families]] {
	if {($fam == "ORFN") || ($fam == "VORFN")} continue
	if {$fbc_file != ""} {
	    puts $fbc_fp "\"$fam\""
	}
	if {$atr_file != ""} {
	    puts $atr_fp ""
	    puts $atr_fp "begin family $fam"
	    puts $atr_fp "    begin solver \"$totitle\""
	}
	set nbcs ""
	set natrs ""
	
	#set verbose 0
	set verbose [expr {$fam == "ET1D2001/PROP756"}]
	
	set fambcs [ic_boco_get $fam]
	
	# We need to deal with the case where we get multiple src->target links.
	# For example the family might have a PBEAM, OR, and PINFL.  This would give
	# us one ET1_BEAM for each, but they need to be merged.  However we can't
	# know this until we parse all the src bc's because some may have predicates.
	catch {unset num_bcs_of_type}
	foreach bc $fambcs {
	    set bctype [lindex $bc 1]
	    if [info exists trans_data($bctype)] {
		# Use this array for mapping &num between param_node and bctype
		global bcc_amp_map
		catch {unset bcc_amp_map}
		foreach {n1 v1} $trans_data($bctype) {
		    set to_bctype [lindex $v1 1]
		    if $verbose { puts "$bctype -> $n1 $to_bctype" }
		    set nbc ""
		    set natr ""
		    switch $n1 {
			bctype {
			    set ok 1
			    set nbc [list [lindex $bc 0] $to_bctype]
			    set natr [list $to_bctype]
			    set bcpred [lindex $v1 0]
			    
			    foreach pr $bcpred {
				if ![lindex $pr 1] {
				    # This means to look at the arg vals before
				    # translation (i.e. with commonstruct this is
				    # used to go to the subsolver)
				    
				    set have [lindex $bc [expr [lindex $pr 0] + 1]]
				    if {[lsearch [lrange $pr 2 end] $have] < 0} { set ok 0 }
				}
			    }
			    if $ok {
				set pos 1
				foreach {name arg} [lrange $v1 2 end] {
				    if {[string index $arg 0] == "\{"} {
					set nval [bcc_convert_bc_pred $arg $bc \
						    $fromtype $totype $bctype]
				    } else {
					set nval [bcc_convert_bc_prim $arg $bc \
						    $fromtype $totype $bctype]
					if {([string index $arg 0] == "\#") && ([llength [split $arg *]] == 1)} {
					    set arg2 [lindex [split [string range $arg 1 end] :] 1]
					    set convert_dist_vals($bcc_solver_title($fromtype):$bctype:$arg2) $bcc_solver_title($totype):$to_bctype:$name
					}
				    }
				    if {$nval == "*fail"} {
					set ok 0
				    } else {
					lappend nbc $nval
					lappend natr [list $name $nval $pos]
					if $verbose { puts "$name $nval" }
					incr pos
				    }
				}
				foreach pr $bcpred {
				    if [lindex $pr 1] {
					# This means to look at the arg vals after
					# translation (i.e. with commonstruct this is
					# used to go from the subsolver)
					set have [lindex $nbc [expr [lindex $pr 0] + 1]]
					if {[lsearch [lrange $pr 2 end] $have] < 0} { set ok 0 }
				    }
				}
			    }
			    if !$ok { set nbc ""; set natr "" }
			}
			param_node {
			    do this
			}
		    }
		    if {$nbc != ""} {
			if [info exists num_bcs_of_type($to_bctype)] {
			    # We have more than one of these.  If this bctype has a set
			    # field then don't merge, otherwise do.
			    if {[info command aie_get_${to_bctype}_set] == ""} {
				# Merge with a previous bc ...  
				bla bla bla
			    }
			} else {
			    set num_bcs_of_type($to_bctype) 1
			}
			lappend nbcs $nbc
			lappend natrs $natr
		    }
		}
		
		# Now, we might have multiple bctypes that need to get merged together.
		# However we might also have ones that come from different loadsets, and
		# these we do *not* merge together.  For now, if a bctype does not have
		# a set type defined, merge all the instances of that bctype.  If it does
		# have a set type defined then really we should check that all instances
		# have different set values.
		# *** what do we do if there is both a force *and* a moment? ***
		# we can make a rule that if a given bctype corresponds to multiple
		# bctypes and param_nodes in the other solver, it can't have a set type
		# and there can't be the chance of multiple valid bc's in one family.
		# that we can check ****
		# Also we have to do the merging above and not below because ...
		if $verbose {
		    puts $nbcs
		}
	    } else {
		if {![string match *_NAME $bctype] && ($bctype != "color")} {
		    puts "no equivalent for $bctype, for fam $fam"
		}
		#lappend nbcs $bc
	    }
	}
	if {$fbc_fp != ""} {
	    foreach nbc $nbcs {
		if {[lindex $nbc 0] == 0} {
		    puts -nonewline $fbc_fp "\#"
		}
		puts -nonewline $fbc_fp "\"$fam\""
		foreach a [lrange $nbc 1 end] {
		    if {[form_check_type float $a] != ""} {
			set a \"$a\"
		    }
		    puts -nonewline $fbc_fp " $a"
		}
		puts $fbc_fp ""
	    }
	}
	if {$atr_file != ""} {
	    foreach atr $natrs {
		puts $atr_fp "        begin bctype [lindex $atr 0]"
		foreach arg [lrange $atr 1 end] {
		    puts $atr_fp "            $arg"
		}
		puts $atr_fp "        end bctype [lindex $atr 0]"
	    }
		
	    puts $atr_fp "    end solver \"$totitle\""
	    puts $atr_fp "end family $fam"
	}
	if {($fbc_fp == "") && ($atr_fp == "")} {
	    ic_boco_set $fam $nbcs
	}
    }
    if {$fbc_fp != ""} {
	close $fbc_fp
    }
    if {$atr_fp != ""} {
	close $atr_fp
    }
    
    if {($fbc_fp == "") && ($atr_fp == "")} {
	ic_boco_solver $bcc_solver_title($totype)
    }
    
    set dist_vals_converted ""
    foreach bcf [ic_uns_bcfield_list] {
	if [info exists convert_dist_vals($bcf)] {
	    #puts "Rename $bcf to $convert_dist_vals($bcf)"
	    ic_uns_bcfield_rename $bcf $convert_dist_vals($bcf)
	    lappend dist_vals_converted $bcf $convert_dist_vals($bcf)
	}
    }
    return $dist_vals_converted
}

# If $file is "" just switch it in place

proc bcc_convert_params {fromtype totype file} {
    global whoami aie_params_are_whole_subtree
    
    if {$file == ""} {
	if ![ic_param_node_exists :$totype] {
	    ic_param_rename "" :$fromtype 0
	}
    } else {
	# This is a bit of a work-a-round
	global param_values
	set opv [array get param_values]
	ic_param_rename :$fromtype "" 1
	ic_param_save $file
	catch {unset param_values}
	array set param_values $opv
    }
}

proc bcc_convert_bc_pred {a bc fromtype totype bctype} {
    foreach {pred val} $a {
	set bad 0
	foreach pred1 $pred {
	    # Just evalulate the argument this time
	    set pval [bcc_convert_bc_prim $pred1 $bc $fromtype $totype $bctype]
	    if {[lsearch [lrange $pred1 1 end] $pval] < 0} {
		set bad 1
		break
	    }
	}
	if !$bad {
	    return [bcc_convert_bc_prim $val $bc $fromtype $totype $bctype]
	}
    }
    return "*fail"
}

# Now comes the code to decode the special characters

proc bcc_convert_bc_prim {a bc fromtype totype bctype} {
    global bcc_amp_map
    
    set v [string range $a 1 end]
    switch -- [string index $a 0] {
	\# {
	    set comps [split $a *]
	    if {[llength $comps] > 1} {
		set val 1
		foreach comp [split $a *] {
		    # get rid of the :argname
		    set comp [lindex [split $comp :] 0]
		    # get rid of the #
		    set comp [string range $comp 1 end]
		    set val1 [lindex $bc [expr $comp + 1]]
		    set val [expr $val * $val1]
		}
	    } else {
		set comp [lindex [split $v :] 0]
		set val [lindex $bc [expr $comp + 1]]
	    }
	    return $val
	}
	+ {
	    return $v
	}
	* {
	    set v2 [split $v ,]
	    set a2 [bcc_convert_bc_prim [lindex $v2 0] $bc $fromtype $totype $bctype]
	    set func [lindex $v2 1]
	    return [$func $a2]
	}
	& {
	    # This is either of the form &num which means ..
	    or &:real/#6:set/1:r1 which means
	    bla bla bla
	}
    }
}

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

# Set solver stuff - needed because radioItem can't use global variables

proc onSetSolverDEZLoad {} {
    global aie_current_flavor
    set flavor $aie_current_flavor
}

proc onSetSolverDEZOK {} {
    global aie_current_flavor
    set aie_current_flavor $flavor
}

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

proc bcc_mesh_import {solver} {
    # This should be rationalized a bit
    switch $solver {
	nastran {
	    aie_import_nastran_new
	}
	ansys {
	    aie_mesh_import ansys
	}
	abaqus {
	    aie_import_abaqus
	}
	patran {
	    aie_mesh_import patran
	}
	lsdyna {
	    aie_import_lsdyna
	}
    }
}

proc bcc_mesh_export {solver} {
    ${solver}_Input_DEZ show
}

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

proc bcc_do_write_solver_input {name ssname sstitle filename} {
    global file_name
    
    aie_saveProject 0 1
    
    set sdomain [file rootname $file_name(domain)].$ssname.uns
    set sfbc [file rootname $file_name(family_boco)].$ssname.fbc
    set satr [file rootname $file_name(family_boco)].$ssname.atr
    set spar [file rootname $file_name(solver_params)].$ssname.par
    
    set dist_vals_cvt [bcc_convert_bcs $name $ssname $sfbc $satr]
    bcc_convert_params $name $ssname $spar
    
    cmd_cp $file_name(domain) $sdomain
    cmd_cp $file_name(solver_params) $spar
    
    # work-a-round
    aie_export_nastran $filename $sdomain $satr $spar 1 2 2 2 0 0
    
    foreach {old new} $dist_vals_cvt {
	ic_uns_bcfield_rename $new $old
	#puts "Back rename $new to $old"
    }
}
