
# Unit stuff.
#
# Copyright (c) 1998 Pacific Marketing and Consulting
# Author:  Wayne A. Christopher, wayne@pmac.com
#          Pacific Marketing and Consulting, Berkeley, California

proc unit_get_choices {unittype {also ""}} {
    global unit_choices
    if {[lindex $unit_choices($unittype) 0] == ""} { return "" }
    return [concat $unit_choices($unittype) $also]
}

proc unit_get_default_choice {unittype} {
    global unit_choices unit_default
    if {$unit_default($unittype) != ""} {
	return $unit_default($unittype)
    } else {
	return [lindex $unit_choices($unittype) 0]
    }
}

proc unit_select_one {unittype default} {
    global unit_choices
    
    return [choose_one "Select a unit for scaling the CAD data." \
		$unit_choices($unittype) $default]
}

proc unit_get_post_coeffs {num is_vec} {
    global unit_data post_units post_unit_types

    if [info exists post_unit_types($num,$is_vec)] {
	set ut $post_unit_types($num,$is_vec)
	if {$ut == ""} {
	    return "0 1 0"
	} else {
	    return $unit_data($post_units($ut))
	}
    } else {
#	puts "ERROR: nothing for post_unit_types($num,$is_vec)"
	return "0 1 0"
    }
}

proc unit_get_flpost_coeffs {name is_vec} {
    global flpost_varnames_ext unit_names_ext
    global unit_data post_units post_unit_types
    
    if [info exists flpost_varnames_ext($name)] {
	set ext $flpost_varnames_ext($name)
    } else {
	set ext $name
    }
    set uname $unit_names_ext($ext)

    return $unit_data($post_units($uname))
}

proc unit_convert {val dims to_external {report_err 1}} {
    global unit_data problem_temp problem_pressure unit_choices unit_default
    global job_precision problem_temp_units problem_pressure_units
    global meshing_frequency_scale meshing_frequency_value tdv_default

    # This is just a quick optimization
    if {$dims == "m"} { return $val }
    
    if {$val == "default"} { return default }
    if {$val == ""} { return "" }
    if [string match *$* $val] { return $val }
    
    if {$val == "ambient"} {
	if {[lsearch $unit_choices(temperature) $dims] >= 0} {
	    if $to_external { return $problem_temp }
	    set val [expression_evaluate $problem_temp]
	    set dims $problem_temp_units
	} elseif {[lsearch $unit_choices(pressure) $dims] >= 0} {
	    if $to_external { return $problem_pressure }
	    set val [expression_evaluate $problem_pressure]
	    set dims $problem_pressure_units
	} else {
	    if $report_err {
		user_error "Don't know about any ambient variables with $dims units"
	    }
	    return
	}
    }
    
    if {$dims == ""} { return $val }
    
    # Just make sure that the value is something reasonable.
    if {[scan $val %f valf] != 1} {
	if $report_err {
	    user_error "Value \"$val\" is not a floating-point number, converting units to \"$dims\"."
	}
	return 0
    }
    
    switch $dims {
	wavlen {
	    set mv $meshing_frequency_value
	    set ms $meshing_frequency_scale
	    if !$mv {
		set mv 1
		set ms GHz
	    }
	    
	    set y0 0
	    set x0 0
	    set speed_light 2.99793e8
	    array set scales { GHz 1e9 MHz 1e6 KHz 1e3 Hz 1 }
	    set c [expr ($mv * $scales($ms)) / $speed_light]
	}
	model_size {
	    set y0 0
	    set x0 0
	    set diam [tdv_get_diameter $tdv_default]
	    if $diam {
		set c [expr 1 / $diam]
	    } else {
		set c 1 ;# ????
	    }
	}
	default {
	    if {[lindex $dims 0] == "default"} {
		set dims $unit_default([lindex $dims 1])
	    }
	    if ![info exists unit_data($dims)] {
		if $report_err {
		    user_error "No unit information is defined for dimensions \"$dims\""
		}
		return
	    }
	    set y0 [lindex $unit_data($dims) 0]
	    set c [lindex $unit_data($dims) 1]
	    set x0 [lindex $unit_data($dims) 2]
	}
    }
    switch $to_external {
	1 { set rval [expr $y0 + $c * ($valf + $x0)] }
	0 { set rval [expr ($valf - $y0) / ($c + 0.0) - $x0] }
    }
    if $to_external {
	#return [format %.*g $job_precision $val]
	return $rval
    } else {
	return $rval
    }
}

