
# The bcinfo compiler

proc bcc_do_solver {name} {
    global env famboco_info
    
    set interf_dir $env(MED_ROOT)/icemcfd/output-interfaces
    if ![file exists $interf_dir] {
	set interf_dir $env(MED_ROOT)/../output_gui
    }
    set infile $interf_dir/$name.bcinfo
    puts $infile
    if [info exists env(ICEM_DEVELOPMENT_PATHS)] {
	set basedir $env(MED_ROOT)/..//ai_env
    } else {
	set basedir $env(MED_ROOT)/lib/ai_env
    }
    
    famboco_load_bcinfo $infile
    
    # Transform any dup blocks we see into expanded versions with active
    # predicates that disable the ones that are not in use.  This way we
    # don't have to do anything special below.
    # Note that this breaks the FBC files ...
    famboco_expand_dup_blocks
    
    foreach {bct def names} [famboco_get_default_args_and_names $infile 1] {
	set famboco_info(default_args,$name,$bct) $def
	set famboco_info(arg_names,$name,$bct) $names
    }
    
    foreach s $famboco_info(solvers) {
	# The thing is that we need to get the default arguments for all the bctypes
	# for the subsolvers.  Also the arg names by position.
	# Do some tricks to make sure we don't overwrite the common solver info.
	set subfile $interf_dir/[lindex $s 1].bcinfo
	foreach {bct def names} [famboco_get_default_args_and_names $subfile 1] {
	    set famboco_info(default_args,[lindex $s 1],$bct) $def
	    set famboco_info(arg_names,[lindex $s 1],$bct) $names
	    #puts [list set famboco_info(arg_names,[lindex $s 1],$bct) $names]
	    #puts [list set famboco_info(default_args,[lindex $s 1],$bct) $def]
	}
    }
    bcc_do_solver_main $name $infile $basedir $famboco_info(solvers)
    
    set import_fp [open $basedir/resource/$name/${name}_import_menu.ttkrf w]
    set export_fp [open $basedir/resource/$name/${name}_export_menu.ttkrf w]
    foreach s $famboco_info(solvers) {
	bcc_do_solver_subname $name $infile [lindex $s 1] [lindex $s 0] \
	    $basedir
	puts $import_fp "menuItem \"From [lindex $s 0]\" \"bcc_mesh_import [lindex $s 1]\""
	puts $export_fp "menuItem \"To [lindex $s 0]\" \"bcc_mesh_export [lindex $s 1]\""
    }
    close $export_fp
    close $import_fp
}

proc bcc_do_solver_main {name infile basedir solvers} {
    global famboco_info env
    
    set scrdir $basedir/scripts/$name
    set resdir $basedir/resource/$name
    set icdir $basedir/icons/$name
    
    if ![file exists $scrdir] { file mkdir $scrdir }
    if ![file exists $resdir] { file mkdir $resdir }
    if ![file exists $icdir] { file mkdir $icdir }
    
    puts "$name main"
    bcc_write_ttk $infile $name \
	$resdir/${name}_menus.ttkrf \
	$resdir/${name}_tabs.ttkrf \
	$resdir/${name}_dez.ttkrf \
	$scrdir/${name}_routines.tcl \
	$icdir $name/ ""
    
    set fp [open $scrdir/init.tcl w]
    puts $fp "\# WARNING: this file automatically generated by bccomp.tcl - DO NOT EDIT"
    puts $fp ""
    puts $fp "set aie_guiOpt(topTTKRF)      $name/$name.ttkrf"
    puts $fp "set aie_guiOpt(winTitle)      \"AI*Environment for $famboco_info(name)\""
    puts $fp "set bcc_solver_title($name) \"$famboco_info(name)\""
    foreach ss $solvers {
	set ss1 [lindex $ss 1]
	puts $fp ""
	puts $fp "set enable_solver($ss1) 1"
	puts $fp "set bcc_solver_title($ss1) \"[lindex $ss 0]\""
	puts $fp "source \$AIEnvDir/scripts/$name/${name}_${ss1}_trans.tcl"
	puts $fp "source \$AIEnvDir/scripts/$name/${name}_${ss1}_routines.tcl"
    }
    if [file exists $env(MED_ROOT)/icemcfd/output-interfaces/$name.tcl] {
	puts $fp "source \$env(MED_ROOT)/icemcfd/output-interfaces/$name.tcl"
    } elseif [file exists $env(ICEM_ACN)/icemcfd/output-interfaces/$name.tcl] {
	puts $fp "source \$env(ICEM_ACN)/icemcfd/output-interfaces/$name.tcl"
    }
    if {[info exists famboco_info(params_are_whole_subtree)] && \
	    $famboco_info(params_are_whole_subtree)} {
	puts $fp "set aie_params_are_whole_subtree 1"
    }
    puts $fp ""
    puts $fp "proc aie_solver_setup {} { setComSolverDEZ show }"

    close $fp
    
    set fp [open $resdir/$name.ttkrf w]
    puts $fp "\# WARNING: this file automatically generated by bccomp.tcl - DO NOT EDIT"
    puts $fp "include popup_menus.ttkrf"
    puts $fp "winMenu windowMenu"
    puts $fp "include main_menus_first.ttkrf"
    puts $fp "include $name/${name}_menus.ttkrf"
    puts $fp "include main_menus_last.ttkrf"
    puts $fp "winMenu END"
    puts $fp ""
    puts $fp "include CommonToolbars.ttkrf"
    puts $fp ""
    puts $fp "include GeometryTab.ttkrf"
    puts $fp "include MeshTab.ttkrf"
    puts $fp "include BlockingTab.ttkrf"
    puts $fp "include MeshEditTab.ttkrf"
    puts $fp "include $name/${name}_tabs.ttkrf"
    puts $fp "include PostTab.ttkrf"
    puts $fp ""
    puts $fp "include common_dez.ttkrf"
    puts $fp "include $name/${name}_setsolver.ttkrf"
    puts $fp "include $name/${name}_dez.ttkrf"
    
    set ssfp [open $resdir/${name}_setsolver.ttkrf w]
    puts $ssfp "dataEntryDialog setComSolverDEZ \"Set Current Solver\""
    puts $ssfp "    radioGroup setComSolverDEZ_rg \"Select a solver\" 1 flavor 1 NULL 0"
    puts $ssfp "        radioItem setComSolverDEZ_$name $name $name"
    
    foreach ss $solvers {
	set ss1 [lindex $ss 1]
	puts $fp "include $name/${name}_${ss1}_dez.ttkrf"
	puts $ssfp "        radioItem setComSolverDEZ_$ss1 $ss1 $ss1"
    }
    puts $ssfp "    radioGroup END"
    puts $ssfp "dataEntryDialog END"
    close $ssfp
    close $fp
}

proc bcc_do_solver_subname {name infile subname subtitle basedir} {
    global famboco_info env
    
    set scrdir $basedir/scripts/$name
    set resdir $basedir/resource/$name
    set icdir $basedir/icons/$name
    
    set name3 ${name}_$subname
    set subname2 " (for $subtitle)"
    
    puts "$name $subname"
    bcc_write_ttk $infile $name \
	$resdir/${name3}_menus.ttkrf \
	$resdir/${name3}_tabs.ttkrf \
	$resdir/${name3}_dez.ttkrf \
	$scrdir/${name3}_routines.tcl \
	$icdir $name/ $subname
    
    bcc_write_translators $infile $scrdir/${name}_${subname}_trans.tcl \
	$name $subname
}

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

