#!/usr/local/bin/wish8.0
#
# $Source: /home/nlfm/Working/Trevi/RCS/trevi,v $
# $Date: 1997/01/09 16:18:54 $
# $Revision: 1.2 $
#
# ----------------------------------------------------------------------
#   AUTHOR:  Lindsay Marshall <lindsay.marshall@newcastle.ac.uk>
# ----------------------------------------------------------------------
# Copyright 1997 The University of Newcastle upon Tyne (see COPYRIGHT)
# ======================================================================
#
proc trevi_getSize {win} {
    global size ss
    set ss $size
    set w [toplevel .$win@s]
    wm title $w {Typeface Size}
    wm resizable $w 0 0
    message $w.msg -aspect 500 -text {Enter required size in points:}
    entry $w.ent -textvariable ss -width 12
    button $w.ok -text OK -command "set size \$ss ; destroy $w" -width 5
    button $w.cancel -text cancel -command "destroy $w" -width 5
    grid $w.msg -
    grid $w.ent -
    grid $w.ok $w.cancel
    tkwait window $w
    unset ss
}
#
proc trevi_newFont {w args} {
    global family size weight slant CFt underline overstrike
    catch {font delete $CFt}
    set CFt [font create -family $family -weight \
	$weight -slant $slant -size $size]
    foreach x {family slant weight size underline overstrike} {
	upvar #0 $x var
	if {$var != [font actual $CFt -$x]} {
	    bell
	    set var [font actual $CFt -$x]
	    update idletasks
	    return
	}
    }
    .trevi.txt configure -font $CFt
    foreach {x y} [font metrics [.trevi.txt cget -font]] {
	.trevi.$x configure -text "[string range $x 1 end] : $y"
    }
}
#
proc fontbrowser {w args} {
    global family size weight slant CFt underline overstrike
    toplevel $w
    grid columnconfigure $w 0 -weight 1
    grid columnconfigure $w 1 -weight 1
    grid rowconfigure $w 4 -weight 1
    wm title $w {Font browser}
    wm resizable $w 1 1
    eval tk_optionMenu $w.family family [font families]
    tk_optionMenu $w.size size 6 8 9 10 11 12 14 16 18 20 24 28 36
    $w.size.menu add separator
    $w.size.menu add command -label Other -command "trevi_getSize $w"
    radiobutton $w.normal -variable weight -value normal -text Normal
    radiobutton $w.bold -variable weight -value bold -text Bold
    radiobutton $w.roman -variable slant -value roman -text Roman
    radiobutton $w.italic -variable slant -value italic -text Italic
    checkbutton $w.under -variable underline -text Underline
    checkbutton $w.strike -variable overstrike -text Overstrike
    grid $w.family $w.size -sticky ew
    grid $w.normal $w.bold -sticky ew
    grid $w.roman $w.italic -sticky ew
    grid $w.under $w.strike -sticky ew
    grid [text $w.txt -width 40 -height 4 -relief raised] - -sticky nsew
    for {set x 32} {$x <= 255} {incr x} {
	switch 127 $x continue
	$w.txt insert end [format %c $x]
    }
    array set Fnt [font actual [$w.txt cget -font]]
    foreach x {family weight slant size underline overstrike} {
	set $x $Fnt(-$x)
	trace variable $x w "trevi_newFont $w"
    }
    foreach {x y} [font metrics [$w.txt cget -font]] {
	grid [label $w.$x -text "[string range $x 1 end] : $y"] -
    }
    set CFt {}
    grid [frame $w.sep1 -bg red -borderwidth 2] - -sticky ew
    grid [frame $w.btn] - -sticky ew
    button $w.btn.quit -text OK -command "destroy $w" -width 6 -default 1
    button $w.btn.cancel -text Cancel -command "set CFt {} ; destroy $w" -width 6
    pack $w.btn.quit $w.btn.cancel -side left -expand 1
    tkwait window $w
    set res $CFt
    unset family size weight slant CFt underline overstrike
    return $res
}
#
wm withdraw .
#
fontbrowser .trevi
exit
