- FROM using hard-coded numbers for making the meters and their needles
- TO using variables that work off of queries on the current size of frame and canvas widgets.
CAPTURING THE GENERATED IMAGE:When you get an image that you want to save --- say, to report a memory-leak problem for some software --- a screen/window capture utility (like 'gnome-screenshot' on Linux) can be used to capture the GUI image in a PNG or GIF file, say.If necessary, an image editor (like 'mtpaint' on Linux) can be used to crop the window capture image. The image could also be down-sized --- say to make a smaller image suitable for presentation in an email or on a web page.
A LITTLE MEMORY EXPERIMENT:To get the memory figures to change, I tried bringing up an instance of the Seamonkey web browser on my computer and then clicking on the 'Refresh' button. I found that for each new instance of Seamonkey that I started (I started about seven), the memory usage went up about 2 to 10 Megabytes.At that level of memory consumption, the percent-needle hardly moved, because 10/3000 is less than one-half of one percent.
The codeBelow, I provide the Tk script code for this 'memory-and-swap in tachometers' display utility.I follow my usual 'canonical' structure for Tk code for this Tk script:
0) Set general window & widget parms (win-name, win-position,
win-color-scheme, fonts, widget-geometry-parms, win-size-control,
text-array-for-labels-etc).
1a) Define ALL frames (and sub-frames, if any).
1b) Pack ALL frames and sub-frames.
2) Define & pack all widgets in the frames, frame by frame.
Within each frame, define ALL the widgets.
Then pack the widgets.
3) Define keyboard and mouse/touchpad/touch-sensitive-screen action
BINDINGS, if needed.
4) Define PROCS, if needed.
5) Additional GUI initialization (typically with one or more of
the procs), if needed.This Tk coding structure is discussed in more detail on the page A Canonical Structure for Tk Code --- and variations.This structure makes it easy for me to find code sections --- while generating and testing a Tk script, and when looking for code snippets to include in other scripts (code re-use).I call your attention to step-zero. One new thing that I have started doing recently is using a text-array for text in labels, buttons, and other widgets in the GUI. This can make it easier for people to internationalize my scripts. I will be using a text-array like this in most of my scripts in the future.Experimenting with the GUIAs in all my scripts that use the 'pack' geometry manager (which is all of my 100-plus scripts, so far), I provide the four main pack parameters --- '-side', '-anchor', '-fill', '-expand' --- on all of the 'pack' commands for the frames and widgets.That helps me when I am initially testing the behavior of a GUI (the various widgets within it) as I resize the main window.I think that I have used a pretty nice choice of the 'pack' parameters. The label and button widgets stay fixed in size and relative-location if the window is re-sized --- while the two canvas areas (without scroll bars) expand/contract whenever the window is re-sized, and the 'Refresh' button is clicked.The meters expand/contract when the window is re-sized --- but probably not always in a way you would expect. Occasionally, you may need to tug the borders of the window to center the meters in a way that suits you.You can experiment with the '-side', '-anchor', '-fill', and '-expand' parameters on the 'pack' commands for the various frames and widgets --- to get the widget behavior that you want.And you can look into the code that is drawing the meters to see if you can devise meter-resizing behavior that pleases you more.___Additional experimentation: You might want to change the fonts used for the various GUI widgets. For example, you could change '-weight' from 'bold' to 'normal' --- or '-slant' from 'roman' to 'italic'. Or change font families.In fact, you may NEED to change the font families, because the families I used may not be available on your computer --- and the default font that the 'wish' interpreter chooses may not be very pleasing.I use variables to set geometry parameters of widgets --- parameters such as border-widths and padding. And I have included the '-relief' parameter on the definitions of frames and widgets. Feel free to experiment with those 'appearance' parameters as well.
Some features in the codeThat said, here's the code --- with plenty of comments to describe what most of the code-sections are doing.You can look at the top of the PROCS section of the code to see a list of the procs used in this script, along with brief descriptions of how they are called and what they do.The main procs are
'make_tachometers' - to draw 2 meters within their 2 Tk (square) canvases.
(We may allow the 2 canvases to resize according to
a resizing of the window. This proc will set the
SQUARE size of the 2 canvases according to the current
size of the frame containing the 2 canvases.)
'make_one_tachometer' - called by 'make_tachometers', to make each meter.
'draw_rivet' - called by 'make_one_tachometer', 4 times, to put
rivets in 4 corners around a meter.
'draw_circle_shadow' - called by 'make_one_tachometer' to put a shadowed
edge around the circle that makes the meter.
Also called to help make a 'pin' in the center of
the meter to hold the needle. Also called to make
the 4 rivets.
'update_needles' - to update the needles on the 2 meters.
'update_one_needle' - called by 'update_needles', to draw each needle.
'Refresh' - called by 'Refresh' button. Runs 'make_tachometers'
and 'update_needles'.
'popup_msgVarWithScroll' - called by the 'Help' button,
to show text in variable $HELPtext.Thanks to Marco Maggi whose 'shadow-circle' drawing technique and code made this script much easier to write.It is my hope that the copious comments in the code will help Tcl-Tk coding 'newbies' get started in making GUI's like this.Without the comments, potential young Tcler's might be tempted to return to their iPhones and iPads and iPods --- to watch videos of skydiving free falls gone scarily wrong. (Anyone see the video of the old grandmother who almost slips out of the harness and grasp of the skydiving instructor who no doubt assured her that there's nothing to worry about? If the instructor had not been able to hold onto her, the photographer who was free-falling with them would have probably, helplessly, gotten a video sequence of her free-falling without a parachute, to the ground below.)
Code for Tk script 'meters_memory_swap.tk' :
#!/usr/bin/wish -f
##+########################################################################
##
## SCRIPT: meters_memory_swap.tk
##
## PURPOSE: This script is meant to show a GUI that holds a pair of
## tachometer-style meters. The needles on the meters can be updated
## periodically to show the amount of memory and swap in use.
##
## This script was developed on Linux and uses the 'free'
## command to periodically get the memory and swap data to
## determine where to relocate the position of the needles.
##
##+################
## GUI DESCRIPTION:
##
## This script provides a Tk GUI with the following widgets.
##
## 1) There is an 'fRbuttons' frame to hold BUTTONS such as
## 'Exit' and 'Help' buttons --- as well as a 'Refresh'
## button.
##
## There is also a SCALE widget for the user to set a
## 'wait-seconds' parameter for auto-refresh of the meters ---
## in seconds --- down to tenths of seconds, and up to multiple
## minutes.
##
## 2) There is an 'fRcanvases' frame to contain 2 CANVAS widgets that
## hold the two meter images, in 2 SQUARE canvases, side by side.
## Also the 'fRcanvases' frame holds some LABEL widgets, to show
## TOTAL-and-USED MEMORY and TOTAL-and-USED SWAP, as text items.
##
##+################################
## METHOD USED to update the meters:
##
## A Tcl 'exec' command calls on a separate shell script that uses
## the 'free' command to get the memory and swap data and
## extract-and-format the data for return to this Tk script.
##
## (Since extraction of the data from the 'free' command is rather
## simple, the use of a separate 'external' script could be
## avoided by including some of the formatting code within
## the comand string called by 'exec'.)
##
##+#######################
## CAPTURING THE GUI IMAGE:
##
## A screen/window capture utility (like 'gnome-screenshot'
## on Linux) can be used to capture the GUI image in a PNG
## or GIF file, say.
##
## If necessary, an image editor (like 'mtpaint' on Linux)
## can be used to crop the window capture image. The image
## could also be down-sized --- say to make a smaller image
## suitable for use in a web page or an email.
##
##+#######################################################################
## 'CANONICAL' 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 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.
##
##+#################################
## Some detail of the code structure of this particular script:
##
## 1a) Define ALL frames:
##
## Top-level :
## '.fRbuttons' - to contain 'Exit', 'Help', 'Refresh' buttons,
## as well as a label-and-scale pair.
## '.fRcanvases' - to contain 2 canvas widgets, which will display
## the two meters, side-by-side.
##
## Sub-frames:
## '.fRcanvases.fRcanvas1' - for 2 label widgets & 1 canvas widget
## '.fRcanvases.fRcanvas2' - for 2 label widgets & 1 canvas widget
##
## 1b) Pack ALL frames.
##
## 2) Define & pack all widgets in the frames -- basically going through
## frames & their interiors in left-to-right, or top-to-bottom order.
##
## 3) Define BINDINGS: none
##
## 4) Define PROCS:
##
## 'make_tachometers' - to draw 2 meters within their 2 Tk (square) canvases.
##
## (We allow the 2 canvases to resize according to
## a resizing of the window. This proc will set the
## SQUARE size of the 2 canvases according to the current
## size of the frame containing the 2 canvases.)
##
## 'make_one_tachometer' - called by 'make_tachometers', to make each meter.
##
## 'draw_rivet' - called by 'make_one_tachometer', 4 times, to put
## rivets in 4 corners around a meter.
##
## 'draw_circle_shadow' - called by 'make_one_tachometer' to put a shadowed
## edge around the circle that makes the meter.
## Also called to help make a 'pin' in the center of
## the meter to hold the needle. Also called to make
## the 4 rivets.
##
## 'update_needles' - to update the needles on the 2 meters.
##
## 'update_one_needle' - called by 'update_needles', to draw each needle.
##
## 'Refresh' - called by 'Refresh' button. Runs 'make_tachometers'
## and 'update_needles'.
##
## 'popup_msgVarWithScroll' - called by 'Help' button to show HELPtext var.
##
##
## 5) Additional GUI Initialization:
## - call 'make_tachometers' to put the 2 meters on the canvas
## - call 'update_needles' --- to initialize the needle locations
## and start the updating of the GUI
## according to an initial setting of
## the WAITseconds scale variable.
##
##+#######################################################################
## 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 2013jul29 Started the basic code of the
## script based on the tachometer
## demo script by Marco Maggi
## at http://wiki.tcl.tk/9107
## Changed by: Blaise Montandon 2013aug30 Get most of the GUI working, using
## an appropriate hierarchy of procs.
## Changed by: Blaise Montandon 2013sep01 Settled on using a 'Refresh' button,
## instead of a scale widget with a
## WAITseconds variable.
## Changed by: Blaise Montandon 2013sep04 Commented some extra 'update'
## commands that I had been using
## during testing of the GUI. Also
## changed some comments to update
## them according to the current
## widget and proc implementations
## in the code.
## Changed by: Blaise Montandon 2013sep09 Activated use of the 'scale' widget
## and auto-updates of the needles
## with 'after $WAITmillisecs', within
## the 'update_needles' proc.
##+########################################################################
##+######################################################
## Set WINDOW TITLE and POSITION.
##+######################################################
wm title . "Percent of Total Memory & Swap in Use"
wm iconname . "MemSwap"
wm geometry . +15+30
##+######################################################
## Set the COLOR SCHEME for the window and its widgets ---
## such as listbox and entry field background color.
##+######################################################
tk_setPalette "#e0e0e0"
# set listboxBKGD "#ffffff"
# set entryBKGD "#ffffff"
set scaleBKGD "#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 Help-text in a TEXT widget, and for
## the text in ENTRY fields, if any.
##+########################################################
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)
##+###########################################################
## CANVAS widget geom settings:
set initCanWidthPx 200
set initCanHeightPx 200
# set BDwidthPx_canvas 2
set BDwidthPx_canvas 0
## BUTTON widget geom settings:
set PADXpx_button 0
set PADYpx_button 0
set BDwidthPx_button 2
## LABEL widget geom settings:
set PADXpx_label 0
set PADYpx_label 0
set BDwidthPx_label 2
## SCALE widget geom parameters:
set BDwidthPx_scale 2
set initScaleLengthPx 200
set scaleThicknessPx 10
##+######################################################################
## Set a MIN-SIZE of the window (roughly).
##
## For WIDTH, allow for the min-width of the '.fRbuttons' and '.fRcanvas'
## frames --- at least, the widgets in the 'fRbuttons' frame.
##
## For HEIGHT, allow for the stacked frames:
## 2 chars high for the '.fRbuttons' frame,
## at least 50 pixels high for the '.fRcanvas' frame.
##+#####################################################################
## FOR MIN-WIDTH:
set minWidthPx [font measure fontTEMP_varwidth \
" Exit Help Refresh Sampling Rate "]
## We add pixels for length of the scale widget, at least 100.
##
## For now, we simply 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 {124 + $minWidthPx}]
## For MIN-HEIGHT --- for
## 2 char high for 'fRbuttons'
## 50 pixels high for 'fRcanvas'
set charHeightPx [font metrics fontTEMP_varwidth -linespace]
set minWinHeightPx [expr {2 * $charHeightPx}]
## Add about 50 pixels for height of the canvas
## AND add about 20 pixels for top-bottom window decoration --
## and some pixels for top-and-bottom of frame/widget borders
## (~4 widgets x 4 pixels/widget = 16 pixels).
set minWinHeightPx [expr {86 + $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
##+##############################################################
## 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(buttonEXIT) "Exit"
set aRtext(buttonHELP) "Help"
set aRtext(buttonREFRESH) "Refresh"
set aRtext(labelSCALE) "Sampling rate
(seconds) :"
## END OF if { "$VARlocale" == "en"}
##+################################################################
## DEFINE *ALL* THE FRAMES:
##
## Top-level : '.fRbuttons' , '.fRcanvases'
##
## Sub-frames: '.fRcanvases.fRcanvas1' '.fRcanvases.fRcanvas2'
##+################################################################
## FOR TESTING: (to see size of frames as window is resized)
# set BDwidth_frame 2
# set RELIEF_frame raised
set BDwidth_frame 0
set RELIEF_frame flat
frame .fRbuttons -relief $RELIEF_frame -bd $BDwidth_frame
frame .fRcanvases -relief $RELIEF_frame -bd $BDwidth_frame
frame .fRcanvases.fRcanvas1 -relief raised -bd 2
frame .fRcanvases.fRcanvas2 -relief raised -bd 2
##+##############################
## PACK the FRAMES.
##+##############################
pack .fRbuttons \
-side top \
-anchor nw \
-fill x \
-expand 0
pack .fRcanvases \
-side top \
-anchor nw \
-fill both \
-expand 1
pack .fRcanvases.fRcanvas1 \
-side left \
-anchor nw \
-fill both \
-expand 1
pack .fRcanvases.fRcanvas2 \
-side right \
-anchor ne \
-fill both \
-expand 1
##+##########################################################
## The FRAMES ARE PACKED. START PACKING WIDGETS IN THE FRAMES.
##+##########################################################
##+##########################################################
## In FRAME '.fRbuttons' -
## DEFINE-and-PACK 'BUTTON' WIDGETS
## --- Exit, Help, ... --- and a LABEL-AND-SCALE widget pair
## (for changing the 'refresh rate' for the meter needles.
##+##########################################################
button .fRbuttons.buttEXIT \
-text "$aRtext(buttonEXIT)" \
-font fontTEMP_varwidth \
-padx $PADXpx_button \
-pady $PADYpx_button \
-relief raised \
-bd $BDwidthPx_button \
-command {set loop0or1 0 ; exit}
button .fRbuttons.buttHELP \
-text "$aRtext(buttonHELP)" \
-font fontTEMP_varwidth \
-padx $PADXpx_button \
-pady $PADYpx_button \
-relief raised \
-bd $BDwidthPx_button \
-command {popup_msgVarWithScroll .topHelp "$HELPtext"}
button .fRbuttons.buttREFRESH \
-text "$aRtext(buttonREFRESH)" \
-font fontTEMP_varwidth \
-padx $PADXpx_button \
-pady $PADYpx_button \
-relief raised \
-bd $BDwidthPx_button \
-command {Refresh}
label .fRbuttons.labelSCALE \
-text "$aRtext(labelSCALE)" \
-font fontTEMP_SMALL_varwidth \
-justify left \
-anchor w \
-relief flat \
-padx $PADXpx_label \
-pady $PADYpx_label \
-bd $BDwidthPx_label
## Set this widget var in the GUI initialization section
## at the bottom of this script.
# set WAITseconds 60
scale .fRbuttons.scaleSECONDS \
-from 0.1 -to 120.0 \
-resolution 0.1 \
-font fontTEMP_SMALL_varwidth \
-variable WAITseconds \
-showvalue true \
-orient horizontal \
-bd $BDwidthPx_scale \
-length $initScaleLengthPx \
-width $scaleThicknessPx
## Here is a label to show the current sample count.
label .fRbuttons.labelCOUNT \
-textvariable VARsampcnt \
-font fontTEMP_varwidth \
-justify left \
-anchor w \
-relief flat \
-bd 0
## Pack the widgets in frame '.fRbutton'.
pack .fRbuttons.buttEXIT \
.fRbuttons.buttHELP \
.fRbuttons.buttREFRESH \
.fRbuttons.labelSCALE \
.fRbuttons.scaleSECONDS \
.fRbuttons.labelCOUNT \
-side left \
-anchor w \
-fill none \
-expand 0
##+########################################################
## In FRAME '.fRcanvases.fRcanvas1' -
## DEFINE-and-PACK TWO LABELs and
## ONE CANVAS WIDGET (no scrollbars).
##
## We highlightthickness & borderwidth of the canvas to
## zero, as suggested on page 558, Chapter 37, 'The Canvas
## Widget', in the 4th edition of the book 'Practical
## Programming in Tcl and Tk'.
##+#######################################################
label .fRcanvases.fRcanvas1.labelINFO1 \
-text "" \
-font fontTEMP_SMALL_varwidth \
-justify left \
-anchor w \
-relief flat \
-padx $PADXpx_label \
-pady $PADYpx_label \
-bd $BDwidthPx_label
label .fRcanvases.fRcanvas1.labelINFO2 \
-text "" \
-font fontTEMP_SMALL_varwidth \
-justify left \
-anchor w \
-relief flat \
-padx $PADXpx_label \
-pady $PADYpx_label \
-bd $BDwidthPx_label
canvas .fRcanvases.fRcanvas1.can \
-width $initCanWidthPx \
-height $initCanHeightPx \
-relief flat \
-highlightthickness 0 \
-borderwidth 0
## Pack the widgets in frame '.fRcanvases.fRcanvas1'.
pack .fRcanvases.fRcanvas1.labelINFO1 \
.fRcanvases.fRcanvas1.labelINFO2 \
-side top \
-anchor nw \
-fill x \
-expand 0
pack .fRcanvases.fRcanvas1.can \
-side top \
-anchor nw \
-fill none \
-expand 0
##+########################################################
## In FRAME '.fRcanvases.fRcanvas2' -
## DEFINE-and-PACK TWO LABELs and
## ONE CANVAS WIDGET (no scrollbars).
##
## We highlightthickness & borderwidth of the canvas to
## zero, as suggested on page 558, Chapter 37, 'The Canvas
## Widget', in the 4th edition of the book 'Practical
## Programming in Tcl and Tk'.
##+#######################################################
label .fRcanvases.fRcanvas2.labelINFO1 \
-text "" \
-font fontTEMP_SMALL_varwidth \
-justify left \
-anchor w \
-relief flat \
-padx $PADXpx_label \
-pady $PADYpx_label \
-bd $BDwidthPx_label
label .fRcanvases.fRcanvas2.labelINFO2 \
-text "" \
-font fontTEMP_SMALL_varwidth \
-justify left \
-anchor w \
-relief flat \
-padx $PADXpx_label \
-pady $PADYpx_label \
-bd $BDwidthPx_label
canvas .fRcanvases.fRcanvas2.can \
-width $initCanWidthPx \
-height $initCanHeightPx \
-relief flat \
-highlightthickness 0 \
-borderwidth 0
## Pack the widgets in frame '.fRcanvases.fRcanvas2'.
pack .fRcanvases.fRcanvas2.labelINFO1 \
.fRcanvases.fRcanvas2.labelINFO2 \
-side top \
-anchor nw \
-fill x \
-expand 0
pack .fRcanvases.fRcanvas2.can \
-side top \
-anchor nw \
-fill none \
-expand 0
##+##################################################
## END OF DEFINITION of the GUI widgets.
##+##################################################
## Start of BINDINGS, PROCS, Added-GUI-INIT sections.
##+##################################################
##+##################################################################
##+##################################################################
## BINDINGS SECTION: none
##+##################################################################
##+##################################################################
##+##################################################################
## DEFINE PROCS SECTION:
##
## 'make_tachometers' - to draw 2 meters within 2 Tk canvases
##
## (We allow the Tk canvases to resize according to
## a resizing of the window. This proc will draw the
## 2 meters in proportion to the size of a canvas.)
##
## 'make_one_tachometer' - to draw one tachometer. Called by 'make_tachometers'
## to make the 2 meters.
##
## 'draw_rivet' - called by 'make_tachometers' to put rivets in 4
## corners around each meter.
##
## 'draw_circle_shadow' - called by 'make_tachometers' to put a shadowed
## edge around the circle that makes each meter.
## Also called by 'make_tachometers' to put
## a shadowed edge on the 'pin' that holds a needle.
## Also called by 'draw_rivet' to put a shadowed
## edge on each rivet.
##
## 'update_needles' - to update the 2 needles on the 2 meters. Called in the
## 'Additional GUI Initialization' section at the
## bottom of this script. Also called by itself, in
## an 'after $WAITmillisecs' statement.
## And called in the 'Refresh' proc.
##
## 'update_one_needle' - to draw one needle in a specified canvas. Called by
## 'update_needles' to update the 2 needles on the 2 meters.
##
## 'Refresh' - called by the 'Refresh' button. Runs the procs
## 'make_tachometers' and 'update_needles' --- in particular,
## for the user to force the meters to be resized if
## the user resizes the window --- and whenever the user
## wants a new 'reading'.
##
## 'popup_msgVarWithScroll' - to show the HELPtext var. Called by the 'Help' button.
##
##+#################################################################
##+########################################################################
## PROC 'make_tachometers'
##+########################################################################
## PURPOSE: Draws all features of 2 tachometer-style meters (except the
## needles) --- in a 'nice filling-size' according to the
## current canvas dimensions.
##
## (We will allow the canvas to resize according to
## a resizing of the window. This proc will redraw the
## meters in proportion to the new size of the canvas.)
##
## CALLED BY: once, at the 'Additional GUI Initialization' section,
## at the bottom of this script --- and
## in the 'ReDraw...' proc.
##+########################################################################
proc make_tachometers {} {
global marginPx
## FOR TESTING: (to dummy out this proc)
# return
############################################################
## Get current '.fRcanvases' dimensions --- in case the user
## has resized the window, and thus the '.fRcanvases' frame,
## which was packed with '-fill both -expand 1'.
############################################################
set curCanvasesWidthPx [winfo width .fRcanvases]
set curCanvasesHeightPx [winfo height .fRcanvases]
############################################################
## Set a width-and-height to use for a canvas to contain
## each of the 2 meters. (Half the 'fRcanvases' width. Also
## take the height of 'fRcanvases' into account.)
## (We take 8 pixels off the width to account for some
## borderwidths of frames within the 'fRcanvases' frame.)
############################################################
set canvasSizePx [expr {int(($curCanvasesWidthPx - 8) / 2.0)}]
if {$curCanvasesHeightPx < $canvasSizePx} {set canvasSizePx $curCanvasesHeightPx}
####################################################################
## Resize the canvases 'fRcanvas1.can' and 'fRcanvas2.can' that
## hold the 2 (square) Tk canvases for the 2 meters. Note that those
## 2 canvases and their parent frames were all packed with
## '-fill both -expand 1' --- so if the canvas widgets
## expand/contract, then the parent frames should do the same.
####################################################################
.fRcanvases.fRcanvas1.can configure -width $canvasSizePx
.fRcanvases.fRcanvas1.can configure -height $canvasSizePx
## FOR TESTING:
# update
.fRcanvases.fRcanvas2.can configure -width $canvasSizePx
.fRcanvases.fRcanvas2.can configure -height $canvasSizePx
## FOR TESTING:
# update
## Following not needed? The resizing of the '.can' canvas
## widgets should cause the parent frames to resize.
if {0} {
.fRcanvases.fRcanvas1 configure -width $canvasSizePx
.fRcanvases.fRcanvas1 configure -height $canvasSizePx
.fRcanvases.fRcanvas2 configure -width $canvasSizePx
.fRcanvases.fRcanvas2 configure -height $canvasSizePx
}
# set doubleWidthPx [expr {(2 * $canvasSizePx) + 8}]
# .fRcanvases configure -width $doubleWidthPx
# .fRcanvases configure -height $canvasSizePx
#####################################################
## NEEDED to force the canvases and frames to update
## according to the new canvas sizes.
#####################################################
update
#########################################################
## Draw meter1 (without needle).
#########################################################
make_one_tachometer .fRcanvases.fRcanvas1.can
#########################################################
## Draw meter2 (without needle).
#########################################################
make_one_tachometer .fRcanvases.fRcanvas2.can
}
## END OF proc 'make_tachometers'
##+########################################################################
## PROC 'make_one_tachometer'
##+########################################################################
## PURPOSE: Draws all features of a tachometer-style meter (except the
## needle) --- according to the 'marginPx' parameter to set
## top-right and bottom-left coordinates to specify the location
## of the square exactly containing the circular meter on
## the canvas whose ID is passed into this proc.
##
## The features include:
## - white-filled circle for the meter background
## - a gray-shaded (shadowed) edge around the circle
## - a 'pin' in the center of the circle, for the needle
## - 4 decorative rivets at the corners of the canvas
## - an arc with tic-marks
## - a red danger-zone in the last segment of the arc
## (between the last pair of tic-marks)
## - labels for the tic-marks
##
## CALLED BY: proc 'make_tachometers'
##+#######################################################################
## Set an 'indentation' to use for placing the outer-circle of the 2 meters
## from the 4 edges of their respective canvases.
set marginPx 12
set pi [expr {4.0 * atan(1.0)}]
set radsPERdeg [expr {$pi/180.0}]
set Nsegs 10
set pcentLabels "0 10 20 30 40 50 60 70 80 90 100"
## The above variables are set ONCE, for use in the following proc.
proc make_one_tachometer {canvas} {
global marginPx pi radsPERdeg Nsegs pcentLabels
## FOR TESTING: (to dummy out this proc)
# return
################################################################
## Remove any previously drawn elements in this canvas, if any.
################################################################
catch {$canvas delete all}
##################################################################
## Get the width (= height) of the specified (square) canvas.
##################################################################
set curCanvasSizePx [winfo width $canvas]
##################################################################
## Set the corner coords for drawing the meter circle (background).
##################################################################
set topleftXpx $marginPx
set topleftYpx $marginPx
set botrightXpx [expr {$curCanvasSizePx - $marginPx}]
set botrightYpx [expr {$curCanvasSizePx - $marginPx}]
################################################
## Draw basic white-filled circle for the meter.
################################################
$canvas create oval \
$topleftXpx $topleftYpx $botrightXpx $botrightYpx \
-fill white -outline {}
# -width 1 -outline lightgray
## FOR TESTING: (exit this proc before adding more to the meter)
# return
#######################################################################
## Draw shadow-circle at the outer circle of the meter.
#######################################################################
## INPUTS:
## - the 4 corner coordinates of the oval/circle box (in pixels)
## - number of segments for the arc (segments of differing color shade)
## - width (in pixels) to draw the arc segments
## - start angle for drawing the (darker) arc segments
## (measured counter-clockwise from the 3 o'clock position)
## (An angle of +135=90+45 means the dark side of the 'shadow-circle'
## is on the north-west side of the circle.)
######################################################################
draw_circle_shadow $canvas \
$topleftXpx $topleftYpx $botrightXpx $botrightYpx \
40 6 135.0
## FOR TESTING: (exit this proc before adding more to the meter)
# return
###################################################################
## Draw a shadow-circle for the 'pin' of the meter needle.
###################################################################
## INPUTS:
## - the 4 corner coordinates of the oval/circle box (in pixels)
## - number of segments for the arc (segments of differing color shade)
## - width (in pixels) to draw the arc segments
## - start angle for drawing the (darker) arc segments
## (measured counter-clockwise from the 3 o'clock position)
## (An angle of -45 means the dark side of the 'shadow-circle'
## is on the south-east side of the circle.)
###################################################################
set centerXpx [expr {int($curCanvasSizePx/2.0)}]
set centerYpx $centerXpx
set pinOuterRadiusPx 14
set x1 [expr {$centerXpx - $pinOuterRadiusPx}]
set y1 [expr {$centerYpx - $pinOuterRadiusPx}]
set x2 [expr {$centerXpx + $pinOuterRadiusPx}]
set y2 [expr {$centerYpx + $pinOuterRadiusPx}]
draw_circle_shadow $canvas $x1 $y1 $x2 $y2 40 6 -45.0
## FOR TESTING: (exit this proc before adding more to the meter)
# return
############################################################
## Draw a red-filled circle on the 'pin' of the meter needle.
############################################################
set pinRadiusPx 12
set x1 [expr {$centerXpx - $pinRadiusPx}]
set y1 [expr {$centerYpx - $pinRadiusPx}]
set x2 [expr {$centerXpx + $pinRadiusPx}]
set y2 [expr {$centerYpx + $pinRadiusPx}]
$canvas create oval \
$x1 $y1 $x2 $y2 -fill red -outline {}
# -width 1 -outline lightgray
## FOR TESTING: (exit this proc before adding more to the meter)
# return
###########################################
## Draw arc-line on which to put tic marks.
#################################################
## 320 degrees counter-clockwise from -70 degrees
## (based at 3 oclock) is 70 degrees beyond 180.
## I.e. -70 + 320 = 250 = 180 + 70
#################################################
set arcLineIndentPx 10
set x1 [expr {$topleftXpx + $arcLineIndentPx}]
set y1 [expr {$topleftYpx + $arcLineIndentPx}]
set x2 [expr {$botrightXpx - $arcLineIndentPx}]
set y2 [expr {$botrightYpx - $arcLineIndentPx}]
$canvas create arc $x1 $y1 $x2 $y2 \
-start -70 -extent 320 -style arc \
-outline black -width 2
## FOR TESTING: (exit this proc before adding more to the meter)
# return
##################################################
## Draw tic-marks and labels around the meter.
##################################################
set DEGperTIC [expr {320.0/$Nsegs}]
set half $centerXpx
## outer location (radius) of tic marks
set l1 [expr {$half - ($arcLineIndentPx + $marginPx)}]
## inner location (radius) of tic marks
set l2 [expr {$l1 - $arcLineIndentPx}]
## inner location of tic labels
set l3 [expr {$l2 - $arcLineIndentPx}]
set angle0 250.0
for {set i 0} {$i <= $Nsegs} {incr i} {
set rads [expr {($angle0 - ($DEGperTIC * $i)) * $radsPERdeg}]
set x1 [expr {$half + $l1 * cos($rads)}]
set y1 [expr {$half - $l1 * sin($rads)}]
set x2 [expr {$half + $l2 * cos($rads)}]
set y2 [expr {$half - $l2 * sin($rads)}]
$canvas create line \
$x1 $y1 $x2 $y2 \
-fill black -width 2
set x1 [expr {$half + $l3 * cos($rads)}]
set y1 [expr {$half - $l3 * sin($rads)}]
set label [lindex $pcentLabels $i]
if { [string length $label] } {
$canvas create text \
$x1 $y1 \
-anchor center -justify center -fill black \
-text $label -font { Helvetica 10 }
}
## END OF labels loop.
}
## END OF i-loop for tic-marks
## FOR TESTING: (exit this proc before adding more to the meter)
# return
#######################################################
## Draw red-line arc-segment (danger zone) of the meter.
#######################################################
set redLineIndentPx 15
set x1 [expr {$topleftXpx + $redLineIndentPx}]
set y1 [expr {$topleftYpx + $redLineIndentPx}]
set x2 [expr {$botrightXpx - $redLineIndentPx}]
set y2 [expr {$botrightYpx - $redLineIndentPx}]
$canvas create arc $x1 $y1 $x2 $y2 \
-start -70 -extent $DEGperTIC -style arc \
-outline red -fill red -width 8
## FOR TESTING: (exit this proc before adding more to the meter)
# return
##################################
## Draw 4 rivets around the meter.
##################################
set RIVETindentPx 10
set RIVEToutdentPx [expr {$curCanvasSizePx - $RIVETindentPx}]
## upper-left rivet
draw_rivet $canvas $RIVETindentPx $RIVETindentPx
## upper-right rivet
draw_rivet $canvas $RIVEToutdentPx $RIVETindentPx
## lower-left rivet
draw_rivet $canvas $RIVETindentPx $RIVEToutdentPx
## lower-right rivet
draw_rivet $canvas $RIVEToutdentPx $RIVEToutdentPx
}
## END OF proc 'make_tachometers'
##+########################################################################
## PROC 'draw_rivet'
##+########################################################################
## PURPOSE: Put a rivet at a specified center point.
## The center point is specified in pixels, as a location on
## the canvas of the GUI, relative to the upper left corner.
##
## (We pass the radius of the rivets in a global variable.)
##
## CALLED BY: the 'make_tachometer' proc
##+########################################################################
set rivetRadiusPx 4
proc draw_rivet { canvas centerXpx centerYpx } {
global rivetRadiusPx
## FOR TESTING:
# return
########################################################
## Draw a color shaded arc using
## - 5 arc segments around each half of the circle/oval
## - 3 pixels for width of the arc segments
## - -45 degrees for the start angle (darkest shade)
########################################################
draw_circle_shadow $canvas \
[expr {$centerXpx - $rivetRadiusPx}] \
[expr {$centerYpx - $rivetRadiusPx}] \
[expr {$centerXpx + $rivetRadiusPx}] \
[expr {$centerYpx + $rivetRadiusPx}] \
5 3 -45.0
}
## END OF proc 'draw_rivet'
##+########################################################################
## PROC 'draw_circle_shadow'
##+########################################################################
## PURPOSE: Puts a shadowed edge around an oval/circle in a specified 'box'.
##
## INPUTS: - the corner coordinates of the oval/circle box (in pixels)
## - number of segments for the arc (segments of differing color shade)
## - width (in pixels) to draw the arc segments
## - start angle for drawing the arc segments
##
## CALLED BY: the 'make_tachometers' and 'draw_rivets' procs
##+########################################################################
proc draw_circle_shadow {canvas x1 y1 x2 y2 Nsegs ARCwidthPx startDEGREES } {
## FOR TESTING: (dummy out this proc)
# return
set DEGperSHADE [expr {180.0/$Nsegs}]
for {set i 0} {$i <= $Nsegs} {incr i} {
set a [expr {($startDEGREES + $i * $DEGperSHADE)}]
set b [expr {($startDEGREES - $i * $DEGperSHADE)}]
## Make darker grays for greater angles.
set color255 [expr {40 + $i*(200/$Nsegs)}]
set hexcolor [format "#%x%x%x" $color255 $color255 $color255]
$canvas create arc \
$x1 $y1 $x2 $y2 \
-start $a -extent $DEGperSHADE \
-style arc -outline $hexcolor -width $ARCwidthPx
$canvas create arc \
$x1 $y1 $x2 $y2 \
-start $b -extent $DEGperSHADE \
-style arc -outline $hexcolor -width $ARCwidthPx
## FOR TESTING: (show each pair of segments before
## drawing the next pair)
# update
}
## END OF loop over the arc segments
}
## END OF proc 'draw_circle_shadow'
##+########################################################################
## PROC 'update_needles'
##+########################################################################
## PURPOSE: Updates the a needle on a square canvas --- using the
## Linux/Unix/BSD/Mac 'free' command to get
## MEMtot, MEMused, SWAPtot, SWAPused (in Megabytes).
##
## Input is the canvas ID. This proc queries the canvas to
## get its center and to determine an appropriate length for
## the needle.
##
## CALLED BY: the 'Additional GUI Initialization' section at the
## bottom of this script, and within this proc itself.
##+########################################################################
##+#############################################################
## Outside of the 'update_needles' proc:
## Get the directory that this Tk script is in. That will be the
## directory that the 'external' utility shell script should be
## in --- to get the mem-and-swap values via the 'free' command.
##+#############################################################
## FOR TESTING:
# puts "argv0: $argv0"
# set DIRscripts "."
# set DIRscripts "[pwd]"
# set DIRscripts "$env(HOME)/apps/tkUtils"
set DIRscripts "[file dirname $argv0]"
proc update_needles {} {
global argv0 DIRscripts WAITseconds VARsampcnt
# global env
# global WAITseconds
##########################################################
## Get MEMtot,MEMused,SWAPtot,SWAPused via 'free' command.
##########################################################
foreach {MEMtot MEMused SWAPtot SWAPused} \
[exec $DIRscripts/get_memory_and_swap.sh] {break}
###########################################################
## AN ALTERNATIVE, avoiding use of 'external' shell script.
## (Untested. Something like this should work.)
###########################################################
# foreach {MEMtot MEMused SWAPtot SWAPused} \
# [exec {/bin/sh -c "free -m -o | tail -2 | cut -c6-30 | tr '\n' ' ' | sed 's/ */ /g'"}] \
# {break}
########################################################
## ANOTHER ALTERNATIVE, suggested by RLE of wiki.tcl.tk,
## to avoid use of 'external' shell script.
########################################################
# set freeinfo [ exec free -m -o ]
# regexp {Mem: +([0-9]+) +([0-9]+).*Swap: +([0-9]+) +([0-9]+)} $freeinfo -> MEMtot MEMused SWAPtot SWAPused
## FOR TESTING:
# puts " MEMtot: $MEMtot MEMused: $MEMused"
# puts "SWAPtot: $SWAPtot SWAPused: $SWAPused"
##################################################
## Increment the sample count, to show on the GUI.
##################################################
incr VARsampcnt
#########################################################
## Update the 2 needles.
#########################################################
## FOR TESTING: (hardcoded meter values)
# update_one_needle .fRcanvases.fRcanvas1 2000 650 Memory
# update_one_needle .fRcanvases.fRcanvas2 1000 0 Swap
update_one_needle .fRcanvases.fRcanvas1 $MEMtot $MEMused Memory
update_one_needle .fRcanvases.fRcanvas2 $SWAPtot $SWAPused Swap
############################################################
## Force the needles to show up on the GUI.
## (Needed???) It appears NOT.
############################################################
# update
####################################################################
## 'Pseudo-Recursively' 'fork off' another (delayed) instance of the
## 'update_needles' here to support the wait-seconds scale widget
## --- using the 'after ms cmd arg arg ...' form of the 'after'
## command.
####################################################################
## It appears that we do NOT need an 'after idle update_needles'
## somewhere in this script to 'register'/'queue' the 'update_needles'
## proc for execution at idle times --- and assure responsiveness
## of the GUI.
####################################################################
set WAITmillisecs [expr {int($WAITseconds * 1000)}]
after $WAITmillisecs update_needles
}
## END OF proc 'update_needles'
##+########################################################################
## PROC 'update_one_needle'
##+########################################################################
## PURPOSE: Updates the a needle on a square canvas --- using the
## canvas ID and the tot and used numbers passed as arguments.
##
## Input is the canvas ID. This proc queries the canvas to
## get its center and to determine an appropriate length for
## the needle as a proportion of the (square) canvas size.
##
## CALLED BY: the 'update_needles' proc
##+########################################################################
proc update_one_needle {frame TOT USED TYPE} {
global pi radsPERdeg Nsegs
## FOR TESTING: (dummy out this routine)
# return
set PERcent [expr {($USED * 100.0) / $TOT}]
set TOTtext "Total $TYPE = $TOT Megabytes"
set USEDtext "Used $TYPE = $USED Megabytes"
$frame.labelINFO1 configure -text "$TOTtext"
$frame.labelINFO2 configure -text "$USEDtext"
## Set the angle for the zero-point on the arc-of-tic-marks.
set angle0 250.0
## Convert PERcent to an angle in radians on the arc.
set degs [expr {$angle0 - (320.0 * $PERcent / 100.0)}]
set rads [expr {$degs * $radsPERdeg}]
## FOR TESTING:
# puts "PERcent: $PERcent degs: $degs rads: $rads"
## Get the coord(s) of the center of the (square) canvas
## and calculate a length of the needle.
# set width [$frame.can cget -width]
set width [winfo width $frame.can]
set half [expr {int($width / 2.0)}]
set length [expr {int($half * 0.5)}]
## Calculate the coordinates for the tip and base of the needle.
set xtip [expr {$half + $length*cos($rads)}]
set ytip [expr {$half - $length*sin($rads)}]
# set xbase [expr {$half + 0.2*$length*cos($rads)}]
# set ybase [expr {$half - 0.2*$length*sin($rads)}]
set xbase $half
set ybase $half
## Remove a previous needle, if any.
catch {$frame.can delete -tags TAGneedle}
####################################################################
## Draw a red-line needle and a reddish-white line on either side
## --- for an (attempted) anti-aliasing effect.
##
## NOTE: This attempt at anti-aliasing did not work out well.
## This code needs improvement --- or simply one 'create line'.
####################################################################
$frame.can create line \
$xbase $ybase $xtip $ytip \
-fill #ff0000 -width 4 -tag TAGneedle
$frame.can create line \
[expr {$xbase + 1}] [expr {$ybase + 1}] \
[expr {$xtip + 1}] [expr {$ytip + 1}] \
-fill #ff8888 -width 2 -tag TAGneedle
$frame.can create line \
[expr {$xbase - 1}] [expr {$ybase - 1}] \
[expr {$xtip - 1}] [expr {$ytip - 1}] \
-fill #ff8888 -width 2 -tag TAGneedle
}
## END OF proc 'update_one_needle'
##+#############################################################
## proc Refresh
##
## PURPOSE: 'Refresh' the two meters and their needles ---
## for when the user wants a new set of values
## and/or when the user resizes the window.
##
## CALLED BY: 'Refresh' button
##+#############################################################
proc Refresh {} {
## Cancel pending needle update(s), before redrawing
## the meters and restarting the update-needles cycle.
set LISTids [after info]
foreach ID $LISTids {
after cancel $ID
}
make_tachometers
update_needles
}
## END OF proc 'Refresh'
##+#############################################################
## proc ReDraw_if_canvases_resized
##
## PURPOSE: To handle resizing the meters when the window is
## resized --- IF the <Configure> binding is implemented.
##
## The intent is to avoid too many redraws --- for
## almost every little resize of the window as its
## border(s) are dragged.
##
## CALLED BY: bind .fRcanvas.can <Configure>
## at bottom of this script.
##+#############################################################
## NOT IMPLEMENTED.
## Code is included for possible future development.
##+#############################################################
set draw_wait0or1 0
proc ReDraw_if_canvases_resized {} {
global PREVcanvasesWidthPx PREVcanvasesHeightPx draw_wait0or1
## FOR TESTING: (to dummy out this proc)
# return
if {$draw_wait0or1 == 1} {return}
set CURcanvasesWidthPx [winfo width .fRcanvases]
set CURcanvasesHeightPx [winfo height .fRcanvases]
if { $CURcanvasesWidthPx != $PREVcanvasesWidthPx || \
$CURcanvasesHeightPx != $PREVcanvasesHeightPx} {
## Set the wait indicator to keep subsequent <Configure> calls
## to this proc from trying to resize --- until this call is done
## --- in case calls to this proc are being done asynchronously.
set draw_wait0or1 1
## The following 'after 500' is intended to prevent too many
## redraws (and flickering and unnecessary processing)
## as the window is being moved.
##
## The wait should allow time for the user to stop moving the
## window. After about 200 to 3000 milliseconds, it is unlikely
## that the window is moving and thus causing multiple calls
## to this proc and multiple redraws.
after 500
make_tachometers
update_needles
set PREVcanvasesWidthPx $CURcanvasesWidthPx
set PREVcanvasesHeightPx $CURcanvasesHeightPx
set draw_wait0or1 0
}
}
## END OF proc 'ReDraw_if_canvases_resized'
##+########################################################################
## 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 } {
## 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 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_varwidth \
-width $VARwidth \
-height $VARheight \
-bg "#f0f0f0" \
-relief raised \
-bd 2 \
-yscrollcommand "$toplevName.scrolly set" \
-xscrollcommand "$toplevName.scrollx set"
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_varwidth \
-width $VARwidth \
-height $VARheight \
-bg "#f0f0f0" \
-relief raised \
-bd 2
}
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
}
#####################################
## 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.
##+########################
## Set HELPtext var.
##+########################
set HELPtext "\
\ \ ** HELP for this 'Memory and Swap Usage' Monitoring Utility **
This utility is meant to show a GUI that holds a pair of
tachometer-style meters. The needles on the meters are updated
periodically --- OR whenever the user chooses to click on the
'Refresh' button.
The needles show the PERCENT of available MEMORY and SWAP resources
in use, on this computer --- as well as the actual TOTAL and USED
values of the those two resources.
This Tcl-Tk script was developed on Linux and uses the 'free'
command to get the memory and swap data to determine where to
relocate the position of the needles on the meters.
***************************************
WINDOW RESIZE (an experimental feature):
We can allow the user to resize the window rather than using a fixed
window (and fixed meters) size. If the user resizes the window, the
'Refresh' button can be used to force the meters to be resized
according to the new window size. (The meters may be resized such that
they are 'too tall' for the new window size. Just pull the bottom
border of the window down, to see the entire meters.)
************************************
THE SCRIPT USED to update the meters:
A Tcl 'exec' command calls on a separate shell script ---
'get_memory_and_swap.sh' --- that uses the 'free' command
to get the memory and swap data (total and used) and
extract-and-format the data for return to this Tk script.
If the 'free' command is not available on your computer,
you may have to install it --- or edit the shell script to use
a different command to get the memory and swap data.
***********************
CAPTURING THE GUI IMAGE:
A screen/window capture utility (like 'gnome-screenshot'
on Linux) can be used to capture the GUI image in a PNG
or GIF file, say.
If necessary, an image editor (like 'mtpaint' on Linux)
can be used to crop the window capture image. The image
could also be down-sized --- say to make a smaller image
suitable for use in a web page or an email.
"
##+################################################################
##+################################################################
## Additional GUI INITIALIZATION: Mainly to
## - Put the 2 meters on their 2 canvases, with 'make_tachometers'.
## - Start an execution loop for the 'update_needles' proc.
##+################################################################
##+###################################################
## Set the scale widget var for initial 'refresh rate'
## (actually wait-time = 'wave-length', not 'frequency')
## --- in seconds.
##+###################################################
set WAITseconds 60.0
## FOR TESTING:
set WAITseconds 1.0
# set WAITseconds 0.1
##+####################################################
## Initialize the variable we use to keep track of
## the sample count.
##+####################################################
set VARsampcnt 0
##+#################################################
## Draw the 2 tachometers (without needles).
##+#################################################
## Need 'update' here to set the size of the canvases,
## because 'make_tachometers' uses 'winfo' to get
## the width and height of some frames and canvases.
##+#################################################
update
make_tachometers
##+######################################################
## Do an initial draw of the needles.
##
## NOTE:
##
## The proc 'update_needles' calls itself,
## with 'after $WAITmillisecs', where WAITmillisecs is
## set from the $WAITseconds 'scale' var.
##+######################################################
update_needles
##+#################################################
## Set a resize binding on the canvas ---
## to redraw the tachometers and needles
## if the window is resized.
##
## DE-ACTIVATED, for now.
## (Code is here for future experimentation.
## It is not easy to avoid extraneous redraws of
## the GUI as the window is being dragged/resized.)
##
## The user can click on the 'Refresh' button to cause
## the meters to re-size after resizing the window.
##+#################################################
if {0} {
set draw_wait0or1 0
set PREVcanvasesWidthPx [winfo width .fRcanvases]
set PREVcanvasesHeightPx [winfo height .fRcanvases]
bind .fRcanvases <Configure> "ReDraw_if_canvases_resized"
}
#!/bin/sh ## ## SCRIPT NAME: get_memory_and_swap.sh ## ## PURPOSE: ## Gets 'memory' and 'swap' data from output of the 'free' command. ## ## Example output from the 'free -m -o' command: ## ## total used free shared buffers cached ## Mem: 3275 595 2679 0 114 243 ## Swap: 2290 0 2290 ## ## where '-m' means the data is shown in megabytes instead of the default of ## kilobytes --- and '-o' means that a line of buffer/cache data is not shown. ## ## This script gets the data from the 'total' and 'used' columns. ## ## CALLED BY: a Tk GUI script that shows 'memory' and 'swap' data ## as needle readings on a couple of meters (dials) drawn ## on a Tk canvas --- Tk script name: ## meters_memory_swap.tk ## ## MAINTENANCE HISTORY: ## Updated by: Blaise Montandon 2013aug08 Started this script on Linux, ## using Ubuntu 9.10 (2009 October, ## 'Karmic Koala'). ## Updated by: Blaise Montandon 20....... ## FOR TESTING: # set -x # FREEOUT=`free -m -o | tail -2 | cut -c6-30 | tr '\n' ' ' | sed 's/ */ /g'` free -m -o | tail -2 | cut -c6-30 | tr '\n' ' ' | sed 's/ */ /g'
SIMILAR UTILITIES:There are several more 'meter utilities' on my 'to-do' list at the bottom of my 'bio' page at uniquename --- in the 'CME' (Code for MEters) group.In particular, I may make a meter utility that shows network activity --- and a meter utility that shows CPU activity (preferably for all the CPU's on multiple CPU computers, which are everywhere nowadays).
IN CONCLUSIONAs I have said on several other code-donation pages on this wiki ...There's a lot to like about a utility that is 'free freedom' --- that is, no-cost and open-source so that you can modify/enhance/fix it without having to wait for someone else to do it for you (which may be never).A BIG THANK YOU to Ousterhout for starting Tcl-Tk, and a BIG THANK YOU to the Tcl-Tk developers and maintainers who have kept the simply MAH-velous 'wish' interpreter going.
uniquename 2013sep09 - updateThanks to suggestions by RLE, I tried getting an auto-update feature working, based on 'wait-seconds' of a 'scale' widget on the GUI. I got that working in a similar meters script that I composed after this script. See A Pair of Tachometer-style Meters --- for Network Activity. I used that experience to put the feature in this script.I have replaced the code above with the new code. Here is an image of the GUI with the added 'scale' widget.
- But I found that there were technical problems with using the wait-time. Namely, in my attempt at implementation, the GUI became essentially non-interactive during the wait time.
- reinstate the wait time variable as an integer value in milli-seconds of wait time;
- modify your "update_needles" proc to do, as the very last command after the proc finishes the rest of its work the following:
after $::WAITmilliseconds update_needlesAnd, change the last command in your script from "update_needles" to the following:
after idle update_needlesAt which point you will have the auto-update you wanted, the responsive GUI you wanted, and not have the recursive stack consumption you feared from update_needles calling itself. After you make this change, you can reinstate your slider idea to modify the WAITmilliseconds variable (likely adjusting so that a user see's seconds instead of milliseconds).You can also replace your existing foreach loop over the output of get_memory_and_swap.sh and the entire shell script itself with this one line of Tcl:
regexp {Mem: +([0-9]+) +([0-9]+).*Swap: +([0-9]+) +([0-9]+)} [ exec free -m -o ] -> MEMtot MEMused SWAPtot SWAPusedor if you prefer two lines: set freeinfo [ exec free -m -o ]
regexp {Mem: +([0-9]+) +([0-9]+).*Swap: +([0-9]+) +([0-9]+)} $freeinfo -> MEMtot MEMused SWAPtot SWAPuseduniquename 2013sep02 - Thanks for the feedback, RLE. Finally, after 15+ years of Tcl-Tk programming, I am introduced to a use for the 'after idle' command. (There is always more to be learned about Tcl-Tk --- or about any programming language --- or about life. Whenever I hear/read of someone saying they are bored, I have to think they are really unimaginative at that point in their life --- and need to be introduced to Tcl-Tk.)I am still a little concerned about having 'update_needles' recursively calling itself. (I would be 'mightily' concerned if the wait-time were a fraction of a second --- but, in this particular application, I would probably have the wait time set at about 2 minutes, in most use cases.)Funny thing, though. This utility is just the thing to use to check if the recursive calls are using more and more memory. Just use a wait time of about 0.1 second and let it run for an hour or two. Check the GUI occasionally to see if the needle(s) is(are) moving.
RLE (2013-09-02): The after method is not recursive. After is a general delay and scheduler command. The last command of update_needles" being "after $waittime update_needles" means "schedule a task to execute "update_needles" in $waittime milli-seconds. No recursive calls. Once the future task is scheduled, the current update_needles call exists. At a later time, a new call to update_needles will occur from the Tk event loop machinery.Even if the wait time were 1 milli-second, there would still be no recursive calling. The effect is that "update_needles" would be executed every: (time to perform update_needles) + (wait time for after command) seconds. So you would likely not get 1ms execution, instead if update needles takes 250ms, you'd get a call every 251ms. But no recursion.
uniquename 2013sep02 It still looks recursive to me --- 'update_needles' is calling itself. The only way that it would NOT be recursive is if the 'after' command were allowing the proc that called the 'after' command to finish and commit suicide. In other words, it would be nice if 'after' essentially 'forks off' a new 'update_needles' proc, and the wait-time applies to the 'future-instance' of 'update_needles', not causing a wait within the current instance --- while any resources used by the 'current instance' of 'update_needles' are 'recovered' when it commits suicide.Perhaps I did not explain well what I tried, in the comments at the bottom of the script. I tried TWO techniques:
- a 'while' loop
- the recursive proc-calling-itself technique.
RLE (2013-09-02): Except that based upon your comments above, you did not actually try the after command method. Neither a while loop nor a recursive call-itself is the after command method.Change your script in this way:
--- tach.orig 2013-09-02 18:35:07.805534592 -0400
+++ tach.fixed 2013-09-02 18:35:45.717534262 -0400
@@ -1149,7 +1149,7 @@
## do not 'fall into' the normal Tk event handling loop.)
############################################################
- update
+ after 5000 update_needles
}
## END OF proc 'update_needles'
@@ -1674,4 +1674,4 @@
## button to do the needle updates.
##+############################################
-update_needles
+after idle update_needlesAnd you will get updates every 5 seconds.The key is that "update_needles" must use after to reschedule itself, it can not recursively call itself.The after idle is not strictly required, it just gives the Tk event loop queue a chance to drain after setting everything up before the first update happens.uniquename 2013sep02 - Just because I did not leave the 'after' command that I tried (commented) in the 'update_needles' proc does not mean that I did not try the 'after' command. In fact, what I tried included a statement to convert from the user-friendly seconds units that I was using on the the 'scale' widget to the milliseconds required by the 'after' command.That is what my comments on 'recursive' were talking about. I would NOT have called 'update_needles' within itself WITHOUT a wait. That would have resulted in an ultra-tight loop. That might be OK for mathematical computations, but not for this application where the point is to wait some time between 'samples'.What I haven't tried is the 'after idle'. I will try that (after I finish a few other projects, not necessarily Tcl-Tk, that I have in progress).
RLE (2013-09-02): Your comment in the code above:
## The proc 'update_needles' called itself, recursively, ## after waiting $WAITseconds. NOTE:Your comment says you tried this:
after 10000 update_needlesYour comment says you utilized the "wait for a length of time" version of after. That is not at all similar to the schedule a callback to occur later in time version of after, which would have been this:
after 10000 update_needlesThis second version, the one with a time, and a script to call, is nothing at all like the basic "wait a while" after. The second version is documented this way in the man page:
after ms ?script script script ...?
In this form the command returns immediately, but it arranges
for a Tcl command to be executed ms milliseconds later as an
event handler. The command will be executed exactly once, at
the given time.Apply the very simple patch I supplied above, it will substitute the proper after calls to get automatic repetitive updates, without recursive calls. Note, you do have to apply the patch to two places, both inside your update_needles proc and the end of the script. The important change is inside the update_needles definition. The after idle at the bottom is not strictly required.uniquename 2013sep02 - When you put
after 10000 update_needlesabove, that is YOUR interpretation of my words --- what you THINK I was saying. That is NOT what I tried. I worded it that way because I thought that the 'after' command caused a wait of so-many milliseconds before 'releasing' the script. I did not know that "the command returns immediately" --- until I looked up the 'after' command in a Tcl-Tk reference about an hour ago --- and found that it said what you quoted above.I think a little 'extra sauce' is needed --- besides simply
after <millisecs> update_needlesIn the Tcl-Tk 8.4.19 reference PDF I am looking at, it shows the following example:
proc doOneStep {} {
if {[::my_calc::one_step]} {
after idle [list after 0 doOneStep]
}
}
doOneStepPerhaps I need to do
after idle [list after $WAITmillisecs update_needles]to "ensure that a Tk GUI remains responsive" and to "ensure that the event loop is not starved " --- as it says just above that example.RLE (2013-09-02): Have you even once made the change I posted as a patch above and tested it?I have it running, right now, locally, on a 5 second update cycle, with no other changes than the two line patch I submitted above, and it is updating every 5 seconds, and the GUI is perfectly responsive.Just try the change I posted above, what do you have to lose by trying it?
uniquename 2013sep02 - Like I said above, I thought I tried that already --- except for the 'after idle' at the bottom of the entire script.I will try again --- on a similar script --- and return to this one.It is not a deal breaker for me. The 'Refresh' button works fine for me, for now. Having the wait-seconds scale widget working is just 'icing on the cake'.I have a wife --- and a life. I need to give them some attention. I have spent enough time on this script for the past several days. I need a little break --- to come back fresh --- after thinking some more about 'after ms' and 'after idle'. I would like to understand the 'how it works' and 'why it has to be that way' --- and be able to explain it better than it is explained in the Tcl-Tk reference manuals.Have you tried 1ms yet? Or even 250ms, for many minutes?
RLE (2013-09-03): How about somewhat over one hour of runtime at a 1ms update rate? I've now had it running that long, using "after 1 update_needles" as the update trigger. No change in memory size as compared to when it started. Perfectly responsive GUI even at 1ms update rates. By responsive I mean the "help" window appears instantly upon clicking "Help", and if I shrink the size of the help window, I can scroll up/down using the scrollbar with no noticeable delays.The only real "result" is about 10% CPU utilization for an hour, and many more instances of the CPU fan speeding up to dispense with build up heat.The after command is actually three quite different commands in one package.It is:
- A general "pause this script for some length of time" command ("after ms" usage);
- A general "perform a task when the Tk system has no other work available to perform" command ("after idle <script>" usage);
- A general "schedule a task to happen in the background at a later time" command ("after ms <script>" usage);