proc bcc_write_ttk {bcinfo name menufile tabfile dezfile tclfile icondir iconprefix subname} {
    global famboco_info param_info bcc_name_used
    
    set subname2 ""; set pref $name
    if {$subname != ""} {
	set subname2 " (for $subname)"
	set pref $subname
    }
    
    catch {unset bcc_name_used}

    array set dim_names { 0 Point 1 Curve 2 Surface 3 Body s Subset f Part a Any }
    array set dim_names_p { 0 Points 1 Curves 2 Surfaces 3 Bodies s Subsets f Parts a Any }
    array set dim_names_s { 0 PT 1 CV 2 SF 3 BD s SS f PT a AN }
    
    upvar \#0 famboco_info fi
    upvar \#0 param_info pi
    
    set menuf [open $menufile w]
    set tabf [open $tabfile w]
    set dezf [open $dezfile w]
    set tclf [open $tclfile w]
    
    foreach ff [list $menuf $tabf $dezf $tclf] {
	puts $ff ""
	puts $ff "\# WARNING: this file automatically generated by bccomp.tcl - DO NOT EDIT"
	puts $ff "\# Source: $bcinfo$subname2"
	puts $ff "\# Date: [cmd_date]"
	puts $ff ""
    }
    
    set treenodes ""
    set mult_treenodes ""
    set need_wrappers ""
    
    foreach cat [concat $fi(categories) {""}] {
	catch {unset cdata}
	array set cdata [list tab_title $cat bubble $cat tab_icon ""]
	if [info exists fi(cat_args,$cat)] {
	    foreach {n v} $fi(cat_args,$cat) { set cdata($n) $v }
	}
	set group_by_dim [info exists cdata(group_by_dim)]
	
	set cat2 [bcc_nice_name $cat 1]
	set ictext $cdata(tab_title)
	if {$cdata(tab_title) == ""} { set cdata(tab_title) "Unknown" }
	if {$cdata(tab_icon) == ""} {
	    if {$ictext == ""} {
		set cdata(tab_icon) unknown.gif
	    } else {
		set cdata(tab_icon) $iconprefix/${cat2}_tab.gif
		bcc_make_text_icon $icondir/${cat2}_tab.gif $ictext
	    }
	}
	if {$cdata(bubble) == ""} { set cdata(bubble) "hmm..." }
	set barname [bcc_nice_name $fi(name)_${cat2}_Bar 1]
	set ibarname [bcc_nice_name $fi(name)_${cat2}_iconBar 1]
	
	set got_tn 0
	set got_tab 0
	set prev_dims ""
	
	# -----------------------------------------------------------------
	
	foreach bc $fi(bctypes) {
	    if [info exists skip_this($bc)] continue
	    if {$fi(category,$bc) == $cat} {
		if {[info exists fi(solvers,$bc)] && ($subname != "") &&
		    ![lmember $fi(solvers,$bc) $subname]} {
		    #puts "skipping bc $bc"
		    continue
		}
		
		if !$got_tab {
		    puts $tabf "\# Category $cat"
		    puts $tabf "tabbedIconBar $barname \"$cdata(tab_title)\" $cdata(tab_icon) \\\n\t\"$cdata(bubble)\""
		    puts $tabf "    iconBar $ibarname"
		    
		    #mess "Category $cat\n"
		    set got_tab 1
		}
		
		set dez_args $fi(args,$bc)
		catch {unset seen_args}
		foreach a $dez_args {
		    set na ""
		    foreach {n v} [lrange $a 1 end] {
			if {$n == "name"} { set na [bcc_nice_name $v 0] }
		    }
		    if {$na != ""} { set seen_args($na) 1 }
		}
		foreach mb $fi(merge_bctypes,$bc) {
		    set skip_this($mb) 1
		    foreach a $fi(args,$mb) {
			set na ""
			foreach {n v} [lrange $a 1 end] {
			    if {$n == "name"} { set na [bcc_nice_name $v 0] }
			}
			if {$na != ""} continue
			lappend a from_bctype $mb
			lappend dez_args $a
		    }
		}
		
		set has_set ""; set has_lcs ""
		set make_args ""
		foreach a $dez_args {
		    set ok 1
		    set aname ""
		    foreach {n v} [lrange $a 1 end] {
			switch $n {
			    name    { set aname $v }
			    is_set  { if $v { set has_set $aname } }
			    is_lcs  { if $v { set has_lcs $aname } }
			    ignore  { if $v { set ok 0 } }
			    type    { if {($v == "fixed") || ($v == "separator")} { set ok 0 } }
			    solvers {
				if {($subname != "") && \
					![lmember $v $subname]} {
				    #puts "skipping bc $bc arg $a"
				    set ok 0
				}
			    }
			}
		    }
		    if $ok { lappend make_args $a }
		}
		
		set bctitle $fi(title,$bc)
		if [info exists fi(${subname}_subtitle,$bc)] {
		    append bctitle " ($fi(${subname}_subtitle,$bc))"
		} elseif [info exists fi(subtitle,$bc)] {
		    append bctitle " ($fi(subtitle,$bc))"
		}
		
		# Figure out all the default values for the params and make
		# sure everything has a name
		set default_vals ""
		set choice_lists ""
		set active_data ""
		if 0 {
		    if $fi(has_name,$bc) {
			lappend default_vals name ""
		    }
		    if {$has_set != ""} {
			lappend default_vals $has_set ""
		    }
		    if {$has_lcs != ""} {
			lappend default_vals $has_lcs ""
		    }
		}
		set pp 0
		set make_args2 ""
		foreach a $make_args {
		    catch {unset adata}
		    foreach {n v} [lrange $a 1 end] { set adata($n) $v }
		    if ![info exists adata(name)] {
			set adata(name) arg$pp
			lappend a name arg$pp
		    }
		    set adata(name) [bcc_nice_name $adata(name) 0]
		    incr pp
		    lappend make_args2 $a
		    
		    if ![info exists adata(type)] {
			error "no type given for $bc arg $adata(name)"
		    }
		    switch $adata(type) {
			float - int - string - charflags - bool {
			    if ![info exists adata(default)] {
				error "no default for $bc $adata(name)"
			    }
			    lappend default_vals $adata(name) $adata(default)
			}
			choice_group {
			    lappend choice_lists $adata(name) \
				{{Must must} {Fix fix} {Me! me}}
			    lappend default_vals $adata(name) $adata(default)
			}
			table {
			    lappend choice_lists $adata(name) \
				{{Must must} {Fix fix} {Me! me}}
			    lappend default_vals $adata(name) $adata(default)
			}
		    }
		    
		    set active ""
		    if [info exists adata(solvers)] {
			set active or
			foreach ss $adata(solvers) {
			    lappend active enable_solver($ss)
			}
		    }
		    if [info exists adata(active)] {
			set active [form_active_concat_and \
					$adata(active) $active]
		    }
		    if [info exists adata(${subname}_active)] {
			set active [form_active_concat_and \
					$adata(${subname}_active) $active]
		    }
		    
		    set ch ""
		    
		    if [info exists adata(choice_pnode)] {
			set ch [list choice_pnode $adata(choice_pnode)]
		    } elseif [info exists adata(choice_func)] {
			set ch [list choice_func $adata(choice_func)]
		    }
		    if [info exists adata(choices)] {
			set ch [concat $ch $adata(choices)]
		    }
		    if {$ch != ""} { lappend choice_lists $adata(name) $ch }
		    
		    if {$active != ""} {
			lappend active_data [bcc_nice_name $adata(name) 0] \
			    $active
		    }
		}
		set make_args $make_args2
		
		if {$subname == ""} {
		    puts $tclf "\# $bc functions ---------------------------"
		    puts $tclf ""
		    puts $tclf "set ::aie_bcclass_title($bc) \"$fi(title,$bc)\""
		    if {$cat != ""} {
			puts $tclf "set ::aie_prop_subtype($bc) [join $cat _]"
			puts $tclf "set ::aie_tree_nodes([join $cat _]) \"$cat\""
		    } elseif !$fi(partbc,$bc) {
			puts $tclf "set ::aie_tree_nodes($bc) \"$fi(title,$bc)\""
		    }
		    
		    if $fi(partbc,$bc) {
			puts $tclf "set ::aie_bcclass_is_part($bc) 1"
		    }
		    puts $tclf "set ::aie_bctypes_used($bc) \{ $bc \}"
		    puts $tclf ""
		}
		
		set dezname [bcc_nice_name modify_${pref}_${bc}_DEZ 1]
		
		lappend need_wrappers modify_${bc}_DEZ $dezname $pref
		# This is a work-a-round
		foreach ss $fi(solvers) {
		    set ss [lindex $ss 1]
		    set dezname1 [bcc_nice_name modify_${ss}_${bc}_DEZ 1]
		    lappend need_wrappers modify_${bc}_DEZ $dezname1 $ss
		}
		
		bcc_write_dez $dezf $tclf $dezname $bc $has_set $has_lcs \
		    1 $make_args $default_vals \
		    $choice_lists $active_data "" $bctitle "" 1 $subname
		
		if {$subname == ""} {
		    bcc_write_edit_func $tclf $dezname $bc $fi(has_name,$bc) $fi(short_title,$bc) \
			$default_vals
		    
		    bcc_write_parse_func $tclf $bc $make_args
		    
		    bcc_write_icons_func $tclf $bc $has_set \
			$fi(symbol_type,$bc) \
			$fi(symbol_params,$bc) \
			$fi(symbol_label,$bc)
		    
		    if {$has_set != ""} {
			bcc_write_get_set_func $tclf $bc $has_set
		    }
		}
		
		set text_icon $bc
		if {$fi(text_icon,$bc) != ""} {
		    set text_icon $fi(text_icon,$bc)
		}
		if $fi(partbc,$bc) {
		    set appd f
		} elseif {$fi(apply_dims,$bc) != ""} {
		    set appd $fi(apply_dims,$bc)
		} else {
		    set appd $fi(dims,$bc)
		}
		set def_tab_icon [lindex $fi(tab_icons,$bc) end]
		set icons $fi(tab_icons,$bc)
		
		if [info exists fi(one_dez_for_all_dims,$bc)] {
		    set appd a
		    set icons $fi(icon,$bc)
		}
		foreach d $appd icon $icons {
		    set dn $dim_names($d)
		    set dnp $dim_names_p($d)
		    if {$icon == ""} {
			if {$def_tab_icon != ""} {
			    set icon $def_tab_icon
			} else {
			    set ti $text_icon
			    if {$d != "f"} {
				append ti /$dim_names_s($d)
			    }
			    #set icon unknown.gif
			    set icon $iconprefix/${bc}_${d}_but.gif
			    bcc_make_text_icon $icondir/${bc}_${d}_but.gif $ti
			}
		    }
		    set butname [bcc_nice_name create_${dn}_${bc}_But 1]
		    set dezname [bcc_nice_name create_${pref}_${dn}_${bc}_DEZ 1]
		    set dezname_np [bcc_nice_name create_${dn}_${bc}_DEZ 1]
		    
		    lappend need_wrappers $dezname_np $dezname $pref
		    # This is a work-a-round
		    foreach ss $fi(solvers) {
			set ss [lindex $ss 1]
			set dezname1 [bcc_nice_name create_${ss}_${dn}_${bc}_DEZ 1]
			lappend need_wrappers $dezname_np $dezname1 $ss
		    }
		    
		    if {$group_by_dim && [llength $prev_dims] && ($prev_dims != $fi(dims,$bc))} {
			puts $tabf "        separator"
		    }
		    set prev_dims $fi(dims,$bc)

		    puts $tabf "        iconButton $butname \"$dn $fi(short_title,$bc)\" $icon \\\n\t\t\"$dezname_np show\" \\\n\t\t\"$fi(title,$bc) on $dnp\""
		    
		    bcc_write_dez $dezf $tclf $dezname $bc $has_set $has_lcs \
			[expr $fi(has_name,$bc) || !$fi(partbc,$bc)] $make_args $default_vals \
			$choice_lists $active_data $d $bctitle $dnp 0 $subname
		}

		#mess "\tBC $bc\n"
	    }
	}
	
	# --------------------------------------------------------------
	
	# Only write the param node stuff for the commonstruct version
	
	if {$subname == ""} {
	    foreach pn $pi(pnodes) {
		if {$pi(category,$pn) == $cat} {
		    set butname [bcc_nice_name edit_${pn}_But 1]
		    set dezname [bcc_nice_name edit_${pref}_${pn}_DEZ 1]
		    
		    lappend need_wrappers edit_${pn}_DEZ $dezname $pref
		    # This is a work-a-round
		    foreach ss $fi(solvers) {
			set ss [lindex $ss 1]
			set dezname1 [bcc_nice_name edit_${ss}_${pn}_DEZ 1]
			lappend need_wrappers edit_${pn}_DEZ $dezname1 $ss
		    }
		    
		    if 0 {
			# don't make this tool bar because it's all in the tree
			set icon $pi(tab_icon,$pn)
			if {$icon == ""} {
			    set text_icon $pi(title,$pn)
			    if {$pi(text_icon,$pn) != ""} { set text_icon $pi(text_icon,$pn) }
			    #set icon unknown.gif
			    set icon $iconprefix/${pn}_but.gif
			    bcc_make_text_icon $icondir/${pn}_but.gif $text_icon
			}
			
			puts $tabf "        iconButton $butname \"$pi(title,$pn)\" $icon \\\n\t\t\"$dezname show\" \\\n\t\t\"$pi(title,$pn)\""
		    }
		    
		    set multiple $pi(multiple,$pn)
		    set make_args ""
		    foreach a $pi(args,$pn) {
			set ok 1
			foreach {n v} [lrange $a 1 end] {
			    switch $n {
				ignore   { if $v { set ok 0 } }
			    }
			}
			if $ok { lappend make_args $a }
		    }
		    
		    set default_vals ""
		    set make_args2 ""
		    set choice_lists ""
		    set active_data ""
		    set nodename ""
		    set nodename_style suffix
		    foreach a $make_args {
			catch {unset adata}
			foreach {n v} [lrange $a 1 end] { set adata($n) $v }
			
			if [info exists adata(nodename)] {
			    set adata(default) ""
			} elseif ![info exists adata(default)] {
			    continue
			}
			
			set nname [bcc_nice_name $adata(name) 0]
			
			switch $adata(type) {
			    float - int - string - charflags - bool {
				lappend default_vals $nname $adata(default)
			    }
			}
			
			set ch ""
			
			if [info exists adata(choice_pnode)] {
			    set ch [list choice_pnode $adata(choice_pnode)]
			} elseif [info exists adata(choice_func)] {
			    set ch [list choice_func $adata(choice_func)]
			}
			if [info exists adata(choices)] {
			    set ch [concat $ch $adata(choices)]
			}
			if {$ch != ""} { lappend choice_lists $nname $ch }
			
			set active ""
			if [info exists adata(solvers)] {
			    set active or
			    foreach ss $adata(solvers) {
				lappend active enable_solver($ss)
			    }
			}
			if [info exists adata(active)] {
			    set active [form_active_concat_and \
					    $adata(active) $active]
			}
			
			if [info exists adata(${subname}_active)] {
			    set active [form_active_concat_and \
					    $adata(${subname}_active) $active]
			}
			
			if {$active != ""} {
			    lappend active_data $nname $active
			}
			lappend make_args2 $a
			
			if {[info exists adata(nodename)] && $adata(nodename)} {
			    set nodename $nname
			    if [info exists adata(nodename_style)] {
				set nodename_style $adata(nodename_style)
			    }
			}
		    }
		    set make_args $make_args2
		    
		    bcc_write_param_dez $dezf $tclf $dezname $pn \
			$make_args $default_vals $choice_lists $active_data \
			$pi(title,$pn) $subname [expr {$multiple ? $nodename : ""}]
		    
		    if 0 {
			set ncat [bcc_nice_name $cat 0]
			if !$got_tn {
			    set bub $cat ;# this should come from somewhere else
			    lappend treenodes [list $ncat "" "" $cat $bub]
			    set got_tn 1
			}
		    }
		    set ncat ""
		    
		    set tnname $ncat$pn
		    set par [join [lrange [split $tnname :] 0 end-1] :]
		    set bub $pi(title,$pn) ;# this should come from somewhere else
		    if {[info exists pi(multiple,$pn)] && $pi(multiple,$pn)} {
			set cmd [list bcc_do_multiple_param_node $pn $cat \
				     $dezname $nodename $nodename_style $default_vals]
			lappend treenodes [list $tnname $par $cmd \
					       $pi(title,$pn) $bub]
			lappend mult_treenodes $tnname $nodename
		    } else {
			lappend treenodes [list $tnname $par "$dezname show" $pi(title,$pn) $bub]
		    }
		    
		    #mess "\tPAR $pn\n"
		}
	    }
	}
	
	# --------------------------------------------------------------
	
	if $got_tab {
	    puts $tabf "    iconBar END"
	    puts $tabf "tabbedIconBar END"
	    puts $tabf ""
	}
    }
    
    if {$subname == ""} {
	set barname [bcc_nice_name $fi(name)_Output_Bar 1]
	set ibarname [bcc_nice_name $fi(name)_Output_iconBar 1]
	puts $tabf "tabbedIconBar $barname \"Solution\"  unknown.gif\\\n\t\"Write output to solvers\""
	
	puts $tabf "    iconBar $ibarname"
	foreach ss $fi(solvers) {
	    set sstitle [lindex $ss 0]
	    set ssname [lindex $ss 1]
	    puts $tabf "        iconButton ${barname}_${ssname}_Setup_But \"$sstitle Setup\" unknown.gif\\\n            \"${ssname}_Setup_DEZ show\" \"Set up $sstitle solution\""
	    puts $tabf "        iconButton ${barname}_${ssname}_Input_But \"$sstitle Input\" unknown.gif\\\n            \"${ssname}_Input_DEZ show\" \"Write $sstitle input\""
	    puts $tabf "        iconButton ${barname}_${ssname}_Run_But \"Run $sstitle\" unknown.gif\\\n            \"${ssname}_Run_DEZ show\" \"Run $sstitle solution\""
	    bcc_write_solver_setup $dezf $tclf $name $ssname $sstitle ${ssname}_Setup_DEZ
	    bcc_write_solver_input $dezf $tclf $name $ssname $sstitle ${ssname}_Input_DEZ
	    bcc_write_solver_run $dezf $tclf $name $ssname $sstitle ${ssname}_Run_DEZ
	}
	puts $tabf "    iconBar END"
	puts $tabf "tabbedIconBar END"
	puts $tabf ""
    }
    
    if {$subname == ""} {
	puts $tclf ""
	puts $tclf "array set ::aie_tree_param_nodes \{"
	foreach treenode $treenodes {
	    puts $tclf "    [lindex $treenode 0] \{ [lrange $treenode 1 end] \}"
	}
	puts $tclf "\}"
	puts $tclf ""
	puts $tclf "array set ::aie_param_multiple \{"
	foreach {mt1 mt2} $mult_treenodes {
	    puts $tclf "    $mt1 \"$mt2\""
	}
	puts $tclf "\}"
	puts $tclf ""
	
	puts $tclf "set ::aie_current_flavor $name"
	puts $tclf ""
	foreach {dez subdez val} $need_wrappers {
	    append nrs($dez) "        $val \{ return \[eval $subdez \$args\] \}\n"
	}
	foreach dez [array names nrs] {
	    puts $tclf "proc $dez args \{"
	    puts $tclf "    global aie_current_flavor"
	    puts $tclf "    switch \$aie_current_flavor \{"
	    puts $tclf "$nrs($dez)        default \{ error \"unhandled flavor \$aie_current_flavor\" \}"
	    puts $tclf "    \}"
	    puts $tclf "\}"
	}
    }
    
    close $menuf
    close $tabf
    close $dezf
    close $tclf
}

