Version 5 of YAFSG - Yet Another Font Selector GUI
Updated 2012-08-14 16:12:06 by uniquenameuniquename - 2012aug13
I recently published the code for a color selector Tk script on a page titled A non-obfuscated color selector GUI, at this site.
I have one more 'selector' script that I think would be helpful to publish on this site --- helpful to Tcl-Tk 'newbies' who need complete examples of working, useful scripts to speed up their learning process --- and perhaps helpful to someone still looking for a better font selector GUI.
By doing a search on this site with keywords like 'font chooser', you will find that everyone seems to have their own idea as to what they need in a font chooser --- A little font chooser, A small font chooser, Another Font Chooser Dialog.
And there is the code for yet another font chooser in the book 'Practical Programming in Tcl and Tk' (4th edition) by Brent Welch, Ken Jones, and Jeffrey Hobbs --- page 643 --- where this image is shown --- along with the code used to generate it.
I built my font selector based on that code --- but I reorganized the code according to a 'canonical' code structure that I have used for all my Tk scripts written in the past 10 years or so (on the order of a hundred Tk scripts):
0) Set general window parms (name,position-size,color-scheme,fonts,etc.). 1) Define ALL frames (and sub-frames). Pack them. 2) Define & pack all widgets in the frames. 3) Define key/mouse action BINDINGS, if needed. 4) Define PROCS, if needed. 5) Additional GUI initialization (with procs), if needed.
When I need to find a proc (or a binding, or a widget definition, or an example pack statement, etc. etc.) in my scripts, I can find what I need relatively quickly.
In addition, I added a few features to the example presented in the Welch book. Some of those features can be seen by comparing the following image to the image above.
The code for this font selector GUI is about twice as long (in bytes/characters) as the code for the color selector GUI.
But it may be helpful to publish the code here, if only to give some examples of using widgets not used in the color selector GUI script --- to aid Tcl-Tk 'newbies' who are looking for code samples.
(Besides, even though it might take more than 30 PageDown key strokes to page through this code image, when considered in bytes, the file holding this code is less than 2% of the size of the typical JPEG file from a 12 megapixel digital camera.)
Anyway, the widgets in this font selector GUI include 'listbox' (with y-scrollbar), 'text' widget with both x and y scrollbars, 'radiobutton' widgets, 'checkbutton' widgets --- even a 'tk_optionMenu' button widget (a predecessor of the newer 'spinbox' widget).
(I stick with the 'tk_optionMenu' widget so that this code will run even for people using an old 7.x era 'wish' interpreter.
Alternatively, I could replace the 'tk_optionMenu' button with the 'spinner' proc at the spinbox page. It is "a concoction of a 1-line high listbox with two tiny buttons", so it would run with old 7.x wish interpreters. Maybe I will do that --- someday.)
After I retired and started assembling the software in my 'Freedom Environment' (FE) software system (see [L1 ]), I used this font selector GUI as a font setting utility in the 'xpg', 'feAppMenus, and 'feHandyTools' subsystems of my Freedom Environment software.
That was my single, main motivation for making this font selector. It is a font selector that blends in with the other Tk GUI's in my FE systems. Plus, it does exactly what I need it to do.
I provide all the FE code as free and open source code. A lot of the FE Tcl-Tk scripts (such as the code for the 'xpg' utility) are really too long for a page on this Tcl-Tk wiki. But the code for this font-selector utility is probably useful enough to risk stretching the bounds of propriety in regard to script length in these pages.
I have 'left in' many of my comments that explain the usage of the GUI and the structure and intent of the code.
In my FE subsystems, I use some Tk 'include' scripts in my scripts to provide some parameter setting that is shared with other utility scripts. I have replaced the corresponding 'source' statements with the essential Tk statements from those 'include' scripts.
(Some of the 'include' statements, involving parameters for 'entry' and 'message' widgets, widgets not used in this GUI, may be left in this code --- and commented, for the most part. Those statments can be useful if other GUIs are made using this code as a starting point.)
As I do in all my Tk scripts, I have put the four main pack parameters --- '-side', '-anchor', '-fill', '-expand' --- on the 'pack' command for the various frames and widgets. That helps me when I am initially testing the behavior of a GUI (the various widgets within it) as I resize the main window.
For this particular GUI, when one chooses to display a font in a really big size, the sample text widget needs to be allowed to expand --- to full screen size if necessary.
To help restore the window to a more desirable size, when going back to a smaller font size from a really big font size, there is a 'DwnWin' button on the GUI.
You can click on that button repeatedly to quickly down-size the window, in increments of about 10%. I find this much more speedy and less frustrating than trying to grab a really thin edge of the window, to drag the window edge, to make a smaller window.
I think I have found a good setting of the '-side', '-anchor', '-fill', and '-expand' parameters on the 'pack' commands for the various widgets. In particular ...
The 'listbox' widget and the sample 'text' area widget expand/contract appropriately when the window size is changed --- and button and label widgets stay fixed in size and relative-location as the window size is changed.
However, if anyone wants to change the way the GUI configures itself as the main window size is changed, they can experiment with the '-side', '-anchor', '-fill', and '-expand' parameters on the 'pack' commands for the various widgets --- to get the widget behavior that they want.
(I leave it as an 'exercise for the reader' to change the 'tk_optionMenu' widget to a 'spinbox' widget.)
#!/usr/bin/wish -f
##
## Tk SCRIPT NAME: select_tkFont.tk
##
##+#######################################################################
## PURPOSE: This TkGUI script provides a GUI for selecting a set of
## Tcl-Tk font specification values (6 of them):
## family, size (pixels or points ; negative or positive integers),
## normal/bold, roman/italic, underscore/null, overstrike/null.
##
##
## The GUI includes a scrolling listbox to present the font families
## known to Tcl-Tk. The listbox is loaded via the 'font families' Tk command.
##
## We use a Tk optMenu to get the font size.
## (We use 'tk_optionMenu' to display a fixed set of sizes, about 20 of them.)
##
## We use a couple of radiobuttons for the user to specify pixels or points.
##
## We use 4 checkboxes for the user to specify bold and/or italic
## and/or underline and/or overstrike.
##
## In summary, we need 1 listbox, 1 optMenu (with or without entry field),
## 2 radiobuttons, and 4 checkbuttons --- to completely specify a font.
##
## The GUI shows an example display of the chosen font: upper and lower case
## alphabetic characters, numerals, and special characters.
##
## We use 'bindings' to these widgets, to update the font of the
## sample-text area, as soon as one of the widgets is used.
##
## The GUI also has several buttons --- including OK/UseIt, Cancel, and
## Help buttons.
##
## Clicking on the OK/UseIt button returns the font specification
## (the six specification values) to the calling application.
##
## -----------------------------------------------------------------------
##
## This script is useful, for example, to a Tcl-Tk app developer
## so that he can offer a user the option of specifying a font
## for a major area of the GUI, like a text area that occupies
## most of the GUI real estate.
##
## In addition, this Tcl-Tk script may be called from a shell
## script. The 6 vars, which go to stdout, can be caught in
## a shell script variable for use in the shell script.
##
##+#####################################################################
## CALLED BY: The 'shofil.tk' Tk script that is the guts of the
## so-called 'xpg' utility, which is part of the 'FE' system.
##
## Also called by 'make_chest.tk' in $FEDIR_TKGUIS
## and probably by more FE Tcl-Tk scripts in the future.
##+#####################################################################
## INPUTS: User selects font properties from the widgets of the
## GUI generated by this script.
##
## OUTPUT: A set of values specifying the font that the user saw
## displayed in a text-numerics-punctuation sample in the GUI.
##
## Sample output string: { helvetica -12 { bold roman null null } }
## --- in this case, an array of 4 items.
## Actually this is a Tcl list with 3 items,
## where the 3rd items is, ordinarily, a list
## of 2 to 4 items.
##+#####################################################################
## CALL FORMAT: (in a Tcl-Tk script)
##
## [ exec $feDIR_tkguis/select_tkFont.tk ] (with no input parameters)
##
## ------------
## EXAMPLE CALL in a shell script:
##
## TEMP=`$FEDIR_TKGUIS/select_tkFont.tk`
##
## (Note: A command like 'cut' or 'awk' could separate the values in TEMP
## into 6 separate variables.)
##+########################################################################
## 'CANONICAL' STRUCTURE OF THIS CODE:
##
## 0) Set general window parms (name,position-size,color-scheme,fonts,etc.).
## 1) Define ALL frames (and sub-frames). Pack them.
## 2) Define & pack all widgets in the frames.
##
## 3) Define key/mouse action BINDINGS, if needed.
## 4) Define PROCS, if needed.
## 5) Additional GUI initialization (with procs), if needed.
##
## Some detail on the code structure of this particular Tk script:
##
## 1a) Define ALL frames:
##
## Top-level : 'fRleft' and 'fRright'
## Sub-frames of 'fRleft': none, just one listbox with scrollbar(s)
## Sub-frames of 'fRright' (top to bottom):
## - 'fRbuttons' for OK/UseIt and Cancel (and Help and Color) buttons
## - 'fRsize' for optMenu and 2 radiobuttons
## - 'fRcheck1' for bold and italic checkbuttons as well as
## underline and overstrike checkbuttons
## - 'fRtext' for two text widgets (one to hold, in one line, the
## font family name and font size
## --- the 2nd, in about 8 lines, to hold sample text)
##
## 1b) Pack ALL frames.
##
## 2) Define & pack all widgets in the frames -- basically going through
## frames & their interiors in left-to-right, top-to-bottom order:
##
## 3) Define bindings: none currently
##
## 4) Define procs:
## - 'loadfams2listbox' for GUI initialization
## - 'font_update' for bindings to font-attribute setting widgets
## - 'put_vars' for the OK/UseIt button
##
## - 'getset_bkgdcolor' for Color button
## (gets r255,g255,b255 via a GUI with 3 slider bars,
## then calls 'set_palette')
## - 'set_palette' used by the 'getset_bkgdcolor' proc ---
## and may be used for GUI initializaton
## (sets window color scheme from r255,g255,b255)
## - 'donwsize_win' for the DwnWin button
##
## 5) Additional GUI initialization: run 'loadfams2listbox'
##
##+#######################################################################
## DEVELOPED WITH: Tcl-Tk 8.4 on Ubuntu 9.10.
## wish> puts "$tcl_version $tk_version"
## 8.4 8.4
##+########################################################################
## FE system Copyright 2006+ by Blaise Montandon
##+########################################################################
## MAINTENANCE HISTORY:
## Started by: Blaise Montandon 2010aug21 Started development, on Ubuntu 9.10.
...
...
## Changed by: Blaise Montandon 2011oct05 Used the new wm border size vars ---
## wmPIXELS_top & wmPIXELS_left ---
## in the 'downsize_win' proc.
## Trimmed up some indentation.
## Chged/fixed some '-pady' to '-padx'.
##+#######################################################################
## For window title:
set VERSIONfontsel "ver2011oct05"
## For debugging msgs, below:
set THISscript "select_tkFont.tk"
##+#######################################################################
## SET COLOR SCHEME (palette) FOR THE WINDOW.
##+#######################################################################
## and
##+#######################################################################
## SET BACKGROUND COLOR vars FOR WIDGETS, like ENTRY & LISTBOX widgets.
##+#######################################################################
## Gray palette
set r255 210
set g255 210
set b255 210
set COLOR_pal [format "#%02X%02X%02X" $r255 $g255 $b255]
tk_setPalette $COLOR_pal
## "#BCD2EE" is a "lightsteelblue2". Change it if you want.
## "#FFFFFF" (white) may be too bright.
set feBGcolor_entry "#BCD2EE"
set feBGcolor_listbox $feBGcolor_entry
##+#######################################################################
## SET FONT VARS FOR THE VARIOUS WIDGET DEFINITIONS.
##+#######################################################################
set FONTsize 14
set FONT_SMALLsize 12
## BUTTON and LABEL : (generally variable width is best)
set feFONT_label " -family {comic sans ms} -size -$FONTsize -weight bold -slant roman "
set feFONT_button "$feFONT_label"
set feFONT_SMALL_label " -family {comic sans ms} -size -$FONT_SMALLsize -weight normal -slant roman "
set feFONT_SMALL_button "$feFONT_SMALL_label"
## ENTRY and LISTBOX : (generally fixed width is best)
set feFONT_entry " -family {dejavu sans mono} -size -$FONTsize -weight bold -slant roman "
set feFONT_listbox "$feFONT_entry"
set feFONT_SMALL_entry " -family {dejavu sans mono} -size -$FONT_SMALLsize -weight normal -slant roman "
set feFONT_SMALL_listbox "$feFONT_SMALL_entry"
## TEXT and MESSAGE : (generally fixed width is best)
set feFONT_text " -family {dejavu sans mono} -size -$FONTsize -weight bold -slant roman "
#vset feFONT_msg "$feFONT_text"
set feFONT_SMALL_text " -family {dejavu sans mono} -size -$FONT_SMALLsize -weight normal -slant roman "
# set feFONT_SMALL_msg "$feFONT_SMALL_text"
##+#####################################################################
## DEFINE (temporary) FONT VARS to be used in '-font' widget specs below.
##+#####################################################################
eval font create fontTEMP_button $feFONT_button
eval font create fontTEMP_label $feFONT_label
eval font create fontTEMP_entry $feFONT_entry
eval font create fontTEMP_listbox $feFONT_listbox
# eval font create fontTEMP_msg $feFONT_msg
eval font create fontTEMP_text $feFONT_text
eval font create fontTEMP_SMALL_button $feFONT_SMALL_button
eval font create fontTEMP_SMALL_label $feFONT_SMALL_label
eval font create fontTEMP_SMALL_entry $feFONT_SMALL_entry
eval font create fontTEMP_SMALL_listbox $feFONT_SMALL_listbox
# eval font create fontTEMP_SMALL_msg $feFONT_SMALL_msg
eval font create fontTEMP_SMALL_text $feFONT_SMALL_text
##+#######################################################################
## The user could override a font setting(s) for some of the
## widget types --- at least for testing --- via a statement(s)
## like the example below.
##+#######################################################################
# font create fontTEMP_button -family {liberation sans} -size -14 \
# -bold -roman -underline 0 -overstrike 0
##+#######################################################################
## SET GEOM VARS FOR THE VARIOUS WIDGET DEFINITIONS.
## (e.g. pady for Buttons)
##+#######################################################################
######################################################
## Set internal PADDING (X and Y) for BUTTON widgets.
######################################################
set fePADY_button 0
set fePADX_button 0
######################################################
## Set BORDER-WIDTH for LABEL, BUTTON, ENTRY, LISTBOX,
## TEXT, and MESSAGE widgets.
######################################################
set feBDwidth_label 2
set feBDwidth_button 2
set feBDwidth_entry 2
set feBDwidth_listbox 2
set feBDwidth_text 2
# set feBDwidth_msg 2
##############################################################
## Set window-manager TOP and LEFT side widths (in pixels)
## for the currently used window manager.
##############################################################
## NOTE:
## We could probably generate these widths using
## some Tk queries like
##
## [winfo . rootx] and [winfo . rooty]
##
## versus what we get by parsing
##
## [wm geometry .]
##
## But, we avoid doing this processing by simply setting
## the values here and allowing the user to change the values
## --- once for all the FE subsystem GUIs --- according
## to the window manager being used.
##
## (Besides, there is a question whether such a routine
## based on those Tk queries would work for ALL Linux/Unix
## window managers.)
##############################################################
set wmPIXELS_top 23
set wmPIXELS_left 3
##+#######################################################################
## SET THE TOP WINDOW NAME.
##+#######################################################################
wm title . "FE Font Selector - $VERSIONfontsel"
wm iconname . "FontSel"
catch { wm title . "$env(FE_WINTITLE)" }
catch { wm iconname . "$env(FE_ICONTITLE)" }
##+#######################################################################
## SET THE TOP WINDOW POSITION & SET A MIN-SIZE.
##+#######################################################################
## Examples:
# wm geometry . 662x646+431+202
# wm geometry . 300x200
wm geometry . +50+50
catch {eval wm geometry . "$env(FE_FONTSEL_GEOM)" }
## Set 'minsize'.
wm minsize . 650 400
catch {eval wm minsize . "$env(FE_FONTSEL_MINSIZE)" }
## Alternative to minsize (make win not resizable).
## That is not suitable to this app.
## Some fonts can cause the sample text area to overflow.
## We need that widget to expand as needed.
# wm resizable . 0 0
##+#######################################################################
## GET AN INITIAL FONT DEFINITION PARAMETERS STRING, if it is
## being passed into this Tk script.
##
## We will use this to position the font listbox at a specific
## font, and have that font displayed in the sample text area
## when this GUI first comes up.
##
## The string should be a string like this:
##
## -family {dejavu sans mono} -size -12 -weight bold -slant roman -underline 0 -overstrike 0
##
## The underline, overstrike, and slant parms (and even weight) could be missing,
## in which case, the values would be defaulted to Tcl-Tk defaults.
##+#######################################################################
set argc [llength $argv]
if {$argc != 0} {
## The following join of the argv Tcl-list into a string
## works for either one-word or multi-word fams in args.
set feINITfontparms [join $argv " "]
## FOR TESTING:
# puts "feINITfontparms: $feINITfontparms"
eval font create fontINIT $feINITfontparms
} else {
eval font create fontINIT $feFONT_text
}
##+####################################################################
##+####################################################################
## DEFINE *ALL* THE FRAMES:
##
## Top-level : 'fRleft' and 'fRright'
## Sub-frames of 'fRleft': none, just one listbox with scrollbar(s)
## Sub-frames of 'fRright' (top to bottom):
## - 'fRbuttons' for OK and Cancel (and Help) buttons
## - 'fRsize' for optMenu and 2 radiobuttons
## - 'fRcheck1' for bold and italic checkbuttons &
## underline and overstrike checkbuttons
## - 'fRtext' for two text widgets (one to hold the
## font family name, or more specs)
##+####################################################################
##+####################################################################
## FOR TESTING of expansion of frames (esp. during window expansion):
# set feRELIEF_frame raised
# set feBDwidth_frame 2
set feRELIEF_frame flat
set feBDwidth_frame 0
frame .fRleft -relief $feRELIEF_frame -borderwidth $feBDwidth_frame
frame .fRright -relief $feRELIEF_frame -borderwidth $feBDwidth_frame
frame .fRright.fRbuttons -relief $feRELIEF_frame \
-borderwidth $feBDwidth_frame
frame .fRright.fRspacer1 -relief $feRELIEF_frame \
-borderwidth $feBDwidth_frame -height 20
frame .fRright.fRsize -relief $feRELIEF_frame \
-borderwidth $feBDwidth_frame
frame .fRright.fRcheck1 -relief $feRELIEF_frame \
-borderwidth $feBDwidth_frame
frame .fRright.fRspacer2 -relief $feRELIEF_frame \
-borderwidth $feBDwidth_frame -height 20
frame .fRright.fRtext -relief $feRELIEF_frame \
-borderwidth $feBDwidth_frame
##+########################################################
## PACK *ALL* the FRAMES.
##+########################################################
pack .fRleft \
-side left \
-anchor w \
-fill both \
-expand 1
pack .fRright \
-side right \
-anchor e \
-fill both \
-expand 1
## PACK the subframes of '.fRright'.
pack .fRright.fRbuttons \
-side top \
-anchor n \
-fill none \
-expand 0
# -fill x
pack .fRright.fRspacer1 \
-side top \
-anchor n \
-fill x \
-expand 0
pack .fRright.fRsize \
-side top \
-anchor n \
-fill x \
-expand 0
pack .fRright.fRcheck1 \
-side top \
-anchor n \
-fill x \
-expand 0
pack .fRright.fRspacer2 \
-side top \
-anchor n \
-fill x \
-expand 0
pack .fRright.fRtext \
-side top \
-anchor center \
-fill both \
-expand 0
##+################################################################
##+################################################################
## START DEFINING & PACKING WIDGETS WITHIN THEIR FRAMES.
##+################################################################
##+################################################################
##+########################################################
## IN THE 'fRleft' frame -- DEFINE 1 listbox widget,
## with vertical scrollbar.
##+########################################################
listbox .fRleft.listbox \
-width 30 \
-height 25 \
-font fontTEMP_listbox \
-relief raised \
-borderwidth 2 \
-state normal \
-yscrollcommand ".fRleft.scrbary set"
# -width 0 \
# -height 0 \
scrollbar .fRleft.scrbary -command ".fRleft.listbox yview"
pack .fRleft.listbox \
-side left \
-anchor center \
-fill both \
-expand 1
pack .fRleft.scrbary \
-side right \
-anchor center \
-fill y \
-expand 0
##+####################################
## START PACKING THE *RIGHT-SIDE* FRAME:
##+####################################
##+########################################################
## IN THE 'fRright.fRbuttons' frame -- DEFINE several buttons
## --- OK/UseIt, Cancel, DwnWin/Update, Help, ColorMe.
##+########################################################
## Label Widget on which to write the number of families
## read in by the 'loadfams2listbox' proc.
label .fRright.fRbuttons.label \
-text "" \
-font fontTEMP_label \
-justify left \
-anchor w \
-relief flat \
-bd 0
## Buttons: OK/UseIt, Cancel, DwnWin, Help, ColorMe
button .fRright.fRbuttons.buttOK \
-text "UseIt" \
-font fontTEMP_button \
-padx $fePADX_button \
-pady $fePADY_button \
-relief raised \
-bd $feBDwidth_button \
-command {put_vars}
button .fRright.fRbuttons.buttCANCEL \
-text "Cancel" \
-font fontTEMP_button \
-padx $fePADX_button \
-pady $fePADY_button \
-relief raised \
-bd $feBDwidth_button \
-command {exit}
button .fRright.fRbuttons.buttDWNWIN \
-text "DwnWin" \
-font fontTEMP_button \
-padx $fePADX_button \
-pady $fePADY_button \
-relief raised \
-bd $feBDwidth_button \
-command { downsize_win }
button .fRright.fRbuttons.buttHELP \
-text "Help" \
-font fontTEMP_button \
-padx $fePADX_button \
-pady $fePADY_button \
-relief raised \
-bd $feBDwidth_button \
-command "eval exec $feDIR_tkguis/shofil.tk \
$feDIR_helps/select_tkFont.hlp &"
button .fRright.fRbuttons.buttCOLOR \
-text "ColorMe" \
-font fontTEMP_button \
-padx $fePADX_button \
-pady $fePADY_button \
-relief raised \
-bd $feBDwidth_button \
-command {getset_bkgdcolor}
##+########################################
## Pack the widgets in the 'fRbuttons' frame
##+########################################
pack .fRright.fRbuttons.buttOK \
-side left \
-anchor w \
-fill none \
-expand 0
pack .fRright.fRbuttons.buttCANCEL \
-side left \
-anchor w \
-fill none \
-expand 0
pack .fRright.fRbuttons.buttDWNWIN \
-side left \
-anchor w \
-fill none \
-expand 0
pack .fRright.fRbuttons.buttHELP \
-side left \
-anchor w \
-fill none \
-expand 0
pack .fRright.fRbuttons.buttCOLOR \
-side left \
-anchor w \
-fill none \
-expand 0
pack .fRright.fRbuttons.label \
-side left \
-anchor w \
-fill none \
-expand 0
##+########################################################
## IN THE 'fRright.fRsize' frame -- DEFINE 1 entry widget,
## with optmenu (or a tk_optionMenu button) ---
## and 2 radiobuttons (pixels,points).
##+########################################################
label .fRright.fRsize.label \
-text "Size :" \
-font fontTEMP_label \
-justify left \
-anchor w \
-relief flat \
-bd 2
pack .fRright.fRsize.label \
-side left \
-anchor w \
-fill none \
-expand 0
## Option menu of sizes:
# set fontSIZE 12
set fontSIZE 14
set menu1 [ tk_optionMenu .fRright.fRsize.optbuttSIZE fontSIZE \
7 8 9 10 11 12 13 14 15 16 17 18 19 20 24 28 32 36 48 60 72 ]
## A shorter list used by Welch:
## 7 8 10 12 14 18 24 36 72
.fRright.fRsize.optbuttSIZE configure -font fontTEMP_button
.fRright.fRsize.optbuttSIZE configure -pady $fePADY_button
$menu1 entryconfigure 0 -command font_update
$menu1 entryconfigure 1 -command font_update
$menu1 entryconfigure 2 -command font_update
$menu1 entryconfigure 3 -command font_update
$menu1 entryconfigure 4 -command font_update
$menu1 entryconfigure 5 -command font_update
$menu1 entryconfigure 6 -command font_update
$menu1 entryconfigure 7 -command font_update
$menu1 entryconfigure 8 -command font_update
$menu1 entryconfigure 9 -command font_update
$menu1 entryconfigure 10 -command font_update
$menu1 entryconfigure 11 -command font_update
$menu1 entryconfigure 12 -command font_update
$menu1 entryconfigure 13 -command font_update
$menu1 entryconfigure 14 -command font_update
$menu1 entryconfigure 15 -command font_update
$menu1 entryconfigure 16 -command font_update
$menu1 entryconfigure 17 -command font_update
$menu1 entryconfigure 18 -command font_update
$menu1 entryconfigure 19 -command font_update
$menu1 entryconfigure 20 -command font_update
## DEFINE Radiobuttons for units - pixels or points :
radiobutton .fRright.fRsize.radbuttPIX \
-text "Pixels" \
-font fontTEMP_button \
-anchor w \
-variable fontUNITS \
-value "pix" \
-selectcolor "#cccccc" \
-relief flat \
-bd 2
radiobutton .fRright.fRsize.radbuttPTS \
-text "Points" \
-font fontTEMP_button \
-anchor w \
-variable fontUNITS \
-value "pts" \
-selectcolor "#cccccc" \
-relief flat \
-bd 2
## fontUNITS is the var for the Pixels & Points radiobuttons.
set PIXperPOINT "[format "%.3f" [tk scaling]]"
label .fRright.fRsize.labelRight \
-text " ($PIXperPOINT pixels/point)" \
-font fontTEMP_label \
-justify left \
-anchor w \
-relief flat \
-bd 2
## PACK the '.fRsize' buttons.
pack .fRright.fRsize.optbuttSIZE \
.fRright.fRsize.radbuttPIX \
.fRright.fRsize.radbuttPTS \
.fRright.fRsize.labelRight \
-side left \
-anchor w \
-fill none \
-expand 0
##+########################################################
## IN THE 'fRright.fRcheck1' frame -- DEFINE 4 checkbutton
## widgets (bold,italic,underline,overstrike).
##+########################################################
set fontBOLD01 1
checkbutton .fRright.fRcheck1.chkbuttBOLD \
-text "Bold" \
-font fontTEMP_button \
-variable fontBOLD01 \
-selectcolor "#cccccc" \
-relief raised
set fontITALIC01 0
checkbutton .fRright.fRcheck1.chkbuttITALIC \
-text "Italic" \
-font fontTEMP_button \
-variable fontITALIC01 \
-selectcolor "#cccccc" \
-relief raised
## Two more checkbuttons:
set fontUNDERLINE01 0
checkbutton .fRright.fRcheck1.chkbuttUNDERLINE \
-text "Underline" \
-font fontTEMP_button \
-variable fontUNDERLINE01 \
-selectcolor "#cccccc" \
-relief raised
set fontOVERSTRIKE01 0
checkbutton .fRright.fRcheck1.chkbuttOVERSTRIKE \
-text "Overstrike" \
-font fontTEMP_button \
-variable fontOVERSTRIKE01 \
-selectcolor "#cccccc" \
-relief raised
## PACK the checkbuttons:
pack .fRright.fRcheck1.chkbuttBOLD \
.fRright.fRcheck1.chkbuttITALIC \
.fRright.fRcheck1.chkbuttUNDERLINE \
.fRright.fRcheck1.chkbuttOVERSTRIKE \
-side left \
-anchor w \
-fill none \
-expand 0
##+########################################################
## IN THE 'fRright.fRtext' frame -- DEFINE 2 text areas
## --- 1 for family name (and size), 1 for text sample.
##+########################################################
##+###################################################################
## Text widget#1, 'txtFONTNAME', displays the current font family name.
##+###################################################################
text .fRright.fRtext.txtFONTNAME \
-relief raised \
-borderwidth 2 \
-height 1 \
-width 38 \
-wrap none \
-font fontTEMP_button
##+########################################################
## PACK the 1st text widget in the '.fRright.fRtext' frame.
##+########################################################
pack .fRright.fRtext.txtFONTNAME \
-side top \
-anchor center \
-fill x \
-expand 1
##+##############################################################
## Initialize the FONTNAME text area with the current family name
## of the initial font. (Also show the font size --- via index 3
## in the 'font actual' query.)
##+##############################################################
set fontFAMILY [ lindex [font actual fontINIT] 1 ]
set fontSIZE [ lindex [font actual fontINIT] 3 ]
if { $fontSIZE < 0 } {
set fontSIZE [expr 0 - $fontSIZE]
## fontUNITS is the var for the Pixels & Points radiobuttons.
set fontUNITS "pix"
} else {
set fontUNITS "pts"
}
## FOR TESTING:
# set fontACTUAL [font actual fontINIT]
# puts "'font actual fontINIT' gives : $fontACTUAL"
.fRright.fRtext.txtFONTNAME insert end "Family: $fontFAMILY ; Size: $fontSIZE $fontUNITS"
##+##############################################################
## Text widget#2, 'txtSAMPLE', displays a sampler of characters
## to be re-rendered each time the user changes a font attribute.
##+##############################################################
text .fRright.fRtext.txtSAMPLE \
-relief raised \
-borderwidth 4 \
-height 9 \
-width 18 \
-wrap none \
-font fontINIT \
-yscrollcommand ".fRright.fRtext.scrbary set" \
-xscrollcommand ".fRright.fRtext.scrbarx set"
scrollbar .fRright.fRtext.scrbary \
-command ".fRright.fRtext.txtSAMPLE yview"
scrollbar .fRright.fRtext.scrbarx \
-orient horizontal \
-command ".fRright.fRtext.txtSAMPLE xview"
pack .fRright.fRtext.scrbary \
-side right \
-anchor center \
-fill y \
-expand 0
pack .fRright.fRtext.scrbarx \
-side bottom \
-anchor center \
-fill x \
-expand 0
pack .fRright.fRtext.txtSAMPLE \
-side left \
-anchor w \
-fill both \
-expand 1
##+#############################################
## Load this text area with the 'insert' command.
##+#############################################
.fRright.fRtext.txtSAMPLE insert end \
" ABCDEFGHIJKLM 41-4D hex
NOPQRSTUVWXYZ 4E-5A hex
abcdefghijklm 61-6D hex
nopqrstuvwxyz 6E-7A hex
01234 30-34 hex
56789 35-39 hex
!\"#$%&'()* 20-2A hex
+,-./:;<=>? 2B-2F,3A-3F hex
@\[\\\]^_`{|}~ 40,5B-60,7B-7E hex
"
## SPECIAL CHARS WERE (like in Welch's Tcl-Tk book
## --- but the brackets were not escaped in the book) :
##
## !@#$%^&*()_+-
## =\[\]{} ;:\"'`~,
## .<>/?\\|
##
## Changed so there are exactly 11 chars on the 3 lines
## of special characters.
##+#################################################
## Keep the user from changing the sample text,
## in case they type in the widget.
##+#################################################
.fRright.fRtext.txtSAMPLE configure -state disabled
##+########################################################
## PACK the 2nd text widget in the '.fRright.fRtext' frame.
##+########################################################
pack .fRright.fRtext.txtSAMPLE \
-side top \
-anchor center \
-fill x \
-expand 1
##+#####################################################################
## END OF MAIN SECTION TO SETUP THE GUI.
##+#####################################################################
##+#####################################################################
##+#####################################################################
## DEFINE BINDINGS:
## - Run the 'font_update' proc whenever one of the font
## attribute widgets have a <ButtonRelease-1> event.
##+#####################################################################
bind .fRleft.listbox <ButtonRelease-1> {
font_update
}
## END OF '.fRleft.listbox' <ButtonRelease-1> BINDING
bind .fRright.fRsize.radbuttPIX <ButtonRelease-1> {
font_update
}
## END OF '.fRright.fRsize.radbuttPIX' <ButtonRelease-1> BINDING
bind .fRright.fRsize.radbuttPTS <ButtonRelease-1> {
font_update
}
## END OF '.fRright.fRsize.radbuttPTS' <ButtonRelease-1> BINDING
bind .fRright.fRcheck1.chkbuttBOLD <ButtonRelease-1> {
font_update
}
## END OF '.fRright.fRcheck1.chkbuttBOLD' <ButtonRelease-1> BINDING
bind .fRright.fRcheck1.chkbuttITALIC <ButtonRelease-1> {
font_update
}
## END OF '.fRright.fRcheck1.chkbuttITALIC' <ButtonRelease-1> BINDING
bind .fRright.fRcheck1.chkbuttUNDERLINE <ButtonRelease-1> {
font_update
}
## END OF '.fRright.fRcheck1.chkbuttUNDERLINE' <ButtonRelease-1> BINDING
bind .fRright.fRcheck1.chkbuttOVERSTRIKE <ButtonRelease-1> {
font_update
}
## END OF '.fRright.fRcheck1.chkbuttOVERSTRIKE' <ButtonRelease-1> BINDING
##+#####################################################################
##+#####################################################################
## DEFINE PROCEDURES:
## - 'loadfams2listbox' for GUI initialization
## - 'font_update' for Button1-Release bindings to font-attribute widgets
## - 'put_vars' for OK/UseIt button
##
## - 'getset_bkgdcolor' for Color button
## (gets r255,g255,b255 via a GUI with 3 slider bars,
## then calls 'set_palette')
## - 'set_palette' used by the 'getset_bkgdcolor' proc ---
## and may be used for GUI initializaton
## (sets window color scheme from r255,g255,b255)
## - 'downsize_win' for 'DwnWin' button
##+#####################################################################
##+#####################################################################
##+#####################################################################
## PROCEDURE -- loadfams2listbox
##
## Purpose: Loads font family names to listbox.
## Done once, at GUI initialization.
##
## Called by: at bottom of this Tk script
##+#####################################################################
proc loadfams2listbox { } {
## 'fontFAMILY' is the family name we got when setting up text widget#2,
## the 'txtSAMPLE' widget.
global fontFAMILY
## Get the font family names.
# set allfams [font families]
set allfams [lsort -dictionary [font families]]
## Get the number of names.
## (We could display the num fonts, for user info.)
set numfams [llength $allfams]
.fRright.fRbuttons.label configure -text "$numfams Font Families "
## Make sure the listbox is empty.
.fRleft.listbox delete 0 end
## Insert each family name into the listbox list.
foreach family $allfams {
.fRleft.listbox insert end $family
}
####################################################
## INITIALIZE THE POSITION IN THE LISTBOX so that
## the font of the 'textSAMPLE' text widget is
## selected and in view.
####################################################
set INDEXofINITfont [ lsearch -exact $allfams $fontFAMILY ]
## FOR TESTING:
# puts "INDEXofINITfont: $INDEXofINITfont"
if { "$INDEXofINITfont" != "-1" } {
set seeINDEX [expr $INDEXofINITfont - 4 ]
if { "$seeINDEX" < "0" } {
set seeINDEX "0"
}
.fRleft.listbox see $seeINDEX
.fRleft.listbox selection set $INDEXofINITfont
}
}
## END of 'loadfams2listbox' proc
##+#####################################################################
## PROCEDURE -- font_update
##
## Purpose: Reconfigures the font parms of the
## 2 text widgets in the sample text area.
##
## Called by: bindings (above) on various radio & check buttons
##+#####################################################################
proc font_update {} {
global fontFAMILY fontSIZE fontUNITS fontBOLD01 fontITALIC01 \
fontUNDERLINE01 fontOVERSTRIKE01
set sel_index [ .fRleft.listbox curselection ]
if { $sel_index != "" } {
set fontFAMILY [ .fRleft.listbox get $sel_index ]
}
## FOR TESTING:
# puts "font_update: fontFAMILY = $fontFAMILY"
# puts "font_update: fontSIZE = $fontSIZE"
# puts "font_update: fontUNITS = $fontUNITS"
## Load in the fontname in the text-1 area with the 'insert' command.
.fRright.fRtext.txtFONTNAME delete 1.0 end
.fRright.fRtext.txtFONTNAME insert end "Family: $fontFAMILY ; Size: $fontSIZE $fontUNITS"
## Configure the font parms of the 2 text areas.
if { "$fontBOLD01" == "1" } {
set fontBOLD "bold"
} else {
set fontBOLD "normal"
}
if { "$fontITALIC01" == "1" } {
set fontITALIC "italic"
} else {
set fontITALIC "roman"
}
if { "$fontUNITS" == "pix" } {
set fontSIZEsigned [ expr -$fontSIZE ]
} else {
set fontSIZEsigned $fontSIZE
}
set fontPARMS [list -family $fontFAMILY -size $fontSIZEsigned \
-weight $fontBOLD -slant $fontITALIC \
-underline $fontUNDERLINE01 -overstrike $fontOVERSTRIKE01 ]
.fRright.fRtext.txtSAMPLE configure -font $fontPARMS
}
## END of 'font_update' proc
##+#####################################################################
## PROCEDURE -- put_vars
##
## Purpose: Puts font-setting parms to stdout.
##
## Called by: button .fRright.fRbuttons.buttOK
##+#####################################################################
proc put_vars { } {
global fontFAMILY fontSIZE fontUNITS fontBOLD01 fontITALIC01 \
fontUNDERLINE01 fontOVERSTRIKE01
if { "$fontBOLD01" == "1" } {
set fontBOLD "bold"
} else {
set fontBOLD "normal"
}
if { "$fontITALIC01" == "1" } {
set fontITALIC "italic"
} else {
set fontITALIC "roman"
}
if { "$fontUNITS" == "pix" } {
set fontSIZEsigned [ expr -$fontSIZE ]
} else {
set fontSIZEsigned $fontSIZE
}
puts "-family \"$fontFAMILY\" -size $fontSIZEsigned \
-weight $fontBOLD -slant $fontITALIC \
-underline $fontUNDERLINE01 -overstrike $fontOVERSTRIKE01"
exit
}
## END of 'put_vars' proc
##+#####################################################################
## 'getset_bkgdcolor' PROCEDURE
##+#####################################################################
##
## PURPOSE:
## This procedure is invoked to get an RGB triplet (r255 g255 b255)
## via 3 RGB slider bars.
##
## Then uses 'set_palette' proc to set window color scheme, esp.
## color of text widget, .fRmain.text.
##
## Arguments: none
##
## CALLED BY: .fRright.fRbuttons.buttCOLOR button
##+#####################################################################
proc getset_bkgdcolor {} {
global r255 g255 b255 feDIR_tkguis
## FOR TESTING:
# puts "r255: $r255"
# puts "g255: $g255"
# puts "b255: $b255"
set TEMPrgb [ exec \
$feDIR_tkguis/sho_colorvals_via_sliders3rgb.tk \
$r255 $g255 $b255]
## FOR TESTING:
# puts "TEMPrgb: $TEMPrgb"
if { "$TEMPrgb" == "" } { return }
## 2010aug23 changed output of 'sho_colorvals_via_sliders3rgb.tk'.
## It no longer has the strings 'R255=','G255=','B255='.
##
## WAS: scan $TEMPrgb "R255=%s ; G255=%s ; B255=%s" r255 g255 b255
scan $TEMPrgb "%s %s %s %s" r255 g255 b255 hexRGB
## FOR TESTING:
# puts "TEMPrgb: $TEMPrgb"
# puts "r255: $r255"
# puts "g255: $g255"
# puts "b255: $b255"
eval set r255 $r255
eval set g255 $g255
eval set b255 $b255
set_palette
}
## END OF 'getset_bkgdcolor' PROCEDURE
##+#####################################################################
## 'set_palette' PROCEDURE
##+#####################################################################
##
## PURPOSE:
## This procedure is invoked to set the 'palette' for this tkGUI's
## window --- based on three global vars: r255 g255 b255.
## Uses the 'tk_setPalette' Tcl-Tk command.
##
## [Could also set the foreground [text] colors, for all the widgets in the GUI,
## to black or (off-)white depending on a calculated luminance value of the chosen
## palette background color.
##
## Since setting the foreground color is built into the 'tk_setPalette' command,
## we do not try to set the foreground color. But, if that ever proves
## desirable, this proc would be a good place to do it.]
##
## Arguments: 3 global vars: r255 g255 b255
##
## CALLED BY: proc 'getset_bkgdcolor', which is invoked by
## .fRright.fRbuttons.buttCOLOR button
##
## (Could be called as an initialization procedure at the
## bottom of this script if we wanted to set the palette
## there instead of via 'set_widget_colors.tki'.)
##+#####################################################################
proc set_palette {} {
global r255 g255 b255
set COLOR4gui [format "#%02X%02X%02X" $r255 $g255 $b255]
tk_setPalette $COLOR4gui
}
## END OF 'set_palette' PROCEDURE
##+#####################################################################
## 'downsize_win' PROCEDURE
##+#####################################################################
##
## PURPOSE:
## This procedure is invoked to downsize the Tk window.
## Several methods could be used.
## For now, we query the current width and height of the window
## (with 'winfo') and downsize those by 10%.
##
## Arguments: none
##
## CALLED BY: .fRright.fRbuttons.buttDWNWIN
##
## The user can keep clicking the button to downsize 10% per click.
##
##+#####################################################################
proc downsize_win {} {
## These wm border parms should be set in 'set_widget_geom.tki'.
global wmPIXELS_top wmPIXELS_left
set winXlen [ winfo width .]
set winYlen [ winfo height .]
set winXloc [ winfo rootx . ]
set winYloc [ winfo rooty . ]
## Reduce the window size about 10%
set winXlen [expr {int(floor ( 0.9 * $winXlen ))} ]
set winYlen [expr {int(floor ( 0.9 * $winYlen ))} ]
## Adjust the 'loc' vars for the window manager border.
set winXloc [ expr $winXloc - $wmPIXELS_left ]
set winYloc [ expr $winYloc - $wmPIXELS_top ]
wm geometry . ${winXlen}x${winYlen}+${winXloc}+${winYloc}
}
## END OF 'downsize_win' PROCEDURE
##+######################################################
## Additional GUI INITIALIZATION:
##+######################################################
## Load the listbox. The other widgets (checkbutton and
## radiobutton defaults) should be set already.
loadfams2listbox
I hope that some Tcl-Tk 'newbies' can learn from this useful script and its many widget types.
Thanks to Brent Welch et. al. for putting in the tremendous amount of work it takes to provide 'lasting' reference works on the Tcl-Tk programming system --- where twenty to thirty years is 'lasting' in this fast moving information age.
And thanks to Ousterhout for
- the vision to create the Tk toolkit,
- the excellent initial implementation of that vision that makes Tk such a joy to use compared to coding GUI's in a language such as C or C++, along with the many library routines involved (He has sheltered us --- leaving us only the essentials to specify --- hiding a lot of coding, underneath the covers, that we should not really have to do. Yet he allowed for a tremendous amount of flexibility and capability. He made a tremendous number of excellent choices.)
- the perspiration that it took to implement those hundreds (nay thousands) of GUI parameters and functions that give Tcl-Tk code nerds (I mean warriors) such an array of coding weapons.