proc unit_edit {} {
    #set buts [list accept {Apply unit_update_conversion} {New unit_edit_new}]
    
    set buttons ""
    lappend buttons [list "All projects" \
			 {form_accept_hack .units_edit; \
			      unit_update_conversion; options_changed 1 1}]
    lappend buttons [list "This project" \
			 {form_accept_hack .units_edit; \
			      unit_update_conversion; options_changed 0 1}]
    lappend buttons {Cancel "form_done .units_edit"}
    lappend buttons {New unit_edit_new}
    
    set d [form_init .units_edit "Unit definitions" "" $buttons]
    if {$d != ""} {
	unit_edit_setup_form $d
	
	form_finish bot
    }
    unit_edit_setup_vars
    
    if ![form_wait .units_edit] return
    
    unit_edit_done
}

proc unit_edit_setup_form {d} {
    global unit_edit
    
    form_label $d.catl  "Category             " {0 0}
    form_label $d.unitl "Units                     " {0 1}
    form_label $d.convl "Conversion                         " {3 0}
    form_frame $d.cat ridge 2 {1 0 -rows 2}
    form_frame $d.unit ridge 2 {1 1}
    form_frame $d.conv ridge 2 {4 0}
    form_label $d.unitl2 "* = default" {2 1}
    form_label $d.conv.l " \n " {0 0 -cols 3}
    form_label $d.conv.cl "c" {1 0 -fill none}
    form_label $d.conv.xl "x0" {2 0 -fill none}
    form_label $d.conv.yl "y0" {3 0 -fill none}
    form_entry $d.conv.c unit_edit(c) float_blank {1 1 -fill both}
    form_entry $d.conv.x unit_edit(x0) float_blank {2 1 -fill both}
    form_entry $d.conv.y unit_edit(y0) float_blank {3 1 -fill both}
    form_button $d.conv.sd "Set as default" unit_set_cur_default {4 1 -fill x}
    foreach c {c x y} { bind $d.conv.$c <Return> unit_update_conversion }
    form_label $d.conv.ed "" {5 0 -cols 2}
    
    form_frame $d.setall flat 0 {4 1}
    form_button $d.setall.n "New unit" "unit_edit_new" {0 0 -fill x}
    form_button $d.setall.del "Delete unit" "unit_edit_delete" {1 0 -fill x}
    form_rowheight $d.setall 2 5
    form_button $d.setall.s "Set all to SI" "units_convert_all_objects si" {3 0 -fill x}
    form_button $d.setall.i "Set all to Imperial" "units_convert_all_objects imp" {4 0 -fill x}
    form_button $d.setall.d "Set all to defaults" "units_convert_all_objects def" {5 0 -fill x}
    
    set unit_edit(form) $d
}

proc unit_edit_setup_vars {} {
    global unit_choices unit_names unit_data unit_edit unit_default
    global unit_exclude unit_include
    
    set unit_edit(prev) ""
    set c_opts ""
    foreach ch [lsort [array names unit_choices]] {
	if ![info exists unit_names($ch)] continue
	if {[lindex $unit_choices($ch) 0] == ""} continue
	if {[info exists unit_exclude($ch)]} continue
	if {[info exists unit_include] && ![info exists unit_include($ch)]} {
	    continue
	}
	set name $unit_names($ch)
	if {$name != ""} {
	    lappend c_opts [list $ch -text $name -command unit_sel_cat]
	}
    }
    if ![info exists unit_edit(cur_cat)] {
	set unit_edit(cur_cat) [lindex [lindex $c_opts 0] 0]
    }
    check_box $unit_edit(form).cat $c_opts 16 unit_edit(cur_cat) 0
    unit_sel_cat
}