proc bcc_nice_name {name uniq} {
    global bcc_name_used
    
    if {$uniq && ($name == "")} { set name unnamed }
    foreach c {" " : - "\t" \\( \\) \\.} {
	regsub -all -- $c $name _ name
    }
    if $uniq {
	if [info exists bcc_name_used($name)] {
	    set i 1
	    while {[info exists bcc_name_used($name$i)]} { incr i }
	    set name $name$i
	}
	set bcc_name_used($name) 1
    }
    return $name
}

proc bcc_make_text_icon {gif text} {
    global tcl_platform env

#    if [file exists $gif] return

    if { $tcl_platform(platform) == "windows" } {    
	set gif_image [file join $env(ICEM_ACN) lib ai_env icons help.gif]
	file copy -force $gif_image $gif
    } else {
	#set text [string range $text 0 6]
	catch {exec pbmtext $text | pnmcrop | ppmtogif -transparent white > $gif}
    }

}

proc old__bcc_make_text_icon {gif text} {
#    if [file exists $gif] return
    
    set stext [string range $text 0 6]
    set len [expr 120 * ([string length $stext] + 1)]
    set tmp /tmp/fig[pid]
    set fp [open $tmp w]
    puts $fp "#FIG 3.2"
    puts $fp "Landscape"
    puts $fp "Center"
    puts $fp "Inches"
    puts $fp "Letter"
    puts $fp "100.00"
    puts $fp "Single"
    puts $fp "7"
    puts $fp "1200 2"
    puts $fp "4 0  0  10 50 2 15 0.0000 0 150 $len 0 0 $stext\001"
    close $fp
    exec fig2dev -L gif $tmp $gif
    file delete $tmp
}

