#************************************************************
# keydlg.tcl
#
# A pair of scrolled listboxes with sets of keys in the left
# box and individual keys in the right one, which allows the
# user to toggle the value of the keys (0/1) and select one
# keyset.
#
# Author : Dan Gunter
# Created: 1/13/98
# Credits: Brent Welch, "Practical Programming in Tcl/Tk",
#          (c)1995 Prentice-Hall
#************************************************************

####################
# ScrolledLB --
#
#   Scrolled listbox widget, from
#   Brent Welch, "Practical .."
#
proc ScrolledLB { parent args} {
    global param

    set sbg $param(color-ctlbg)
    frame $parent
    eval {listbox $parent.lb \
	    -yscrollcommand [list $parent.sy set] \
	    -xscrollcommand [list $parent.sx set]} $args
    scrollbar $parent.sy \
            -orient vertical \
            -width 12 \
	    -background $sbg \
            -activebackground $sbg \
	    -command [list $parent.lb yview]
    frame $parent.bottom
    scrollbar $parent.sx  \
            -orient horizontal \
            -width 12 \
	    -background $sbg \
            -activebackground $sbg \
	    -command [list $parent.lb xview]
    set pad [expr [$parent.sy cget -width] + 2* \
	    ([$parent.sy cget -bd] + \
	    [$parent.sy cget -highlightthickness])]
    frame $parent.pad \
            -width $pad \
            -height $pad \
            -bg $sbg
    pack $parent.bottom -side bottom -fill x
    pack $parent.pad -in $parent.bottom -side right
    pack $parent.sx -in $parent.bottom -side bottom -fill x
    pack $parent.sy -side right -fill y
    pack $parent.lb -side left -fill both -expand true
    return $parent.lb
}
####################
# ScrolledLBh --
#
#   Scrolled listbox widget, from
#   Brent Welch, "Practical .."
#   MODIFIED to only have the horizontal
#   scrollbar visible.
#
proc ScrolledLBh { parent args} {
    global param

    set sbg $param(color-ctlbg)
    frame $parent
    eval {listbox $parent.lb \
            -yscrollcommand [list $parent.sy set] \
            -xscrollcommand [list $parent.sx set]} $args
    scrollbar $parent.sy \
            -orient vertical \
            -width 12 \
            -background $sbg \
            -activebackground $sbg \
            -command [list $parent.lb yview]
    frame $parent.bottom
    scrollbar $parent.sx  \
            -orient horizontal \
            -width 12 \
            -background $sbg \
            -activebackground $sbg \
            -command [list $parent.lb xview]
    pack $parent.bottom -side bottom -fill x
    pack $parent.sx -in $parent.bottom -side bottom -fill x
    pack $parent.lb -side left -fill both -expand true
    return $parent.lb
}

#########################
# KeySelect --
#
#    Widget to select keys
#
proc KeySelect { parent } {
    global CKeySet CKey param

    set bopts [list -background $param(color-buttonbg) \
	            -foreground $param(color-buttonfg) \
		    -activebackground $param(color-buttonabg) \
		    -highlightbackground $param(color-ctlbg) \
		    -width 5]
    set cbg $param(color-ctlbg)
    set fopts [list -background $cbg]
    set lbg #ffffff

    toplevel $parent
    eval {frame $parent.1} $fopts
    eval {frame $parent.2} $fopts
    eval {frame $parent.3} $fopts
    eval {frame $parent.1.spacer} $fopts -width 5
    eval {frame $parent.2.but} $fopts

    # top frame

    label $parent.1.l1 -text "Event Sets" -anchor w -justify left -width 12 \
	    -background $cbg
    label $parent.1.l2 -text "Events" -anchor w -justify left -width 20 \
	    -background $cbg
    pack $parent.1.l2 $parent.1.l1 -side right

    # middle frame

    set lsht 8
    set list1 [ScrolledLB $parent.2.lb1 -width 12 -selectmode 1 -height $lsht -background $lbg]
    $parent.2.lb1.pad configure -background $cbg
    set list2 [ScrolledLB $parent.2.lb2 -width 20 -height $lsht -background $lbg]
    $parent.2.lb2.pad configure -background $cbg
    bind $list1 <ButtonPress-1> [list CSel 1 $list1 $list2 %y]
    bind $list2 <ButtonPress-1> [list CSel 2 $list1 $list2 %y]
    eval { button $parent.2.but.sel -text "+/- Set"  \
	    -command [list ToggleSet $list1 $list2]} $bopts
    eval {button $parent.2.but.up -text "^ UP"\
	    -command [list MoveSet up $list1 $list2 ]} $bopts
    eval {button $parent.2.but.down -text "v DOWN" \
	    -command [list MoveSet down $list1 $list2]} $bopts
    pack $parent.2.but.up $parent.2.but.sel $parent.2.but.down -side top
    pack $parent.2.lb2 $parent.2.lb1 $parent.2.but -side right

    # bottom frame

    eval {button $parent.3.ok -text "OK" -padx 5 -pady 5 \
	    -command [list keyOKButtonPressed $parent]} $bopts
    eval {button $parent.3.cancel -text "Cancel" -padx 5 -pady 5 \
	    -command [list keyCancelButtonPressed $parent]} $bopts
    pack $parent.3.ok $parent.3.cancel \
	    -side left -padx 10 -pady 5

    # whole thing

    pack $parent.1 $parent.2 $parent.3 -side top -fill both

    set CKeySet 0
    set CKey    0
    Redraw 2 $list1 $list2
    return $parent
}

#####################
#
# Redraw --
#
#    Show all keys.
#

