
# 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 toolbar_setup {tbar} {
    global toolbar guibase_dir
    
    set toolbar(frame) $tbar
    set toolbar(dir) [file dirname $guibase_dir]/icons
    if ![file exists $toolbar(dir)] {
	set toolbar(dir) [file dirname [file dirname $guibase_dir]]/icons
    }
    menu $tbar.opts -tearoff 0
    $tbar.opts add command -label "Edit toolbars" -command toolbar_edit
    
    bind $tbar <3> "tk_popup $tbar.opts %X %Y"
}

proc toolbar_register_frame {fname path vert} {
    global toolbar guibase_dir
    
    set toolbar(frame-$fname) $path
    set toolbar(is_vert-$fname) $vert
    menu $path.opts -tearoff 0
    $path.opts add command -label "Edit toolbars" -command toolbar_edit
    
    bind $path <3> "tk_popup $path.opts %X %Y"
}

proc toolbar_addgroup {name where buts reenable} {
    global toolbar
    
    if [info exists toolbar(packinfo,$name)] {
	# Put it back where it was before
	set rownum [lindex $toolbar(packinfo,$name) 0]
	set before [lindex $toolbar(packinfo,$name) 1]
	set frame [lindex $toolbar(packinfo,$name) 2]
	set vert [lindex $toolbar(packinfo,$name) 3]
#	unset toolbar(packinfo,$name)
	set visible 1
    } else {
	set before END
	set rownum [lindex $where 0]
	set fname [lindex $where 1]
	set visible 1
	if {$rownum == ""} { set rownum $toolbar(rownum,$name) }
	if {$rownum <= 0} {
	    set visible 0
	    set rownum [expr -$rownum]
	    if !$rownum { set rownum 1 }
	}
	if {$fname == ""} {
	    set frame $toolbar(frame)
	    set vert 0
	} else {
	    set frame $toolbar(frame-$fname)
	    set vert $toolbar(is_vert-$fname)
	}
    }
    
    if ![info exists toolbar(group-$name)] {
	lappend toolbar(all-names) $name
    }
    if {$buts == ""} {
	set buts $toolbar(group-$name)
    } else {
	set toolbar(group-$name) $buts
    }
    set toolbar(rownum,$name) $rownum
    
    if !$visible return
    
    if {[info exists toolbar(subframe,$name)] && [winfo exists $toolbar(subframe,$name)]} {
	set fr $toolbar(subframe,$name)
	form_delete $fr 0
	foreach ch [winfo children $fr] { destroy $ch }
    } else {
	set row $frame.row$rownum
	if ![winfo exists $row] {
	    frame $row -relief flat -borderwidth 0
	    if $vert {
		grid $row -column $rownum -row 0 -sticky n
		# Make all the toolbars flush top
		grid rowconfigure $frame 1 -weight 1000
	    } else {
		grid $row -row $rownum -column 0 -sticky w
		# Make all the toolbars flush left
		grid columnconfigure $frame 1 -weight 1000
	    }
	}
	#for {set i 0} {[winfo exists $row.f$i]} {incr i} {}
	#set fr $row.f$i
	set fr $row.[string tolower $name]
	regsub -all " " $fr _ fr
	
	set toolbar(subframe,$name) $fr
	
	# Figure out who to put it after.
	foreach pre $before {
	    if [winfo exists $pre] {
		set after_me $pre
	    }
	}
	set firstone [lindex [pack slaves $row] 0]
	if $vert { set side top } else { set side left }
		
	frame $fr -relief raised -borderwidth 1
	
	if [info exists after_me] {
	    pack $fr -side $side -after $after_me -fill y
	    #puts "pack $fr -side $side -after $after_me -fill y"
	} elseif {($before == "") && ($firstone != "")} {
	    pack $fr -side $side -before $firstone -fill y
	    #puts "pack $fr -side $side -before $firstone -fill y"
	} else {
	    pack $fr -side $side -fill y
	    #puts "pack $fr -side $side -fill y"
	}
	
	set before ""
	foreach sl [pack slaves [winfo parent $fr]] {
	    if {$sl != $fr} { lappend before $sl } else break
	}
	
	set toolbar(packinfo,$name) [list $rownum $before $frame $vert]
    }
    
    set bg [$fr cget -background]
    
    toolbar_fillin $fr $buts $vert
    
    if !$vert {
	foreach icon {icon_x icon_box icon_v} {
	    if ![info exists toolbar(image-$icon)] {
		set file $toolbar(dir)/$icon.xbm
		if [catch {image create bitmap -file $file \
			       -foreground black -background ""} res] {
		    puts "ERROR: bad bitmap $file"
		    set res [image create bitmap]
		}
		set toolbar(image-$icon) $res
	    }
	}
	
	foreach {icon func} {
	    icon_x toolbar_remove
	    icon_box toolbar_tearoff
	} {
	    set wid $fr.$func
	    button $wid -image $toolbar(image-$icon) -relief flat \
		-borderwidth 1 -command [list $func $name] -background $bg
	    pack $wid -side top -padx 1 -pady 1 -anchor n
	    bind $wid <Enter> "$wid configure -relief raised"
	    bind $wid <Leave> "$wid configure -relief flat"
	}
	if {$reenable != ""} {
	    set toolbar(reenable-when-killed,$name) $reenable
	}
    }
}

