


proc bcc_write_ttk {bcinfo menufile tabfile dezfile tclfile} {
    global famboco_info param_info

    array set dim_names { 0 Point 1 Curve 2 Surface 3 Body s Subset f Family }
    array set dim_names_p { 0 Points 1 Curves 2 Surfaces 3 Bodies s Subsets f Families }
    
    upvar \#0 famboco_info fi
    upvar \#0 param_info pi
    
    famboco_load_bcinfo $bcinfo
    
    set tabf [open $tabfile w]
    set dezf [open $dezfile w]
    set tclf [open $tclfile w]
    
    foreach ff [list $tabf $dezf $tclf] {
	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 ""
    }
    
    foreach cat $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 barname $fi(name)_${cat}_Bar
	set ibarname $fi(name)_${cat}_iconBar
	puts $tabf "\# Category $cat"
	puts $tabf "tabbedIconBar $barname \"$cdata(tab_title)\" $cdata(tab_icon) \\\n\t\"$cdata(bubble)\""
	puts $tabf "    iconBar $ibarname"
	
	# -----------------------------------------------------------------
	
	foreach bc $fi(bctypes) {
	    if [info exists skip_this($bc)] continue
	    if {$fi(category,$bc) == $cat} {
		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 $v }
		    }
		    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 $v }
			}
			if {$na != ""} continue
			lappend a from_bctype $mb
			lappend dez_args $a
		    }
		}
		
		set has_set 0; set has_lcs 0
		set make_args ""
		foreach a $dez_args {
		    set ok 1
		    foreach {n v} [lrange $a 1 end] {
			switch $n {
			    is_set  { set has_set $v }
			    is_lcs  { set has_lcs $v }
			    ignore  { if $v { set ok 0 } }
			}
		    }
		    if $ok { lappend make_args $a }
		}
		
		# Figure out all the default values for the params and make
		# sure everything has a name
		set default_vals ""
		if $fi(has_name,$bc) {
		    lappend default_vals name ""
		}
		if $has_set {
		    lappend default_vals set_value ""
		}
		if $has_lcs {
		    lappend default_vals lcs_value ""
		}
		set pp 0
		set make_args2 ""
		set bci_args ""
		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
		    }
		    incr pp
		    lappend make_args2 $a
		    
		    if [info exists adata(icon_arg)] {
			lappend bci_args $adata(name) $adata(icon_arg)
		    }
		    
		    switch $adata(type) {
			float {
			    lappend default_vals $adata(name) $adata(default)
			}
		    }
		}
		set make_args $make_args2
		
		puts $tclf "\# $bc functions ---------------------------\n"
		
		set dezname Modify_${bc}_DEZ
		
		bcc_write_dez $dezf $tclf $dezname $bc $has_set $has_lcs \
		    $fi(has_name,$bc) $make_args $default_vals \
		    "" $fi(title,$bc) ""
		
		bcc_write_edit_func $tclf $dezname $bc $fi(short_title,$bc) \
		    $default_vals
		
		bcc_write_parse_func $tclf $bc $make_args
    
		bcc_write_icons_func $tclf $bc $dez_args \
			[string toupper $fi(short_title,$bc)] \
			$fi(bcicon_type,$bc) $bci_args $fi(icon_arg_extra,$bc)
		    
		bcc_write_get_set_func $tclf $bc $dez_args
    
		foreach d $fi(apply_dims,$bc) icon $fi(tab_icons,$bc) {
		    set dn $dim_names($d)
		    set dnp $dim_names_p($d)
		    if {$icon == ""} { set icon \"\" }
		    set butname ${dn}_${bc}_But
		    set dezname Create_${dn}_${bc}_DEZ

		    puts $tabf "        iconButton $butname \"$dn $fi(short_title,$bc)\" $icon \\\n\t\t\"$dezname show\" \\\n\t\t\"$fi(title,$bc) on $dnp\""
		    
		    bcc_write_dez $dezf $tclf $dezname $bc $has_set $has_lcs \
			$fi(has_name,$bc) $make_args $default_vals \
			$d $fi(title,$bc) $dnp		    
		}
	    }
	}
	
	# --------------------------------------------------------------
	
	foreach pn $pi(pnodes) {
	    if {$pi(category,$pn) == $cat} {
		regsub -all : $pn _ pn2
		set butname ${pn2}_But
		set dezname Edit_${pn2}_DEZ

		puts $tabf "        iconButton $butname \"$pi(title,$pn)\" $pi(tab_icon,$pn) \\\n\t\t\"$dezname show\" \\\n\t\t\"$pi(title,$pn)\""
		
		set make_args ""
		foreach a $pi(args,$pn) {
		    set ok 1
		    foreach {n v} [lrange $a 1 end] {
			switch $n {
			    is_lcs  { set has_lcs $v }
			    ignore  { if $v { set ok 0 } }
			}
		    }
		    if $ok { lappend make_args $a }
		}
		
		bcc_write_param_dez $dezf $tclf $dezname $pn $has_lcs \
		    $make_args $default_vals $pi(title,$pn)	
	    }
	}
	
	# --------------------------------------------------------------
	
	puts $tabf "    iconBar END"
	puts $tabf "tabbedIconBar END"
	puts $tabf ""
    }
    close $tabf
    close $dezf
    close $tclf
}

