#!/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