# d could be 0, 1, 2, 3, f, s, a

proc bcc_write_dez {dezf tclf dezname bc has_set has_lcs \
			has_name make_args default_vals choice_lists \
			active_data d title dnp editing subname} {
    puts $dezf "#--------------------------------------------"
    puts $dezf ""
    if {$dnp == ""} {
	puts $dezf "dataEntryDialog $dezname \"Modify $title\""
    } else {
	puts $dezf "dataEntryDialog $dezname \"Define $title on $dnp\""
    }
    set sp 0
    if $has_name {
	if {$dnp == ""} {
	    puts $dezf "    textEntry ${dezname}_$bc \"Name\" name READONLY"
	} else {
	    puts $dezf "    textEntry ${dezname}_$bc \"Name\" name TEXT"
	}
	incr sp
    }
    if {$has_set != ""} {
	puts $dezf "    dropDownEntry ${dezname}_Set \"$title Set\" set_list $has_set TRUE"
	incr sp
    }
    if {$has_lcs != ""} {
	puts $dezf "    dropDownEntry ${dezname}_LCS \"Coord System\" lcs_list $has_lcs TRUE"
	incr sp
    }
    if $sp { puts $dezf "    dialogSpace 1" }
    if {$dnp != ""} {
	if {$d == "a"} {
	    puts $dezf "    exclusiveGroup ${dezname}_Dimtype \"Apply to\" \"Apply to\" 5 ICON"
	    foreach {bd bn bi bv} {
		0 Point PointIcon.gif POINT_0D_EL
		1 Curve CurveIcon.gif CURVE_1D_EL
		2 Surface SurfaceIcon.gif SURF_2D_EL
		3 Body BodyIcon.gif BODY_3D_EL
		s Subset SubsetIcon.gif SUBSET
	    } {
		puts $dezf "        exclusiveGroupItem ${dezname}_Dim$bd $bn $bi"
		puts $dezf "            entityChooser ${dezname}_Pick$bd \"$bn\" obj_list $bv ANY"
		puts $dezf "        exclusiveGroupItem END"
	    }
	    puts $dezf "    exclusiveGroup END"
	} else {
	    switch $d {
		0 { set dv POINT_0D_EL }
		1 { set dv CURVE_1D_EL }
		2 { set dv SURF_2D_EL }
		3 { set dv BODY_3D_EL }
		f { set dv PART }
	    }
	    puts $dezf "    entityChooser ${dezname}_Pick \"$dnp\" obj_list \\\n\t$dv ANY"
	}
	puts $dezf "    dialogSpace 1"
    }
    
    set titles ""
    foreach a $make_args {
	if [bcc_write_arg $dezf $dezname $a $subname] {
	    lappend titles [bcc_nice_name [bcc_get_aval $a name] 0] \
		[bcc_get_aval $a title]
	}
    }
    puts $dezf "dataEntryDialog END"
    puts $dezf ""
    
    bcc_write_load_function $tclf $dezname $bc $default_vals $choice_lists \
	$active_data $titles $has_set $has_name $has_lcs
    
    bcc_write_apply_function $tclf $dezname $bc $d \
	$default_vals $choice_lists $editing
}