proc bcc_write_dez {dezf tclf dezname bc has_set has_lcs \
			has_name make_args default_vals d title dnp} {
    puts $dezf "#--------------------------------------------"
    puts $dezf ""
    if {$dnp == ""} {
	puts $dezf "dataEntryDialog $dezname \"Edit $title\""
    } else {
	puts $dezf "dataEntryDialog $dezname \"Define $title on $dnp\""
    }
    set sp 0
    if $has_name {
	puts $dezf "    textEntry ${dezname}_$bc \"Name\" name TEXT"
	incr sp
    }
    if $has_set {
	puts $dezf "    dropDownEntry ${dezname}_Set \"$title Set\" \\\n\tset_list set_value"
	incr sp
    }
    if $has_lcs {
	puts $dezf "    dropDownEntry ${dezname}_LCS \"Coord System\" \\\n\tlcs_list lcs_value"
	incr sp
    }
    if $sp { puts $dezf "    dialogSpace 1" }
    if {$dnp != ""} {
	puts $dezf "    entityChooser ${dezname}_Pick \"$dnp\" obj_list \\\n\tPOINT_${d}D_EL ANY"
	puts $dezf "    dialogSpace 1"
    }
    
    foreach a $make_args {
	bcc_write_arg $dezf $dezname $a
    }
    puts $dezf "dataEntryDialog END"
    puts $dezf ""
    
    bcc_write_load_function $tclf $dezname $bc $default_vals \
	$has_set $has_name $has_lcs
    
    bcc_write_apply_function $tclf $dezname $bc $d \
	$default_vals
}

proc bcc_write_load_function {tclf dezname bc default_vals \
				  has_set has_name has_lcs} {
    puts $tclf "proc on${dezname}Load \{\} \{"
    puts $tclf "    global bcc_${bc}_to_load"
    puts $tclf ""
    puts $tclf "    foreach \{n v\} \{"
    puts $tclf "        $default_vals"
    puts $tclf "    \} \{"
    puts $tclf "        if \[info exists bcc_${bc}_to_load\] \{"
    puts $tclf "            set \$n \$bcc${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 \{\$set_value == \"\"\} \{"
	puts $tclf "        set set_value \[lindex \$set_list 0\]"
	puts $tclf "    \}"
    }
    if $has_name {
    }
    if $has_lcs {
	puts $tclf "    set lcs_list \[aie_list_lcs $bc\]"
	puts $tclf "    if \{\$lcs_value == \"\"\} \{"
	puts $tclf "        set lcs_value \[lindex \$lcs_list 0\]"
	puts $tclf "    \}"
    }
    puts $tclf "    set AllowActiveReload 1"
    puts $tclf "\}"
    puts $tclf ""
}

proc bcc_write_apply_function {tclf dezname bc d default_vals} {
    puts $tclf "proc on${dezname}Apply \{\} \{"
    puts $tclf "    if !\[info exists obj_list\] \{ set obj_list \"\" \}"
    puts $tclf ""
    set bcargs ""
    foreach {n v} $default_vals {
	append bcargs " $n \$$n"
    }
    puts $tclf "    set vv \[bcc_on_apply $bc \"$d\" \[list$bcargs\]\]"
    puts $tclf "    foreach \{n v\} \$vv \{ set \$n \$v \}"
    puts $tclf "    set obj_list \"\""
    puts $tclf "\}"
    puts $tclf ""
}

proc bcc_write_edit_func {tclf dezname bc short_title default_vals} {
    puts $tclf "proc bcc_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\] \{"
    puts $tclf "            ${bc}_NAME \{ lappend ret name \[lindex \$bc1 2\] \}"
    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 "    \}"
    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 dez_args pref icontype pass_to_bci \
			       extra_bci} {
    if {$icontype == ""} return
    
    puts $tclf "proc aie_apply_icons_$bc \{fam obtype vis\} \{"
    puts $tclf "    if !\[string match *$pref* \$fam\] \{ return \"\" \}"
    puts $tclf "    set name \"\""
    puts $tclf "    set bcs \[ic_boco_get \$fam\]"
    puts $tclf "    if \{\$bcs == \"\"\} \{ return \"\" \}"
    puts $tclf "    set parsed \[aie_parse_bcs_$bc \$bcs\]"
    puts $tclf "    if \{\$parsed == \"\"\} \{ return \"\" \}"
    puts $tclf "    foreach \{n v\} \$parsed \{ set \$n \$v \}"
    set aa ""
    foreach {p n} $pass_to_bci {
	append aa " $n \$$p"
    }
    foreach p $extra_bci {
	append aa " $p"
    }
    puts $tclf " make sure you update boco_apply_generic .. or make a new variant"
    puts $tclf "    ic_boco_apply_generic_icon_to_group \$fam $icontype \[list$aa\] \$vis"
    puts $tclf "    return \[aie_verify_name \$name $bc \$fam\]"
    puts $tclf "\}"
    puts $tclf ""
}

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

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

