ui-resource.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-resource.tcl,v 1.4 1997/01/11 00:45:28 aswan Exp $

proc init_resources {} {
    #
    # use 2 pixels of padding by default
    #
    option add *padX 2
    option add *padY 2
    #
    # don't put tearoffs in pull-down menus
    #
    option add *tearOff 0

    #
    # Make the color scheme a little darker than the default gray.
    # Go through all the palette resources and raise the option data
    # base priority from widgetDefault to 61 so that user's X resources
    # won't override these.
    #
    tk_setPalette gray80
    foreach option [array names tkPalette] {
	option add *$option $tkPalette($option) 61
    }

    option add *Radiobutton.relief flat startupFile

    #
    # These can be overridden.
    #
    option add Rtpmon.threshold 1 startupFile
    option add Rtpmon.autosort 0 startupFile
    option add Rtpmon.autosortInterval 5 startupFile
    option add Rtpmon.autoclean 0 startupFile
    option add Rtpmon.autocleanInterval 5 startupFile
    option add Rtpmon.refreshInterval 3 startupFile
    option add Rtpmon.defaultHostSpec 224.2.1.1/4444 startupFile
    option add Rtpmon.sessbw 64. startupFile

    option add Rtpmon.foundry adobe startupFile
    init_fonts
}

proc resource r {
    return [option get . $r Rtpmon]
}

global font
set font(helvetica10) {
    r-normal--*-100-75-75-*-*-*-*
    r-normal--10-*-*-*-*-*-*-*
    r-normal--11-*-*-*-*-*-*-*
    r-normal--*-100-*-*-*-*-*-*
    r-normal--*-*-*-*-*-*-*-*
}
set font(helvetica12) {
    r-normal--*-120-75-75-*-*-*-*
    r-normal--12-*-*-*-*-*-*-*
    r-normal--14-*-*-*-*-*-*-*
    r-normal--*-120-*-*-*-*-*-*
    r-normal--*-*-*-*-*-*-*-*
}
set font(helvetica14) {
    r-normal--*-140-75-75-*-*-*-*
    r-normal--14-*-*-*-*-*-*-*
    r-normal--*-140-*-*-*-*-*-*
    r-normal--*-*-*-*-*-*-*-*
}
set font(times14) {
    r-normal--*-140-75-75-*-*-*-*
    r-normal--14-*-*-*-*-*-*-*
    r-normal--*-140-*-*-*-*-*-*
    r-normal--*-*-*-*-*-*-*-*
}

proc search_font { foundry style weight points } {
    global font
    foreach f $font($style$points) {
	set fname -$foundry-$style-$weight-$f
	if [havefont $fname] {
	    return $fname
	}
    }
    puts stderr "rtpmon: can't find $weight $fname font (using fixed)"
    if ![havefont fixed] {
	puts stderr "rtpmon: can't find fixed font"
	exit 1
    }
    return fixed
}


proc init_fonts {} {
    set foundry [resource foundry]

    set helv10  [search_font $foundry helvetica medium 10]
    set helv10b [search_font $foundry helvetica bold 10]
    set helv12b [search_font $foundry helvetica bold 12]
    set times14 [search_font $foundry times medium 14]

    option add *Font $helv12b startupFile
    option add Rtpmon.medfont $helv12b startupFile
    option add Rtpmon.smallfont $helv10b startupFile
    option add Rtpmon.helpFont $times14 startupFile
    option add Rtpmon.entryFont $helv10 startupFile
}