proc bcc_write_solver_setup {dezf tclf name ssname sstitle dezname} {
    puts $dezf "dataEntryDialog $dezname \"Set up $sstitle\""
    puts $dezf "dataEntryDialog END"
    puts $dezf ""
    
    puts $tclf "proc on${dezname}Load \{\} \{"
    puts $tclf "\}\n"
    
    puts $tclf "proc on${dezname}Apply \{\} \{"
    puts $tclf "\}\n"
}

proc bcc_write_solver_input {dezf tclf name ssname sstitle dezname} {
    puts $dezf "dataEntryDialog $dezname \"Write $sstitle input\""
    puts $dezf "    fileChooser ${dezname}_filename \"$sstitle File\" filename TRUE\\\n\t\"$sstitle File, .dat .nas .bdf, All Files, .*\""
    puts $dezf "dataEntryDialog END"
    puts $dezf ""
    
    puts $tclf "proc on${dezname}Load \{\} \{"
    puts $tclf "\}\n"
    
    puts $tclf "proc on${dezname}Apply \{\} \{"
    puts $tclf "    bcc_do_write_solver_input $name $ssname \"$sstitle\" \$filename"
    puts $tclf "\}\n"
}

proc bcc_write_solver_run {dezf tclf name ssname sstitle dezname} {
    puts $dezf "dataEntryDialog $dezname \"Run $sstitle\""
    puts $dezf "dataEntryDialog END"
    puts $dezf ""
    
    puts $tclf "proc on${dezname}Load \{\} \{"
    puts $tclf "\}\n"
    
    puts $tclf "proc on${dezname}Apply \{\} \{"
    puts $tclf "\}\n"
}

proc bcc_write_load_function {tclf dezname bc default_vals choice_lists \
				  active_data titles \
				  has_set has_name has_lcs} {
    global famboco_info
    
    puts $tclf "proc on${dezname}Load \{\} \{"
    puts $tclf "    global bcc_${bc}_to_load"
    puts $tclf ""
    puts $tclf "    set default_vals \{ name \"\" $default_vals \}"
    puts $tclf "    foreach \{n v\} \$default_vals \{"
    puts $tclf "        if \[info exists current_${bc}_to_load\] \{"
    puts $tclf "            set \$n \$current_${bc}_to_load(\$n)"
    puts $tclf "        \} else \{"
    puts $tclf "            set \$n \$v"
    puts $tclf "        \}"
    puts $tclf "    \}"
    if {$has_set != ""} {
	puts $tclf "    set set_list \[aie_list_sets $bc\]"
	puts $tclf "    if \{\$$has_set == \"\"\} \{"
	puts $tclf "        set $has_set \[lindex \$set_list 0\]"
	puts $tclf "    \}"
    }
    if $has_name {
    }
    if {$has_lcs != ""} {
	puts $tclf "    set lcs_list \[aie_list_lcs $bc\]"
	puts $tclf "    if \{\$$has_lcs == \"\"\} \{"
	puts $tclf "        set $has_lcs \[lindex \$lcs_list 0\]"
	puts $tclf "    \}"
    }
    
    foreach {chn chl} $choice_lists {
	bcc_write_choice_list_load $tclf $chn $chl
    }
    
    bcc_write_load_function_active_data $tclf $dezname $default_vals \
	$active_data $choice_lists $titles
    
    puts $tclf ""
    puts $tclf "    set AllowActiveReload 1"
    puts $tclf "\}"
    puts $tclf ""
}

proc bcc_write_apply_function {tclf dezname bc d default_vals \
				   choice_lists editing} {
    global famboco_info
    
    set ispart $famboco_info(partbc,$bc)
    
    puts $tclf "proc on${dezname}Apply \{\} \{"
    if !$editing {
	puts $tclf "    if !\[info exists obj_list\] \{ set obj_list \"\" \}"
    }
    
    # It may be that the args are in the wrong order..   need to take this
    # into account for some solvers
    set bcargs ""
    foreach {n v} $default_vals {
	#set ni $n; if [info exists map_internal($ni)] { set ni $map_internal($ni) }
	#append bcargs " $n \$$ni"
	#append bcargs " \$$ni"
	append bcargs " \$$n"
    }
    array set dnames { 0 point 1 curve 2 surface 3 body s subset f part a any }
    
    puts $tclf ""
    if $ispart {
	if $editing {
	    puts $tclf "    set vv \[bcc_on_apply_to_part $bc __editing__ \[list$bcargs\]\]"
	} else {
	    puts $tclf "    set vv \[bcc_on_apply_to_part $bc \$obj_list \[list$bcargs\]\]"
	}
    } elseif $editing {
	puts $tclf "    set vv \[bcc_on_apply_to_group $bc \$name existing \"\" \[list$bcargs\]\]"
    } elseif {$d == "a"} {
	puts $tclf "    set typ \[lindex \{point curve surface body subset\} \$${dezname}_DimtypeVal\]"
	puts $tclf "    set vv \[bcc_on_apply_to_group $bc \$name \$typ \$obj_list \[list$bcargs\]\]"
    } else {
	puts $tclf "    set vv \[bcc_on_apply_to_group $bc \$name $dnames($d) \$obj_list \[list$bcargs\]\]"
    }
    
    puts $tclf "    foreach \{n v\} \$vv \{ set \$n \$v \}"
    if !$editing {
	puts $tclf "    set obj_list \"\""
    }
    puts $tclf "\}"
    puts $tclf ""
}

proc bcc_write_load_function_active_data {tclf dezname default_vals
					  active_data choice_lists titles} {
    set rvkey ""
    foreach {n v} $default_vals {
	lappend rvkey $n ::AIEnv::DEZ::${dezname}::$n
    }
    foreach {n t} $titles {
	lappend rvkey $t ::AIEnv::DEZ::${dezname}::$n
	set map_t($t) $n
    }
    foreach {aname active} $active_data {
	set active2 [form_active_replace_varnames $active $rvkey \
			 $choice_lists]
	set vars ""
	foreach v [form_active_extract_depends $active] {
	    if [info exists map_t($v)] { set v $map_t($v) }
	    lappend vars $v
	}
	
	puts $tclf ""
	puts $tclf "    set cmd \[list bcc_trace_update_widget ${dezname}_$aname \[namespace current\] \{$active2\}\]"
	puts $tclf "    foreach v \{$vars\} \{ trace variable \$v w \$cmd \}"
	puts $tclf "    eval \$cmd"
    }
}

proc bcc_write_edit_func {tclf dezname bc has_name short_title default_vals} {
    puts $tclf "proc aie_edit_$bc \{name\} \{"
    puts $tclf "    bcc_edit_attribute \$name \"$dezname\" \"$bc\" \"$short_title\" \{$default_vals\}"
    puts $tclf "\}"
    puts $tclf ""
}

proc bcc_write_parse_func {tclf bc all_args} {
    # Figure out all the bctypes that we need to pull stuff in for this
    # bc group
    set pp 2
    foreach a $all_args {
	set thisb $bc
	set pos $pp
	incr pp
	foreach {n v} [lrange $a 1 end] {
	    switch $n {
		from_bctype { set thisb $v }
		name        { set name $v }
		title       { set title $v }
		from_pos    { set pos $v }
	    }
	}
	lappend for_bc($thisb) $name $title $pos
    }
    
    puts $tclf "proc aie_parse_bcs_$bc \{bcs\} \{"
    puts $tclf "    set ret \"\""
    puts $tclf "    set got_it 0"
    puts $tclf "    foreach bc1 \$bcs \{"
    puts $tclf "        switch \[lindex \$bc1 1\] \{"
    foreach tbc [array names for_bc] {
	puts $tclf "            $tbc \{"
	foreach {n t p} $for_bc($tbc) {
	    puts $tclf "                lappend ret $n \[lindex \$bc1 $p\] ;\# $t"
	}
        puts $tclf "                set got_it 1"
	puts $tclf "            \}"
    }
    puts $tclf "        \}"
    puts $tclf "    \}"
    puts $tclf "    if \$got_it \{"
    puts $tclf "        return \$ret"
    puts $tclf "    \} else \{"
    puts $tclf "        return \"\""
    puts $tclf "    \}"
    puts $tclf "\}"
    puts $tclf ""
}