proc unit_edit_done {args} {
    global unit_data unit_default tdv_default
    
    unit_update_conversion
    
    eval tdv_set_ruler_units $tdv_default \
	[lrange $unit_data($unit_default(length)) 0 2] \
	\"$unit_default(length)\"
}

proc unit_sel_cat {} {
    global unit_edit unit_default
    
    set unit_edit(cur_unit) $unit_default($unit_edit(cur_cat))
    unit_fix_unit_list
    unit_sel_unit
}

proc unit_fix_unit_list {} {
    global unit_choices unit_names unit_data unit_edit unit_default
    
    if ![info exists unit_edit(cur_cat)] return
    
    set u_opts ""
    foreach ch $unit_choices($unit_edit(cur_cat)) {
	if {$unit_default($unit_edit(cur_cat)) == $ch} {
	    set star "* "
	} else {
	    set star "  "
	}
	lappend u_opts [list $ch -text $star$ch -command unit_sel_unit]
    }
    check_box $unit_edit(form).unit $u_opts 15 unit_edit(cur_unit) 0
} 

proc unit_set_cur_default {} {
    global unit_edit unit_default default_object_units unit_data
    
    set unit_default($unit_edit(cur_cat)) $unit_edit(cur_unit)
    unit_fix_unit_list
    catch {unset default_object_units}
    unit_update_shape_length_scale
}

proc unit_update_shape_length_scale {} {
    global unit_default unit_data shape_default_length_scale
    
    set shape_default_length_scale [lindex $unit_data($unit_default(length)) 1]
}

proc unit_sel_unit {} {
    global unit_choices unit_names unit_data unit_edit
    
    if {$unit_edit(cur_unit) == ""} return
    
    unit_update_conversion
    
    set unit_edit(prev) $unit_edit(cur_unit)
    set data $unit_data($unit_edit(cur_unit))
    set unit_edit(y0) [lindex $data 0]
    set unit_edit(c) [lindex $data 1]
    set unit_edit(x0) [lindex $data 2]
    
    if [lindex $data 4] {
	form_label_settext $unit_edit(form).conv.ed ""
    } else {
	form_label_settext $unit_edit(form).conv.ed "Not user-editable"
    }
    
    if {$unit_edit(cur_cat) == "temperature"} {
	# This is a wierd case because K is not really the standard from the
	# user's point of view but it is for fluent
	set si K
	set stdmess "Base temperature unit"
    } else {
	set si [lindex $unit_choices($unit_edit(cur_cat)) 0]
	set stdmess "Standard SI unit"
    }
    set cur $unit_edit(cur_unit)
    if {$si == $cur} {
	$unit_edit(form).conv.l configure -justify left
	form_label_settext $unit_edit(form).conv.l "$stdmess\n "
    } else {
	$unit_edit(form).conv.l configure -justify left
	form_label_settext $unit_edit(form).conv.l "$cur = \n   c * ($si + x0) + y0"
    }
}

proc unit_update_conversion {} {
    global unit_choices unit_names unit_data unit_edit
    
    if {$unit_edit(prev) == ""} return
    
    set ny $unit_edit(y0)
    set nc $unit_edit(c)
    set nx $unit_edit(x0)
    set data $unit_data($unit_edit(prev))
    set oy [lindex $data 0]
    set oc [lindex $data 1]
    set ox [lindex $data 2]
    if {($nc != $oc) || ($nx != $ox) || ($ny != $oy)} {
	if ![lindex $data 4] {
	    mess "Can't modify pre-defined unit $unit_edit(prev)\n" red
	    set unit_edit(y0) $oy
	    set unit_edit(c) $oc
	    set unit_edit(x0) $ox
	} else {
	    set unit_data($unit_edit(prev)) \
		[list $ny $nc $nx [lindex $data 3] 1]
	    mess "Updated unit conversion for $unit_edit(prev)\n"
	}
    }
}

