
#!/bin/sh
# \
exec wish "$0" -- "$@"
package require Tk
set i {}
proc color {type} {
global i
set color [tk_chooseColor -initialcolor [$i.text cget -$type]]
if {$color != ""} {$i.text configure -$type $color}
}
proc fontupdate {type args} {
global i font
switch $type {
scale {
font configure font -size $args
font configure fontb -size $args -weight bold
}
font {
font configure font -family $font
font configure fontb -family $font -weight bold
}
}
}
if {![winfo exists .$i]} {toplevel .$i}
.$i configure -bd 2 -relief raised
wm title .$i "Font Viewer"
wm geometry .$i 350x200
frame $i.bottom
text $i.text -background white
frame $i.bottom.1 -relief groove -bd 2
frame $i.bottom.2 -relief groove -bd 2
scale $i.bottom.1.size -from 6 -to 22 -orient h -command [list fontupdate scale]
button $i.bottom.2.fg -text Foreground -command "color foreground"
button $i.bottom.2.bg -text Background -command "color background"
set menu [tk_optionMenu $i.bottom.1.font font "Choose a font"]
pack $i.bottom -side bottom -fill both
pack $i.text -fill both
pack $i.bottom.1.font -pady 3
pack $i.bottom.1.size
grid $i.bottom.1 $i.bottom.2 -pady 5 -padx 5 -ipady 5 -ipadx 5 -sticky ns
grid columnconfigure $i.bottom {0 1} -weight 1
grid $i.bottom.2.fg -sticky nesw -pady 3
grid $i.bottom.2.bg -sticky nesw -pady 3
font create font -family fixed
font create fontb -family fixed -weight bold
$i.text configure -font font
$i.text tag configure bold -font fontb
$i.text tag configure underline -underline 1
$i.text insert end {normal } {} {bold} bold { } {} {underline} underline { } {} {both} {bold underline}
$i.text configure -state disabled
$menu delete 0
foreach x [lsort -dictionary [font families]] {
$menu add radiobutton -label $x -variable font -command [list fontupdate font]
}
$i.bottom.1.size set 14
# --[AF] 22-06-03Zipguy 2013-09-03 - You can find out my email address by clicking on Zipguy. Thanks rle, it looks very interesting. I do like the way it does a full screen height list when you hit the "Choose a font" button. It looks like this on my laptop (which is running tcl on Windows 7):
I added the screenshot and added a new page called Font Choosers, which references this page, to organize them a liitle bit.See also: font