proc bcc_write_icons_func {tclf bc setname symtype symparams symlabel} {
    puts $tclf "proc aie_apply_icons_$bc \{group obtype vis lvis\} \{"
    if {$symtype == ""} {
	puts $tclf "    return 1"
    } else {
	puts $tclf "    global aie_all_labels"
	puts $tclf "    if \[string match *:* \$group\] \{ return 1 \}"
	puts $tclf "    if \{\[info exists aie_all_labels($bc,\$group)\] && \$aie_all_labels($bc,\$group) && \$lvis\} \{ set lvis 2 \}"
	puts $tclf "    set name \"\""
	puts $tclf "    set bcs \[ic_boco_get \$group\]"
	puts $tclf "    if \{\$bcs == \"\"\} \{ return \"\" \}"
	puts $tclf "    set parsed \[aie_parse_bcs_$bc \$bcs\]"
	puts $tclf "    if \{\$parsed == \"\"\} \{ return \"\" \}"
	
	puts $tclf "    ic_boco_apply_attr_symbol \$group $bc \"$setname\" \\"
	puts $tclf "        $symtype \\"
	puts $tclf "        \$parsed \\"
	puts $tclf "        $symparams \\"
	puts $tclf "        $symlabel \\"
	puts $tclf "        \$vis \$lvis"
	puts $tclf "    return 1"
    }
    puts $tclf "\}"
    puts $tclf ""
}

proc bcc_write_get_set_func {tclf bc has_set} {
    puts $tclf "proc aie_get_${bc}_set \{fam\} \{"
    puts $tclf "    return \[aie_get_bc_argument \$fam $bc $has_set\]"
    puts $tclf "\}"
    puts $tclf ""
}

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

proc bcc_write_param_dez {dezf tclf dezname pn make_args default_vals \
			      choice_lists active_data title subname multnn} {
    puts $dezf "#--------------------------------------------"
    puts $dezf ""
    puts $dezf "dataEntryDialog $dezname \"$title\""

    puts $dezf "    dialogSpace 1"
    
    foreach a $make_args {
	bcc_write_arg $dezf $dezname $a $subname
    }
    puts $dezf "dataEntryDialog END"
    puts $dezf ""
    
    bcc_write_param_load_function $tclf $dezname $pn $make_args \
	$default_vals $choice_lists $active_data $multnn
    
    bcc_write_param_apply_function $tclf $dezname $pn $make_args $default_vals $multnn
}

proc bcc_write_param_load_function {tclf dezname pn make_args \
					default_vals choice_lists \
					active_data multnn} {
    puts $tclf "proc on${dezname}Load \{\} \{"
    puts $tclf "    global bcc_editing_param_node_vals"
    puts $tclf "    foreach \{n v\} \[list $default_vals\] \{ set \$n \$v \}"
    if {$multnn != ""} {
	puts $tclf "    foreach \{n v\} \[array get bcc_editing_param_node_vals\] \{"
    } else {
	puts $tclf "    foreach \{n v\} \[ic_param_get_values $pn\] \{"
    }
    puts $tclf "	set n2 \[bcc_nice_name \$n 0\]"
    puts $tclf "	set \$n2 \$v"
    puts $tclf "    \}"
    puts $tclf ""
    
    set titles ""
    foreach a $make_args {
	bcc_write_load_arg $tclf $dezname $a
	lappend titles [bcc_nice_name [bcc_get_aval $a name] 0] \
	    [bcc_get_aval $a title]
    }
    
    bcc_write_load_function_active_data $tclf $dezname $default_vals \
	$active_data $choice_lists $titles
    
    puts $tclf "\}"
    puts $tclf ""
}

proc bcc_write_param_apply_function {tclf dezname pn make_args default_vals multnn} {
    puts $tclf "proc on${dezname}Apply \{\} \{"
    puts $tclf "    global bcc_editing_param_node_vals"
    puts $tclf "    set value_list \{\}"
    foreach a $make_args {
	bcc_write_apply_arg $tclf $dezname $a
    }
    puts $tclf ""
    if {$multnn != ""} {
	puts $tclf "    ic_param_set_values $pn/\$$multnn \$value_list"
	puts $tclf "    if \{\[info exists bcc_editing_param_node_vals($multnn)\] && (\$bcc_editing_param_node_vals($multnn) != \$$multnn)\} \{"
	puts $tclf "        bcc_rename_mult_param $pn \$bcc_editing_param_node_vals($multnn) \$$multnn"
	puts $tclf "    \}"
    } else {
	puts $tclf "    ic_param_set_values $pn \$value_list"
    }
    puts $tclf "\}"
    puts $tclf ""
}

proc bcc_get_aval {a n} {
    foreach {p v} [lrange $a 1 end] { set dv($p) $v }
    return $dv($n)
}
    
proc bcc_write_arg {dezf dezname arg subname} {
    global famboco_info
    
    set type ""; set title ""; set default ""; set options ""
    set choices ""; set active ""; set html ""; set bubble ""
    set variable ""; set name ""; set nodename 0; set command ""
    set width ""; set allow_others 0; set gui_type "";
    set post_choice ""; set choice_pnode ""; set choice_func ""
    set default_func ""
    foreach {n v} [lrange $arg 1 end] { set $n $v }

    if [info exists famboco_info(choice_def,$choices)] {
	set choices $famboco_info(choice_def,$choices)
    }
    
    set name [bcc_nice_name $name 0]
    
    if [info exists ${subname}_subtitle] {
	append title " ([set ${subname}_subtitle])"
    } elseif [info exists subtitle] {
	append title " ($subtitle)"
    }
    
    if {[lindex $arg 0] == "label"} {
	
    } elseif {$type == "button"} {
	
    } elseif {$type == "button_box"} {
	
    } elseif {$type == "fixed"} {
	
    } elseif {$type == "endlabel"} {
	
    } elseif {$type == "separator"} {
	puts $dezf "    separator"
	return 0
	
    } elseif {$type == "table"} {
	puts $dezf "    dropDownEntry ${dezname}_$name \"$title\" ${name}_list ${name}_ext TRUE"
	
    } elseif {$type == "choice_group"} {
	puts $dezf "    dropDownEntry ${dezname}_$name \"$title\" ${name}_list ${name}_ext TRUE"
	
    } elseif {($choices == "") && ($choice_pnode == "")} {
	switch $gui_type {
	    filename {
		puts $dezf "    textEntry ${dezname}_$name \"$title FIXME\" $name NUM"
	    }
	    matprop_table {
		puts $dezf "    textButton ${dezname}_$name \"Edit [string tolower $title]\" \"bcc_edit_table $dezname $name \{$title\}\""
	    }
	    default {
		switch $type {
		    float - int - float_blank - int_blank {
			puts $dezf "    textEntry ${dezname}_$name \"$title\" $name NUM"
		    }
		    string - charflags - coords {
			puts $dezf "    textEntry ${dezname}_$name \"$title\" $name NUM"
		    }
		    bool {
			puts $dezf "    checkItem ${dezname}_$name \"$title\" $name FALSE"
		    }
		    default {
			puts "UNKNOWN TYPE $type"
		    }
		}
	    }
	}
	
    } elseif {($choices == "0 1") || ($choices == "1 0")} {
	# Use the variable ${name}_ext because $name is the internal name
	puts $dezf "    checkItem ${dezname}_$name \"$title\" ${name}_ext FALSE"
	
    } else {
	switch $gui_type {
	    radio {
		# Note that we ignore the _ext and _list values for this gui type.
		# It would be neater if we didn't but what the heck.
		puts $dezf "    radioGroup ${dezname}_$name \"$title\" 1 $name 1 NULL 0"
		foreach ch $choices {
		    set cht [lindex $ch 0]; set chn [lindex $ch 1]
		    if {$chn == ""} { set chn $cht }
		    puts $dezf "    radioItem ${dezname}_${name}_$chn \"$cht\" \"$chn\""
		}
		puts $dezf "    radioGroup END"
	    }
	    default {
		puts $dezf "    dropDownEntry ${dezname}_$name \"$title\" ${name}_list ${name}_ext TRUE"
	    }
	}
    }
    return 1
}

