#!/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 event. ##+##################################################################### bind .fRleft.listbox "font_update 0" bind .fRright.fRsize2.radbuttPIX "font_update 0" bind .fRright.fRsize2.radbuttPTS "font_update 0" bind .fRright.fRcheck1.chkbuttBOLD "font_update 0" bind .fRright.fRcheck1.chkbuttITALIC "font_update 0" bind .fRright.fRcheck1.chkbuttUNDERLINE "font_update 0" bind .fRright.fRcheck1.chkbuttOVERSTRIKE "font_update 0" ## Could use this binding, instead of '-command' on the scale widget. # bind .fRright.fRsize1.scaleSIZE "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