proc unit_edit_new {} {
    global unit_choices unit_names unit_data unit_edit
    
    set cat $unit_edit(cur_cat)
    set nn [question_box .new_unit_name "New unit name" \
		"Enter name for new $unit_names($cat) unit." ""]
    if {$nn == ""} return
    
    lappend unit_choices($cat) $nn
    if ![info exists unit_data($nn)] {
	set unit_data($nn) [list 0 1 0 $cat 1]
    }
    unit_sel_cat
    set unit_edit(cur_unit) $nn
    unit_sel_unit
    $unit_edit(form).unit.list see end
}

proc unit_edit_delete {} {
    global unit_edit unit_default default_object_units unit_data unit_choices
    
    if ![confirm "Delete $unit_edit(cur_cat) unit $unit_edit(cur_unit)?" 1] return
    
    set un $unit_edit(cur_unit)
    set cat $unit_edit(cur_cat)
    set unit_choices($cat) [ldelete $unit_choices($cat) $un]
    if {$unit_default($cat) == $un} {
	set unit_default($cat) [lindex $unit_choices($cat) 0]
    }
    set unit_edit(cur_unit) $unit_default($cat)
    unit_fix_unit_list
    unit_sel_unit
    unset unit_data($un)
    db_dirty model
}

proc model_unitentry {w var unittype tabgeo {activedata ""}
		      {width 8} {unitvar ""} {only_float 0} {extraunits ""}} {
    switch $only_float {
	0 { set datatype "float_expr ambient" }
	1 { set datatype float }
	2 { set datatype "float ambient" }
    }

    if {$tabgeo != ""} { append tabgeo " -sticky w" }
    form_frame $w flat 0 $tabgeo
    form_entry $w.e $var $datatype {0 0 -sticky w -padx 0 -pady 0} $activedata
    $w.e configure -width $width
    grid columnconfigure $w 0 -weight 0

    if {($unitvar == "") && ($var != "")} {
	set basev [lindex [split $var ()] 0]
	set subv [lindex [split $var ()] 1]
	if {$subv == ""} {
	    set unitvar ${basev}_units
	} else {
	    set unitvar ${basev}_units($subv)
	}
    }

    set chs [unit_get_choices $unittype $extraunits]

    if {$chs != ""} {
	if {$var != ""} {
	    lappend activedata [list $var !ambient]
	}

        futil_unitmenu $w.m [list unit_get_choices $unittype $extraunits] \
	    {0 1 -padx 0 -pady 0} $unitvar $activedata
	grid columnconfigure $w 1 -weight 0
    }
    return $w.e
}

proc model_unitentry_change_variable {w var unitvar unittype} {
    global form_entry_var

    $w.e configure -textvariable $var
    $w.m.ent configure -textvariable $unitvar
    set postc "futil_update_unitmenu $w.m \"unit_get_choices $unittype\" \
	$unitvar \"$command\""
    $w.m.menu.m configure -postcommand $postc
    set form_entry_var($w.m) $varname
}

proc model_unitentry_setvar {w unittype unitvar} {
    futil_unitmenu $w.m "unit_get_choices $unittype" "" $unitvar ""
}

proc futil_unitmenu {w choice_func tabdata varname {activedata ""} \
			 {command ""} {before_select ""}} {
    global subtitle_font
    if {$tabdata != ""} {
	if ![string match *sticky* $tabdata] { append tabdata " -fill none" }
	form_frame $w sunken 1 $tabdata
	form_label_variable $w.ent $varname {0 0 -padx 0 -pady 0} $activedata
	form_menubutton $w.menu "" $w.menu.m {0 1 -padx 0 -pady 0 -sticky ns} $activedata
    } else {
	$w.ent configure -textvariable $varname
    }
    if ![winfo exists $w] { return 0 }
    futil_drop_down_button $w.menu #c0ffc0 #a0ffa0
    set postc "$before_select ; futil_update_unitmenu $w \"$choice_func\" \"$varname\" \"$command\""
    bind $w.menu <Button-1> {
	if {[string compare $tkPriv(inMenubutton) ""]} {
	    futil_tkMbPost $tkPriv(inMenubutton)
	}
    }
    bind $w.ent <Button-1> "\
	if {[string compare \$tkPriv(inMenubutton) {}]} {
	    futil_tkMbPost $w.menu
	}"
    bind $w.ent <ButtonRelease-1> "tkMbButtonUp $w.menu"

    if {$tabdata != ""} {
	menu $w.menu.m -tearoff 0 -postcommand $postc
    } else {
	$w.menu.m configure -postcommand $postc
    }

    eval $postc

    if {$varname != ""} {
	global form_entry_var
	form_add_save $varname "futil_unitmenu_get $w" "futil_unitmenu_set $w"
	set form_entry_var($w) $varname
    }
    return 1
}