proc toolbar_addspace {rownum} {
    global toolbar
    
    set row $toolbar(frame).row$rownum
    if ![winfo exists $row] {
	frame $row -relief flat -borderwidth 0
	grid $row -row $rownum -column 0 -sticky w
	# Make all the toolbars flush left
	grid columnconfigure $toolbar(frame) 1 -weight 1000
    }
    for {set i 0} {[winfo exists $row.space$i]} {incr i} {}
    set fr $row.space$i
    label $fr -relief flat -borderwidth 0 -text "  "
    pack $fr -side left -fill y
}

# Buts is a list of lists of button specifications.

proc toolbar_fillin {fr buts vert} {
    global toolbar

    if $vert {
	set side top; set hdim width; set hfill x
    } else {
	set side left; set hdim height; set hfill y
    }
    
    set bg [$fr cget -background]
    set n 0
    foreach butlist $buts {
	if {$butlist == ""} {
	    set wid $fr.f$n
	    frame $wid -relief flat -borderwidth 0 -$hdim 1 -bg black
	    pack $wid -side $side -padx 3 -pady 3 -fill $hfill
	    incr n
	    continue
	}
	set wids ""
	set rightclick ""
	set is_menu 0
	if {[lindex $butlist 0] == "multiple"} {
	    set rightclick [lindex $butlist 2]
	    set butlist [list [lindex $butlist 1]]
	} elseif {[lindex $butlist 0] == "menu"} {
	    set is_menu 1
	    set bactive ""
	    set par $fr.f$n
	    set toolbar(cascade-name,$par) [lindex $butlist 1]
	    set butlist [lrange $butlist 2 end]

	    # We need to create one button which is a child of the main one
	    # and also a menu entry for this menu.
	    frame $par
	    pack $par -side $side -padx 1 -pady 1 -fill both
	    
	    set menu $fr.f$n.opts.m
	    menubutton $par.opts -image $toolbar(image-icon_v) -menu $menu \
		-bg $bg
	    menu $menu -tearoff 1 -tearoffcommand toolbar_tearoff_configure
	    pack $par.opts -side right -padx 0 -pady 0 -anchor s
	    form_doactive $par.opts menubutton $bactive
	}
	set m 0
	foreach but $butlist {
	    set text [lindex $but 0]
	    set icon [lindex $but 1]
	    set cmd [lindex $but 2]
	    set whenactive [lindex $but 3]
	    set bubble [lindex $but 4]
	    set url [lindex $but 5]
	    set dragoff_cmd [lindex $but 6]
	    
	    if $is_menu {
		set wid $fr.f$n.b$m
		incr m
	    } else {
		set wid $fr.f$n
	    }
	    
	    if {($icon == "") && [info exists toolbar(icon-$text)]} {
		set icon $toolbar(icon-$text)
	    }
	    switch [lindex $cmd 0] {
		radiobutton {
		    set var [lindex $cmd 1]
		    set val [lindex $cmd 2]
		    set cmd [lindex $cmd 3]
		    set create [list radiobutton $wid -variable $var \
				    -value $val -indicatoron 0 \
				    -selectcolor "" -borderwidth 1]
		    set mcreate [list radiobutton -variable $var \
				    -value $val -indicatoron 0 -selectcolor ""]
		    set btype radiobutton
		}
		checkbutton {
		    set var [lindex $cmd 1]
		    set cmd [lindex $cmd 2]
		    set create [list checkbutton $wid -variable $var \
				    -indicatoron 0 -selectcolor "" \
				    -borderwidth 1]
		    set mcreate [list checkbutton -variable $var \
				     -indicatoron 0 -selectcolor ""]
		    set btype checkbutton
		}
		cyclebutton {
		    set var [lindex $cmd 1]
		    set vals [lindex $cmd 2]
		    set cmd [list toolbar_cycle $var $vals [lindex $cmd 3]]
		    set create [list button $wid -relief flat]
		    set mcreate command
		    set btype button
		}
		default {
		    set create [list button $wid -relief flat]
		    set mcreate command
		    set btype button
		}
	    }
	    if {$icon == ""} {
		eval $create -text \{$text\} -command \{toolbar_update_relief $wid \; $cmd\}
		if $is_menu {
		    eval $menu add $mcreate -label \{$text\} \
			-command \{toolbar_do_toolbut $wid \; $cmd \}
		}
	    } else {
		if ![info exists toolbar(image-$icon)] {
		    if [file exists $toolbar(dir)/$icon.gif] {
			set file $toolbar(dir)/$icon.gif
			set toolbar(image-$icon) [image create photo \
						      -file $file]
			
		    } elseif [file exists $toolbar(dir)/$icon.xbm] {
			set file $toolbar(dir)/$icon.xbm
			set toolbar(image-$icon) [image create bitmap \
						      -file $file \
						      -foreground black \
						      -background ""]
		    } else {
			puts "Warning: can't find $toolbar(dir)/$icon.gif or .xbm"
			set file $toolbar(dir)/icepak_unknown.gif
			set toolbar(image-$icon) [image create photo \
						      -file $file]
		    }
		}
		eval $create -image \{$toolbar(image-$icon)\} \
		    -command \{toolbar_update_relief $wid \; $cmd\} \
		    -relief flat -borderwidth 1 -background \{$bg\}
		if $is_menu {
		    eval $menu add $mcreate -image \{$toolbar(image-$icon)\} \
			-command \{toolbar_do_toolbut $wid \; $cmd \}
		    bubble_define $menu,$toolbar(image-$icon) $bubble
		}
	    }
	    if {$dragoff_cmd != ""} {
		bind $wid <B1-Leave> "$dragoff_cmd $wid"
	    }
	    if {$rightclick != ""} {
		bind $wid <ButtonPress-3> "$wid configure -relief sunken"
		bind $wid <ButtonRelease-3> "$wid configure -relief raised; [lindex $rightclick 2]"
		append bubble "\n-\nRight click = [lindex $rightclick 4]"
	    }
	    toolbar_update_relief $wid
	    if {$bubble != ""} {
		bubble_define $wid $bubble
	    }
	    if {$url != ""} {
		help_define $wid "" [lindex $url 0] [lindex $url 1]
	    }
	    form_doactive $wid $btype $whenactive
	    lappend toolbar(cmd-$cmd) $wid
	    
	    if $is_menu {
		if {$m == 1} {
		    pack $wid -side $side -padx 1 -pady 1 -fill both
		}
	    } else {
		pack $wid -side $side -padx 1 -pady 1 -fill both
	    }
	    if {[winfo reqwidth $wid] < 20} { $wid configure -width 20 }
	    bind $wid <Enter> "$wid configure -relief raised"
	    bind $wid <Leave> "$wid configure -relief flat"
	}
	incr n
    }
}

