0) Set general window parms (win-name, win-position, win-color-scheme,
fonts, widget-geom-parms, win-size-control).
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 (typically with one or more
of the procs), if needed.This structure is discussed in more detail on the page A Canonical Structure for Tk Code --- and variations.By consistently using this Tk code structure, when I need to find a proc (or a binding, or a widget definition, or an example pack statement, etc. etc.) in my Tk scripts, I can find what I need relatively quickly (code re-use).In addition to the code reorganization, 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.Code for the Tk script 'select_tkFont_standAlone.tk' :
#!/usr/bin/wish -f
##
## Tk SCRIPT NAME: select_tkFont_standAlone.tk
##
## ('stand-alone' version --- no 'source' statements)
## (version with 'scale' widget instead of 'tk_optionMenu')
##
## FROM: $FEDIR_TKGUIS = $FEDIR/tkGUIs
##
## where $FEDIR is the installation
## directory of an FE subsystem.
## Ref: www.freedomenv.com
##
##+#######################################################################
## PURPOSE: This TkGUI script provides a GUI for selecting a set of
## Tcl-Tk font specification values (6 of them):
##
## - font-family
## - font-size (pixels or points ; negative or positive integers),
## - weight: normal or bold
## - slant: roman (erect) or italic
## - underscore: off or on
## - overstrike: off or on
##
## This script displays a set of sample text (the alphabet, numeric
## digits, and special characters) in a scrollable text widget.
##
## USE-CASES:
##
## 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 a Tk GUI, for example: 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.
##
##+###########
## GUI DESIGN:
##
## 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 'scale' widget to get the font size.
## (This works quickly and allows for specifying a 'fine-grain' of
## font sizes. Nowadays, with scalable fonts being the norm, it is
## desirable to be able to pick any integer from about 6 to 100 ---
## pixels or points --- for a font-size.)
##
## 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 are using 1 listbox widget, 1 scale widget,
## 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 the button and listbox 'selector' 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.
##
##+#####################################################################
## CALLED BY: In its original 'non-stand-alone' form, the
## 'select_tkFont.tk' script is called by
## the 'shofil.tk' Tk script that is the guts of the
## so-called 'xpg' utility, which is part of the 'FE'
## (Freedom Environment) system. Ref: www.freedomenv.com
##
## Also called by 'make_chest.tk' in the 'feAppMenus'
## and 'feHandyTools' FE subsystems ---
## 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.
##
## If the user clicks the 'UseIt' button, the font info for
## the user-selected font is sent to stdout.
##
## Sample output string: { helvetica -12 { bold roman null null } }
## --- in this case, an array of 4 items,
## if you don't count the 2 null elements.
## Actually this is a Tcl list with 3 items,
## where the 3rd item 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 (win-name,win-position,color-scheme,
## fonts,widget-geom-parameters,win-size-control).
## 1a) Define ALL frames (and sub-frames).
## 1b) Pack ALL frames and sub-frames.
## 2) Define & pack all widgets in the frames.
##
## 3) Define key and mouse/touchpad/touch-sensitive-screen action
## BINDINGS, if needed.
## 4) Define PROCS, if needed.
## 5) Additional GUI INITIALIZATION (typically with one or two procs
## from section 4), 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 buttons: OK/UseIt, Cancel, Help, ColorMe
## - 'fRsize1' for a scale for font-size
## - 'fRsize2' for 2 radiobuttons for font-units
## - '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: alphabet,numerics,special-chars)
##
## 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 a scale '-command' and for bindings to
## font-attribute setting widgets
## - 'put_vars' - for the OK/UseIt button
##
## - 'getset_bkgdcolor' - for ColorMe button (gets r255,g255,b255 via
## a separate color-selectorGUI 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 the DwnWin button
##
## 5) Additional GUI initialization: run 'loadfams2listbox'
##
##+#######################################################################
## DEVELOPED WITH: Tcl-Tk 8.4 on Ubuntu 9.10 (2009oct version, 'Karmic Koala').
## 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.
## for use in Freedom Environment (FE)
## subsystems, such as 'xpg',
## 'feAppMenus', and 'feHandyTools'.
## See www.freedomenv.com
## Changed by: Blaise Montandon 2012aug Converted 'select_tkFont.tk' script,
## the 2011oct05 version that is
## used the FE subsystems,
## to be 'stand-alone'. I.e. the code
## from Tk 'include' files that are
## incorporated into the script code
## via 'source' statements, was
## hard-coded into this script ---
## to make a 'stand-alone' script.
## Changed by: Blaise Montandon 2012oct30 Replaced the 'tk_optionMenu' widget
## with a 'scale' widget. Improved
## the setting of window 'minsize'.
## Moved 'widget-var' settings to
## the bottom of the script.
## Changed by: Blaise Montandon 2012nov03 Added '-repeatdelay' to scale.
## Changed '-expand' from 1 to 0
## in pack of scale. Added an
## x-scrollbar to the listbox.
## Changed a variety of pack and
## fill parms to get better widget
## behavior if window expands.
## Chgd calcs of win-min-width.
## Chgd initial win-position.
## Chgd scale max from 100 to 300.
## Changed by: Blaise Montandon 2012nov18 Add 'UpWin' button. Add text-array
## for labels, buttons, etc.
##+#######################################################################
##+#######################################################################
## SET THE TOP WINDOW NAME.
##+#######################################################################
wm title . "FE Font Selector - a version for wiki.tcl.tk"
wm iconname . "feFontSel"
# catch { wm title . "$env(FE_WINTITLE)" }
# catch { wm iconname . "$env(FE_ICONTITLE)" }
##+#######################################################################
## SET THE TOP WINDOW POSITION.
##+#######################################################################
# wm geometry . +10+10
wm geometry . +3+3
# catch {eval wm geometry . "$env(FE_FONTSEL_GEOM)" }
##+#######################################################################
## SET COLOR SCHEME (palette) FOR THE WINDOW.
##+#######################################################################
## and
##+#######################################################################
## SET BACKGROUND COLOR vars FOR WIDGETS, like ENTRY & LISTBOX widgets.
##+#######################################################################
## Set a Gray palette for the GUI.
##
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 BGcolor_entry "#BCD2EE"
# set BGcolor_listbox $feBGcolor_entry
##+#######################################################################
## SET FONT VARS for use in the 'font create' statements below.
##+#######################################################################
set guiFONTsize 14
set guiFONT_SMALLsize 12
## For variable width:
set FONT_varwidth \
" -family {comic sans ms} -size -$guiFONTsize -weight bold -slant roman "
set FONT_SMALL_varwidth \
" -family {comic sans ms} -size -$guiFONT_SMALLsize -weight normal -slant roman "
## For fixed width:
set FONT_fixedwidth \
" -family {dejavu sans mono} -size -$guiFONTsize -weight bold -slant roman "
set FONT_SMALL_fixedwidth \
" -family {dejavu sans mono} -size -$guiFONT_SMALLsize -weight normal -slant roman "
##+#####################################################################
## DEFINE (temporary) FONT-NAMES using 'font create'.
## The font names are to be used in '-font' widget specs below ---
## BUT not necessarily used for the default, initial font used by this
## font-selector GUI. See the setting of 'fontNAMEinit' below based
## on arguments passed to this script.
##+#####################################################################
eval font create fontTEMP_button $FONT_varwidth
eval font create fontTEMP_label $FONT_varwidth
eval font create fontTEMP_entry $FONT_fixedwidth
eval font create fontTEMP_listbox $FONT_fixedwidth
eval font create fontTEMP_text $FONT_fixedwidth
# eval font create fontTEMP_msg $FONT_fixedwidth
eval font create fontTEMP_SMALL_button $FONT_SMALL_varwidth
eval font create fontTEMP_SMALL_label $FONT_SMALL_varwidth
eval font create fontTEMP_SMALL_entry $FONT_SMALL_fixedwidth
eval font create fontTEMP_SMALL_listbox $FONT_SMALL_fixedwidth
eval font create fontTEMP_SMALL_text $FONT_SMALL_fixedwidth
# eval font create fontTEMP_SMALL_msg $FONT_SMALL_fixedwidth
##+#######################################################################
## SET GEOM VARS FOR THE VARIOUS WIDGET DEFINITIONS.
## (e.g. padx,pady for Buttons)
##+#######################################################################
## For BUTTON widgets:
set fePADY_button 0
set fePADX_button 0
set feBDwidth_button 2
## For LABEL widgets:
set fePADY_label 0
set fePADX_label 0
set feBDwidth_label 2
## For ENTRY widgets:
set feBDwidth_entry 2
## For LISTBOX widgets:
set feBDwidth_listbox 2
## For TEXT and MESSAGE widgets:
set feBDwidth_text 2
# set feBDwidth_msg 2
##+#######################################################################
## SET the top window MIN-SIZE (roughly).
##
## For width: on the LEFT SIDE of the GUI, allow for
## about 30 chars for the font-family names in the listbox.
## and, on the RIGHT SIDE of the GUI, allow for
## the minwidth of the '.fRbuttons' frame:
## about 5 buttons (UseIt,Cancel,DwnWin,Help,ColorMe), and
## a label with number-of-font-families info.
##
## For height: allow about 20 chars high --- so that at least 20 font-family
## names show in the listbox.
##+#######################################################################
set minWinWidthPx [font measure fontTEMP_varwidth \
"123456789012345 UseIt Cancel DwnWin ColorMe 123 Font Families"]
## Add some pixels to account for right-left-side window decoration
## (about 8 pixels), about 6 widgets x 3 pixels/widget for borders/padding
## for 6 widgets --- listbox, 4 buttons, and 1 label.
set minWinWidthPx [expr {26 + $minWinWidthPx}]
## MIN HEIGHT --- allow for about 20 chars high in the listbox:
set charHeightPx [font metrics fontTEMP_fixedwidth -linespace]
set minWinHeightPx [expr { 20 * $charHeightPx}]
## Add about 28 pixels for top-bottom window decoration, and
## about 6 pixels for the listbox widget's borders/padding.
set minWinHeightPx [expr {$minWinHeightPx + 34}]
## FOR TESTING:
# puts "minWinWidthPx = $minWinWidthPx"
# puts "minWinHeightPx = $minWinHeightPx"
wm minsize . $minWinWidthPx $minWinHeightPx
## We allow the window to be resizable and we pack the canvas with
## '-fill both' so that the canvas can be enlarged by enlarging the
## window.
# catch {eval wm minsize . "$env(FE_FONTSEL_MINSIZE)" }
## If you want to make the window un-resizable,
## you can use the following statement.
##
## However, that is not suitable for this font selector.
## Some fonts can cause the sample text area to overflow.
## We need that text widget (and the window) to expand as needed.
# wm resizable . 0 0
##+####################################################################
## Set a TEXT-ARRAY to hold text for buttons & labels on the GUI.
## NOTE: This can aid INTERNATIONALIZATION. This array can
## be set according to a nation/region parameter.
##+####################################################################
## if { "$VARlocale" == "en"}
set aRtext(buttonOK) "UseIt"
set aRtext(buttonCANCEL) "Cancel"
set aRtext(buttonDWNWIN) "DwnWin"
set aRtext(buttonUPWIN) "UpWin"
set aRtext(buttonCOLOR) "ColorMe"
set aRtext(labelFONTSIZE) "FontSize:"
set aRtext(labelFONTUNITS) "FontSize Units:"
set aRtext(radbuttPIXELS) "Pixels"
set aRtext(radbuttPOINTS) "Points"
set aRtext(chkbuttBOLD) "Bold"
set aRtext(chkbuttITALIC) "Italic"
set aRtext(chkbuttUNDERLINE) "Underline"
set aRtext(chkbuttOVERSTRIKE) "Overstrike"
## END OF if { "$VARlocale" == "en"}
##+#######################################################################
## GET AN INITIAL FONT DEFINITION PARAMETERS STRING, if it is
## being passed into this Tk script.
##
## We use this in FE subsytems 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]
## FOR TESTING:
# puts "argc: $argc argv: $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 fontPASSEDparms [join $argv " "]
## FOR TESTING:
# puts "fontPASSEDparms: $fontPASSEDparms"
eval font create fontNAMEinit $fontPASSEDparms
} else {
eval font create fontNAMEinit $FONT_fixedwidth
}
##+####################################################################
##+####################################################################
## 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
## - 'fRsize1' for a scale widget
## - 'fRsize2' for 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.fRsize1 \
-relief $feRELIEF_frame -borderwidth $feBDwidth_frame
frame .fRright.fRsize2 \
-relief $feRELIEF_frame -borderwidth $feBDwidth_frame
frame .fRright.fRcheck1 \
-relief $feRELIEF_frame -borderwidth $feBDwidth_frame
frame .fRright.fRtext \
-relief $feRELIEF_frame -borderwidth $feBDwidth_frame
##+########################################################
## PACK *ALL* the FRAMES.
##+########################################################
pack .fRleft \
-side left \
-anchor nw \
-fill y \
-expand 0
pack .fRright \
-side left \
-anchor nw \
-fill both \
-expand 1
## PACK the subframes of '.fRright'.
pack .fRright.fRbuttons \
-side top \
-anchor nw \
-fill none \
-expand 0
pack .fRright.fRsize1 \
-side top \
-anchor nw \
-fill none \
-expand 0
pack .fRright.fRsize2 \
-side top \
-anchor nw \
-fill none \
-expand 0
pack .fRright.fRcheck1 \
-side top \
-anchor nw \
-fill none \
-expand 0 \
-pady 10
pack .fRright.fRtext \
-side top \
-anchor nw \
-fill both \
-expand 1
##+################################################################
##+################################################################
## START DEFINING & PACKING WIDGETS WITHIN THEIR FRAMES.
##+################################################################
##+################################################################
##+########################################################
## IN THE 'fRleft' frame -- DEFINE 1 listbox widget,
## with vertical scrollbar.
##+########################################################
listbox .fRleft.listbox \
-width 20 \
-height 25 \
-font fontTEMP_listbox \
-relief raised \
-borderwidth 2 \
-state normal \
-yscrollcommand ".fRleft.scrbary set" \
-xscrollcommand ".fRleft.scrbarx set" \
# -width 0 \
# -height 0 \
scrollbar .fRleft.scrbary \
-orient vertical -command ".fRleft.listbox yview"
scrollbar .fRleft.scrbarx \
-orient horizontal -command ".fRleft.listbox xview"
## Pack the widgets in the 'fRleft' frame.
pack .fRleft.scrbary \
-side right \
-anchor e \
-fill y \
-expand 0
pack .fRleft.scrbarx \
-side bottom \
-anchor sw \
-fill x \
-expand 0
pack .fRleft.listbox \
-side left \
-anchor nw \
-fill y \
-expand 0
##+#############################################################
## START DEFINING WIDGETS and PACKING in THE *RIGHT-SIDE* FRAME:
##+#############################################################
##+##########################################################
## IN THE 'fRright.fRbuttons' frame --
## DEFINE several BUTTONS
## --- OK/UseIt, Cancel, DwnWin/Update, Help, ColorMe
## and 1 LABEL widget.
##+##########################################################
button .fRright.fRbuttons.buttOK \
-text "$aRtext(buttonOK)" \
-font fontTEMP_button \
-padx $fePADX_button \
-pady $fePADY_button \
-relief raised \
-bd $feBDwidth_button \
-command {put_vars}
button .fRright.fRbuttons.buttCANCEL \
-text "$aRtext(buttonCANCEL)" \
-font fontTEMP_button \
-padx $fePADX_button \
-pady $fePADY_button \
-relief raised \
-bd $feBDwidth_button \
-command {exit}
## Could implement this Help button someday.
## It IS implemented in the FE systems.
# button .fRright.fRbuttons.buttHELP \
# -text "$aRtext(buttonHELP)" \
# -font fontTEMP_button \
# -padx $fePADX_button \
# -pady $fePADY_button \
# -relief raised \
# -bd $feBDwidth_button \
# -command {popup_msg_var_scroll "$HELPtext"}
button .fRright.fRbuttons.buttDWNWIN \
-text "$aRtext(buttonDWNWIN)" \
-font fontTEMP_button \
-padx $fePADX_button \
-pady $fePADY_button \
-relief raised \
-bd $feBDwidth_button \
-command { downsize_win }
button .fRright.fRbuttons.buttUPWIN \
-text "$aRtext(buttonUPWIN)" \
-font fontTEMP_button \
-padx $fePADX_button \
-pady $fePADY_button \
-relief raised \
-bd $feBDwidth_button \
-command { upsize_win }
button .fRright.fRbuttons.buttCOLOR \
-text "$aRtext(buttonCOLOR)" \
-font fontTEMP_button \
-padx $fePADX_button \
-pady $fePADY_button \
-relief raised \
-bd $feBDwidth_button \
-command {getset_bkgdcolor}
## Label Widget on which to write the number of families
## read in by the 'loadfams2listbox' proc.
label .fRright.fRbuttons.labelNUMFAMS \
-text "" \
-font fontTEMP_label \
-justify left \
-anchor w \
-relief flat \
-bd 0
##+##########################################
## Pack the widgets in the 'fRbuttons' frame.
##+##########################################
pack .fRright.fRbuttons.buttOK \
.fRright.fRbuttons.buttCANCEL \
.fRright.fRbuttons.buttDWNWIN \
.fRright.fRbuttons.buttUPWIN \
.fRright.fRbuttons.buttCOLOR \
.fRright.fRbuttons.labelNUMFAMS \
-side left \
-anchor w \
-fill none \
-expand 0
## Implement someday? like in FE systems.
# pack .fRright.fRbuttons.buttHELP \
##+########################################################
## IN THE 'fRright.fRsize1' frame --
## DEFINE 1 SCALE widget (for specifying font-size).
##+########################################################
label .fRright.fRsize1.labelSIZE \
-text "$aRtext(labelFONTSIZE)" \
-font fontTEMP_label \
-justify left \
-anchor w \
-relief flat \
-bd 2
## We will set 'fontSIZE' (the scale variable) in the
## GUI-init section at the bottom of this script.
##
# set fontSIZE 14
scale .fRright.fRsize1.scaleSIZE \
-orient horizontal \
-resolution 1 \
-from 6 -to 300 \
-digits 0 \
-length 350 \
-repeatdelay 1000 \
-font fontTEMP_label \
-variable fontSIZE \
-command "font_update"
## Pack the widgets in frame 'fRsize1'.
pack .fRright.fRsize1.labelSIZE \
-side left \
-anchor w \
-fill none \
-expand 0
pack .fRright.fRsize1.scaleSIZE \
-side left \
-anchor w \
-fill x \
-expand 0
## DO NOT USE '-expand 1'. It makes the scale action 'jumpy'.
##+########################################################
## IN THE 'fRright.fRsize2' frame --
## and 2 RADIOBUTTONS (for pixels or points)
## and 1 LABEL widget (to display pixels/points ratio).
##+########################################################
label .fRright.fRsize2.labelUNITS \
-text "$aRtext(labelFONTUNITS)" \
-font fontTEMP_label \
-justify left \
-anchor w \
-relief flat \
-bd 2
## fontUNITS is the var for the Pixels & Points radiobuttons.
## It will be set in the GUI-init section at the bottom of
## this script.
radiobutton .fRright.fRsize2.radbuttPIX \
-text "$aRtext(radbuttPIXELS)" \
-font fontTEMP_button \
-anchor w \
-variable fontUNITS \
-value "pix" \
-selectcolor "#cccccc" \
-relief flat \
-bd 2
radiobutton .fRright.fRsize2.radbuttPTS \
-text "$aRtext(radbuttPOINTS)" \
-font fontTEMP_button \
-anchor w \
-variable fontUNITS \
-value "pts" \
-selectcolor "#cccccc" \
-relief flat \
-bd 2
## We show the ratio of pixels to points.
set PIXperPOINT "[format "%.3f" [tk scaling]]"
label .fRright.fRsize2.labelRATIO \
-text " ($PIXperPOINT pixels/point)" \
-font fontTEMP_label \
-justify left \
-anchor w \
-relief flat \
-bd 2
## PACK the widgets in frame 'fRsize2'.
pack .fRright.fRsize2.labelUNITS \
.fRright.fRsize2.radbuttPIX \
.fRright.fRsize2.radbuttPTS \
.fRright.fRsize2.labelRATIO \
-side left \
-anchor w \
-fill none \
-expand 0
##+########################################################
## IN THE 'fRright.fRcheck1' frame --
## DEFINE 4 CHECKBUTTON widgets
## (for bold,italic,underline,overstrike).
##+########################################################
## The checkbutton var 'fontBOLD01' will be set in the
## GUI-init section at the bottom of this script.
##
# set fontBOLD01 1
checkbutton .fRright.fRcheck1.chkbuttBOLD \
-text "$aRtext(chkbuttBOLD)" \
-font fontTEMP_button \
-variable fontBOLD01 \
-selectcolor "#cccccc" \
-relief raised
## The checkbutton var 'fontITALIC01' will be set in the
## GUI-init section at the bottom of this script.
##
# set fontITALIC01 0
checkbutton .fRright.fRcheck1.chkbuttITALIC \
-text "$aRtext(chkbuttITALIC)" \
-font fontTEMP_button \
-variable fontITALIC01 \
-selectcolor "#cccccc" \
-relief raised
## The checkbutton var 'fontUNDERLINE01' will be set in the
## GUI-init section at the bottom of this script.
##
# set fontUNDERLINE01 0
checkbutton .fRright.fRcheck1.chkbuttUNDERLINE \
-text "$aRtext(chkbuttUNDERLINE)" \
-font fontTEMP_button \
-variable fontUNDERLINE01 \
-selectcolor "#cccccc" \
-relief raised
## The checkbutton var 'fontOVERSTRIKE01' will be set in the
## GUI-init section at the bottom of this script.
##
# set fontOVERSTRIKE01 0
checkbutton .fRright.fRcheck1.chkbuttOVERSTRIKE \
-text "$aRtext(chkbuttOVERSTRIKE)" \
-font fontTEMP_button \
-variable fontOVERSTRIKE01 \
-selectcolor "#cccccc" \
-relief raised
## PACK the widgets in frame 'fRcheck1'.
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 font-family name (and size),
## and 1 below the first text area --- for the text sample
## (alphabet, numerics, special chars).
##+########################################################
##+###################################################################
## 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
##+##############################################################
## 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 fontNAMEinit \
-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 the text widgets in the '.fRright.fRtext' frame.
##+########################################################
pack .fRright.fRtext.txtFONTNAME \
-side top \
-anchor n \
-fill x \
-expand 0
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 top \
-anchor n \
-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
##+#####################################################################
## 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 0"
bind .fRright.fRsize2.radbuttPIX <ButtonRelease-1> "font_update 0"
bind .fRright.fRsize2.radbuttPTS <ButtonRelease-1> "font_update 0"
bind .fRright.fRcheck1.chkbuttBOLD <ButtonRelease-1> "font_update 0"
bind .fRright.fRcheck1.chkbuttITALIC <ButtonRelease-1> "font_update 0"
bind .fRright.fRcheck1.chkbuttUNDERLINE <ButtonRelease-1> "font_update 0"
bind .fRright.fRcheck1.chkbuttOVERSTRIKE <ButtonRelease-1> "font_update 0"
## Could use this binding, instead of '-command' on the scale widget.
# bind .fRright.fRsize1.scaleSIZE <ButtonRelease-1> "font_update 0"
##+#####################################################################
##+#####################################################################
## DEFINE PROCEDURES:
## 'loadfams2listbox' - for GUI initialization
##
## 'show-select_cur_family_in_listbox' - for GUI initialization
##
## 'font_update' - for a scale '-command' and 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
##
## 'upsize_win' - for 'UpWin' button
##+#####################################################################
##+#####################################################################
##+#####################################################################
## proc 'loadfams2listbox'
##+#####################################################################
## PURPOSE: Loads font family names to listbox.
##
##
## CALLED BY: Done once, at GUI initialization, at bottom of this script.
##+#####################################################################
proc loadfams2listbox { } {
## Get the font family names --- sorted.
# set allfams [font families]
set allfams [lsort -dictionary [font families]]
## Get the number of names.
## (We display the num fonts, for user info.)
set numfams [llength $allfams]
.fRright.fRbuttons.labelNUMFAMS 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
}
}
## END OF PROC 'loadfams2listbox'
##+#####################################################################
## proc 'show-select_cur_family_in_listbox'
##+#####################################################################
## PURPOSE: Based on a family-name passed to this proc,
## sets the selected line in the font-families-listbox.
##
## CALLED BY: Done once, at GUI initialization, at bottom of this script.
##+#####################################################################
proc show-select_cur_family_in_listbox {family} {
## Get the font family names --- sorted --- just
## as they were in proc 'loadfams2listbox'.
## (Alternatively, we could query the listbox.)
set allfams [lsort -dictionary [font families]]
## INITIALIZE THE POSITION IN THE LISTBOX so that
## the specified font-family is selected and in view.
set INDEXofINITfont [ lsearch -exact $allfams $family ]
## 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 PROC 'show-select_cur_family_in_listbox'
##+################################################################
## proc '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 {x} {
global fontFAMILY fontSIZE fontUNITS fontBOLD01 fontITALIC01 \
fontUNDERLINE01 fontOVERSTRIKE01 fontupdateBUSY0or1
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 PROC 'font_update'
##+##################################################
## proc '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
##+#####################################################################
## proc 'getset_bkgdcolor'
##+#####################################################################
## 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.
##
## 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 \
../SELECTORutils/select_RGBcolor_standAlone.tk \
$r255 $g255 $b255]
# $feDIR_tkguis/sho_colorvals_via_sliders3rgb.tk \
## 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 PROC 'getset_bkgdcolor'
##+#####################################################################
## proc 'set_palette'
##+#####################################################################
## 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 in the colors-setting section above.)
##+#####################################################################
proc set_palette {} {
global r255 g255 b255
set COLOR4gui [format "#%02X%02X%02X" $r255 $g255 $b255]
tk_setPalette $COLOR4gui
}
## END OF PROC 'set_palette'
##+#######################################################
## 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 overall window
## height and width from
##
## [wm geometry .]
##
## But, we avoid doing this processing by simply setting
## the values here and allowing the user to change the values
## 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
## and other OS window managers.)
##
## USED BY: the 'downsize_win' proc.
##+############################################################
set wmPIXELS_top 23
set wmPIXELS_left 3
##+#####################################################################
## proc 'downsize_win'
##+#####################################################################
## PURPOSE:
## This procedure is invoked to downsize the Tk window.
## This is handy after the display of a very large-sized font has
## caused the window to expand mightily.
##
## METHOD:
## 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 are set just above proc 'downsize_win'.
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( 0.9 * $winXlen )} ]
set winYlen [expr {int( 0.9 * $winYlen )} ]
## Adjust the 'loc' vars for the window manager border,
## so that the window does not move down each time the
## user clicks on the 'DwnWin' button.
set winXloc [ expr {$winXloc - $wmPIXELS_left} ]
set winYloc [ expr {$winYloc - $wmPIXELS_top} ]
wm geometry . ${winXlen}x${winYlen}+${winXloc}+${winYloc}
}
## END OF PROC 'downsize_win'
##+#####################################################################
## proc 'upsize_win'
##+#####################################################################
## PURPOSE:
## This procedure is invoked to up-size the Tk window.
## This is handy after the display of a very large-sized font has
## caused the window to expand to full size, and then the user
## down-sizes the window after a smaller font is shown.
##
## Tk seems to 'forget how to up-size' the window after it is
## downsized from full-screen size and Tk does not handle the downsizing
## (for example, the user does the downsizing, by 'grabbing' the window
## edge or by using the 'DwnSize' button). If the user starts choosing
## very large font sizes again, Tk no longer enlarges the window
## automatically. And, if the user down-sized a little too far with
## the 'DwnSize' button, the user will need to up-size.
##
## Rather than trying to 'grab' the very narrow edges of the window to
## enlarge the window, it is more convenient to have an 'UpSize' button.
##
## METHOD:
## Several methods could be used.
## For now, we query the current width and height of the window
## (with 'winfo') and up-size those by 10%.
##
## Arguments: none
##
## CALLED BY: .fRright.fRbuttons.buttUPWIN
##
## The user can keep clicking the button to up-size 10% per click.
##
##+#####################################################################
proc upsize_win {} {
## These wm border parms are set just above proc 'downsize_win'.
global wmPIXELS_top wmPIXELS_left
set winXlen [ winfo width .]
set winYlen [ winfo height .]
set winXloc [ winfo rootx . ]
set winYloc [ winfo rooty . ]
## Increase the window size about 10%
set winXlen [expr {int( 1.1 * $winXlen )} ]
set winYlen [expr {int( 1.1 * $winYlen )} ]
## Adjust the 'loc' vars for the window manager border,
## so that the window does not move down each time the
## user clicks on the 'UpWin' button.
set winXloc [ expr {$winXloc - $wmPIXELS_left} ]
set winYloc [ expr {$winYloc - $wmPIXELS_top} ]
wm geometry . ${winXlen}x${winYlen}+${winXloc}+${winYloc}
}
## END OF PROC 'upsize_win'
##+######################################################
## Additional GUI INITIALIZATION:
## (for most of the APPLICATION-SPECIFIC initialization;
## i.e. for widget VARIABLES --- NOT widget PARAMETERS
## like button padding or '-relief' settings.)
##+######################################################
## Use 'fontNAMEinit' to get the font-family-name and the
## font-size and font-units to show in the text widget:
## .fRright.fRtext.txtFONTNAME
set fontFAMILY [ font actual fontNAMEinit -family ]
set tempSIZE [ font actual fontNAMEinit -size ]
## FOR TESTING:
# # puts "fontFAMILY: $fontFAMILY tempSIZE: $tempSIZE"
# tk_dialog .debug "Title goes here." \
# "fontFAMILY: $fontFAMILY tempSIZE: $tempSIZE" \
# question OK OK
## FOR TESTING:
# set fontINITparms [font actual fontNAMEinit]
# # puts "'font actual fontNAMEinit' gives : $fontINITparms"
# tk_dialog .debug "Title goes here." \
# "'font actual fontNAMEinit' gives : $fontINITparms" \
# question OK OK
## Set 'fontUNITS' according to the sign of $tempSIZE.
## 'fontUNITS' is the var for the 2 radiobuttons: Pixels & Points.
##
## And set 'fontSIZE', the var for the scale widget.
## We need to make sure it is not negative.
if { $tempSIZE < 0 } {
set fontUNITS "pix"
## Our scale widget is for postive numbers.
## Negate $tempSIZE to set the scale widget var 'fontSIZE'.
set fontSIZE [expr {0 - $tempSIZE}]
} else {
set fontUNITS "pts"
set fontSIZE $tempSIZE
}
## We have fontFAMILY,fontSIZE,fontUNITS.
## Now insert it in the text widget.
## (We could use a label widget, but this allows
## for copy-and-paste of the text.)
.fRright.fRtext.txtFONTNAME delete 1.0 end
.fRright.fRtext.txtFONTNAME insert end \
"Family: $fontFAMILY ; Size: $fontSIZE $fontUNITS"
## Set the vars for the 4 checkbutton widgets - for
## weight,slant,underline,overstrike.
if {[font actual fontNAMEinit -weight] == "bold"} {
set fontBOLD01 1
} else {
set fontBOLD01 0
}
if {[font actual fontNAMEinit -slant] == "italic" } {
set fontITALIC01 1
} else {
set fontITALIC01 0
}
set fontUNDERLINE01 [font actual fontNAMEinit -underline]
set fontOVERSTRIKE01 [font actual fontNAMEinit -overstrike]
## Load the listbox.
loadfams2listbox
## Show and select $fontFAMILY in the listbox.
show-select_cur_family_in_listbox $fontFAMILY
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 'external' library routines involved in C and C++ programming.
(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.___uniquename 2012oct28 UPDATEThe code that was above has been replaced. The new code includes the following changes:
- Comments were re-organized and improved --- and it was noted in the comments that this is a 'stand-alone' script that was converted from a script that used 'source' statements to incorporate 'common' code from some Tk 'include' files.
- Indenting was improved to a more consistent format, and some white-space at the start of many widget-definition and widget-packing lines was removed.
- Braces were added to 'expr' statments.
- The bindings section was compacted.
- The font setting section was compacted somewhat.
- The initial part of the code was re-organized to follow the 'canonical' format that I use in most of the other Tk scripts that I have posted here. That format is described on the page titled A Canonical Structure for Tk Code --- and variations.
- Removed a superfluous 'pack' statement that was keeping the text area from expanding nicely for large fonts. The text area behavior, under certain window expansion conditions, is still not quite what I would like. I may need to add some configure height and width statements to the 'font_update' proc.
- Replaced the 'tk_optionMenu' widget with a 'scale' widget.
- Improved the setting of window 'minsize'.
- Moved 'app-vars' initial settings to the bottom of the script.
- Added an x-scrollbar to the listbox.
- Changed the 'pack' of the listbox to allow y-expansion, not 'both'.
- Changed '-expand' from 1 to 0 in the 'pack' of scale.
- Added '-repeatdelay' to scale.
- Changed several other pack parms to get better widget behavior if window expands.
- Changed calculation of win-min-width (it was too large).
- Changed initial win-position.
- Changed scale max from 100 to 300.
- I added an 'UpWin' button.
- I put the text of labels, buttons, radiobuttons, and checkbuttons into a text array in one section of the code, so that Tcler's can easily 'internationalize' the text in this GUI.
