
##------------------------------------------------------------------------
## PROCEDURE
##	optionbar
##
## DESCRIPTION
##	Implements an option bar mega-widget
##
## ARGUMENTS
##	optionbar <window pathname> <options> list1 list2 ...
##   where list= name frame command
##
## OPTIONS
##
## no options
##
## RETURNS: the window pathname
##
## 
## EXAMPLE USAGE:
##
## pack [optionbar .optb {OPT1 .frame1 ExecOPT1} {OPT2 .frame2 ExecOPT2} ]
##
##------------------------------------------------------------------------

proc optionbar {w args} {
    global GIDDEFAULT _G_OptionBarPriv

    # Search args for comands
    if {$args=="GetSelected"} {

	upvar \#0 $w data
	set name ""
	catch {set name $data(current)}
	return $name
	
    }
    if ![string compare [set op [lindex $args 0]] "state"] {
	tkOptionState $w [lrange $args 1 end]
    } else {
	# Create the option bar
	canvas $w -bd 0 -takefocus 1 -highlightthickness 0
	bind $w <FocusIn> "tkSetFocusRing $w"
	bind $w <FocusOut> "tkSetFocusRing $w no"

	set hei [font metrics BoldFont -linespace]

	set ini 3
	set base [expr $hei+10]
	frame $w.fr -relief raise -bd 2
	$w create window [expr $ini-1] [expr $base+5] \
		-window $w.fr -anchor nw -tags mainwin
	frame $w.hide -relief flat 
	$w create window [expr $ini+1] [expr $base+5] \
		-window $w.hide -anchor nw -tags hidewin


	frame $w.arrows

	# if { [lsearch [image names] arrow_left_vsmall.gif] == -1 } {
	#     image create photo arrow_left_vsmall.gif -file [file join $GIDDEFAULT bitmaps \
	# 	      arrow_left_vsmall.gif]
	# }
	# if { [lsearch [image names] arrow_right_vsmall.gif] == -1 } {
	#     image create photo arrow_right_vsmall.gif -file [file join $GIDDEFAULT bitmaps \
	# 	      arrow_right_vsmall.gif]
	# }
	# 
	# button $w.arrows.arrow-l -image arrow_left_vsmall.gif \
	# 	  -command "tkMoveOptionBar $w 10" -padx 0 -pady 0 \
	# 	  -highlightthickness 0 -takefocus 0
	# 
	# button $w.arrows.arrow-r -image arrow_right_vsmall.gif \
	# 	  -command "tkMoveOptionBar $w -10" -padx 0 -pady 0 \
	# 	  -highlightthickness 0 -takefocus 0
	
	set triang_color blue
	if { ![ info exist _G_OptionBarPriv(triangle_left,$triang_color)]} {
	    set _G_OptionBarPriv(triangle_left,$triang_color) [ image create bitmap -data {
		#define triangle_left_width 9
		#define triangle_left_height 15
		static unsigned char triangle_left_bits[] = {
		    0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x40, 0x00, 0x60, 0x00, 0x70, 0x00,
		    0x78, 0x00, 0x7c, 0x00, 0x78, 0x00, 0x70, 0x00, 0x60, 0x00, 0x40, 0x00,
		    0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
		} -foreground $triang_color
		]
	}

	if { ![ info exist _G_OptionBarPriv(triangle_right,$triang_color)]} {
	    set _G_OptionBarPriv(triangle_right,$triang_color) [ image create bitmap -data {
		#define triangle_right_width 9
		#define triangle_right_height 15
		static unsigned char triangle_right_bits[] = {
		    0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x04, 0x00, 0x0c, 0x00, 0x1c, 0x00,
		    0x3c, 0x00, 0x7c, 0x00, 0x3c, 0x00, 0x1c, 0x00, 0x0c, 0x00, 0x04, 0x00,
		    0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
		} -foreground $triang_color 
		]
	}

	button $w.arrows.arrow-l -image $_G_OptionBarPriv(triangle_left,$triang_color) \
		  -command "tkMoveOptionBar $w 10" -padx 0 -pady 0 \
		  -highlightthickness 0 -takefocus 0
	
	button $w.arrows.arrow-r -image $_G_OptionBarPriv(triangle_right,$triang_color) \
		  -command "tkMoveOptionBar $w -10" -padx 0 -pady 0 \
		  -highlightthickness 0 -takefocus 0
	
	grid $w.arrows.arrow-l $w.arrows.arrow-r


	bind $w.arrows.arrow-l <1> "after 500 tkMoveOptionBarDynamically $w 10"
	bind $w.arrows.arrow-l <ButtonRelease-1> \
		"after cancel  tkMoveOptionBarDynamically $w 10"
	bind $w.arrows.arrow-r <1> "after 500 tkMoveOptionBarDynamically $w -10"
	bind $w.arrows.arrow-r <ButtonRelease-1> \
		"after cancel  tkMoveOptionBarDynamically $w -10"
	
	$w create window [expr $ini-1] [expr $base+5] \
		-window $w.arrows -anchor se -tags arrows
	
#	bind $w <Configure> "tkConfigureOptionBar $w $base %w %h"
	bind $w <Destroy> { tkOptionBarDestroy %W }
    
	bind $w <Right> "tkOptionBarNext $w 1"
	bind $w <Left> "tkOptionBarNext $w -1"
	
	
	tkProcessOptionBarArgs $w $args $ini $base $hei

	bind $w <Configure> "tkConfigureOptionBar $w $base %w %h"

	catch {
	    rename $w .$w
	}
	proc $w args "eval tkOptionBarEval [list $w] \$args"
	return $w
    }
}

proc tkOptionState { w largs } {
    upvar \#0 $w data

    set istab 1
    foreach o $largs {
	if $istab {
	    set tabname $o
	    regsub -all { } $o {} texttag
	    set istab 0
	} else {
	    if { [string compare $tabname $data(current)] && [string compare $o data(state,$tabname)] } {
		if ![string compare $data(state,$tabname) "hidden"] {
		    tkCoverButton $w $tabname 1
		}
		switch $o {
		    "normal" {
			$w itemconfigure $texttag.shadow -fill $data(shadow,normal)
			$w itemconfigure $texttag.light -fill $data(light,normal)
			$w itemconfigure $texttag.text -fill $data(text,normal)
		    }
		    "hidden" {
			$w itemconfigure $texttag.shadow -fill $data(shadow,hidden)
			$w itemconfigure $texttag.light -fill $data(light,hidden)
			$w itemconfigure $texttag.text -fill $data(text,hidden)
			tkCoverButton $w $tabname
		    }
		    "disabled" {
			$w itemconfigure $texttag.shadow -fill $data(shadow,disabled)
			$w itemconfigure $texttag.light -fill $data(light,disabled)
			$w itemconfigure $texttag.text -fill $data(text,disabled)
		    }
		    default {
			error "tkOptionState: invalid state $o"
		    }
		}
		set data(state,$tabname) $o
	    }
	    set istab 1
	}
    }
}

proc tkOptionBarDestroy { w } {
    upvar \#0 $w data
    catch { rename $w {}; unset data }

}

proc tkOptionBarEval { w args } {

    if { [lindex $args 0] == "replace" } {
	set hei [font metrics BoldFont -linespace]
	
	set ini 3
	set base [expr $hei+10]
	tkOptionBarDeleteAllButtons $w
	tkProcessOptionBarArgs $w [lrange $args 1 end] $ini $base $hei
    } else {
	eval [concat .$w $args]
    }
}

proc tkProcessOptionBarArgs { w args ini base hei } {
    upvar \#0 $w data

    catch { unset data }
    array set data [list \
	    firstname [lindex [lindex $args 0] 0] \
	    lastname [lindex [lindex $args end] 0] \
	    ]

    set mw 0 ; set mh 0
    update idletasks
    set data(optlist) ""
    set data(numopts)  0
    set data(visibles) 0

    array set data {
	shadow,normal    grey50
	shadow,disabled  grey60
	shadow,hidden    grey75
	light,normal     white
	light,disabled   grey60
	light,hidden     grey75
	text,normal      grey25
	text,disabled    grey60
	text,hidden      grey75
    }

    foreach opt {shadow light text} {
	set data($opt,hidden) [$w cget -bg]
    }

    set mxwei 0
    foreach i $args {
	set name [lindex $i 0]
	set wei [font measure BoldFont $name]
	if { $wei > $mxwei } { set mxwei $wei }
    }

    foreach i $args {
	
	set name [lindex $i 0]
	set frame [lindex $i 1]
	set command [lindex $i 2]
	#set wei [font measure BoldFont $name]
	set wei $mxwei
	tkAddButtonToOptionBar $w $name $ini $base $wei $hei
	set data(frames,$name) $frame
	set data(commands,$name) $command
	set data(state,$name) normal
	lappend data(optlist) $name
	incr data(numopts)
	incr ini [expr $wei+11]

 	set ww [winfo reqwidth $frame]
 	set h [winfo reqheight $frame]
 	if { $ww > $mw } { set mw $ww }
 	if { $h > $mh } { set mh $h }
    }
    set data(visibles) $data(numopts)
    tkSelectOptionBar $w $data(firstname)
    update
    $w conf -width $mw -height [expr $mh+$hei+20]
}

proc tkOptionBarDeleteAllButtons { w } {
    upvar \#0 $w data

    foreach i $data(optlist) {
	regsub -all { } $i {} texttag 
	$w delete $texttag.but2 $texttag.but
    }
    catch { unset data }
}

proc tkAddButtonToOptionBar { w text x y width height } {
    upvar \#0 $w data

    set end [expr $width+$x+8]
    set up [expr $y-$height-4]

    regsub -all { } $text {} texttag 

    set wei [font measure BoldFont $text]
    set incr [expr ($width-$wei)/2]

    $w create text [expr $x+4+$incr] $y -text $text -font BoldFont \
	-fill $data(text,normal) -anchor sw -tags [list $texttag.text $texttag.but2]
    $w create line $end [expr $y+6] \
	$end [expr $up+3] \
	[expr $end-3] $up \
	-width 2 -fill $data(shadow,normal) -joinstyle bevel -tags [list $texttag.shadow $texttag.but2]
    
    $w create line [expr $end-3] $up \
	[expr $x+3]  $up \
	$x [expr $up+3] \
	$x [expr $y+6] \
	-width 2 -fill $data(light,normal) -joinstyle bevel -tags [list $texttag.light $texttag.but2]

    $w create polygon  $end [expr $y+6] \
	    $end $up \
	    $x  $up \
	    $x [expr $y+6] \
	    -fill ""  -tags $texttag.but
    $w bind $texttag.but <ButtonRelease-1> [list tkSelectOptionBar $w $text]
}

proc tkCheckButtonsStateOptionBarCB { w } {
    catch { tkCheckButtonsStateOptionBar $w }
}

proc tkConfigureOptionBar { w base width height } {
    upvar \#0 $w data
    $w itemconf mainwin -width [expr $width-3] -height \
	    [expr $height-$base-5]
    $w coords arrows [expr $width-0] [expr $base+5]

    after idle [list tkSelectOptionBarCB $w $data(current) nocom]

    after idle tkCheckButtonsStateOptionBarCB $w
}

proc tkSelectOptionBarCB { w name {docom yescom}} {
    catch { tkSelectOptionBar $w $name $docom }
}

proc tkCoverButton { w name { dir -1 } } {
    upvar \#0 $w data

    regsub -all { } $name {} texttag 
    regexp {([^ ]*)[ ]*([^ ]*)[ ]*([^ ]*)[ ]*([^ ]*)} [$w bbox $texttag.but] \
	t x y xe ye
    set width [expr $dir*($xe-$x-1)]
    if { [set i [lsearch $data(optlist) $name]] == -1 } return
    incr i
    for {} { $i < [llength $data(optlist)] } { incr i } {
	regsub -all { } [lindex $data(optlist) $i] {} texttag
	$w move $texttag.but2 $width 0
	$w move $texttag.but $width 0
    }
}

proc tkSelectOptionBar { w name {docom yescom}} {

    upvar \#0 $w data

    if ![string compare $data(state,$name) "normal"] {
	set data(current) $name
	
	if { ![info exists data(frames,$name)] } { return }
	set frame $data(frames,$name)
	set command $data(commands,$name)
	regsub -all { } $name {} texttag 
	regexp {([^ ]*)[ ]*([^ ]*)[ ]*([^ ]*)[ ]*([^ ]*)} [$w bbox $texttag.but] \
	    t x y xe ye
	set wei [expr $xe-$x-4]
	
	if { $x < 1 } {
	    tkMoveOptionBar $w [expr 2-$x]
	    regexp {([^ ]*)[ ]*([^ ]*)[ ]*([^ ]*)[ ]*([^ ]*)} [$w bbox $texttag.but] \
		t x y xe ye
	}
	
	if { [winfo exists $w.arrows] && [winfo x $w.arrows]>1 && \
		 $xe > [winfo x $w.arrows] } {
	    tkMoveOptionBar $w [expr [winfo x $w.arrows]-$xe]
	    regexp {([^ ]*)[ ]*([^ ]*)[ ]*([^ ]*)[ ]*([^ ]*)} [$w bbox $texttag.but] \
		t x y xe ye
	}
	
	$w.hide conf -width $wei -height 5
	$w coords hidewin [expr $x+3] [expr $ye-3]
	foreach i [pack slaves $w.fr] { pack forget $i }
	pack $frame -in $w.fr -expand yes -fill both
	raise $frame
	
	if { [$w find withtag FocusRingTag] != "" } {
	    $w coords FocusRingTag [expr $x+4] [expr $y+4] [expr $xe-5] [expr $ye-4]
	}


	if { $docom == "yescom" && $command != "" } { eval $command }
    }
}

proc tkCheckButtonsStateOptionBar { w  } {
    upvar \#0 $w data

    regsub -all { } $data(firstname) {} texttag 
    regsub -all { } $data(lastname) {} texttaglast

    regexp {([^ ]*)[ ]*([^ ]*)[ ]*([^ ]*)[ ]*([^ ]*)} \
	    [$w bbox $texttag.but] t x y xe ye

    if { $x >= 1} { 
	$w.arrows.arrow-l conf -state disabled
    } else {
	$w.arrows.arrow-l conf -state normal
    }

    regexp {([^ ]*)[ ]*([^ ]*)[ ]*([^ ]*)[ ]*([^ ]*)} \
	    [$w bbox $texttaglast.but] t x y xe ye

    if { [winfo exists $w.arrows] && \
	    $xe <= [winfo x $w.arrows] } {
	$w.arrows.arrow-r conf -state disabled
    } else {
	$w.arrows.arrow-r conf -state normal
    }
    set sb1 [lindex [$w.arrows.arrow-l conf -state] 4]
    set sb2 [lindex [$w.arrows.arrow-r conf -state] 4]
    if {$sb1 == "disabled" && $sb2 == "disabled"} {
	grid forget $w.arrows.arrow-l
	grid forget $w.arrows.arrow-r
    } else {
	grid $w.arrows.arrow-l $w.arrows.arrow-r
    }
}

proc tkMoveOptionBar { w dx } {
    upvar \#0 $w data

    tkCheckButtonsStateOptionBar $w

    regsub -all { } $data(firstname) {} texttag
    regsub -all { } $data(lastname) {} texttaglast

    regexp {([^ ]*)[ ]*([^ ]*)[ ]*([^ ]*)[ ]*([^ ]*)} \
	    [$w bbox $texttag.but] t x y xe ye

    if { $x >= 1 && $dx > 0 } { return }

    regexp {([^ ]*)[ ]*([^ ]*)[ ]*([^ ]*)[ ]*([^ ]*)} \
	    [$w bbox $texttaglast.but] t x y xe ye

    if { [winfo exists $w.arrows] && \
	    $xe <= [winfo x $w.arrows] } {
	
	if { $dx < 0 } { return }
    }
    foreach i [array names data frames,*] {
	regexp {frames,(.*)} $i t name
	regsub -all { } $name {} texttag
	$w move $texttag.but $dx 0
	$w move $texttag.but2 $dx 0
    }
    $w move hidewin $dx 0

}

proc tkMoveOptionBarDynamically { w dx } {
    tkMoveOptionBar $w $dx
    after 75 tkMoveOptionBarDynamically $w $dx
}

proc tkOptionBarNext { w { sense 1 } } {
    upvar \#0 $w data

    set pos [lsearch $data(optlist) $data(current)]
    incr pos $sense
    if { $pos < 0 } { set pos [expr $data(numopts)-1] }
    if { $pos == $data(numopts) } { set pos 0 }

    set text [lindex $data(optlist) $pos]

    tkSelectOptionBar $w $text

}

proc tkSetFocusRing { w { set yes } } {
    upvar \#0 $w data
    if { $set == "yes" } {
	if { [$w find withtag FocusRingTag] == "" } {
	    $w create rectangle 0 0 0 0 -tags FocusRingTag
	}
	regsub -all { } $data(current) {} texttag
	regexp {([^ ]*)[ ]*([^ ]*)[ ]*([^ ]*)[ ]*([^ ]*)} \
		[$w bbox $texttag.but] t x y xe ye
	$w coords FocusRingTag [expr $x+4] [expr $y+4] [expr $xe-5] [expr $ye-4]


    } else {
	
	if { [$w find withtag FocusRingTag] != "" } {
	    $w delete FocusRingTag
	}
    }
}