proc bcc_write_load_arg {tclf dezname arg} {
    set type ""; set choices ""; set name ""; set gui_type ""
    set choice_pnode ""
    foreach {n v} [lrange $arg 1 end] { set $n $v }
    set name [bcc_nice_name $name 0]
    
    puts $tclf "    \# $name ----------------------------------\n"
    
    if {[lindex $arg 0] == "label"} {
	
    } elseif {$type == "button"} {
	
    } elseif {$type == "button_box"} {
	
    } elseif {$type == "fixed"} {
	
    } elseif {$type == "endlabel"} {
	
    } elseif {$type == "table"} {
	puts $tclf "    set ${name}_list \[list must fix\]"
	
    } elseif {$type == "choice_group"} {
	puts $tclf "    set ${name}_list \[list must fix\]"
	
    } elseif {($choices == "") && ($choice_pnode == "")} {
	
    } elseif {($choices == "0 1") || ($choices == "1 0")} {
	
    } elseif {$choice_pnode != ""} {
	bcc_write_choice_list_load $tclf $name [list choice_pnode $choice_pnode]
	
    } else {
	bcc_write_choice_list_load $tclf $name $choices
    }
}

proc bcc_write_choice_list_load {tclf chn chl} {
    global famboco_info
    
    if [info exists famboco_info(choice_def,$chl)] {
	set chl $famboco_info(choice_def,$chl)
    }
    
    puts $tclf "\n    \# Choices for $chn -------------------------------------"

    puts $tclf "    set ${chn}_list \"\""
    switch -- [lindex $chl 0] {
	choice_pnode {
	    puts $tclf "    foreach ch \[ic_param_list_children [lindex $chl 1] 1\] \{"
	    puts $tclf "        lappend ${chn}_list \$ch"
	    puts $tclf "        set ${chn}_array(\$ch) \$ch"
	    puts $tclf "    \}"
	    set chl [lrange $chl 2 end]
	}
	choice_func {
	    puts $tclf "    foreach ch \[eval [lindex $chl 1]\] \{"
	    puts $tclf "        set n \[lindex \$ch 0\]"
	    puts $tclf "        lappend ${chn}_list \$n"
	    puts $tclf "        set v \[lindex \$ch 1\]\; if \{\$v == \"\"\} \{ set v \$n \}"
	    puts $tclf "        set ${chn}_array(\$n) \$v"
	    puts $tclf "    \}"
	    set chl [lrange $chl 2 end]
	}
    }
    
    set names ""
    set arrayset ""
    foreach choice $chl {
	set name [lindex $choice 0]
	lappend names $name
	set val [lindex $choice 1]; if {$val == ""} { set val $name }
	lappend arrayset $val $name
    }
    puts $tclf "    set ${chn}_list \[concat \$${chn}_list \[list $names\]\]"
    puts $tclf "    array set ${chn}_array \[list $arrayset\]"
    
    puts $tclf "    set ${chn}_ext \$$chn"
    puts $tclf "    if \[info exists ${chn}_array(\$$chn)\] \{"
    puts $tclf "        set ${chn}_ext \$${chn}_array(\$$chn)"
    puts $tclf "    \}"
    puts $tclf "    trace variable ${chn}_ext w \[list bcc_update_internal_val \[array get ${chn}_array\]\]"
}

proc bcc_write_apply_arg {tclf dezname arg} {
    global famboco_info
    
    set type ""; set choices ""; set name ""; set gui_type ""
    set choice_pnode ""; set choice_func ""
    foreach {n v} [lrange $arg 1 end] { set $n $v }
    set int_name [bcc_nice_name $name 0]
    
    if [info exists famboco_info(choice_def,$choices)] {
	set choices $famboco_info(choice_def,$choices)
    }
    
    if {[lindex $arg 0] == "label"} {
	return
	
    } elseif {$type == "button"} {
	return
	
    } elseif {$type == "button_box"} {
	return
	
    } elseif {$type == "fixed"} {
	return
	
    } elseif {$type == "endlabel"} {
	return
	
    } elseif {($choices == "") && ($choice_pnode == "")} {
	
    } elseif {($choices == "0 1") || ($choices == "1 0")} {
	
    } else {
	set switchcode "    switch \$${int_name}_ext \{\n"
	foreach o $choices {
	    set xv [lindex $o 0]
	    set iv [lindex $o 1]
	    if {$iv == ""} { set iv $xv }
	    append switchcode "        \"$xv\" \{ set ${int_name} \"$iv\" \}\n"
	}
	if {($choice_pnode == "") && ($choice_func == "")} {
	    # Really we should call choice_func again and deal with the
	    # extra options .. *****
	    append switchcode "        default \{ error \"unknown val for $name in $dezname : \$$int_name\" \}"
	}
	append switchcode "    \}"
	
	puts $tclf $switchcode
    }
    puts $tclf "    lappend value_list $name \$$int_name\n"
}

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

proc unised__bcc_write_subname_set {solvers dezf tclf} {
    set fp [open $dezf w]
    puts $fp "\# WARNING: this file automatically generated by bccomp.tcl - DO NOT EDIT"
    puts $fp "dataEntryDialog setComSolverDEZ \"Select Supported Solvers\""
    foreach ss $solvers {
	set n [lindex $ss 1]
	puts $fp "    checkItem setsolver$n \"[lindex $ss 0]\" ::enable_solver($n) FALSE"
    }
    puts $fp "dataEntryDialog END"
    close $fp
    
}

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

# The translator is table-driven.  Make an array describing, for every bctype in the
# base solver type, how to translate into the appropriate one in the subtype.
#
# Also we should do this for param files but that will come in the future.
#
# The routine bcc_translate_bctypes is called with the name and subname ...
# It references this array for its driver

