ui-display.tcl

rtpmon-1.0a7.tar.gz for UNIX like

#
# Copyright (c) 1996 The Regents of the University of California.
# All rights reserved.
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose, without fee, and without written agreement
# is hereby granted, provided that the above copyright notice and the
# following two paragraphs appear in all copies of this software.
#
# IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR
# DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING
# OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE
# UNIVERSITY OF CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
#
# THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,
# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
# AND FITNESS FOR A PARTICULAR PURPOSE.  THE SOFTWARE PROVIDED HEREUNDER IS
# ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
# PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
#
#
# $Id: ui-display.tcl,v 1.19 1997/01/13 22:25:36 aswan Exp $

proc init-ui {} {
    global mon version State Prefs

    set version [version]

    #
    # Setup the toplevel window configuration
    #
    set State(title) [option get . conferenceName Rtpmon]
    if {$State(title) == ""} {
	set State(title) [option get . defaultHostSpec Rtpmon]
    }
    wm title . "rtpmon: $State(title)"
    wm minsize . 300 200
    wm geometry . 300x200

    #
    # Check whether mtrace is available ..
    #  mtrace is not supported on all platforms
    catch {exec mtrace} msg
    if {[string first "Usage: mtrace" $msg] == 0} {
	set State(mtrace) 1
    } else {
	set State(mtrace) 0
    }

    #
    # Setup the default preferences 
    #
    # The Prefs variable keeps track of state which the user should be
    # allowed to modify on the fly .. this is information which would
    # eventually be put into a preferences dialog.
    #

    set Prefs(displayindex) 0
    set Prefs(sortparam) max

    # control whether or not sorting is done automatically
    set Prefs(autosort) [option get . autosort Rtpmon]
    # the autosort interval is in seconds
    set Prefs(autosortInterval) [option get . autosortInterval Rtpmon]
    # control whether or not cleaning is done automatically
    set Prefs(autoclean) [option get . autoclean Rtpmon]
    # the autoclean interval is in seconds
    set Prefs(autocleanInterval) [option get . autocleanInterval Rtpmon]

    # the refresh interval is in seconds
    set Prefs(refreshInterval) [option get . refreshInterval Rtpmon]

    #
    # Setup the default state
    #
    # The State variable is a central repository for global program state.
    # I find it easier to keep a global state array than a bunch of
    # individual global variables.
    #
    set State(infoCount) 0

    #
    # Retrieve the supported display parameters
    #

    set State(displayParams) [$mon statnames]

    set Prefs(threshold) [option get . threshold Rtpmon]

    set Prefs(displayparam) \
	    [lindex [lindex $State(displayParams) $Prefs(displayindex)] 0]

    #
    # Create the basic display (the table and the buttonbar)
    #
    CreateDisplay .display
    CreateButtons .buttonbar
    
    pack .buttonbar -side bottom -fill x -pady 1m
    pack .display -side top -expand 1 -fill both -padx 1m
    
    #
    # Make the focus follow the cursor
    #
    tk_focusFollowsMouse

    #
    # Setup the nifty key bindings for power users
    #
    bind . <Key-s> { 
	$Widgets(sortbutton) configure -state active ; update idletasks
	sort-display
	$Widgets(sortbutton) configure -state normal ; update idletasks
    }
    bind . <Key-c> { 
	$Widgets(cleanbutton) configure -state active ; update idletasks
	clean-display
	$Widgets(cleanbutton) configure -state normal ; update idletasks
    }
    bind . <Key-q> exit
}

proc getlisteners {} {
    global mon
    return [$mon listeners]
}

proc getsenders {} {
    global mon
    return [$mon senders]
}

proc getdata {idx s l} {
    if {"[info commands $l]" != "" && "[info commands $s]" != ""} {
	set stats [$l stats [$s position]]
	return [lindex $stats $idx]
    } else {
	return 0
    }
}

proc toggleWindow {w} {
    if {![winfo exists $w]} { return -1 }

    if [winfo ismapped $w] {
	wm withdraw $w
    } else {
	wm deiconify $w
    }

    return [winfo ismapped $w]
}


