
# This code is shared by all the ICEM CFD GUI's.
#
# Copyright (c) 1993 - 1995 Pacific Marketing and Consulting, Inc,
#       and ICEM Systems, GmbH.  All rights reserved.
# Author:  Wayne A. Christopher, wayne@icemcfd.com

proc futil_drop_down_button {but back activeback} {
    global drop_down_arrow subtitle_font guibase_dir form_bw

    if [info exists drop_down_arrow] {
	$but configure -bitmap @$guibase_dir/dropdown.xbm \
	    -relief raised -borderwidth 1
    } else {
	$but configure -background #c0ffc0 -activebackground #a0ffa0 \
            -relief raised -borderwidth $form_bw -font $subtitle_font
    }
}

proc futil_listnoentry {w var choice_func tabgeo {act ""} {setcmd ""} \
                  {allow_others 0} {with_text ""} {multi_select 0}} {
    global input_background form_entry_datatype

    if $allow_others {
        set data_type choice_others
    } else {
        set data_type choice
    }
    set cmd "futil_post_choicelist $w \{$data_type\} \{$choice_func\} 1"
    if {$with_text == ""} {set with_text "    "}
    form_menubutton ${w}_menu $with_text "" "$tabgeo -fill none" $act
    futil_drop_down_button ${w}_menu #c0ffc0 #a0ffa0
    bind ${w}_menu <ButtonPress-1> $cmd
    bind ${w}_menu <ButtonRelease-1> break

    futil_choicelist_part2 $w $setcmd "" $var $multi_select
}

proc futil_choicelist {w data_type choice_func tabdata {activedata ""} {setcmd ""} {transcmd ""} {labels 0} {postcmd ""} {edit 1}} {
    global subtitle_font input_background form_entry_datatype

    set cmd "futil_post_choicelist $w \{$data_type\} \{$choice_func\} 0 $labels \{$postcmd\}"
    form_menubutton ${w}_menu "    " "" "$tabdata -fill none" $activedata
    futil_drop_down_button ${w}_menu #c0ffc0 #a0ffa0
    bind ${w}_menu <ButtonPress-1> $cmd
    bind ${w}_menu <ButtonRelease-1> break

    set form_entry_datatype($w) "$data_type [eval $choice_func]"

    futil_choicelist_part2 $w $setcmd $transcmd "" 0 $labels

    if {!$edit} {
	$w configure -state disabled -cursor {}
	bind $w <ButtonPress-1> $cmd
        bind $w <ButtonRelease-1> break
    }
}

proc futil_choicelist_part2 {w setcmd transcmd {ent_varName ""} \
				 {multi_select 0} {labels 0}} {
    global subtitle_font input_background form_entry_datatype form_bw
    global toplevel_others

    set m ${w}_menu.m
    if 1 {
	toplevel $m
	wm overrideredirect $m 1
	wm withdraw $m
	set toplevel_others($m) 1
    } else {
	top_transient $m "" 0
    }
    set_cursor $m "left_ptr OrangeRed"

    listbox $m.list -relief raised -borderwidth 1 -yscroll "$m.scroll set" \
	-exportselection 0 -width 12 -height 10 -bg [$m cget -bg] \
	-selectbackground #ececec -selectforeground black
    scrollbar $m.scroll -command "$m.list yview"

    if $multi_select {
	frame $m.bot
	button $m.bot.all  -text All -command "futil_menu_select_cmd \
                    $w all 0 \{$setcmd\} \{$transcmd\} $ent_varName"
	button $m.bot.cancel -text Cancel -command "wm withdraw $m"
	pack $m.bot.all $m.bot.cancel -side left -fill both
	pack $m.bot -side bottom -fill both
    } else {
	#button $m.cancel -text Cancel -command "wm withdraw $m"
    }

    bind ${w}_menu <Unmap> "catch \"wm withdraw $m\""

    if $multi_select {
	bind $m.list <ButtonPress-1> "futil_menu_select_cmd \
                     $w -1 %y \{$setcmd\} \{$transcmd\} $ent_varName"
	bind $m.list <ButtonRelease-1> "futil_menu_select_cmd \
                     $w 1 %y \{$setcmd\} \{$transcmd\} $ent_varName"
	bind $m.list <Button1-Motion> "futil_menu_select_cmd \
                     $w 0 %y \{$setcmd\} \{$transcmd\} $ent_varName"
    } else {
	bind $m.list <ButtonPress-1> \
	    "futil_menu_select_one $w %y \{$setcmd\} \{$transcmd\} $ent_varName"
	# This makes it act like a menu
	bind $m.list <ButtonRelease-1> \
	    "futil_menu_select_one $w %y \{$setcmd\} \{$transcmd\} $ent_varName"
	bind $m.list <Any-Motion> "futil_menu_move_on_one %W %y"
	bind $m <Button> "futil_menu_release_if_not %X %Y $m"
    }

    return 1
}

proc futil_menu_release_if_not {x y m} {
    set con [winfo containing $x $y]
    if ![string match $m* $con] {
	grab release $m
	wm withdraw $m
    }
}

proc futil_menu_move_on_one {w y} {
    global futil_menuentry_disabled

    set pos [$w nearest $y]
    set ch [$w get $pos]
    if [info exists futil_menuentry_disabled($ch)] return

    $w selection clear 0 end
    $w selection set $pos
}

