
# 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 choose_one {mess choices {default ""} {geo +300+300} {delete_cmd ""} {extra_widget_cmd ""} {title Selection}} {
    global choice_var tdv_default form_label_text toplevel
    
    if [info exists form_label_text($mess)] { set mess $form_label_text($mess) }

    # How big should the help window be?
    set nl 0
    foreach ll [split $mess \n] {
	incr nl [expr {[string length $ll] / 50 + 1}]
    }
    
    set sb 1
    set height [llength $choices]
    if {$height > 10} {
	set height 10
	set sb 1
    }
    if !$height { set height 1 }

    set width 30
    foreach ch $choices {
	set cw [expr int([string length $ch] * 0.9)]
	if {$cw > $width} { set width $cw }
    }
    
    set w .choice_win
    catch "top_destroy $w"
    top_window $w 1 $title
    if !$toplevel(single) {
	catch {wm transient $w .v}
    }
    text $w.mess -wrap word -height $nl -width 40 -relief flat -background \
	[$w cget -background]
    entry $w.entry -borderwidth 2 -relief sunken -background white \
	    -textvariable choice_var
    listbox $w.list -borderwidth 2 -relief sunken -background white \
	    -width $width -height $height
    
    catch {pathentry on $w.entry $choices}
    
    frame $w.buts
    button $w.buts.okay -text Okay -width 10 -command \
	    "top_destroy $w"
    button $w.buts.cancel -text Cancel -width 10 -command \
	    "set choice_var {}; top_destroy $w"
    pack $w.buts.okay $w.buts.cancel -side left -fill both -expand 1
    
    if {$delete_cmd != ""} {
	button $w.buts.delete -text Delete -width 10 -command \
		[list choose_one_delete $w $delete_cmd]
	pack $w.buts.delete -side left -fill both -expand 1
    }
    
    pack $w.mess $w.entry -side top -fill both -padx 10 -pady 10
    pack $w.buts -side bottom -fill both -expand 1
    if {$choices != ""} {
	pack $w.list -side left -fill both -expand 1 -padx 10 -pady 10
	
	if $sb {
	    scrollbar $w.scroll -relief sunken -command "$w.list yview" \
		    -orient v
	    $w.list configure -yscroll "$w.scroll set"
	    pack $w.scroll -side right -fill y
	}
    }
    
    set choice_var $default
    
    $w.mess insert end $mess
    foreach choice $choices {
	$w.list insert end $choice
    }
    
    bind $w.list <Button-1> "\
	    %W selection clear 0 end;\
	    %W selection set \[%W nearest %y\] ; \
	    set choice_var \[%W get \[%W nearest %y\]\] ; break"
    bind $w.list <Double-Button-1> " \
	    %W selection clear 0 end;\
	    %W selection set \[%W nearest %y\] ; \
	    set choice_var \[%W get \[%W nearest %y\]\]; \
	    top_destroy $w; break"
        
    bind $w.entry <Double-Button-1> "top_destroy $w; break"
    bind $w.entry <Return> "top_destroy $w; break"
    set prevfoc [focus]
    focus $w.entry
    
    if {$extra_widget_cmd != ""} {
	    frame $w.extras -relief ridge -borderwidth 2
	    pack $w.extras -side bottom -after $w.buts -fill both -padx 2 -pady 2
	    eval $extra_widget_cmd $w.extras
    }
    
    switch -- $geo {
	    upright {
	        set x [expr [winfo rootx $tdv_default] + [winfo width $tdv_default] - 300]
	        set y [winfo rooty $tdv_default]
	        set geo +$x+$y
	    }
    }
    if {[winfo screenwidth .] > 2048} {
        set geo +[expr [winfo rootx .]+ 50]+300
    }
    top_geometry  $w $geo
    catch {form_auto_raise $w}

    tkwait window $w
    if {$prevfoc != ""} { focus $prevfoc }
    return $choice_var
}

proc choose_one_delete {w command} {
    set ch [$w.entry get]
    if {$ch == ""} return
    
    if [eval "$command \"$ch\""] {
	$w.entry delete 0 end
	set s [$w.list size]
	for {set i 0} {$i < $s} {incr i} {
	    set l [$w.list get $i]
	    if {$l == $ch} {
		$w.list delete $i
		return
	    }
	}
    }
}

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

proc choose_multiple {mess choices {geo +300+300} {title "Selection"}} {
    global choice_var
    
    catch {unset choice_var}
    
    # How big should the help window be?
    set nl 0
    foreach ll [split $mess \n] {
	incr nl [expr {[string length $ll] / 50 + 1}]
    }
    
    set sb 1
    set height [llength $choices]
    if {$height > 10} {
	set height 10
	set sb 1
    }
    if !$height { set height 1 }
    
    set w .choice_win
    catch "top_destroy $w"
    top_window $w 1 $title
    text $w.mess -wrap word -height $nl -width 40 -relief flat \
	-borderwidth 0 -background [$w cget -background]
    listbox $w.list -borderwidth 2 -relief sunken -background white \
	    -width 40 -height $height -selectmode multiple
    
    frame $w.buts
    button $w.buts.okay -text Accept -width 5 -command \
	    "top_destroy $w"
    button $w.buts.cancel -text Cancel -width 5 -command \
	"catch {unset choice_var}; top_destroy $w"
    button $w.buts.all -text All -width 5 -command \
	"choose_multiple_all $w.list 1"
    button $w.buts.none -text None -width 5 -command \
	"choose_multiple_all $w.list 0"
    pack $w.buts.okay $w.buts.all $w.buts.none $w.buts.cancel \
	-side left -fill both -expand 1
    
    pack $w.mess -side top -fill both -padx 10 -pady 10
    pack $w.buts -side bottom -fill both -expand 1
    if {$choices != ""} {
	pack $w.list -side left -fill both -expand 1 -padx 10 -pady 10
	
	if $sb {
	    scrollbar $w.scroll -relief sunken -command "$w.list yview" \
		    -orient v
	    $w.list configure -yscroll "$w.scroll set"
	    pack $w.scroll -side right -fill y
	}
    }
    
    $w.mess insert end $mess
    foreach choice $choices {
	$w.list insert end $choice
    }
    
    bind $w.list <Button-1> "select_multiple_toggle %W %y; break"
    
    top_geometry $w $geo
    catch {form_auto_raise $w}
    catch {wm transient $w .}
    
    tkwait window $w
    
    set ret ""
    foreach v [array names choice_var] {
	lappend ret $v
    }
    catch {unset choice_var}
    return $ret
}

proc choose_multiple_all {list on} {
    $list selection [expr {$on ? "set" : "clear"}] 0 end
}

proc select_multiple_toggle {w y} {
    global choice_var
    
    set ch [$w nearest $y]
    set val [$w get $ch]
    if [info exists choice_var($val)] {
	$w selection clear $ch
	unset choice_var($val)
    } else {
	$w selection set $ch
	set choice_var($val) 1
    }
}
    