#
# Create the primary RTCP display
#
proc CreateDisplay {w} {
    global Widgets State Prefs mon

    set State(senders) {}
    set State(listeners) {}
    set State(listenerCount) 0

    set Widgets(topdisplay) $w
    frame $w -relief ridge -bd 2

    # Fix the size of the listener column (for now)
    label $w.title -text {} -relief raised -bd 1 -width 10 -height 1
    grid $w.title -row 0 -column 0 -sticky ew
    
    canvas $w.column0 -width 200 -height 100 \
	    -bg grey30 -bd 0 -relief flat -highlightthickness 0 \
	    -scrollregion [list 0 0 400 100] -yscrollcommand "update-scrollbar"
    grid $w.column0 -row 1 -column 0 -sticky wens

    scrollbar $w.scrolly -orient vertical \
	    -highlightthickness 0 -command "scroll-canvases"
    grid $w.scrolly -row 1 -column 1 -sticky ns
    

    set t [frame $w.column0.frame]
    $w.column0 create window 0 0 -window $w.column0.frame -anchor nw

    set Widgets(column0) $w.column0.frame

    # set up the median label
    label $w.median -text "Median" -anchor w -font [resource smallfont] \
	-relief raised -bd 1
    grid $w.median -row 2 -column 0 -sticky ew

    # Setup the sizes of the main rows
    # GRID LATER: handle the resizing properly
    grid rowconfigure $w 0 -weight 0
    grid rowconfigure $w 1 -weight 1
    
    # Allow adjustments to the size of the listener column
    grid columnconfigure $w 0 -weight 1 -minsize 80
    grid columnconfigure $t 0 -weight 1 -minsize 80
    
    # Fix the size of the scrollbar (rightmost) column
    set col [expr [lindex [grid size $w] 1] - 1]
    grid columnconfigure $w $col -weight 0

    # resize interior table when the canvas is resized
    bind $w <Configure> update-scrollregion

    periodic-clean-inactive [expr int(1000 * $Prefs(refreshInterval))]

    return $w
}

proc update-scrollbar {args} {
    global State Widgets

    set t $Widgets(topdisplay)
    eval $t.scrolly set $args

    set n [expr [llength $State(senders)] + 1]
    for {set i 0} {$i < $n} {incr i} {
	$Widgets(topdisplay).column$i yview moveto [lindex $args 0]
    }
}

proc scroll-canvases {args} {
    global State Widgets

    set t $Widgets(topdisplay)

    set n [expr [llength $State(senders)] + 1]
    for {set i 0} {$i < $n} {incr i} {
	eval $Widgets(topdisplay).column$i yview $args
    }
}

proc update-scrollregion {} {
    global State Widgets
    # Note: the resizing actions may not have actually happened yet, 
    # performing an update will ensure that the column sizes are correct
    update idletasks
    set t $Widgets(topdisplay)

    set n [expr [llength $State(senders)] + 1]
    for {set i 0} {$i < $n} {incr i} {
	set c $t.column$i
	set f $c.frame

	$c itemconfig 1 -width [winfo width $c]
	$c config -scrollregion "0 0 [winfo width $f] [winfo height $f]"
    }
}

#
# Create the button bar
#
proc CreateButtons {w} {    
    global mon version Widgets

    frame $w -relief ridge -bd 2
    label $w.title -text "rtpmon v$version" -relief flat \
	-font [resource smallfont]

    button $w.quit -text Quit -command exit -font [resource smallfont] \
	-highlightthickness 1 -bd 2 -padx 2 -pady 2
    set Widgets(quitbutton) $w.quit

    button $w.help -text Help -command toggle-help -font [resource smallfont] \
	-highlightthickness 1 -bd 2 -padx 2 -pady 2
    set Widgets(helpbutton) $w.help
    
    button $w.menu -text Menu -command toggle-menu -font [resource smallfont] \
	-highlightthickness 1 -bd 2 -padx 2 -pady 2
    set Widgets(menubutton) $w.menu
    
    button $w.sort -text Sort -command sort-display -font [resource smallfont]\
	-highlightthickness 1 -bd 2 -padx 2 -pady 2
    set Widgets(sortbutton) $w.sort

    button $w.clean -text Clean -command clean-display \
	-font [resource smallfont] -highlightthickness 1 -bd 2 -padx 2 -pady 2
    set Widgets(cleanbutton) $w.clean


    pack $w.title -side left -fill x -expand 1 -padx 1m
    pack $w.quit $w.help $w.menu $w.sort $w.clean -side right -padx 1 -pady 2
}

proc new-sender {s} {
    global mon Widgets State names

    set State(senders) [getsenders]

    set col [llength $State(senders)]
    set n [expr $col - 1]

    set t $Widgets(topdisplay)

    # forget the scrollbar while we re-arrange columns
    grid forget $t.scrolly
    
    # Create the button with the sender's name
    set b $t.sender$col

    label $b -highlightthickness 0 -bd 1 -relief raised \
	-anchor w -textvariable names($s) -font [resource smallfont]
    bind $b <Enter> "$b conf -bg [option get . activeBackground Rtpmon]"
    bind $b <Leave> "$b conf -bg [option get . background Rtpmon]"
    bind $b <Button-1> "CreateInfoWindow $s"

    menu $b.menu -transient yes
    $b.menu add command -label "Site Info" -font [resource smallfont] \
	-command "CreateInfoWindow $s"
    $b.menu add command -label "Ignore" -font [resource smallfont] \
	-command "ignore-sender $s"
    bind $b <Button-3> "tk_popup $b.menu %X %Y"