proc Redraw { num lb1 lb2 } {
    global CSet CKeySet param

    if { $num == 2 } {
	$lb1 delete 0 end
	for { set i 0 } { $i < $param(EVENT,NUMSETS) } { incr i } {
	    $lb1 insert end $param(EVENT,$i)
	}
    }
    $lb2 delete 0 end
    for { set j 0 } { $j < $param(EVENT,NUMKEYS,$CKeySet) } { incr j } {
	$lb2 insert end $param(EVENT,$CKeySet,$j)
    }
}

#####################
#
# CSel --
#
#    Select a key or key-set.
#
proc CSel { lnum lb1 lb2 y } {
    global CKeySet CKey
    switch $lnum \
	    "1" { set CKeySet [$lb1 index @0,$y];
	          Redraw 2 $lb1 $lb2 } \
	    "2" { set CKey    [$lb2 index @0,$y];
	          ToggleKey $lb1 $lb2 }
}

#####################
# ToggleKey
#
#   Change +/- of key.
#
proc ToggleKey { lb1 lb2 } {
    global param CKeySet CKey
    set param(EVENT,$CKeySet,$CKey) [Toggle $param(EVENT,$CKeySet,$CKey)]
    if { $param(EVENT,NUMKEYS,$CKeySet) == 1 && \
	     [firstch $param(EVENT,$CKeySet)] != [firstch $param(EVENT,$CKeySet,$CKey)] } {
	# Special case: 1 key in set:
	ToggleSet $lb1 $lb2
    } else {
	# Normal case:
	Redraw 1 none $lb2
    }
}

#####################
# ToggleSet
#
#   Change +/- of set.
#
proc ToggleSet { lb1 lb2 } {
    global param CKeySet ON OFF
    # You cannot turn on a keyset with one key if
    # the key is turned off.
    if { $param(EVENT,NUMKEYS,$CKeySet) == 1 && \
	     [firstch $param(EVENT,$CKeySet)] == $OFF && \
	     [firstch $param(EVENT,$CKeySet,0)] == $OFF } {
	return
    }
    set param(EVENT,$CKeySet) [Toggle $param(EVENT,$CKeySet)]
    Redraw 2 $lb1 $lb2
}
#######################
# MoveSet --
#
#    Move a set up/down.
#
proc MoveSet { dir lb1 lb2 } {
    global param CKey CKeySet
    set old $CKeySet
    set plist [list NUMKEYS]

    switch $dir {
	up { 
	    if {$CKeySet == 0} return;
	    incr CKeySet -1
	}
	down {
	    if {$CKeySet == [expr $param(EVENT,NUMSETS) - 1]} return;
	    incr CKeySet
	}
    }
    # Big swap statement:
    # 1. Copy old to tmp()
    set tmp(0)  $param(EVENT,$old)
    foreach i $plist {
	set tmp($i) $param(EVENT,$i,$old)
    }
    for { set i 0 } { $i < $param(EVENT,NUMKEYS,$old) } { incr i } {
	set tmp(E,$i)  $param(EVENT,$old,$i)
	unset param(EVENT,$old,$i)
    }
    # 2. Copy new to old
    set param(EVENT,$old)         $param(EVENT,$CKeySet)
    foreach i $plist {
	set param(EVENT,$i,$old) $param(EVENT,$i,$CKeySet)
    }
    for { set i 0 } { $i < $param(EVENT,NUMKEYS,$CKeySet) } { incr i } {
	set param(EVENT,$old,$i) $param(EVENT,$CKeySet,$i)
    }
    # 3. Copy tmp() to new
    set param(EVENT,$CKeySet)         $tmp(0)
    foreach i $plist {
	set param(EVENT,$i,$CKeySet) $tmp($i)
    }
    for { set i 0 } { $i < $param(EVENT,NUMKEYS,$CKeySet) } { incr i } {
	set param(EVENT,$CKeySet,$i) $tmp(E,$i)
    }
    # Done: Redraw
    Redraw 2 $lb1 $lb2
}

#####################
# firstch
#
proc firstch { s } { return [string range $s 0 0] }

#####################
# Toggle
#
#   Change +/- of a string.
#
proc Toggle { s } {
    global ON OFF

    if { [firstch $s] == $ON } {
	return "$OFF[string range $s 1 end]"
    } else {
	return "$ON[string range $s 1 end]"
    }
}

#######################
# keyOKButtonPressed --
#
#     Process "OK" button
#
#     Redraw the screen UNLESS there has been NO
#     data read so far. If this is the case,
#     latestRead will be -1 .
#

proc keyOKButtonPressed { parent } {
    global param
    global didPause

    RemapKeys
    HighlightsChanged
    destroy $parent
    .graph yaxis configure -max [YAxisMax]
    .graph y2axis configure -max [YAxisMax]
    set param(ViewChanged) 1
    Refresh
    update idletasks
    if { $didPause }  {
	set param(Paused) 0
	Play
    }
}

########################
# keyCancelButtonPressed --
#
#    Process "Cancel" button
#
proc keyCancelButtonPressed { parent } {
    global didPause

#    Reinstate
    destroy $parent
    if { $didPause }  {
	set param(Paused) 0
	Play
    }
}

#########################
# ShowKeyDlg --
#
#    Initialize and draw the widget
#
proc ShowKeyDlg { } {
    global param didPause

    if { $param(Paused) == 0 } { 
	set param(Paused) 1
	Pause
	set didPause 1 
    } else {
	set didPause 0
    }
    GetKeys
    set dlg [KeySelect .k]
    wm title $dlg "Select Events to Display"
    wm geometry $dlg +100+200
    set param(ViewChanged) 0
}

# Current key and key set
global CKeySet
global CKey
# Paused to do this?
global didPause
global ON OFF
set ON "+"
set OFF "-"