proc bcc_write_param_dez {dezf tclf dezname pn has_lcs \
			      make_args default_vals title} {
    puts $dezf "#--------------------------------------------"
    puts $dezf ""
    puts $dezf "dataEntryDialog $dezname \"$title\""

    if $has_lcs {
	puts $dezf "    dropDownEntry ${dezname}_LCS \"Coord System\" \\\n\tlcs_list lcs_value"
	puts $dezf "    dialogSpace 1"
    }
    
    foreach a $make_args {
	bcc_write_arg $dezf $dezname $a
    }
    puts $dezf "dataEntryDialog END"
    puts $dezf ""
    
    bcc_write_param_load_function $tclf $dezname $pn $make_args \
	$default_vals $has_lcs
    
    bcc_write_param_apply_function $tclf $dezname $pn $make_args $default_vals
}

proc bcc_write_param_load_function {tclf dezname pn make_args \
					default_vals has_lcs} {
    puts $tclf "proc on${dezname}Load \{\} \{"
    foreach a $make_args {
	bcc_write_load_arg $tclf $dezname $a
    }
    puts $tclf "\}"
    puts $tclf ""
}

proc bcc_write_param_apply_function {tclf dezname pn make_args default_vals} {
    puts $tclf "proc on${dezname}Apply \{\} \{"
    foreach a $make_args {
	bcc_write_apply_arg $tclf $dezname $a
    }
    puts $tclf "\}"
    puts $tclf ""
}

proc bcc_write_arg {dezf dezname arg} {
    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 }
    
    set is_label [expr {[lindex $arg 0] == "label"}]
    
    if $is_label {
	
    } elseif {$type == "button"} {
	
    } elseif {$type == "button_box"} {
	
    } elseif {$type == "fixed"} {
	
    } elseif {$type == "endlabel"} {
	
    } elseif {($choices == "") && ($choice_pnode == "")} {
	if {$gui_type == "filename"} {
	} else {
	    switch $type {
		float {
		    puts $dezf "    textEntry ${dezname}_$name \"$title\" $name NUM"
		}
	    }
	}
	
    } 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 {
	puts $dezf "    dropDownEntry ${dezname}_$name \"$title\" ${name}_list $name TRUE"
    }
}

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 }
    
    if {[lindex $arg 0] == "label"} {
	
    } elseif {$type == "button"} {
	
    } elseif {$type == "button_box"} {
	
    } elseif {$type == "fixed"} {
	
    } elseif {$type == "endlabel"} {
	
    } elseif {($choices == "") && ($choice_pnode == "")} {
	
    } elseif {($choices == "0 1") || ($choices == "1 0")} {
	
    } else {
	set vlist ""
	set switchcode "    switch \$$name \{\n"
	foreach o $choices {
	    set xv [lindex $o 0]
	    set iv [lindex $o 1]
	    if {$iv == ""} { set iv $xv }
	    lappend vlist $xv
	    append switchcode "        \"$iv\" \{ set ${name}_ext \"$xv\" \}\n"
	}
	append switchcode "        default \{ error \"unknown val for $name in $dezname : \$$name\" \}\n    \}\n"
	
	puts $tclf $switchcode
	puts $tclf "    set ${name}_list \[list $vlist\]"
    }
}

proc bcc_write_apply_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 }
    
    if {[lindex $arg 0] == "label"} {
	
    } elseif {$type == "button"} {
	
    } elseif {$type == "button_box"} {
	
    } elseif {$type == "fixed"} {
	
    } elseif {$type == "endlabel"} {
	
    } elseif {($choices == "") && ($choice_pnode == "")} {
	
    } elseif {($choices == "0 1") || ($choices == "1 0")} {
	
    } else {
	set switchcode "    switch \$${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 ${name} \"$iv\" \}\n"
	}
	append switchcode "        default \{ error \"unknown val for $name in $dezname : \$$name\" \}\n    \}\n"
	
	puts $tclf $switchcode
    }
}

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

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/test.bcinfo c:/aie/testm.ttkrf c:/aie/testt.ttkrf c:/aie/testd.ttkrf c:/aie/test.tcl} res] {
	puts $res
	puts $errorInfo
    }
}