proc toolbar_cycle {var vals cmd} {
    upvar \#0 $var lvar
    set p [lsearch $vals $lvar]
    incr p
    if {$p >= [llength $vals]} { set p 0 }
    set lvar [lindex $vals $p]
    if {$cmd != ""} {
	uplevel \#0 $cmd
    }
}

proc toolbar_update_text {cmd bubble url} {
    global toolbar
    
    if ![info exists toolbar(cmd-$cmd)] return
    
    foreach wid $toolbar(cmd-$cmd) {
	if ![winfo exists $wid] continue
	if {$bubble != ""} {
	    bubble_define $wid $bubble
	}
	if {$url != ""} {
	    help_define $wid "" [lindex $url 0] [lindex $url 1]
	}
    }
}

proc toolbar_update_relief {w} {
    switch [winfo class $w] {
	Checkbutton {
	    set var [$w cget -variable]
	    upvar \#0 $var lvar
	    set ok $lvar
	}
	Radiobutton {
	    set var [$w cget -variable]
	    set val [$w cget -value]
	    upvar \#0 $var lvar
	    set ok [expr {$lvar == $val}]
	}
	default return
    }
    if $ok {
	$w configure -relief sunken
    } else {
	$w configure -relief raised
    }
}

proc toolbar_do_toolbut {wid} {
    set par [winfo parent $wid]
    foreach ch [lrange [pack slaves $par] 1 end] {
	pack unpack $ch
    }
    pack $wid -side left -padx 0 -pady 0
}