proc futil_unitmenu_get {w} {
    set v [$w.ent cget -textvariable]
    upvar \#0 $v v1
    return $v1
}

proc futil_unitmenu_set {w val} {
    set v [$w.ent cget -textvariable]
    upvar \#0 $v v1
    set v1 $val
}

proc futil_update_unitmenu {w func varname command} {
    global form_entry_datatype futil_menuentry_disabled model_data
    
    set m $w.menu.m

    $m delete 0 1000
    set choices [eval $func]
    if {$choices == ""} {
	$m add command -label " - none - "
    } else {
	foreach ch $choices {
	    set act normal
	    if [info exists futil_menuentry_disabled($ch)] { set act disabled }
	    
	    $m add command -label $ch -state $act -command \
		[list futil_update_unitmenu_action $varname $ch $command]
	}
    }
}

proc futil_update_unitmenu_action {varname val command} {
    global model_data unitmenu_other_values job_all_fixvals
    
    set oval [uplevel \#0 set $varname]
    uplevel \#0 set $varname [list $val]
    if [info exists unitmenu_other_values($varname)] {
	foreach v $unitmenu_other_values($varname) {
	    uplevel \#0 set $v [list $val]
	}
    }
    if {$command != ""} {
	eval $command \"$varname\" \"$oval\" \"$val\"
    } else {
	if [info exists model_data(fixvals)] {
	    switch $job_all_fixvals {
		all  { set fv 1 }
		none { set fv 0 }
		per  { set fv $model_data(fixvals) }
	    }
	    if $fv { edit_modify_params }
	}
    }
}

proc unit_bubble {w varname} {
    set b .unit_bubble
    if {$varname == ""} {
	catch {destroy $b}
	return
    }
    if [winfo exists $b] return
    
    set px [winfo rootx $w]
    set py [winfo rooty $w]
    set val [uplevel \#0 set $varname]
    toplevel $b
    wm overrideredirect $b 1
    wm transient $b $w
    frame $b.f -borderwidth 2 -relief ridge
    label $b.f.lab -background \#FFFF80 -textvariable $varname
    catch {$b.f.lab configure -cursor "plus orangered"}
    pack $b.f
    pack $b.f.lab
    wm geometry $b +$px+$py
    raise $b
    bind $b <1> {
	unit_bubble $w ""
	futil_tkMbPost $tkPriv(inMenubutton)
    }
    bind $b <Leave> [list unit_bubble $w ""]
}

proc units_curve_convert {curve xunits yunits to_ext num1 num2} {
    set ret ""
    set ntot [llength $curve]
    if {$ntot % ($num1 + $num2)} {
	user_error "The curve does not have an integral number of sets of [expr $num1 + $num2] values"
	return
    }
    set count 0
    while {$count < $ntot} {
	for {set i 0} {$i < $num1} {incr i} {
	    set v [lindex $curve $count]
	    if {$xunits != ""} {
		set v [unit_convert $v $xunits $to_ext]
	    }
	    incr count
	    append ret "$v\t"
	}
	for {set i 0} {$i < $num2} {incr i} {
	    set v [lindex $curve $count]
	    if {$yunits != ""} {
		set v [unit_convert $v $yunits $to_ext]
	    }
	    incr count
	    append ret "$v\t"
	}
	append ret \n
    }

    return $ret
}

# how = si, imp, or def

proc units_convert_object {obj how} {
    global unit_data unit_default_si unit_default_english
    
    foreach val [$obj list_values_with_units] {
	set name [lindex $val 0]
	set value [lindex $val 1]
	set units [lindex $val 2]
	if {($units == "") || ($value == "") || \
		[string match {*$*} $value]} continue

	set sival [unit_convert $value $units 0]
	set newunits [units_get_equivalent $units $how]
	$obj setunits $name $newunits
    }
    foreach shape [db_shapes $obj] {
	foreach {name units} [$shape get_all_units 0] {
	    if {[$shape getexpr $name] != ""} continue
	    set newunits [units_get_equivalent $units $how]
	    $shape setunits $name $newunits
	}
    }
    
    # Force the effects of any round-off from converting the values to Tcl variables
    # and back to happen immediately.
    model_set_current $obj 0 1
    edit_modify_params
}

proc units_get_equivalent {units how} {
    global unit_data unit_default_si unit_default_english unit_default
    
    set utype [lindex [lindex $unit_data($units) 3] 0]
    
    switch $how {
	si  { return $unit_default_si($utype) }
	imp { return $unit_default_english($utype) }
	def { return $unit_default($utype) }
    }
}

proc units_convert_all_objects {how} {
    global unit_data unit_default_si unit_default_english unit_default
    global default_object_units post_units current_object meshing_units
    global snap_grid_units
    
    db_dirty mesh ;# force it to go back to the main routine
    
    set ocur $current_object
    model_set_current ""
    
    busy 1
    set objects [db_list_objects_recursive]
    mess "Converting [llength $objects] objects ...\n"
    foreach obj $objects {
	if {[$obj getval mat_lib_path ""] != ""} continue
	units_convert_object $obj $how
	puts -nonewline . ; flush stdout
    }
    mess "Done\n"
    busy 0
    edit_reset_params
    
    model_set_current ""
    model_set_current $ocur
    
    foreach i {x y z} {
	global edit_move_${i}off_units
	set edit_move_${i}off_units $unit_default(length)
    }
    
    foreach type [array names unit_default] {
	switch $how {
	    si {
		set unit_default($type) $unit_default_si($type)
	    }
	    imp {
		set unit_default($type) $unit_default_english($type)
	    }
	}
    }
    if [info exists post_units] {
	foreach type [array names post_units] {
	    set post_units($type) $unit_default($type)
	}
    }
    
    set meshing_units $unit_default(length)
    foreach i {x y z} {
	global edit_move_${i}off_units
	set edit_move_${i}off_units $unit_default(length)
    }
    
    foreach i {0 1 2} {
	set snap_grid_units(start$i) $unit_default(length)
	set snap_grid_units(end$i) $unit_default(length)
	set snap_grid_units(incr$i) $unit_default(length)
    }
    
    unit_fix_unit_list
    catch {unset default_object_units}
    unit_update_shape_length_scale
    
    # to update the unit type for the problem data
    convert_all_problem_units $how
    
    set cmd [info command app_convert_all_units]
    if {$cmd != ""} {
	eval $cmd
    }
    db_dirty mesh
}

proc convert_all_problem_units {how} {
    global problem_params
    
    foreach name $problem_params {
	global problem_$name problem_${name}_units
	
	if ![info exists problem_${name}_units] continue
	
	if [array exists problem_$name] {
	    foreach ind [array names problem_$name] {
		if ![info exists problem_${name}_units($ind)] continue
		set sival [unit_convert [set problem_${name}($ind)] \
			       [set problem_${name}_units($ind)] 0]
		set nunit [units_get_equivalent [set problem_${name}_units($ind)] $how]
		set problem_${name}_units($ind) $nunit
		set problem_${name}($ind) [unit_convert $sival $nunit 1]
	    }
	} else {
	    set sival [unit_convert [set problem_$name] [set problem_${name}_units] 0]
	    set nunit [units_get_equivalent [set problem_${name}_units] $how]
	    set problem_${name}_units $nunit
	    set problem_$name [unit_convert $sival $nunit 1]
	}
    }
}