proc bcc_write_translators {bcinfo transfile name subname} {
    global famboco_info
    
    set ff [open $transfile w]
    
    puts $ff ""
    puts $ff "\# WARNING: this file automatically generated by bccomp.tcl - DO NOT EDIT"
    puts $ff "\# Source: $bcinfo"
    puts $ff "\# Date: [cmd_date]"
    puts $ff ""
    
    puts $ff "array set bcc_translate_${name}_${subname}_data \{"
    
    foreach bc $famboco_info(bctypes) {
	set p 1
	foreach a $famboco_info(args,$bc) {
	    catch {unset av}; array set av [lrange $a 1 end]
	    if {$av(type) == "separator"} continue
	    if [info exists av(pos)] {
		set pos_for_name($bc,$av(name)) $av(pos)
	    } else {
		set pos_for_name($bc,$av(name)) $p
	    }
	    incr p
	}
    }
    
    foreach bc $famboco_info(bctypes) {
	if ![info exists famboco_info(${subname}_equivalent,$bc)] continue
	
	puts $ff "    $bc \{"
	foreach {t v} $famboco_info(${subname}_equivalent,$bc) {
	    switch $t {
		bctype - alternate_bctype - param_node {
		    set is_param [expr {$t == "param_node"}]
		    
		    puts $ff "        $t"
		    set bcpred ""
		    if {[lindex $v 0] == "?"} {
			foreach p1 [lindex $v 1] {
			    # The 0 means look at the predicate *after* translation
			    lappend bcpred [concat $pos_for_name($bc,[lindex $p1 0]) 0 [lrange $p1 1 end]]
			}
			set v [lrange $v 2 end]
		    }
		    set obc [lindex $v 0]
		    puts "$bc -> $obc"
		    catch {unset narg_string}
		    if $is_param {
			set defs ""
		    } else {
			set defs $famboco_info(default_args,$subname,$obc)
		    }
		    foreach {othername a} [lrange $v 1 end] def $defs {
			if {$a == ""} continue
			
			set pre ""
			set post ""
			
			switch -- [string index $a 0] {
			    * {
				set pre *
				set a [string range $a 1 end]
				set post ,${name}_convert_${subname}_${bc}_$a
				set argnames [list $a]
			    }
			    + {
				set narg_string($othername) $a
				continue
			    }
			    = {
				set narg_string($othername) +$def
				continue
			    }
			    ? {
				# this one is tricky
				set a1 ""
				foreach {pred opt} [lrange $a 1 end] {
				    set pred1 ""
				    foreach p $pred {
					set p1 \#$pos_for_name($bc,[lindex $p 0]):[lindex $p 0]
					lappend pred1 [concat $p1 [lrange $p 1 end]]
				    }
				    switch -- [string index $opt 0] {
					* {
					    set n1 [string range $opt 1 end]
					    set opt1 *$pos_for_name($bc,$n1),${name}_convert_${subname}_${bc}_$n1
					}
					+ { set opt1 $opt }
					= { set opt1 +$def }
					default { set opt1 \#$pos_for_name($bc,$opt):$opt }
				    }
				    lappend a1 $pred1 $opt1
				}
				set narg_string($othername) $a1; continue
			    }
			    & {
				# get name of the N'th param node below
				set narg_string($othername) $a
				continue
			    }
			    default {
				# this is to support the fx*scale type syntax
				set argnames [split $a *]
			    }
			}
			
			set positions ""
			foreach a $argnames {
			    lappend positions \#$pos_for_name($bc,$a):$a
			}
			set narg_string($othername) $pre[join $positions *]$post
		    }
		    
		    set nargs [list $bcpred $obc]
		    if $is_param {
			foreach a [lsort [array names narg_string]] {
			    lappend nargs $a $narg_string($a)
			}
		    } else {
			foreach argname $famboco_info(arg_names,$subname,$obc) argdef $defs {
			    if ![info exists narg_string($argname)] {
				puts "WARNING: no $obc $argname translation found - using $argdef"
				lappend nargs $argname $argdef
			    } else {
				lappend nargs $argname $narg_string($argname)
			    }
			}
		    }
		    puts $ff "        \{$nargs\}"
		}
	    }
	}
	puts $ff "    \}"
    }
    puts $ff "\}\n"
    
    # Now write the reverse table.  Note that we're assuming one commonstruct bctype
    # can map to multiple subsolver bctypes and param_nodes but never the opposite.
    # Note that if you have a bctype with some bc predicates and it uses param_nodes
    # then those param_nodes have to have the same bc predicates.
    
    puts $ff "array set bcc_translate_${subname}_${name}_data \{"
    
    foreach bc $famboco_info(bctypes) {
	if ![info exists famboco_info(${subname}_equivalent,$bc)] continue
	
	# First go through the param nodes and determine what stuff
	# comes from where, based on bc predicates
	
	catch {unset param_nodes_used}
	foreach {t v} $famboco_info(${subname}_equivalent,$bc) {
	    switch $t {
		param_node {
		    # Currently this is probably broken
		    set bcpred ""
		    if {[lindex $v 0] == "?"} {
			foreach p1 [lindex $v 1] {
			    # The 1 means look at the predicate *before* translation
			    lappend bcpred [concat $pos_for_name($bc,[lindex $p1 0]) 1 [lrange $p1 1 end]]
			}
			set v [lrange $v 2 end]
		    }
		    lappend param_nodes_used($bcpred) $v
		}
	    }
	}
	
	foreach {t v} $famboco_info(${subname}_equivalent,$bc) {
	    switch $t {
		bctype {
		    puts "reverse $bc"
		    set bcpred ""
		    catch {unset presets}
		    if {[lindex $v 0] == "?"} {
			foreach p1 [lindex $v 1] {
			    # The 1 means look at the predicate *before* translation
			    lappend bcpred [concat $pos_for_name($bc,[lindex $p1 0]) 1 [lrange $p1 1 end]]
			}
			foreach bcp $bcpred {
			    # What if there is more than one value?  We're hosed then.
			    set presets([lindex $bcp 0]) [lindex $bcp 2]
			}
			set v [lrange $v 2 end]
		    }
		    set obc [lindex $v 0]
		    
		    catch {unset otherpos}
		    set n 1
		    foreach argname $famboco_info(arg_names,$subname,$obc) {
			set otherpos($argname) $n
			incr n
		    }
		    
		    # First let's see if any of the args have a & in them
		    catch {unset pnoderef}
		    foreach {othername a} [lrange $v 1 end] {
			
			set n $otherpos($othername)
			if {[string index $a 0] == "&"} {
			    set pnoderef([string range $a 1 end]) $n
			}
		    }
		    
		    catch {unset param_map}
		    if [info exists param_nodes_used($bcpred)] {
			foreach pn $param_nodes_used($bcpred) {
			    set partype [lindex $pn 0]
			    # First pull out the name field
			    catch {unset refval}
			    foreach {n s} [lrange $pn 1 end] {
				if {[string index $s 0] == "&"} {
				    # This is the name field
				    set refval $pnoderef([string range $a 1 end])
				}
			    }
			    
			    foreach {n s} [lrange $pn 1 end] {
				if {[string index $s 0] != "&"} {
				    # This is a regular field - rewrite it as &:real/#6:set/1/r1
				    set param_map($s) &$partype/\#$refval:$n
				}
			    }
			}
		    }
		    
		    puts $ff "    $obc \{"
		    puts $ff "        $t"
		    set nargs [list $bcpred $bc]
		    # First fill this one in with default values
		    catch {unset argval}
		    set n 1
		    foreach a $famboco_info(args,$bc) {
			catch {unset av}; array set av [lrange $a 1 end]
			if {$av(type) == "separator"} continue
			if [info exists presets($av(name))] {
			    set argval($n) [list $av(name) +$presets($av(name))]
			} elseif [info exists param_map($av(name))] {
			    set argval($n) [list $av(name) $param_map($av(name))]
			} else {
			    set argval($n) [list $av(name) +$av(default)]
			}
			incr n
		    }
		    
		    foreach {othername a} [lrange $v 1 end] {
			set pre ""
			set post ""

			switch -- [string index $a 0] {
			    * {
				set pre *
				set a [string range $a 1 end]
				set post ,${subname}_convert_${name}_${bc}_$a
			    }
			    + {
				continue
			    }
			    = {
				continue
			    }
			    & {
				continue
			    }
			    ? {
				continue
				
				
				# this one is tricky
				set a1 ""
				foreach {pred opt} [lrange $a 1 end] {
				    set pred1 ""
				    foreach p $pred {
					set p1 \#$pos_for_name($bc,[lindex $p 0])
					lappend pred1 [concat $p1 [lrange $p 1 end]]
				    }
				    switch -- [string index $opt 0] {
					* {
					    set n1 [string range $opt 1 end]
					    set opt1 *$pos_for_name($bc,$n1),$n1
					}
					+ { set opt1 $opt }
					= { set opt1 +$def }
					default { set opt1 \#$pos_for_name($bc,$opt) }
				    }
				    lappend a1 $pred1 $opt1
				}
				lappend nargs $a1; continue
			    }
			    default {
				# assume the ones after the first one are default 1
				set a [lindex [split $a *] 0]
			    }
			}
			
			set n $otherpos($othername):$othername
			set argval($pos_for_name($bc,$a)) [list $a $pre\#$n$post]
		    }
		    
		    for {set n 1} {[info exists argval($n)]} {incr n} {
			eval lappend nargs $argval($n)
		    }
		    puts $ff "        \{$nargs\}"
		    puts $ff "    \}"
		}
	    }
	}
    }
    puts $ff "\}\n"
    
    close $ff
}

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

proc tt {} {
    global errorInfo
    uplevel \#0 source c:/aie/bccomp.tcl
    uplevel \#0 source c:/aie/family_boco.tcl
    if [catch {bcc_write_ttk c:/aie/test2.bcinfo c:/aie/test2m.ttkrf c:/aie/test2t.ttkrf c:/aie/test2d.ttkrf c:/aie/test2.tcl} res] {
	puts $res
	puts $errorInfo
    }
}