proc toolbar_remove {name} {
    global toolbar

    set fr $toolbar(subframe,$name)
    if {![winfo exists $fr]} return

    # Need to use this function because there might be traces
    foreach b [winfo children $fr] {
	form_delete $b
    }
    form_delete $fr
#    unset toolbar(subframe,$name)
    
    if [info exists toolbar(reenable-when-killed,$name)] {
	if [winfo exists $toolbar(reenable-when-killed,$name)] {
	    foreach ch [winfo children $toolbar(reenable-when-killed,$name)] {
		$ch configure -state normal
	    }
	}
	unset toolbar(reenable-when-killed,$name)
    }
}

proc toolbar_tearoff {name} {
    global toolbar

    set fr $toolbar(subframe,$name)
    if ![winfo exists $fr] return

    for {set i 1} {[winfo exists .toolbar$i]} {incr i} {}
    set top .toolbar$i
    top_window $top 0 $name [list toolbar_tearoff_delete $top $name] "" \
	1 1
    #wm withdraw $top

    toolbar_fillin $top $toolbar(group-$name) 0

    #wm title $top $name
    set pos [top_xypos $fr]
    top_geometry $top +[lindex $pos 0]+[lindex $pos 1]
    top_deiconify $top
    #wm protocol $top WM_DELETE_WINDOW [list toolbar_tearoff_delete $top $name]

    set par [winfo parent $fr]
    regexp {([0-9]*)$} $par dummy rownum
    set before ""
    set parent [winfo parent $fr]
    foreach sl [pack slaves $parent] {
	if {$sl != $fr} { lappend before $sl } else break
    }
    
    set vert [string match "*side top*" [pack info $fr]]
    set toolbar(packinfo,$name) [list $rownum $before [winfo parent $parent] \
				     $vert]
    
    form_delete $fr
#    unset toolbar(subframe,$name)
    
#    bind $top <Configure> "toolbar_tearoff_configure $top"
}

proc toolbar_tearoff_configure {orig new} {
    global toolbar
    
    set but [winfo parent [winfo parent $orig]]
    puts "BUT $but"
    if [info exists toolbar(cascade-name,$but)] {
	destroy $new
	
	set but [winfo parent [winfo parent $orig]]
	foreach ch [winfo children $but] { $ch configure -state disabled }
	
	toolbar_addgroup $toolbar(cascade-name,$but) "" "" $but
    } else {
	set toolbar(tearoff-source,$new) $orig
    }
}

proc toolbar_tearoff_delete {top name} {
    catch {wm protocol $top WM_DELETE_WINDOW ""} 
    toolbar_addgroup $name 0 "" ""
#    form_delete $top
    return 1 ;# that means delete the window
}

proc toolbar_edit {} {
    global toolbar
    
    form_kill .toolbar_edit
    set d [form_init .toolbar_edit "Available toolbars" "" {accept reset cancel help}]
    set n 0
    foreach name $toolbar(all-names) {
	if {[info exists toolbar(subframe,$name)] && \
		[winfo exists $toolbar(subframe,$name)]} {
	    set toolbar(visible-$name) 1
	} else {
	    set toolbar(visible-$name) 0
	}
	set toolbar(changed-$name) 0
	form_checkbutton $d.b$n $name toolbar(visible-$name) "$n 0"
	#	form_button $d.e$n Edit "toolbar_edit_one $name" "$n 1"
	incr n
    }
    form_finish +300+300
    if [form_wait .toolbar_edit] {
	foreach name $toolbar(all-names) {
	    if {$toolbar(visible-$name) &&
		($toolbar(changed-$name) ||
		 ![info exists toolbar(subframe,$name)] ||
		 ![winfo exists $toolbar(subframe,$name)])} {
		toolbar_addgroup $name "" "" ""
	    } elseif {!$toolbar(visible-$name) && 
		      [info exists toolbar(subframe,$name)] &&
		      [winfo exists $toolbar(subframe,$name)]} {
		toolbar_remove $name
	    } 
	}
    }
}

proc toolbar_edit_one {name} {
    global toolbar
    
    ## Not yet implemented
}
