#!/usr/bin/wish -f ## ## Tk SCRIPT NAME: tkBMIcalc.tk ## ##+####################################################################### ## PURPOSE: This Tk script provides a GUI for entering a couple of ## numeric values --- height and weight --- and computing the ## BMI (Body Mass Index) of a person. ## ## The height and weight may be in 'metric' units or ## 'English' units --- namely centimeters or inches for height ## and kilograms or pounds for weight. ## ## This calculator provides advice on improving one's health ## depending on the magnitude of the BMI figure calculated. ## ##+################# ## THE GUI WIDGETS: ## ## The options available to the user are compactly indicated ## by the following 'sketch' of the GUI: ## ## --------------------------------------------------------------------------- ## tkBMIcalc ... calculate Body Mass Index ## [window title] ## --------------------------------------------------------------------------- ## ## {UseIt} {Exit} {Help} {Calc} ## ## Height: ______ O centimeters O inches O meters ## ## Weight: ______ O kilograms O pounds ## ## BMI: [text widget goes here] ## ## Advice: ## [multi-line text widget goes here] ## ## ## -------------------------------------------------------- ## ## In the above sketch of the GUI: ## ## Square brackets indicate a comment (not to be placed on the GUI). ## Braces indicate a Tk 'button' widget. ## Underscores indicate a Tk 'entry' widget. ## A colon indicates that the text before the colon is on a 'label' widget. ## Capital-O indicates a Tk 'radiobutton' widget. ## Capital-X indicates a Tk 'checkbutton' widget. ## ##+############## ## GUI components: ## ## From the GUI 'sketch' above, it is seen that the GUI consists of ## about ## ## - 4 button widgets ## - 4 label widgets ## - 2 entry widgets ## - 5 radiobutton widgets in 2 groups ## - 2 text widgets ## - 0 checkbutton widgets ## - 0 scale widgets ## - 0 listbox widgets ## ##+##################################################################### ## CALLED BY: This script could be put in a sub-directory of the ## user's home directory, such as $HOME/apps/tkBMIcalc. ## ## Then the user can use their desktop system (such as ## Gnome or KDE) to set up the script as an icon on the ## desktop. Then the user can click on the icon to ## startup the script. ## ## This script can also be called via a 'toolchest' in the ## FE 'tkGooies' system. ##+######################################################################## ## STRUCTURE OF THIS CODE: ## ## 0) Set general window parms (win-name, win-position, win-color-scheme, ## fonts, widget-geom-parms, win-size-control, text-array-for-labels-etc). ## ## 1a) Define ALL frames (and sub-frames, if any). ## 1b) Pack the frames. ## ## 2) Define & pack all widgets in the frames, frame by frame. ## After all the widgets for a frame are defined, pack them in the frame. ## ## 3) Define keyboard and/or mouse/touchpad/touch-sensitive-screen 'event' ## BINDINGS, if needed. ## 4) Define PROCS, if needed. ## 5) Additional GUI INITIALIZATION (typically with one or more of ## the procs), if needed. ## ## In more detail: ## ## 1a) Define ALL frames -- and sub-frames: ## ## Top-level : ## 'fRbuttons' for UseIt, Exit, Help, Calc buttons ## 'fRheight' for label, entry,and radiobutton widgets ## 'fRweight' for label, entry,and radiobutton widgets ## 'fRbmi' for a label and text widget ## 'fRadvice' for a label and text widget ## ## 1b) Pack ALL frames, including sub-frames (if any). ## ## 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: See BINDINGS section below. ## ## 4) Define procs: ## ## 'edit_inputs' - called by the 'Calc' button ## ## 'calc_bmi' - called by the 'Calc' button. ## ## 'popup_msgVarWithScroll' - called by 'Help' button to show HELPtext var. ## Also used called by the 'edit_inputs' proc. ## ## For other procs, see the PROCS section below. ## ## 5) Additional GUI initialization: See this section at the bottom ## of this script. ##+####################################################################### ## DEVELOPED WITH: Tcl-Tk 8.5 on Ubuntu 9.10 (2009-october, 'Karmic Koala') ## ## $ wish ## % puts "$tcl_version $tk_version" ## ## showed ## 8.5 8.5 ## but this script should work in most previous 8.x versions, and probably ## even in some 7.x versions (if font handling is made 'old-style'). ##+######################################################################## ## MAINTENANCE HISTORY: ## Started by: Blaise Montandon 2017aug09 Started development, on Ubuntu 9.10, ## based on the code of some Tk scripts ## of mine that contained most of the ## widgets needed. ## Updated by: Blaise Montandon 2017aug22 Put finishing touches on a version ## for release in 2017. ## Changed by: Blaise Montandon 2017aug29 Added some 'BDwidthPx_' and 'RELIEF_' ## variables for widget definitions. ## Changed the order of parameters in ## the widget definitions to basically ## group by FUNCTION (show text or define ## variable), FORMAT (width, height, font), ## GEOMETRY (pad & border parms), COLOR. ##+####################################################################### ##+###################################################### ## Set WINDOW TITLE and POSITION. ##+###################################################### wm title . "tkBMIcalc ... calculate Body Mass Index" wm iconname . "tkBMIcalc" wm geometry . +15+30 ##+###################################################### ## Set the COLOR SCHEME for the window and its widgets --- ## such as listbox and entry field background color. ##+###################################################### set winBKGD "#e0e0e0" tk_setPalette $winBKGD set entryBKGD "#ffffff" set textBKGD "#f0f0f0" set radbuttBKGD $winBKGD set radbuttSELECTCOLOR "#cccccc" ## Not used: # set chkbuttBKGD "#ffffff" # set scaleBKGD "#f0f0f0" # set listboxBKGD "#f0f0f0" ##+######################################################## ## DEFINE (temporary) FONT NAMES. ## ## We use a VARIABLE-WIDTH font for text on LABEL and ## BUTTON widgets. ## ## We use a FIXED-WIDTH font for LISTBOX lists, ## for text in ENTRY fields --- and often for text in ## TEXT widgets. ##+######################################################## font create fontTEMP_varwidth \ -family {comic sans ms} \ -size -14 \ -weight bold \ -slant roman font create fontTEMP_SMALL_varwidth \ -family {comic sans ms} \ -size -12 \ -weight bold \ -slant roman ## Some other possible (similar) variable width fonts: ## Arial ## Bitstream Vera Sans ## DejaVu Sans ## Droid Sans ## FreeSans ## Liberation Sans ## Nimbus Sans L ## Trebuchet MS ## Verdana font create fontTEMP_fixedwidth \ -family {liberation mono} \ -size -14 \ -weight bold \ -slant roman font create fontTEMP_SMALL_fixedwidth \ -family {liberation mono} \ -size -12 \ -weight bold \ -slant roman ## Some other possible fixed width fonts (esp. on Linux): ## Andale Mono ## Bitstream Vera Sans Mono ## Courier 10 Pitch ## DejaVu Sans Mono ## Droid Sans Mono ## FreeMono ## Nimbus Mono L ## TlwgMono ##+########################################################### ## SET GEOM VARS FOR THE VARIOUS WIDGET DEFINITIONS. ## (e.g. width and height of canvas, and padding for Buttons) ##+########################################################### ## LABEL widget geom settings: set PADXpx_label 0 set PADYpx_label 0 set BDwidthPx_label 2 set RELIEF_label flat ## BUTTON widget geom settings: set PADXpx_button 0 set PADYpx_button 0 set BDwidthPx_button 2 set RELIEF_button raised ## ENTRY widget geom settings: set BDwidthPx_entry 2 set RELIEF_entry sunken ## RADIOBUTTON widget geom settings: set PADXpx_radbutton 0 set PADYpx_radbutton 0 set BDwidthPx_radbutt 2 # set RELIEF_radbutt raised # set RELIEF_radbutt ridge set RELIEF_radbutt flat ## TEXT widget geom settings: set BDwidthPx_text 2 set RELIEF_text raised ## CHECKBUTTON widget geom settings: (not used) # set PADXpx_chkbutton 0 # set PADYpx_chkbutton 0 # set BDwidthPx_chkbutt 2 # # set RELIEF_chkbutt raised # set RELIEF_chkbutt ridge ## SCALE widget geom parameters: (not used) # set BDwidthPx_scale 2 # set RELIEF_scale sunken # set scaleLengthPx 300 # set scaleThicknessPx 10 ##+############################################################## ## 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"} ## For '.fRbuttons' frame: set aRtext(buttonUSEIT) "UseIt" set aRtext(buttonEXIT) "Exit" set aRtext(buttonHELP) "Help" set aRtext(buttonCALC) "Calc" ## For '.fRheight' frame: set aRtext(labelHEIGHT) "Height:" set aRtext(radbuttHGTcm) "centimeters" set aRtext(radbuttHGTin) "inches" set aRtext(radbuttHGTm) "meters" ## For '.fRweight' frame: set aRtext(labelWEIGHT) "Weight:" set aRtext(radbuttWGTkg) "kilograms" set aRtext(radbuttWGTlb) "pounds" ## For '.fRbmi' frame: set aRtext(labelBMI) "BMI:" ## For '.fRadvice' frame: set aRtext(labelADVICE) "Advice:" ## Set messages for the advice text widget: set ADVICEhealthy \ "A BMI index lower that 25.0 is good. That person is neither overweight nor obese." set ADVICEoverweight \ "A BMI index between 25.0 and 30.0 is cause for concern. That person is overweight --- but not yet obese." set ADVICEobese \ "A BMI index over 30.0 is cause for taking immediate action. That person is OBESE! Time to cut back on bad carbohydrates --- sugars and starches (long-chains of sugars) like the starches in refined flour products --- like donuts, cookies, cake, bread, etc. Also cut back on starchy vegetables like potatoes and rice. Substitute healthier veggies like cole slaw and steamed broccoli and roasted brussel sprouts. Also consider salads, green beans, and peas." ## END OF if { "$VARlocale" == "en"} ##+###################################################################### ## Set a MIN-SIZE of the window (roughly). ## ## For WIDTH, allow for the min-width of the '.fRbuttons' frame. ## ## For HEIGHT, allow for the stacked frames: ## 1 char high for the '.fRbuttons' frame ## 1 char high for the '.fRheight' frame ## 1 char high for the '.fRweight' frame ## 1 char high for the '.fRbmi' frame ## ~4 chars high for the '.fRadvice' frame ## -------- ## 8 chars high for the 5 frames ##+##################################################################### ## FOR WIDTH: (allow for widgets in the '.fRbuttons' frame) set minWidthPx [font measure fontTEMP_varwidth "$aRtext(buttonUSEIT) \ $aRtext(buttonEXIT) $aRtext(buttonHELP) $aRtext(buttonCALC)"] ## We add some pixels to account for right-left-size of ## window-manager decoration (~8 pixels) and some pixels for ## frame/widget borders (~4 widgets x 4 pixels/widget = 16 pixels). set minWinWidthPx [expr {24 + $minWidthPx}] ## For HEIGHT --- for ## 1 char high for the '.fRbuttons' frame ## 1 char high for the '.fRheight' frame ## 1 char high for the '.fRweight' frame ## 1 char high for the '.fRbmi' frame ## ~4 char high for the '.fRadvice' frame ## -------- ## 8 chars high for the 5 frames set charHeightPx [font metrics fontTEMP_varwidth -linespace] set minWinHeightPx [expr {8 * $charHeightPx}] ## Add about 20 pixels for top-and-bottom window decoration -- ## and some pixels for top-and-bottom of frame/widget borders ## (~5 widgets x 4 pixels/widget = 20 pixels). set minWinHeightPx [expr {40 + $minWinHeightPx}] ## FOR TESTING: # puts "minWinWidthPx = $minWinWidthPx" # puts "minWinHeightPx = $minWinHeightPx" wm minsize . $minWinWidthPx $minWinHeightPx ## We may allow the window to be resizable. We pack the canvases ## (and the frames that contain them) with '-fill both -expand 1' ## so that the canvases can be enlarged by enlarging the window. ## If you want to make the window un-resizable, ## you can use the following statement. # wm resizable . 0 0 ## We fix the y-size of the window, but allow the x-size to vary. wm resizable . 1 0 ##+#################################################################### ##+#################################################################### ## DEFINE *ALL* THE FRAMES: ## ## Top-level : ## 'fRbuttons' for UseIt, Exit, Help, Calc buttons ## 'fRheight' for label, entry, and radiobutton widgets ## 'fRweight' for label, entry, and radiobutton widgets ## 'fRbmi' for a label and a text widget ## 'fRadvice' for a label and a text widget ##+#################################################################### ##+#################################################################### ## FOR TESTING change 0 to 1: ## (Example1: To see appearance of frames when borders are drawn.) ## (Example2: To see sizes of frames for various '-fill' options.) ## (Example3: To see how frames expand as window is resized.) if {0} { set RELIEF_frame raised set BDwidthPx_frame 2 } else { set RELIEF_frame flat set BDwidthPx_frame 0 } frame .fRbuttons -relief $RELIEF_frame -bd $BDwidthPx_frame frame .fRheight -relief raised -bd 2 frame .fRweight -relief raised -bd 2 frame .fRbmi -relief raised -bd 2 frame .fRadvice -relief $RELIEF_frame -bd $BDwidthPx_frame ##+######################################################## ## PACK *ALL* the FRAMES. ##+######################################################## pack .fRbuttons \ -side top \ -anchor nw \ -fill x \ -expand 0 pack .fRheight \ -side top \ -anchor nw \ -fill x \ -expand 0 pack .fRweight \ -side top \ -anchor nw \ -fill x \ -expand 0 pack .fRbmi \ -side top \ -anchor nw \ -fill x \ -expand 0 pack .fRadvice \ -side top \ -anchor nw \ -fill both \ -expand 1 ##+################################################################ ##+################################################################ ## START DEFINING & PACKING WIDGETS WITHIN THEIR FRAMES. ##+################################################################ ##+################################################################ ##+######################################################## ## IN THE '.fRbuttons' frame -- DEFINE several buttons ## --- UseIt, Exit, Help, Calc. ##+######################################################## button .fRbuttons.buttUSEIT \ -text "$aRtext(buttonUSEIT)" \ -font fontTEMP_varwidth \ -padx $PADXpx_button \ -pady $PADYpx_button \ -bd $BDwidthPx_button \ -relief $RELIEF_button \ -command {put_vars} button .fRbuttons.buttEXIT \ -text "$aRtext(buttonEXIT)" \ -font fontTEMP_varwidth \ -padx $PADXpx_button \ -pady $PADYpx_button \ -bd $BDwidthPx_button \ -relief $RELIEF_button \ -command {exit} button .fRbuttons.buttHELP \ -text "$aRtext(buttonHELP)" \ -font fontTEMP_varwidth \ -padx $PADXpx_button \ -pady $PADYpx_button \ -bd $BDwidthPx_button \ -relief $RELIEF_button \ -command {popup_msgVarWithScroll .topHelp "$HELPtext" +10+10} button .fRbuttons.buttCALC \ -text "$aRtext(buttonCALC)" \ -font fontTEMP_varwidth \ -padx $PADXpx_button \ -pady $PADYpx_button \ -bd $BDwidthPx_button \ -relief $RELIEF_button \ -command {calc_bmi} ##+######################################## ## Pack the widgets in the 'fRbuttons' frame ##+######################################## pack .fRbuttons.buttUSEIT \ .fRbuttons.buttEXIT \ .fRbuttons.buttHELP \ .fRbuttons.buttCALC \ -side left \ -anchor w \ -fill none \ -expand 0 ##+######################################################## ## IN THE '.fRheight' frame -- DEFINE 1 LABEL widget, ## 1 ENTRY widget, and 2 or 3 RADIOBUTTON widgets. ##+######################################################## label .fRheight.labelHEIGHT \ -text "$aRtext(labelHEIGHT)" \ -font fontTEMP_varwidth \ -justify left \ -anchor w \ -padx $PADXpx_label \ -pady $PADYpx_label \ -bd $BDwidthPx_label \ -relief $RELIEF_label entry .fRheight.entryHEIGHT \ -textvariable ENTRYheight \ -width 6 \ -font fontTEMP_fixedwidth \ -bd $BDwidthPx_entry \ -relief $RELIEF_entry \ -bg $entryBKGD radiobutton .fRheight.radbuttHGTin \ -variable RADVARheight \ -value "in" \ -text "$aRtext(radbuttHGTin)" \ -font fontTEMP_varwidth \ -anchor w \ -bd $BDwidthPx_radbutt \ -relief $RELIEF_radbutt \ -selectcolor $radbuttSELECTCOLOR \ -bg $radbuttBKGD radiobutton .fRheight.radbuttHGTcm \ -variable RADVARheight \ -value "cm" \ -text "$aRtext(radbuttHGTcm)" \ -font fontTEMP_varwidth \ -anchor w \ -bd $BDwidthPx_radbutt \ -relief $RELIEF_radbutt \ -selectcolor $radbuttSELECTCOLOR \ -bg $radbuttBKGD radiobutton .fRheight.radbuttHGTm \ -variable RADVARheight \ -value "m" \ -text "$aRtext(radbuttHGTm)" \ -font fontTEMP_varwidth \ -anchor w \ -bd $BDwidthPx_radbutt \ -relief $RELIEF_radbutt \ -selectcolor $radbuttSELECTCOLOR \ -bg $radbuttBKGD ## PACK the widgets in the 'fRheight' frame. pack .fRheight.labelHEIGHT \ -side left \ -anchor w \ -fill none \ -expand 0 pack .fRheight.entryHEIGHT \ -side left \ -anchor w \ -fill x \ -expand 1 pack .fRheight.radbuttHGTin \ -side left \ -anchor w \ -fill none \ -expand 0 pack .fRheight.radbuttHGTcm \ -side left \ -anchor w \ -fill none \ -expand 0 pack .fRheight.radbuttHGTm \ -side left \ -anchor w \ -fill none \ -expand 0 ##+######################################################## ## IN THE '.fRweight' frame -- DEFINE 1 LABEL widget, ## 1 ENTRY widget, and 2 or 3 RADIOBUTTON widgets. ##+######################################################## label .fRweight.labelWEIGHT \ -text "$aRtext(labelWEIGHT)" \ -font fontTEMP_varwidth \ -justify left \ -anchor w \ -padx $PADXpx_label \ -pady $PADYpx_label \ -bd $BDwidthPx_label \ -relief $RELIEF_label entry .fRweight.entryWEIGHT \ -textvariable ENTRYweight \ -width 6 \ -font fontTEMP_fixedwidth \ -bd $BDwidthPx_entry \ -relief $RELIEF_entry \ -bg $entryBKGD radiobutton .fRweight.radbuttWGTlb \ -variable RADVARweight \ -value "lb" \ -text "$aRtext(radbuttWGTlb)" \ -font fontTEMP_varwidth \ -anchor w \ -bd $BDwidthPx_radbutt \ -relief $RELIEF_radbutt \ -selectcolor $radbuttSELECTCOLOR \ -bg $radbuttBKGD radiobutton .fRweight.radbuttWGTkg \ -variable RADVARweight \ -value "kg" \ -text "$aRtext(radbuttWGTkg)" \ -font fontTEMP_varwidth \ -anchor w \ -bd $BDwidthPx_radbutt \ -relief $RELIEF_radbutt \ -selectcolor $radbuttSELECTCOLOR \ -bg $radbuttBKGD ## PACK the widgets in the 'fRweight' frame. pack .fRweight.labelWEIGHT \ -side left \ -anchor w \ -fill none \ -expand 0 pack .fRweight.entryWEIGHT \ -side left \ -anchor w \ -fill x \ -expand 1 pack .fRweight.radbuttWGTlb \ -side left \ -anchor w \ -fill none \ -expand 0 pack .fRweight.radbuttWGTkg \ -side left \ -anchor w \ -fill none \ -expand 0 ##+######################################################## ## IN THE '.fRbmi' frame -- DEFINE ## a LABEL widget and a TEXT widget. ##+######################################################## label .fRbmi.labelBMI \ -text "$aRtext(labelBMI)" \ -font fontTEMP_varwidth \ -justify left \ -anchor w \ -bd $BDwidthPx_label \ -relief $RELIEF_label text .fRbmi.text \ -width 8 \ -height 1 \ -font fontTEMP_fixedwidth \ -wrap none \ -bd $BDwidthPx_text \ -relief $RELIEF_text \ -bg "#f0f0f0" ## PACK the widgets in the 'fRbmi' frame. pack .fRbmi.labelBMI \ .fRbmi.text \ -side left \ -anchor w \ -fill none \ -expand 0 ##+######################################################## ## IN THE '.fRadvice' frame -- DEFINE ## a LABEL widget and a TEXT widget. ##+######################################################## label .fRadvice.labelADVICE \ -text "$aRtext(labelADVICE)" \ -font fontTEMP_varwidth \ -justify left \ -anchor w \ -padx $PADXpx_label \ -pady $PADYpx_label \ -bd $BDwidthPx_label \ -relief $RELIEF_label text .fRadvice.text \ -width 0 \ -height 0 \ -font fontTEMP_fixedwidth \ -wrap none \ -bd $BDwidthPx_text \ -relief $RELIEF_text \ -bg "#f0f0f0" ## PACK the widgets in the 'fRadvice' frame. pack .fRadvice.labelADVICE \ -side top \ -anchor nw \ -fill none \ -expand 0 pack .fRadvice.text \ -side top \ -anchor nw \ -fill both \ -expand 1 ##+##################################################################### ## END OF SECTION TO DEFINE AND PACK THE GUI WIDGETS. ##+##################################################################### ##+##################################################################### ##+##################################################################### ## DEFINE BINDINGS: button1-release bindings on some widgets ??? ## Return-key bindings on some entry widgets ??? ##+##################################################################### # bind .fR?????.???widget??? {??proc??} # bind .fR?????.???widget??? {??proc??} ##+##################################################################### ##+##################################################################### ## DEFINE PROCEDURES: ## ## 'calc_bmi' - called by the 'Calc' button. ## ## 'edit_inputs' - called by the 'calc_bmi' proc. ## ## 'decimal_check' - called by the 'edit_input' proc. ## ## 'put_vars' - called by the 'UseIt' button. ## ## 'popup_msgVarWithScroll' - called by 'Help' button to show HELPtext var. ## Also called by the 'edit_inputs' proc. ##+##################################################################### ##+##################################################################### ##+##################################################################### ## Proc 'calc_bmi' ## ## PURPOSE: To edit the input fields and then calc the BMI ## from the height and weight values. ## ## CALLED BY: the '-command' option of the 'Calc' button. ##+##################################################################### proc calc_bmi {} { global ENTRYheight ENTRYweight RADVARheight RADVARweight \ holdINCHES holdPOUNDS varBMI \ ADVICEhealthy ADVICEoverweight ADVICEobese EDITcode #################################################### ## Check the input fields to assure they are numeric. #################################################### edit_inputs if {$EDITcode > 0} {return} ##################################################### ## Calculate the BMI index. ##################################################### if {"$RADVARheight" == "in"} { set holdINCHES $ENTRYheight } elseif {"$RADVARheight" == "cm"} { set holdINCHES [expr {$ENTRYheight * 0.3937}] } elseif {"$RADVARheight" == "m"} { set holdINCHES [expr {$ENTRYheight * 39.37}] } if {"$RADVARweight" == "lb"} { set holdPOUNDS $ENTRYweight } elseif {"$RADVARheight" == "kg"} { set holdPOUNDS [expr {$ENTRYweight * 2.2046}] } set varBMI [expr {(704.5 * $holdPOUNDS) / ($holdINCHES * $holdINCHES)}] set varBMI [ format "%7.4f" $varBMI] .fRbmi.text delete 1.0 end .fRbmi.text insert end $varBMI ################################################ ## Set the 'advice' in the advice text widget. ################################################ if {$varBMI < 25.0} { set holdADVICE "$ADVICEhealthy" .fRadvice.text configure -bg "#90ff90" } elseif {$varBMI >= 25.0 && $varBMI <= 30.0} { set holdADVICE "$ADVICEoverweight" .fRadvice.text configure -bg "#ffa0a0" } elseif {$varBMI > 30.0} { set holdADVICE "$ADVICEobese" .fRadvice.text configure -bg "#ff6060" } .fRadvice.text delete 1.0 end .fRadvice.text insert end "$holdADVICE" ################################################# ## Set ADVwidth & ADVheight from $holdADVICE. ################################################# ## To get ADVheight, ## split at '\n' (newlines) and count 'lines'. ################################################# set TMPlist [ split $holdADVICE "\n" ] ## For testing: # puts "TMPlist: $TMPlist" set ADVheight [ llength $TMPlist ] ## For testing: # puts "ADVheight: $ADVheight" ################################################# ## To get ADVwidth, ## loop through the 'lines' getting length ## of each; save max. ################################################# set ADVwidth 0 ############################################# ## LOOK AT EACH LINE IN THE LIST. ############################################# foreach line $TMPlist { ############################################# ## Get the length of the line. ############################################# set TMPwidth [ string length $line ] if { $TMPwidth > $ADVwidth } { set ADVwidth $TMPwidth } } ## END OF foreach line $TMPlist ## For testing: # puts "ADVwidth: $ADVwidth" ############################################################### ## NOTE: VARwidth works nicely for a fixed-width font ## ... BUT the programmer may need to be ## careful that the contents of holdADVICE are all ## countable characters by the 'string length' command. ############################################################### .fRadvice.text configure -width $ADVwidth -height $ADVheight } ## END OF proc 'calc_bmi' ##+#################################################################### ## PROC: 'edit_inputs' ##+##################################################################### ## PURPOSE: Checks entry widgets entries and pops up an error message ## if the data is invalid. ## ## CALLED BY: the 'distance_update' proc ##+##################################################################### proc edit_inputs {} { global ENTRYheight ENTRYweight EDITcode ## We could do without the following EDITcode variable, by using ## a code with the 'return' statement herein. But using this ## code variable is a little more self-documenting. global EDITcode set EDITcode 0 ####################################################### ## Remove trailing and leading blanks (if any) from the ## user entries in the 'entry' widgets. ####################################################### set ENTRYheight [string trim $ENTRYheight] set ENTRYweight [string trim $ENTRYweight] ######################################################################### ## Check that ENTRYheight ENTRYweight are NOT blank. ######################################################################### set MSGblank "is blank. Must NOT be blank." if {"$ENTRYheight" == ""} { popup_msgVarWithScroll .topErr "The HEIGHT value $MSGblank" +10+10 set EDITcode 1 return } if {"$ENTRYweight" == ""} { popup_msgVarWithScroll .topErr "The WEIGHT value $MSGblank" +10+10 set EDITcode 1 return } ########################################################## ## Check that VARnumPeriods is an integer. ########################################################## # set MSGnotInteger " is NOT INTEGER." # if {![string is integer -strict "$VARnumPeriods"]} { # popup_msgVarWithScroll .topErr "Number of Periods (N) $MSGnotInteger" +10+10 # set EDITcode 1 # return # } ######################################################################### ## Check that ENTRYheight and ENTRYweight are decimal numbers ## (positive or negative) --- such as ## 1.234 or -3 or -3.0 or -.4 or .5 or 7 ######################################################################### ## Implemented using the 'decimal_check' proc below. ######################################################################### set NUMERICmsg "should be a decimal number. Examples: 1.234 or 0.56 or -.789" if {![decimal_check "$ENTRYheight"]} { popup_msgVarWithScroll .topErr "The HEIGHT value $NUMERICmsg" +10+10 set EDITcode 1 return } if {![decimal_check "$ENTRYweight"]} { popup_msgVarWithScroll .topErr "The WEIGHT value $NUMERICmsg" +10+10 set EDITcode 1 return } } ## END of proc 'edit_inputs' ##+######################################################################## ## PROC 'decimal_check' ##+######################################################################## ## PURPOSE: Returns 1 or 0 if the input string looks like a decimal number ## --- positive or negative. Example numbers that are OK: ## 1.234 12.34 0.234 .234 6 ## -1.234 -12.34 -0.234 -.234 -6 ########################################################################### ## References (lots of one-liners): ## http://stackoverflow.com/questions/2072222/regular-expression-for-positive-and-a-negative-decimal-value-in-java ## http://stackoverflow.com/questions/308122/simple-regular-expression-for-a-decimal-with-a-precision-of-2 ## http://stackoverflow.com/questions/4246077/matching-numbers-with-regular-expressions-only-digits-and-commas/4247184#4247184 ## ## More specific to Tcl-Tk (including multi-liners): ## http://wiki.tcl.tk/989 'Regular Expression Examples' ## http://wiki.tcl.tk/768 'Entry Validation' - See "Integer forbidding leading zero:" ## http://wiki.tcl.tk/10166 'string is' ## http://wiki.tcl.tk/40710 'significant digits rounding' - uses regexp to split a number - ## Splits using: if {[regexp {^([+,-]?)([0-9]+)(\.?[0-9]*)?([eE][+-]?[0-9]+)?$} $num -> s i d e]} ## Removes leading zero with: regexp {^(0*)([1-9][0-9]*)$} $i -> NULL DIG ## http://wiki.tcl.tk/530 'Unit converter' has a regexp to parse numbers: ## set RE {(?ix) # Ignore case, extended syntax ## ([-+]?) # Optional leading sign ## ([0-9]*) # Integer part ## \.? # Optional decimal point ## ([0-9]*) # Fractional part ## (e?[0-9]*) # Optional exponent ## } ## ########################################################################### ## I do not mind incurring a little (minute amount of) processing ## with a multiple-line implementation. Probably easier to fix if ## a string gets through --- such as ".0.3" (two decimal points). ## ## CALLED BY: proc 'edit_inputs' ##+######################################################################## proc decimal_check {string} { set PosDecimalOK [regexp {^([0-9]*)\.?([0-9]*)$} "$string"] set NegDecimalOK [regexp {^\-([0-9]*)\.?([0-9]*)$} "$string"] set PosNakedDecimalOK [regexp {^\.?([0-9]*)$} "$string"] set NegNakedDecimalOK [regexp {^\-\.?([0-9]*)$} "$string"] set IntegerOK [string is integer $string] set retCODE [expr { \ $PosDecimalOK || $NegDecimalOK || \ $PosNakedDecimalOK || $NegNakedDecimalOK || \ $IntegerOK }] ## FOR TESTING: if {0} { puts "" puts "decimal_check:" puts "string: $string" puts "PosDecimalOK: $PosDecimalOK" puts "NegDecimalOK: $NegDecimalOK" puts "PosNakedDecimalOK: $PosNakedDecimalOK" puts "NegNakedDecimalOK: $NegNakedDecimalOK" puts "IntegerOK: $IntegerOK" puts "retCODE: $retCODE" } return $retCODE } ## END of proc 'decimal_check' ##+##################################################################### ## PROCEDURE -- put_vars (Put BMI value environment var ## setting string to standard output.) ## ## Called by: button .fRbuttons.butReturn ##+##################################################################### proc put_vars { } { global varBMI holdINCHES holdPOUNDS puts "$varBMI $holdINCHES $holdPOUNDS" exit } ## END of proc 'puts_vars' ##+######################################################################## ## PROC: 'popup_msgVarWithScroll' ##+######################################################################## ## PURPOSE: Report help or error conditions to the user. ## ## We do not use focus,grab,tkwait in this proc, ## because we use it to show help when the GUI is idle, ## and we may want the user to be able to keep the Help ## window open while doing some other things with the GUI ## such as putting a filename in the filename entry field ## or clicking on a radiobutton. ## ## For a similar proc with focus-grab-tkwait added, ## see the proc 'popup_msgVarWithScroll_wait' in a ## 3DterrainGeneratorExaminer Tk script. ## ## REFERENCE: page 602 of 'Practical Programming in Tcl and Tk', ## 4th edition, by Welch, Jones, Hobbs. ## ## ARGUMENTS: A toplevel frame name (such as .fRhelp or .fRerrmsg) ## and a variable holding text (many lines, if needed). ## ## CALLED BY: 'help' button ##+######################################################################## ## To have more control over the formatting of the message (esp. ## words per line), we use this 'toplevel-text' method, ## rather than the 'tk_dialog' method -- like on page 574 of the book ## by Hattie Schroeder & Mike Doyel,'Interactive Web Applications ## with Tcl/Tk', Appendix A "ED, the Tcl Code Editor". ##+######################################################################## proc popup_msgVarWithScroll { toplevName VARtext ULloc} { ## global fontTEMP_varwidth #; Not needed. 'wish' makes this global. ## global env # bell # bell ################################################# ## Set VARwidth & VARheight from $VARtext. ################################################# ## To get VARheight, ## split at '\n' (newlines) and count 'lines'. ################################################# set VARlist [ split $VARtext "\n" ] ## For testing: # puts "VARlist: $VARlist" set VARheight [ llength $VARlist ] ## For testing: # puts "VARheight: $VARheight" ################################################# ## To get VARwidth, ## loop through the 'lines' getting length ## of each; save max. ################################################# set VARwidth 0 ############################################# ## LOOK AT EACH LINE IN THE LIST. ############################################# foreach line $VARlist { ############################################# ## Get the length of the line. ############################################# set LINEwidth [ string length $line ] if { $LINEwidth > $VARwidth } { set VARwidth $LINEwidth } } ## END OF foreach line $VARlist ## For testing: # puts "VARwidth: $VARwidth" ############################################################### ## NOTE: VARwidth works for a fixed-width font used for the ## text widget ... BUT the programmer may need to be ## careful that the contents of VARtext are all ## countable characters by the 'string length' command. ############################################################### ##################################### ## SETUP 'TOP LEVEL' HELP WINDOW. ##################################### catch {destroy $toplevName} toplevel $toplevName # wm geometry $toplevName 600x400+100+50 # wm geometry $toplevName +100+50 wm geometry $toplevName $ULloc wm title $toplevName "Note" # wm title $toplevName "Note to $env(USER)" wm iconname $toplevName "Note" ##################################### ## In the frame '$toplevName' - ## DEFINE THE TEXT WIDGET and ## its two scrollbars --- and ## DEFINE an OK BUTTON widget. ##################################### if {$VARheight > 10} { text $toplevName.text \ -wrap none \ -font fontTEMP_fixedwidth \ -width $VARwidth \ -height $VARheight \ -bg "#f0f0f0" \ -relief raised \ -bd 2 \ -yscrollcommand "$toplevName.scrolly set" \ -xscrollcommand "$toplevName.scrollx set" ## -font fontTEMP_varwidth scrollbar $toplevName.scrolly \ -orient vertical \ -command "$toplevName.text yview" scrollbar $toplevName.scrollx \ -orient horizontal \ -command "$toplevName.text xview" } else { text $toplevName.text \ -wrap none \ -font fontTEMP_fixedwidth \ -width $VARwidth \ -height $VARheight \ -bg "#f0f0f0" \ -relief raised \ -bd 2 ## -font fontTEMP_varwidth } button $toplevName.butt \ -text "OK" \ -font fontTEMP_varwidth \ -command "destroy $toplevName" ############################################### ## PACK *ALL* the widgets in frame '$toplevName'. ############################################### ## Pack the bottom button BEFORE the ## bottom x-scrollbar widget, pack $toplevName.butt \ -side bottom \ -anchor center \ -fill none \ -expand 0 if {$VARheight > 10} { ## Pack the scrollbars BEFORE the text widget, ## so that the text does not monopolize the space. pack $toplevName.scrolly \ -side right \ -anchor center \ -fill y \ -expand 0 ## DO NOT USE '-expand 1' HERE on the Y-scrollbar. ## THAT ALLOWS Y-SCROLLBAR TO EXPAND AND PUTS ## BLANK SPACE BETWEEN Y-SCROLLBAR & THE TEXT AREA. pack $toplevName.scrollx \ -side bottom \ -anchor center \ -fill x \ -expand 0 ## DO NOT USE '-expand 1' HERE on the X-scrollbar. ## THAT KEEPS THE TEXT AREA FROM EXPANDING. pack $toplevName.text \ -side top \ -anchor center \ -fill both \ -expand 1 } else { pack $toplevName.text \ -side top \ -anchor center \ -fill both \ -expand 1 } ################################################ ## Set some 'event' bindings to allow for ## easy scrolling through huge listings. ## is a press of the Page-Down key. ## is a press of the Page-Up key. ## is a press of the Home key ## to go to the top of the listing. ## is a press of the End key ## to go to the bottom of the listing. ## is a press of the Up-arrow key. ## is a press of the Down-arrow key. ################################################ bind $toplevName "$toplevName.text yview scroll +1 page" bind $toplevName "$toplevName.text yview scroll -1 page" bind $toplevName "$toplevName.text see 1.0" bind $toplevName "$toplevName.text see end" bind $toplevName "$toplevName.text yview scroll -1 unit" bind $toplevName "$toplevName.text yview scroll +1 unit" ##################################### ## LOAD MSG INTO TEXT WIDGET. ##################################### ## $toplevName.text delete 1.0 end $toplevName.text insert end $VARtext $toplevName.text configure -state disabled } ## END OF PROC 'popup_msgVarWithScroll' ##+######################## ## END of PROC definitions. ##+######################## ##+###################################################### ## ADDITIONAL GUI INITIALIZATION section. ##+###################################################### ##+########################################### ## Set BMI coefficient for the formula ## in terms of inches and pounds. ##+########################################### # set BMIcoef 703.0 set BMIcoef 704.5 ##+########################################### ## Set initial values of the ENTRY widgets ## and RADIOBUTTON widgets. ##+########################################## set ENTRYheight "70" set RADVARheight "in" set ENTRYweight "170" set RADVARweight "lb" calc_bmi ##+######################## ## Set HELPtext var. ##+######################## set HELPtext \ "** HELP for this utility to 'Calculate BMI = Body Mass Index' ** This utility provides a GUI for calculating the BMI (Body Mass Index) for a human individual of a specified height and weight. The formula for calculating the BMI is given by BMI = ($BMIcoef * POUNDS) / (INCHES * INCHES) This GUI allows the user to specify the height and weight in metric units --- such as centimeters and kilograms. The metric units are converted to inches and pounds and then the formula above is used to calculate the BMI. --- Click on the '$aRtext(buttonCALC)' button of the GUI to cause the calculation to be done with the currently specified height and weight and units of measure. --- This utility can be used to return the BMI value to a script (Linux/Unix shell script or Tcl-Tk script) by clicking on the '$aRtext(buttonUSEIT)' button. A string of 3 values is passed to the calling script: the BMI value and the 2 values in inches and pounds that were used to compute the BMI value. *********************************************** SETTING UP THIS UTILITY FOR EASY ICON-CLICK USE: *********************************************** The file for this utility (a Tk script) could be put in a sub-directory of the user's home directory, such as \$HOME/apps/tkBMIcalc. Then the user can use their desktop system (such as Gnome or KDE) to set up the Tk script as an icon on the desktop. The user can click on the icon to startup the Tk script. --- This utility is also available in the FE 'tkGooies' system where FE = Freedom Environment. Reference: www.freedomenv.com "