proc futil_menu_select_cmd {w mode y setcmd transcmd {ent_varName ""}} {
    global futil_choicelist_posted futil_menu_prev_value
    global futil_menuentry_disabled futil_menu_prev_y

    set m ${w}_menu.m
    if {$mode == "all"} {
	set ch [$m.list get 0 end]
    } elseif {$mode < 0} {
	$m.list selection clear 0 end
	set futil_menu_prev_y $y
	return
    } elseif {$mode == 0} {
	if {![info exist futil_menu_prev_y]} {set futil_menu_prev_y y}
	$m.list selection set [$m.list nearest $futil_menu_prev_y] \
	    [$m.list nearest $y]
	return
    } else {
	if {![info exist futil_menu_prev_y]} {set futil_menu_prev_y y}
	if {$futil_menu_prev_y > $y} {
	    set y1 $y; set y $futil_menu_prev_y; set futil_menu_prev_y $y1
	}
	set ch [$m.list get [$m.list nearest $futil_menu_prev_y] \
		    [$m.list nearest $y]]
	unset futil_menu_prev_y
    }

    if [info exists futil_menuentry_disabled($ch)] return

    if {$ent_varName == ""} {
        set cur [$w get]
        set futil_menu_prev_value $cur
        if {$transcmd != ""} {
            set ch [eval [concat $transcmd [list $ch $cur]]]
        }
        if {$ch != ""} { form_entry_set $w $ch }
    } else {
	uplevel \#0 [list set $ent_varName $ch]
	# This version does not call the traces with the right var names:
        #upvar #0 $ent_varName var
        #set var $ch
    }
    wm withdraw $m
    catch {unset futil_choicelist_posted}
    if {($ch != "") && ($setcmd != "")} { uplevel \#0 eval $setcmd }
}

proc futil_menu_select_one {w y setcmd transcmd {ent_varName ""}} {
    global futil_choicelist_posted futil_menu_prev_value
    global futil_menuentry_disabled menuentry_run_cmd

    #puts [list futil_menu_select_one $w $y $setcmd $transcmd $ent_varName]
    
    set m ${w}_menu.m
    if ![winfo ismapped $m] return

    set ch [$m.list get [$m.list nearest $y]]
    if [info exists futil_menuentry_disabled($ch)] return

    grab release $m
    wm withdraw $m
    catch {unset futil_choicelist_posted}
    
    if {$ent_varName == ""} {
	set cur [$w get]
	set futil_menu_prev_value $cur
	if [info exists menuentry_run_cmd($m.list,$ch)] {
	    uplevel \#0 $menuentry_run_cmd($m.list,$ch)
	    set ch ""
	} elseif {$transcmd != ""} {
	    set ch [eval [concat $transcmd [list $ch $cur]]]
	}
	if {$ch != ""} { form_entry_set $w $ch }
    } else {
	upvar #0 $ent_varName var
	set var $ch
    }
    if {($ch != "") && ($setcmd != "")} { uplevel \#0 eval $setcmd }
}

proc futil_post_choicelist {w type func {no_ent 0} {labels 0} {postcmd ""}} {
    global form_entry_datatype futil_menuentry_disabled futil_choicelist_posted
    global form_also_withdraw toplevel

    if {[lindex [${w}_menu configure -state] 4] == "disabled"} return

    if {[info exists futil_choicelist_posted] && \
	    [winfo exists $futil_choicelist_posted]} {
	top_withdraw $futil_choicelist_posted
    }

    if {$postcmd != ""} { uplevel \#0 $postcmd }

    set m ${w}_menu.m
    set futil_choicelist_posted $m

    $m.list delete 0 end
    set choices [eval $func]
    set width 10
    foreach ch $choices {
	if $labels { set ch [lindex $ch 1] }
	set n [$m.list index end]
	$m.list insert end $ch
	if [info exists futil_menuentry_disabled($ch)] {
	    $m.list itemconfigure $n -foreground gray
	}
	set cl [string length $ch]
	if {$cl > $width} { set width $cl }
    }
    incr width 2
    set nch [llength $choices]
    set height $nch
    if {$nch > $height} { set height $nch }
    if {$height > 8} { set height 8 }
    $m.list configure -width $width -height $height
    $m.list selection clear 0 end
    $m.list selection set 0
    set form_entry_datatype($w) "$type $choices"

    foreach c [winfo children $m] { pack unpack $c }
    if {$nch <= 8} {
	pack $m.list -side left -fill both
    } else {
	if [winfo exists $m.cancel] {
	    pack $m.cancel -side bottom -fill both
	}
	pack $m.list -side left -fill both
	pack $m.scroll -side left -fill both
    }
    # This is necessary for obscure reasons.
    if 1 {
	wm geometry $m +5000+5000
	wm deiconify $m
	update idle
    } else {
	top_geometry $m +5000+5000
	top_deiconify $m
	update idle
    }

    set x [expr [winfo rootx ${w}_menu] - [winfo width $m] + [winfo width ${w}_menu]]
    set y [expr [winfo rooty ${w}_menu] + [winfo height ${w}_menu]]
    if {[info exists toplevel(single)] && $toplevel(single)} {
	# Prevent the menu from going below the bottom of the . window
	set screenw [expr [winfo rootx .] + [winfo width .]]
	set screenh [expr [winfo rooty .] + [winfo height .]]
    } else {
	set screenw [winfo screenwidth $m]
	set screenh [winfo screenheight $m]
    }
    set xoff [expr {$screenw - $x - [winfo width $m]}]
    set yoff [expr {$screenh - $y - [winfo height $m]}]
    if {$xoff < 0} { incr x $xoff }
    if {$yoff < 0} { incr y $yoff }
    if 1 {
	wm geometry $m +$x+$y
    } else {
	top_geometry $m +$x+$y
    }
    update idle
    raise $m
    grab $m

    if !$no_ent {
       for {set ww $w} {[winfo parent $ww] != "."} \
                       {set ww [winfo parent $ww]} {}
       lappend form_also_withdraw($ww) $m
    }
}

proc futil_listentry {w var choice_func tabgeo {act ""}
		      {setcmd ""} {allow_others 0}} {
    global drop_down_arrow
    if $allow_others {
	set choice_opt choice_others
    } else {
	set choice_opt choice
    }
    if [info exists drop_down_arrow] {
	form_frame $w sunken 2 "$tabgeo"
	form_entry $w.e $var "$choice_opt [eval $choice_func]" \
	    {0 0 -padx 0 -pady 0 -sticky news} $act
	$w.e configure -relief flat -borderwidth 0
	futil_choicelist $w.e $choice_opt $choice_func {0 1 -padx 0 -pady 0 -sticky news} \
	    $act $setcmd
	return $w.e
    } else {
	set r [lindex $tabgeo 0]; set c [lindex $tabgeo 1]
	set cols 1; set anch w; set rows 1
	for {set i 2} {$i < [llength $tabgeo]} {incr i} {
	    switch -- [lindex $tabgeo $i] {
		-cols   { set cols [lindex $tabgeo [expr {$i + 1}]] }
		-rows   { set rows [lindex $tabgeo [expr {$i + 1}]] }
		-anchor { set anch [lindex $tabgeo [expr {$i + 1}]] }
	    }
	}
	form_entry $w $var "$choice_opt [eval $choice_func]" $tabgeo $act
	incr c $cols
	futil_choicelist $w $choice_opt $choice_func \
	    "$r $c -rows $rows -anchor $anch" $act $setcmd
	return $w
    }
}

proc futil_tkMbPost {w} {
    global tk_version
    if {$tk_version >= 8.4} {
	tk::MbPost $w %X %Y
    } else {
        if {[catch {tkMbPost $w %X %Y 1}]} {
	    tkMbPost $w %X %Y
        }
    }
}

proc futil_choicemenu {w data_type choice_func tabdata \
              {activedata ""} {setcmd ""} {tearoff 0}} {
    global subtitle_font

    form_menubutton ${w}_menu "    " ${w}_menu.m \
                          "$tabdata -fill none" $activedata
    futil_drop_down_button ${w}_menu #c0c0ff #a0a0ff

    set postc "futil_update_choicemenu $w $data_type \"$choice_func\" \"$setcmd\""

    menu ${w}_menu.m -tearoff $tearoff -postcommand $postc
    bind ${w}_menu <Button-1> {
	if {[string compare $tk::Priv(inMenubutton) ""]} {
	    futil_tkMbPost $tk::Priv(inMenubutton)
	}
    }
    eval $postc
    return 1
}

proc futil_update_choicemenu {w type func setcmd} {
    global form_entry_datatype futil_menuentry_disabled

    set m ${w}_menu.m

    set var [$w cget -textvariable]
    $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 \
		"set \{$var\} \{$ch\}; $setcmd"
	}
    }
    set form_entry_datatype($w) "$type $choices"
}

proc futil_menuentry {w var choice_func tabgeo \
			  {act ""} {setcmd ""} {tearoff 0} {width 8}} {
    global drop_down_arrow
    if [info exists drop_down_arrow] {
	form_frame $w sunken 2 "$tabgeo"
	form_entry $w.e $var "choice [eval $choice_func]" \
                        {0 0 -padx 0 -pady 0 -sticky news} $act $width
	$w.e configure -relief flat -borderwidth 0
	futil_choicemenu $w.e choice $choice_func \
                 {0 1 -padx 0 -pady 0 -sticky news} $act $setcmd $tearoff
	return $w.e
    } else {
	set r [lindex $tabgeo 0]; set c [lindex $tabgeo 1]
	set cols 1; set anch w; set rows 1
	for {set i 2} {$i < [llength $tabgeo]} {incr i} {
	    switch -- [lindex $tabgeo $i] {
		-cols   { set cols [lindex $tabgeo [expr {$i + 1}]] }
		-rows   { set rows [lindex $tabgeo [expr {$i + 1}]] }
		-anchor { set anch [lindex $tabgeo [expr {$i + 1}]] }
	    }
	}
	form_entry $w $var "choice [eval $choice_func]" $tabgeo $act
	incr c $cols
	futil_choicemenu $w choice $choice_func \
	    "$r $c -rows $rows -anchor $anch" $act $setcmd $tearoff
	return $w
    }
}

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

if 1 {
proc try {} {
    global test_var
    set test_var 3
    form_kill .foo
    set d [form_init .foo XX]
    futil_menuentry_labels $d.ml test_var try_func {0 0} "" "puts \$test_var"
    form_finish +100+100
}

proc try_func {} {
    return {
	{ 1 One }
	{ 2 Two }
	{ 3 Three }
	{ 4 Four }
	{ 5 Five }
	{ 6 Six }
	{ 7 Seven }
	{ 8 Eight }
    }
}
}

# The choice_func should return pairs of { value name }

proc futil_menuentry_labels {w var choice_func tabgeo {act ""} {setcmd ""}
			     {width ""} {edit 0}} {
    global menuentry_label menuentry_label_choice_func form_entry_datatype
    global form_traces_toplevel form_entry_never_active

    set choices choice
    foreach ch [eval $choice_func] { lappend choices [lindex $ch 0] }

    form_frame $w sunken 2 "$tabgeo"
    form_entry $w.e menuentry_label($var) $choices {0 0 -padx 0 -pady 0 -sticky news} $act 8 "" $var
    set form_entry_never_active($w.e) 1
    $w.e configure -relief flat -borderwidth 0 -state disabled
    if {$width != ""} { $w.e configure -width $width }
    set form_entry_datatype($w.e) nocheck
    set menuentry_label_choice_func($var) $choice_func

    if 1 { # {[llength $choices] > 32}
        set postc [list futil_update_choicemenu_labels $w $var $choice_func $setcmd]
	set setcmd [list futil_menuentry_labels_list_set $var \{$setcmd\}]
	futil_choicelist $w.e nocheck $choice_func {0 1 -padx 0 -pady 0 -sticky ns} $act $setcmd "" 1 $postc $edit
    } else {
	form_menubutton $w.m "" $w.m.m {0 1 -padx 0 -pady 0 -sticky ns} $act
	futil_drop_down_button $w.m #c0c0ff #a0a0ff
        set postc [list futil_update_choicemenu_labels $w $var $choice_func $setcmd]

	menu $w.m.m -tearoff 0 -postcommand $postc
	bind $w.m <Button-1> {
	    if {[string compare $tk::Priv(inMenubutton) ""]} {
		futil_tkMbPost $tk::Priv(inMenubutton)
	    }
	}
	if !$edit {
	    $w.e configure -state disabled -cursor {}
	    bind $w.e <Button-1> "
            if {[string compare \$tk::Priv(inMenubutton) {}]} {
                futil_tkMbPost $w.m
            }
        "
	    bind $w.e <ButtonRelease-1> "tk::MbButtonUp $w.m"
	}
    }

    eval $postc

    upvar \#0 $var lvar
    if ![info exists lvar] { set lvar "" }

    set got 0
    foreach vt [trace vinfo lvar] {
	if {$vt == [list w "futil_update_choicemenu_text $var; list"]} {
	    set got 1
	    break
	}
    }
    if !$got {
	set trace "futil_update_choicemenu_text $var; list"
	trace variable lvar w $trace
	set top .[lindex [split $w .] 1]
	lappend form_traces_toplevel($top) [list $var $trace]
    }
    set lvar [set lvar]
    return $w.e
}

proc futil_menuentry_labels_list_set {var setcmd} {
    global menuentry_label menuentry_label_choice_func

    #upvar $var lvar

    set val $menuentry_label($var)
    foreach ch [eval $menuentry_label_choice_func($var)] {
	if {$val == [lindex $ch 1]} {
	    uplevel \#0 [list set $var [lindex $ch 0]]
	    # This version does not call the traces with the right var names:
	    #set lvar [lindex $ch 0]
	    if [catch {uplevel \#0 $setcmd} res] {
		user_error $res
	    }
	}
    }
}

proc futil_update_choicemenu_labels {w var func setcmd} {
    global futil_menuentry_disabled menuentry_label
    global menuentry_label_choices menuentry_run_cmd

    upvar $var lvar
    if [info exists lvar] {
	set val $lvar
    } else {
	set val ""
    }

    set choices [eval $func]
    set menuentry_label_choices($var) $choices

    set m $w.m.m
    set mtop $w.m.m
    set listb 0
    if ![winfo exists $m] {
	set m $w.e_menu.m.list
	set mtop $w.e_menu.m
	set listb 1
	if ![winfo exists $m] {
	    return
	}
    }
    wm geometry $mtop +5000+5000; update idle
    $m delete 0 1000
    set vals choice
    if {$choices == ""} {
	if $listb {
	    $m insert end " - none - "
	} else {
	    $m add command -label " - none - "
	}
    } else {
	foreach choice $choices {
	    set ch [lindex $choice 0]
	    set name [lindex $choice 1]
	    if {$name == ""} { set name $ch }
	    set act normal
	    if [info exists futil_menuentry_disabled($ch)] { set act disabled }
	    
	    set cmd "set $var \"$ch\" \; $setcmd"
	    if $listb {
		$m insert end $name
		if {$act == "disabled"} {
		    $m itemconfigure end -foreground gray
		}
		set menuentry_run_cmd($m,$name) $cmd
	    } else {
		$m add command -label $name -state $act -command $cmd
	    }
	}
    }
}

proc futil_update_choicemenu_text {var} {
    global menuentry_label menuentry_label_choices menuentry_label_choice_func

    if ![info exists menuentry_label_choices($var)] return
    upvar \#0 $var lvar
    set val $lvar
    set opts $menuentry_label_choice_func($var)

    if [catch {eval $opts} choices] {
	global errorInfo
	puts "ERROR in futil_update_choicemenu_text: $choices"
	puts $errorInfo
	set choices ""
    }
#    puts "$choices"
    if {$choices == ""} {
	set menuentry_label($var) ""
    } else {
	foreach ch $choices {
	    if {$val == [lindex $ch 0]} {
		set menuentry_label($var) [lindex $ch 1]
		return
	    }
	}
#	puts "looking for $val in $choices (eval $opts) : var is $var"
	set menuentry_label($var) ""
    }
}

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

proc futil_get_file {{msg ""} {dir .} {def ""} {pats *} {geo ""} \
			 {extra_buts ""}} {
    global fileselect_name fileselect_dir fileselect_pats fileselect_same_dir

    if {$msg == ""} { set msg "Please select a file." }
    if {$geo == ""} { set geo +500+500 }

    form_kill .file_selection

    set d [form_init .file_selection "File selection" "" "done cancel"]

    form_label $d.msg $msg {0 0}
    form_entry $d.file fileselect_name string {1 0 -padx 2 -pady 2}
    form_listbox $d.list "" "" futil_fileselect_select \
	futil_fileselect_select2 10x10 {2 0}
    form_label $d.curdir "" {3 0}
    $d.curdir configure -anchor e -textvariable fileselect_dir -width 20

    set here [pwd]; cd $dir; set fileselect_dir [pwd]; cd $here
    set start_dir $fileselect_dir
    set fileselect_name $def
    set fileselect_pats $pats
    set fileselect_same_dir 0
    futil_fileselect_populate

    if {$extra_buts != ""} {
	form_frame $d.extra flat 0 {4 0}
	eval $extra_buts $d.extra
    }

    form_finish $geo

    if ![form_wait .file_selection] { return "" }

    if {[string index $fileselect_name 0] == "/"} {
	return $fileselect_name
    } else {
	return $fileselect_dir/$fileselect_name
    }
}

proc futil_fileentry {w var directory tabgeo {act ""} {pats *}
		      {same_dir 0} {after_cmd ""}} {
    set r [lindex $tabgeo 0]; set c [lindex $tabgeo 1]
    set cols 1; set anch w; set rows 1
    for {set i 2} {$i < [llength $tabgeo]} {incr i} {
	case [lindex $tabgeo $i] in {
	    -cols   { set cols [lindex $tabgeo [expr {$i + 1}]] }
	    -rows   { set rows [lindex $tabgeo [expr {$i + 1}]] }
	    -anchor { set anch [lindex $tabgeo [expr {$i + 1}]] }
	}
    }
    form_entry $w $var string $tabgeo $act
    $w configure -justify right
    $w xview end
    incr c $cols
    futil_filemenu $w $var $directory \
	"$r $c -rows $rows -anchor $anch" $act $pats $same_dir $after_cmd
}

proc futil_filemenu {w var dir tabdata {activedata ""} {pats *}
		     {same_dir 0} {after_cmd ""}} {
    global subtitle_font input_background form_entry_datatype

    form_menubutton ${w}_menu "    " "" "$tabdata -fill none" $activedata
    futil_drop_down_button ${w}_menu #ffc0c0  #ffa0a0
    
    set cmd "futil_fileselect ${w}_menu $w {Select file name:} \
	\{$dir\} $var \{$pats\} $same_dir \{$after_cmd\}"
    bind ${w}_menu <ButtonPress-1> $cmd
    bind ${w}_menu <ButtonRelease-1> break

    #bind ${w} <Return> $cmd
    
    return 1
}

proc unused__futil_fileselect {but ent msg dir var {pats *} {same_dir 0}
		       {after_cmd ""}} {
    global fileselect_dir fileselect_name fileselect_pats fileselect_same_dir
    
    set fileselect_pats $pats
    set def [uplevel \#0 set $var]
    if {$def == ""} { set def $dir }
    if {[file pathtype $def] == "relative"} {
	set def [file join [pwd] $def]
    }
    
    set file [file_select $msg $def "File selection" 0 0 futil_fileselect_ok]
    if {$file == ""} return
    
    uplevel \#0 set $var $file
    if {$after_cmd != ""} {
	uplevel \#0 $after_cmd
    }
    $ent xview end
}

proc futil_fileselect_ok {dir} {
    global fileselect_pats
    foreach p $fileselect_pats {
	if [string match $p $dir] { return 1 }
    }
    return 0
}

proc futil_fileselect {but ent msg dir var {pats *} {same_dir 0}
		       {after_cmd ""}} {
    global fileselect_dir fileselect_name fileselect_pats fileselect_same_dir
    
    set geo +[winfo rootx $but]+[winfo rooty $but]
    
    form_kill .file_selection
    
    set d [form_init .file_selection "File selection" "" "done cancel"]
    
    form_label $d.msg $msg {0 0}
    form_entry $d.file fileselect_name string {1 0 -padx 2 -pady 2}
    form_listbox $d.list "" "" futil_fileselect_select \
	futil_fileselect_select2 10x10 {2 0}
    form_label $d.curdir "" {3 0}
    $d.curdir configure -anchor e -textvariable fileselect_dir -width 20
    
    set here [pwd]
    catch {cd [uplevel \#0 subst $dir]}
    set fileselect_dir [pwd]; cd $here
    set start_dir $fileselect_dir
    if [catch {set fileselect_name [uplevel \#0 set $var]}] {
       set fileselect_name $here
    }
    set fileselect_pats $pats
    set fileselect_same_dir $same_dir
    futil_fileselect_populate
    
    form_finish $geo
    
    if ![form_wait .file_selection] return

    if {$fileselect_dir == $here} {
	$ent configure -justify left
	uplevel \#0 set $var $fileselect_name
    } elseif $same_dir {
	uplevel \#0 set $var $fileselect_name
    } elseif {[string match $here* $fileselect_dir]} {
	$ent configure -justify left
	set lst [string length $here]
	set fdir [string range $fileselect_dir $lst end]
	while {[string index $fdir 0] == "/"} {
	    set fdir [string range $fdir 1 end]
	}
	uplevel \#0 set $var $fdir/$fileselect_name
    } else {
	$ent configure -justify right
	uplevel \#0 set $var $fileselect_dir/$fileselect_name
    }
    if {$after_cmd != ""} {
	uplevel \#0 $after_cmd
    }
    if {[string index $dir 0] == "\$"} {
	uplevel \#0 set [string range $dir 1 end] $fileselect_dir
    }
}

proc futil_fileselect_select {name} {
    global fileselect_name
    
    set fileselect_name $name
}

proc futil_fileselect_select2 {name} {
    global fileselect_name fileselect_dir fileselect_same_dir
    
    set ff $fileselect_dir/$fileselect_name
    if {[file isdirectory $ff] && !$fileselect_same_dir} {
	set here [pwd]; cd $ff; set fileselect_dir [pwd]; cd $here
	set fileselect_name ""
	futil_fileselect_populate
    } else {
	set fileselect_name [string trimright $name " /"]
	form_accept_hack .file_selection
    }
}

proc futil_fileselect_populate {} {
    global fileselect_dir fileselect_pats fileselect_same_dir
    
    set w .file_selection.main.list.list
    
    $w delete 0 end
    if !$fileselect_same_dir { $w insert end .. }
    if {$fileselect_dir == "/"} {  # Tcl7.5 doesn't like //foo
	set ffs /*
    } else {
	set ffs $fileselect_dir/*
    }
    set dirs ""
    set files ""
    foreach f [lsort [glob -nocomplain $ffs]] {
	set ff [file tail $f]
	if [string match .* $ff] continue
	if [file isdirectory $f] {
	    lappend dirs $ff/
	} else {
	    foreach p $fileselect_pats {
		if [string match $p $ff] {
		    lappend files $ff
		    break
		}
	    }
	}
    }
    foreach f $files { $w insert end $f }
    foreach f $dirs { $w insert end $f }
}

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

proc futil_start_end_box {d title vars prefix tabdata {activedata ""}} {
    frame $d
    
    if {$title != ""} {
	form_label $d.title $title {1 1 -cols -} $activedata
    }
    form_label $d.sl Start {2 2} $activedata
    form_label $d.el End {2 5} $activedata
    set row 2
    foreach v $vars {
	form_label $d.${v}sl ${v}S "$row 3" $activedata
	form_label $d.${v}el ${v}E "$row 6" $activedata
	form_entry $d.${v}s ${prefix}_${v}s float "$row 4" $activedata
	form_entry $d.${v}e ${prefix}_${v}e float "$row 7" $activedata
	incr row
    }
    form_dotab $d $tabdata news
}

proc futil_threecomps {d title prefix tabdata {activedata ""}} {
    frame $d
    
    form_label $d.title $title {1 1} $activedata
    form_label $d.xl X {1 2} $activedata
    form_entry $d.x  ${prefix}x {float {}} {1 3} $activedata
    form_colwidth $d 4 20
    form_label $d.yl Y {1 5} $activedata
    form_entry $d.y  ${prefix}y {float {}} {1 6} $activedata
    form_colwidth $d 7 20
    form_label $d.zl Z {1 8} $activedata
    form_entry $d.z  ${prefix}z {float {}} {1 9} $activedata
    form_dotab $d $tabdata news
}

proc futil_radiobuttons {d title options var tabdata {activedata ""}} {
    frame $d
    
    if {$title != ""} {
	form_label $d.title $title {1 1} $activedata
    }
    set col 2
    foreach opt $options {
	set name [lindex $opt 0]
	set value [lindex $opt 1]
	form_radiobutton $d.opt_$value $name $var $value "1 $col" $activedata
	incr col
    }
    form_dotab $d $tabdata nw
}

proc futil_quad_geo {d type tabgeo {prefix ""}} {
    frame $d

    if {$prefix == ""} {set prefix temp_${type}}
    
    futil_radiobuttons $d.plane Location: \
	{{{X-Y plane} xy} {{Y-Z plane} yz} {{X-Z plane} xz}} \
	${prefix}_plane {1 1 -cols -}
    form_colwidth $d 1 50
    
    # -----------------
    frame $d.loc
    
    form_label $d.loc.sl Start {2 2}
    form_label $d.loc.el End {2 5}
    form_label $d.loc.xsl xS "2 3"
    form_label $d.loc.xel xE "2 6" [list "${prefix}_plane xy xz"]
    form_entry $d.loc.xs ${prefix}_xs float "2 4"
    form_entry $d.loc.xe ${prefix}_xe float "2 7" [list "${prefix}_plane xy xz"]
    form_label $d.loc.ysl yS "3 3"
    form_label $d.loc.yel yE "3 6" [list "${prefix}_plane xy yz"]
    form_entry $d.loc.ys ${prefix}_ys float "3 4"
    form_entry $d.loc.ye ${prefix}_ye float "3 7" [list "${prefix}_plane xy yz"]
    form_label $d.loc.zsl zS "4 3"
    form_label $d.loc.zel zE "4 6" [list "${prefix}_plane xz yz"]
    form_entry $d.loc.zs ${prefix}_zs float "4 4"
    form_entry $d.loc.ze ${prefix}_ze float "4 7" [list "${prefix}_plane xz yz"]
    form_dotab $d.loc {2 2 -cols -} nw
    # -----------------
    
    form_rowheight $d 3 10
    
    if {$tabgeo != ""} {form_dotab $d $tabgeo news}
}

proc futil_prism_geo {d type tabgeo {prefix ""}} {
    frame $d
    
    if {$prefix == ""} {set prefix temp_${type}}
    
    form_label $d.label Location: {1 1 -cols -}
    form_colwidth $d 1 50
    futil_start_end_box $d.loc "" {x y z} $prefix {2 2 -cols - -anchor w -fill none}
    form_rowheight $d 3 10
    
    if {$tabgeo != ""} {form_dotab $d $tabgeo news}
}

proc futil_incline_geo {d type tabgeo {prefix ""}} {
    frame $d

    if {$prefix == ""} {set prefix temp_${type}}
    
    futil_radiobuttons $d.plane Location: \
	{{{X axis} x} {{Y axis} y} {{Z axis} z}} \
	${prefix}_axis {1 1 -cols -}
    form_colwidth $d 1 50
    futil_start_end_box $d.loc "" {x y z} $prefix {2 2 -cols - -anchor w -fill none}
    futil_radiobuttons $d.orient Orientation: {{Positive 1} {Negative -1}} \
	${prefix}_rotate_sign {3 1 -cols -}
    form_rowheight $d 4 10
    
    if {$tabgeo != ""} {form_dotab $d $tabgeo news}
}

proc futil_cyl_geo {d type tabgeo use_irad use_height {prefix ""}} {
    frame $d
    
    if {$prefix == ""} {set prefix temp_${type}}
    
    futil_radiobuttons $d.plane Location: \
	{{{X-Y plane} xy} {{Y-Z plane} yz} {{X-Z plane} xz}} \
	${prefix}_plane {1 1 -cols -}
    
    form_label $d.clabel "Center:" {2 1}
    form_label $d.cxl xC {2 2}
    form_entry $d.cx ${prefix}_xc float {2 3}
    form_label $d.cyl yC {3 2}
    form_entry $d.cy ${prefix}_yc float {3 3}
    form_label $d.czl zC {4 2}
    form_entry $d.cz ${prefix}_zc float {4 3}

    if $use_irad {
	form_label $d.radl "Outer radius" {2 4}
	form_entry $d.rad ${prefix}_radius float {2 5}
	form_label $d.iradl "Inner radius" {3 4}
	form_entry $d.irad ${prefix}_iradius float {3 5}
	
    } else {
	form_label $d.radl Radius {2 4}
	form_entry $d.rad ${prefix}_radius float {2 5}
    }
    if $use_height {
	form_label $d.heightl Height {4 4}
	form_entry $d.height ${prefix}_height float {4 5}
    }
    
    form_rowheight $d 5 10
    
    if {$tabgeo != ""} {form_dotab $d $tabgeo news}
}

proc futil_tri_geo {d type tabgeo} {
    frame $d
    
    futil_radiobuttons $d.plane Location: \
	{{{X-Y plane} xy} {{Y-Z plane} yz} {{X-Z plane} xz}} \
	temp_${type}_plane {1 1 -cols -}
    
    form_colwidth $d 1 50
    form_label $d.x1l x1 {2 2}
    form_label $d.y1l y1 {3 2}
    form_label $d.z1l z1 {4 2}
    form_label $d.x2l x2 {2 4}
    form_label $d.y2l y2 {3 4}
    form_label $d.z2l z2 {4 4}
    form_label $d.x3l x3 {2 6}
    form_label $d.y3l y3 {3 6}
    form_label $d.z3l z3 {4 6}
    form_entry $d.x1 temp_${type}_x1 float {2 3}
    form_entry $d.y1 temp_${type}_y1 float {3 3}
    form_entry $d.z1 temp_${type}_z1 float {4 3}
    form_entry $d.x2 temp_${type}_x2 float {2 5}
    form_entry $d.y2 temp_${type}_y2 float {3 5}
    form_entry $d.z2 temp_${type}_z2 float {4 5}
    form_entry $d.x3 temp_${type}_x3 float {2 7}
    form_entry $d.y3 temp_${type}_y3 float {3 7}
    form_entry $d.z3 temp_${type}_z3 float {4 7}
    
    form_label $d.heightl Height {5 2}
    form_entry $d.height temp_${type}_height float {5 3}
    
    form_rowheight $d 6 10
    
    if {$tabgeo != ""} {form_dotab $d $tabgeo news}
}

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

proc futil_setup_switch {frame varname {opts ""} {cmds ""} {change_size 0}} {
    global has_blt
    global [lindex [split $varname \(] 0]

    update idle
    
    set fwidth 0; set fheight 0
    foreach f [winfo children $frame] {
	set width [winfo reqwidth $f]
	set height [winfo reqheight $f]
	if {$fwidth < $width} {set fwidth $width}
	if {$fheight < $height} {set fheight $height}
	
	if $has_blt {
	    catch {blt_table forget $f}
	} else {
	    grid forget $f
	}
    }
    if {$change_size != 2} {
	incr fwidth 4; incr fheight 4
	$frame configure -width $fwidth -height $fheight
	if ![catch {lindex [split [lindex [blt_table info $frame] 1] ,] 0} row] {
	    if $has_blt {
		blt_table_row [winfo parent $frame] configure $row \
		    -height $fheight -resize none
	    } else {
		$frame configure -height $fheight
		set par [winfo parent $frame]
		if {[grid slaves $par] == ""} {
		    $par configure -height $fheight
		} else {
		    grid rowconfigure $par $row -minsize $fheight
		}
	    }
	}
    }
    set cmd [list futil_perform_switch $frame $varname $opts $cmds $change_size]
    trace variable $varname w $cmd
    set $varname [set $varname]
    return $cmd
}

proc futil_perform_switch {w varname opts cmds change_size args} {
    global [lindex [split $varname \(] 0]
    set val [set $varname]
    
    if ![winfo exists $w] return ;# maybe it was destroyed
    
    if ![winfo exists $w.$val] {
	# Maybe there is a subwindow that matches this new value by containing
	# it like val1_val2_val3 matches val2, etc
	set ok 0
	foreach child [winfo children $w] {
	    set cc [split $child .]
	    set last [lindex $cc [expr [llength $cc] - 1]]
	    foreach l [split $last _] {
		if {$l == $val} {
		    set val $last
		    set ok 1
		    break
		}
	    }
	}
	if !$ok {
	    foreach i [winfo children $w] { place forget $i }
	    return
	}
    }
    if {$change_size == 2} {
	if {![catch {pack info $w.$val}]} return
	
	foreach i [winfo children $w] { catch {pack forget $i} }
	
	pack $w.$val -fill both -expand 1
	
    } elseif {$change_size == 1} {
        if [catch {grid info $w.$val}] return

        foreach i [winfo children $w] { catch {grid forget $i} }

        set gf $opts
        if {[lsearch $gf "-sticky"] < 0} {lappend gf "-sticky" news}

        eval grid $w.$val $gf
    } else {
	if {[place info $w.$val] != ""} return
	
	foreach i [winfo children $w] { place forget $i }
	
	eval place $w.$val -in $w -x 0 -y 0 $opts
	futil_check_width $w.$val
	if {[bind $w.$val <Configure>] == ""} {
	    bind $w.$val <Configure> [list futil_check_width $w.$val]
	}
    }
    raise $w.$val ;# This is a mystery
    
    if {$cmds != ""} { uplevel \#0 $cmds }
}


proc futil_check_width {sub} {
    if {[place info $sub] == ""} return
    set par [winfo parent $sub]
    set sw [winfo width $sub]
    if {$sw > [$par cget -width]} {
	$par configure -width $sw
    }
}

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

proc futil_updown {w var minv maxv tabdata {activedata ""}} {
    global guibase_dir futil_updown_minmax
    
    set futil_updown_minmax($var) "$minv $maxv"

    form_frame $w flat 0 $tabdata
    form_entry $w.ent $var int {0 0} $activedata
    form_button_bitmap $w.up @$guibase_dir/goup.xbm \
	    "futil_updown_modify $var 1" {0 1} $activedata
    form_button_bitmap $w.down @$guibase_dir/godown.xbm \
	    "futil_updown_modify $var -1" {0 2} $activedata
}

proc futil_updown_reset_minmax {var minv maxv} {
    global futil_updown_minmax
    set futil_updown_minmax($var) "$minv $maxv"
}

proc futil_updown_modify {var incr} {
    global futil_updown_minmax [lindex [split $var \(] 0]
    
    set minmax $futil_updown_minmax($var)
    
    incr $var $incr
    if {[set $var] < [lindex $minmax 0]} { set $var [lindex $minmax 0] }
    if {[set $var] > [lindex $minmax 1]} { set $var [lindex $minmax 1] }
}

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

proc futil_edit_list {w title var geo {selfunc ""}} {
    global futil_edit_list_entry
    
    upvar \#0 $var lvar
    
    set futil_edit_list_entry ""

    form_kill $w
    set d [form_init $w $title "" "done cancel"]
    if {$d != ""} {
	form_listbox $d.list "" "" "futil_edit_list_select $d.list" "" \
	    "40x4" {0 0 -cols 6}
	form_label $d.newl "Edit entry:" {1 0}
	form_entry $d.newe futil_edit_list_entry string {1 1}
	if {$selfunc == ""} {
	    form_frame $d.buts flat 0 {1 2}
	} else {
	    form_button $d.sel Select \
		[concat $selfunc futil_edit_list_entry] {1 2}
	    form_frame $d.buts flat 0 {2 0 -cols 3}
	}
	form_button $d.buts.add Add "futil_edit_list_add $d.list" {0 0}
	form_button $d.buts.mod Modify "futil_edit_list_update $d.list" {0 1}
	form_button $d.buts.del Delete "futil_edit_list_delete $d.list" {0 2}
	bind $d.newe <Return> "futil_edit_list_update $d.list"
	form_finish $geo
    }
    
    form_listbox_set $w.main.list $lvar
    
    if [form_wait $w] {
	set lvar [form_listbox_get $w.main.list]
	return 1
    } else {
	return 0
    }
}

proc futil_edit_list_select {w ch} {
    global futil_edit_list_entry
    
    set futil_edit_list_entry $ch
}

proc futil_edit_list_update {w} {
    global futil_edit_list_entry
    
    set pos [form_listbox_get_select_index $w]
    if {$pos != ""} {
	form_listbox_set_index $w $pos $futil_edit_list_entry
	set futil_edit_list_entry ""
    } else {
	futil_edit_list_add $w
    }
}

proc futil_edit_list_add {w} {
    global futil_edit_list_entry
    
    if {$futil_edit_list_entry != ""} {
	form_listbox_add_dup $w $futil_edit_list_entry
	set futil_edit_list_entry ""
    }
}

proc futil_edit_list_delete {w} {
    global futil_edit_list_entry
    
    set pos [form_listbox_get_select_index $w]
    if {$pos != ""} {
	form_listbox_delete_index $w $pos
    }
    set futil_edit_list_entry ""
}
