[uniquename] - 2012oct14 Near the bottom of my [uniquename] page, I made a commitment to donating five 'PlotQuik' utilities to this Tcl-Tk wiki. Donating them requires 'extracting' the Tk scripts from the 'feHandyTools' subsystem of my free, open-source Freedom Environment software, that is available at www.freedomenv.com [http://www.freedomenv.com]. The Tk code in the 'feHandyTools' system is written to use Tk 'include' files of common code. The 'include' code is merged into various Tk scripts via Tk 'source' statements. In order to have 'stand-alone' scripts that I can donate here, I needed to merge some statements from those Tk-code 'include' files into the 'PlotQuik' Tk scripts. I have done that for the 'pie chart' PlotQuik GUI and the code is presented below. In the process of doing the merge and changing some comments in the code, I made a few improvements in the script (especially in regard to positioning the pie between a top title line and a 'legend' below the pie). So this donation is actually a little better than the 'PlotQuik' pie-chart-making Tk script in the current version of 'feHandyTools'. I also added braces to some of the 'expr' statements to improve the execution speed by a few milliseconds. However, it is hard to make a visually significant improvement in the execution speed, because the plot is performed in less than a second (after you enter/change the 3 user input fields --- title line, pie segment percents, pie segment legend-labels). Note that this utility is 'Quik' in two ways: 1) Easy for the user to enter the data for the plot. 2) Once the data is entered, the plot is rendered in a fraction of a second. Here is a reduced-size image of the pie chart GUI. [plotquik_pieChart_budget_screenshot_553x350.jpg] A full-size image of the GUI is available at this link [http://wiki.tcl.tk/37140]. This GUI is not meant to be a toy. A plot of budget data is used to show that this GUI is meant to be an actual 'productivity' tool --- a free and open-source one. (When we are all working on 'retina display' monitors --- resolution of more than 2000x1500 for desktop computers, like WQXGA = 2560x1600 --- then the jaggies of the circle may be unnoticeable. The images above were captured on a 1024x768 monitor.) _____________________________________________________________________ Below is the code that produced this GUI. There are comments above the sample code, in a section titled 'OUTPUT:', that describe how one could capture and make use of images produced by this GUI. 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). 1a) Define ALL frames and sub-frames. 1b) Pack ALL frames and sub-frames. 2) Define & pack all widgets in the frames. 3) Define keyboard or 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 makes it easy for me to find code sections --- while generating and testing this script, and when looking for code snippets to include in other scripts. _________________________________________________________________ As in all my scripts that use the 'pack' geometry manager (which is all of my 100-plus Tk scripts, so far), I provide the four main pack parameters --- '-side', '-anchor', '-fill', and '-expand' --- on all the 'pack' commands for the frames and widgets. I think I have found a good setting of the '-side', '-anchor', '-fill', and '-expand' parameters on the 'pack' commands for the various widgets of this GUI. In particular ... The 'canvas' widget expands/contracts appropriately when the window size is changed --- and button and label widgets stay fixed in size and relative-location as the window size is changed. Entry fields x-expand if the window x-expands. Note that there are 'DwnCan' and 'UpCan' buttons on the GUI to help re-size the canvas appropriately within the current window size, whatever that may be. If anyone wants to change the way the GUI configures itself as the main window size is changed, they can experiment with the '-side', '-anchor', '-fill', and '-expand' parameters on the 'pack' commands for the various widgets --- to get the widget behavior that they want. Also, you could change the fonts used for the various GUI widgets and plot elements (title and legend). For example, you could change '-weight' from 'bold' to 'normal' --- or '-slant' from 'roman' to 'italic'. Or change font families. Furthermore, there are variables used to set geometry parameters of widgets --- parameters such as border-widths and padding. Feel free to experiment with those parameters as well. _____________________________________________________________________ That said, here's the code --- with plenty of comments to describe what most of the code-sections are doing. The main plotting code is in the proc 'update_plot'. The copious comments in the code might help Tcl-Tk coding 'newbies' get started in making GUI's like this. Without the comments (especially in the 'update_plot' proc), the code might look too cryptic --- and potential young Tcler's might be tempted to return to their iPhones and iPads and iPods --- to watch America's/Japan's/Germany's/Albania's Funniest Home Videos. ====== #!/usr/bin/wish ## ## SCRIPT NAME: plot_quik_pie2d_forWiki.tk ## ## --- adapted from the script 'plot_quik_pie2d.tk' in the ## 'feHandyTools' subsystem of the 'Freedom Environment' ## subsystems at www.freedomenv.com --- adapted for donation ## of the code to the Tcl-Tk wiki at wiki.tcl.tk. ## ##+####################################################################### ## PURPOSE: A 'quick' 2D (not 3D), intuitive, easy-to-use PIE-CHART plot ## utility that can be used to make 'presentation quality' plots. ## ## This Tk script presents a GUI with a canvas widget that shows ## a 2-D pie-chart plot --- with titles and labels that can be ## dragged with the mouse. ## ## This script presents entry fields in the GUI to prompt for ## pie-slice data and titles. ## ## This is a pie-chart-utility implementation using BASIC ## Tcl-Tk commands, i.e. not requiring an 'extension' of Tcl or Tk. ## ## Unfortunately, there do not seem to be any FAIRLY GENERAL, yet ## RELATIVELY SIMPLE, pie-chart plotting scripts at Tcl-Tk archive ## sites --- even in 2012, more than 20 years after the development ## of the necessary Tk canvas facilities to support plotting. ## ## Nor are such general, easy-to-use pie-chart plotting Tk scripts ## available via web searches on keyword strings such as ## 'bin wish canvas' or 'bin wish oval'. ## ## Even searches on 'canvas' and 'oval' on the wiki.tcl.tk site, ## in early 2012, yield only simplistic pie chart 'demos' that are ## not suited to general and FAST pie chart plots --- with entry ## fields for quick entry of user data. ## ## This script is meant to fill that long-time void. ## ## SOURCES and CREDITS: ## ## The technique of dragging canvas items came from the Tcl-Tk demo in ## /usr/local/lib/tk4.0/demos/plot.tcl (on SGI-IRIX Unix, 1995 May 26). ## However, that script allowed the user to drag the data points. ## This script allows the user to drag titles and labels. ## ## On Linux (for example, Ubuntu 9.10, circa 2009), see ## /usr/share/doc/tk8.4/examples/plot.tcl ## or /usr/share/doc/tk8.5/examples/plot.tcl ## There are 60-plus other Tcl-Tk code examples are in the ## 'examples' directory. ## ## See also 'create oval' plot scripts like ## 'items.tcl' and 'twind.tcl' in /usr/share/doc/tk8.x/examples/. ## These scripts provide examples of procs to move 'items' around ## on the canvas with a mouse. ## ## _____________________________________________________________ ## ## There is a '3D' pie-chart package of tcl-tk scripts (in a rather ## complex, OBJECT-ORIENTED FORM). See the 'demo.tcl' script ## from the contributed package 'tkpiechart' (versions 1.2 thru ## 5.x by 1999) by Jean-Luc Fontaine. ## ## Downloads of 'tkpiechart' are available at Fontaine's home page ## http://jfontain.free.fr/ ## (version 6.5, circa 2006?), as late as 2011 Jul. ## ##+##################################################################### ## ## INPUTS (via entry fields on the GUI): ## plot title, pie-section-percents, pie-section-names. ## ## OUTPUT: Intended for screen/window capture to an image file with a ## screen-capture tool (such as 'gnome-screenshot' on Linux). ## ## The image could be cropped with an image editor (such as ## 'mtpaint' on Linux) and the cropped image could be printed ## using an image view-print utility (such as 'eog' = Eye of ## Gnome, on Linux). ## ## If you are going to print the image, you will probably ## want to change the background color to white, via the ## 'BkgndColor' button at the top of the GUI. ## ## (Optionally, a Postscript-Print button and proc ## could be implemented --- commented below.) ## ##+##################################################################### ## STRUCTURE OF THIS CODE: ## ## 0) Set general window parms (win-name, win-position, color-scheme, ## fonts, widget-geom-parms, win-size-control). ## 1a) Define ALL frames (and sub-frames, if any). ## 1b) Pack ALL frames and sub-frames. ## 2) Define & pack ALL widgets within frames. ## ## 3) Define key and mouse/touchpad/touch-sensitive-screen action ## BINDINGS, if any. ## 4) Define PROCS, if any. ## 5) Additional GUI INITIALIZATION (typically with one or two ## of the procs), if needed. ## ## In more detail for this particular script: ## ## 1a) Define ALL frames: 'fRbuttons', 'fRtitle_main' , 'fRsect_pcnts' , ## 'fRsect_names' 'fRplot.fRmsg', 'fRplot.fRcanvas' ## ## 1b) Pack these frames in appropriate groups to get proper behavior ## of widgets during window expansion (expansion is allowed). ## ## 2) Define & pack all widgets in the frames -- basically going through ## frames & their interiors in top-to-bottom, left-to-right order: ## ## - 'fRbuttons' contains buttons, including 'Exit', 'UpdatePlot', ## 'ToggleBorder', 'BkgdColor', 'DwnCan', 'UpCan'. ## ## - 'fRtitle_main' contains 1 label & 1 entry widget. ## - 'fRsect_pcnts' contains 1 label & 1 entry widget. ## - 'fRsect_names' contains 1 label & 1 entry widget. ## ## - 'fRplot.fRmsg' contains a how-to-use message in a label widget ## on the left side of the 'fRplot' frame. ## ## - 'fRplot.fRcanvas' contains a canvas widget on the right side ## of the 'fRplot' frame (to be populated with ## 'items' when the 'update_plot' proc is issued --- either ## whenever the 'UpdatePlot' button in 'fRbuttons' ## is poked --- or when issued at the bottom of this script ## to initialize the GUI with a sample plot). ## ## 3) Define BINDINGS: (See BINDINGS code section below for more info.) ## ## To Drag pie-slice-titles (and labels and main title): ## - .c bind tagTitles <1> "plotDown .c %x %y" ## - bind .c "plotMove .c %x %y" ## - .c bind tagTitles ".c dtag tagSelected" ## ## 4) Define PROCS: (See PROCS code section below for more info.) ## - 'plotDown' - To drag pie-slice-titles ## - 'plotMove' - To drag pie-slice-titles ## - 'update_plot' - for 'UpdatePlot' button; ## (Re)Sets contents of canvas widget!! ## - 'toggle_border' - for 'ToggleBorder' button ## - 'popup_msg_var' - to pop up a msg whenver needed ## - 'getset_bkgdcolor' - for 'BkgdColor' button ## - 'set_palette' - called by getset_bkgdcolor ## - 'downsize_canvas' - for 'DwnCan' button ## - 'upsize_canvas' - for 'UpCan' button ## ## procs Not used yet (example code): ## - 'print_plot' - for 'Print' button ## - 'print_preview' - for 'PrtPreview' button ## - 'get_logo' - for 'GetLogo' button ## ## 5) Additional GUI initialization: issue 'update_plot' to present ## an intitial demo plot on the canvas ## ##+####################################################################### ## 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 2012oct12 Started development, on Ubuntu 9.10, ## based on my code 'plot_quik_pie2d.tk' ## in the 'feHandyTools' subsystem of ## the 'Freedom Environment' subsystems ## at www.freedomenv.com --- adapted for ## donation of this code to the Tcl-Tk ## wiki at wiki.tcl.tk. ## Updated by: ..... ......... 2012 ##+############################################################################ ##+####################################################################### ## Set general window parms (win-title, win-position). ##+####################################################################### package require Tk wm title . "PlotQuik - Pie Chart - version for wiki.tcl.tk" wm iconname . "PlotPie" wm geometry . +15+30 ##+###################################################### ## Set the color scheme for the window and its widgets --- ## and set the color for the canvas background. ##+###################################################### set r255 200 set g255 200 set b255 200 ## If env vars R255,G255,B255 were set, then we could use the following ## format statement to get a hex value for specifying tkGUI colors, ## after 'catch'-ing the three values into r255,g255,b255 Tcl vars. # catch { set r255 "$env(R255)" } # catch { set g255 "$env(G255)" } # catch { set b255 "$env(B255)" } set COLOR_hex [format "#%02X%02X%02X" $r255 $g255 $b255] tk_setPalette "$COLOR_hex" ## Or could set palette from a hex-valued env var. # catch { tk_setPalette "$env(FE_PLOT_WINCOLOR)" } ## Set colors for canvas/plot items. # set COLOR_plottitle black set COLOR_plottitle #000000 ## Set colors for GUI widgets. set entryBKGD "#f0f0f0" ##+########################################################## ## We use a VARIABLE-WIDTH FONT for label and button widgets. ## ## We use a FIXED-WIDTH FONT for listboxes and entry fields ## and text widgets, if any. ##+########################################################## set FONTsize 14 set FONT_SMALLsize 12 set FONTparms_varwidth " -family {comic sans ms} \ -size -$FONTsize -weight bold -slant roman" set FONTparms_SMALL_varwidth " -family {comic sans ms} \ -size -$FONT_SMALLsize -weight normal -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 set FONTparms_fixedwidth " -family {dejavu sans mono} \ -size -$FONTsize -weight bold -slant roman " set FONTparms_SMALL_fixedwidth " -family {dejavu sans mono} \ -size -$FONT_SMALLsize -weight normal -slant roman " ## Some other possible fixed width fonts (esp. on Linux): ## Andale Mono ## Bitstream Vera Sans Mono ## Courier 10 Pitch ## Liberation Mono ## Droid Sans Mono ## FreeMono ## Nimbus Mono L ## TlwgMono ##+##################################################################### ## DEFINE (temporary) FONT VARS to be used in '-font' widget specs below ## --- and for some plot titles. ##+##################################################################### eval font create fontTEMP_button $FONTparms_varwidth eval font create fontTEMP_label $FONTparms_varwidth eval font create fontTEMP_entry $FONTparms_fixedwidth eval font create fontTEMP_listbox $FONTparms_fixedwidth eval font create fontTEMP_msg $FONTparms_fixedwidth eval font create fontTEMP_text $FONTparms_fixedwidth eval font create fontTEMP_SMALL_button $FONTparms_SMALL_varwidth eval font create fontTEMP_SMALL_label $FONTparms_SMALL_varwidth eval font create fontTEMP_SMALL_entry $FONTparms_SMALL_fixedwidth eval font create fontTEMP_SMALL_listbox $FONTparms_SMALL_fixedwidth eval font create fontTEMP_SMALL_msg $FONTparms_SMALL_fixedwidth eval font create fontTEMP_SMALL_text $FONTparms_SMALL_fixedwidth ## For the text in the plot: eval font create fontTEMP_plottitle $FONTparms_varwidth eval font create fontTEMP_sectnum $FONTparms_varwidth eval font create fontTEMP_legend $FONTparms_SMALL_varwidth ##+####################################################################### ## SET GEOM VARS FOR THE VARIOUS WIDGET DEFINITIONS. ## (e.g. padx, pady for Buttons) ##+####################################################################### ## Set internal PADDING (X and Y) for BUTTON widgets. set fePADY_button 0 set fePADX_button 0 ## Set BORDER-WIDTH for LABEL, BUTTON, ENTRY, LISTBOX, ## TEXT, and MESSAGE widgets. set feBDwidth_label 2 set feBDwidth_button 2 set feBDwidth_entry 2 set feBDwidth_listbox 2 set feBDwidth_text 2 set feBDwidth_msg 2 ##+################################################################### ## Set a MINSIZE of the window (roughly). ## ## For width, allow for the minwidth of the '.fRbuttons' frame: ## about 4 widgets --- Exit & Help buttons, a label for the ## scale widget, and the scale widget. ## ## For height, allow ## 1 char high for the '.fRbuttons' frame, ## ## ## 24 pixels high for the '.fRplot' frame. ##+################################################################### set minWinWidthPx [font measure fontTEMP_varwidth \ "Exit UpdatePlot ToggleBorder BkgdColor DwnCan UpCan"] ## Add some pixels to account for right-left-side window decoration ## (about 8 pixels), about 4 x 4 pixels/widget for borders/padding for ## at least 6 button widgets. set minWinWidthPx [expr {24 + $minWinWidthPx}] ## MIN HEIGHT --- ## for the 5 stacked frames allow ## 1 char high for 'fRbuttons' ## 1 char high for 'fRtitle_main' ## 1 char high for 'fRsect_pcnts' ## 1 char high for 'fRsect_names' ## 24 pixels high for 'fRplot'. set CharHeightPx [font metrics fontTEMP_varwidth -linespace] set minWinHeightPx [expr {4 * $CharHeightPx}] set minWinHeightPx [expr {$minWinHeightPx + 24}] ## Add about 28 pixels for top-bottom window decoration, ## about 5x4 pixels for each of the 5 stacked frames and their ## widgets (their borders/padding). set minWinHeightPx [expr {$minWinHeightPx + 48}] ## FOR TESTING: # puts "minWinWidthPx = $minWinWidthPx" # puts "minWinHeightPx = $minWinHeightPx" wm minsize . $minWinWidthPx $minWinHeightPx ## We allow the window to be resizable and we pack the canvas with ## '-fill both -expand 1' so that the canvas 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 ##+#################################################################### ## DEFINE *ALL* THE FRAMES -- (top to bottom): ## ## - 'fRbuttons' contains buttons -- ## Exit & UpdatePlot and at least 3 other buttons. ## ## - 'fRtitle_main' contains 1 label & 1 entry widget. ## - 'fRsect_pcnts' contains 1 label & 1 entry widget. ## - 'fRsect_names' contains 1 label & 1 entry widget. ## ## - 'fRplot.fRmsg' contains a how-to-use message in a label. ## ## - 'fRplot.fRcanvas' contains a canvas widget. ## ##+#################################################################### ## For testing of packer location & sizing of frames: # set feRELIEF_frame raised # set feBDwidth_frame 2 set feRELIEF_frame flat set feBDwidth_frame 0 frame .fRbuttons -relief $feRELIEF_frame -bd $feBDwidth_frame frame .fRtitle_main -relief $feRELIEF_frame -bd $feBDwidth_frame frame .fRsect_pcnts -relief $feRELIEF_frame -bd $feBDwidth_frame frame .fRsect_names -relief $feRELIEF_frame -bd $feBDwidth_frame frame .fRplot -relief $feRELIEF_frame -bd $feBDwidth_frame frame .fRplot.fRmsg -relief raised -bd 2 frame .fRplot.fRcanvas -relief raised -bd 2 ##+######################################################## ## PACK *ALL* the FRAMES. ##+######################################################## ## PACK THE FRAMES SEPARATELY, in order to ## experiment with different behaviors in window expansion ## (if expansion is allowed/implemented). ##+######################################################## pack .fRbuttons \ -side top \ -anchor w \ -fill none \ -expand 0 pack .fRtitle_main \ -side top \ -anchor w \ -fill x \ -expand 0 pack .fRsect_pcnts \ -side top \ -anchor w \ -fill x \ -expand 0 pack .fRsect_names \ -side top \ -anchor w \ -fill x \ -expand 0 pack .fRplot \ -side top \ -anchor center \ -fill both \ -expand 1 pack .fRplot.fRmsg \ -side left \ -anchor nw \ -fill y \ -expand 0 pack .fRplot.fRcanvas \ -side right \ -anchor ne \ -fill both \ -expand 1 ##+################################################################ ## START DEFINING & PACKING WIDGETS WITHIN THEIR FRAMES. ##+################################################################ ##+######################################################## ## IN THE 'fRbuttons' frame -- DEFINE 5 BUTTON WIDGETs. ## THEN PACK EM. ##+######################################################## button .fRbuttons.buttExit \ -font fontTEMP_button \ -padx $fePADX_button \ -pady $fePADY_button \ -text "Exit" \ -command exit ## User could implement Print option someday. # button .fRbuttons.buttPrint \ # -font fontTEMP_button \ # -padx $fePADX_button \ # -pady $fePADY_button \ # -text "Print" \ # -command print_plot ## User could implement Print-preview option someday. # button .fRbuttons.buttPrtPreview \ # -font fontTEMP_button \ # -padx $fePADX_button \ # -pady $fePADY_button \ # -text "PrtPreview" \ # -command print_preview button .fRbuttons.buttBkgdColor \ -font fontTEMP_button \ -padx $fePADX_button \ -pady $fePADY_button \ -text "BkgdColor" \ -command getset_bkgdcolor button .fRbuttons.buttBorder \ -font fontTEMP_button \ -padx $fePADX_button \ -pady $fePADY_button \ -text "ToggleBorder" \ -command toggle_border ## User could implement Apply-logo option someday. # button .fRbuttons.buttLogo \ # -font fontTEMP_button \ # -padx $fePADX_button \ # -pady $fePADY_button \ # -text "GetLogo" \ # -command get_logo button .fRbuttons.buttUpdate \ -font fontTEMP_button \ -padx $fePADX_button \ -pady $fePADY_button \ -text "UpdatePlot" \ -command update_plot button .fRbuttons.buttDWNwin \ -font fontTEMP_button \ -padx $fePADX_button \ -pady $fePADY_button \ -text "DwnCan" \ -command downsize_can button .fRbuttons.buttUPwin \ -font fontTEMP_button \ -padx $fePADX_button \ -pady $fePADY_button \ -text "UpCan" \ -command upsize_can ## User could implement Help button someday. ## (The shofil.tk script here is the Tk script that ## implements the 'xpg' utility of the Freedom ## Environment software. Ref: www.freedomenv.com) # button .fRbuttons.buttHelp \ # -font fontTEMP_button \ # -padx $fePADX_button \ # -pady $fePADY_button \ # -text "Help" \ # -command "eval exec ${feDIR}/tkGUIs/shofil.tk \ # ${feDIR}/helps/plot_quik_pie2d.hlp &" label .fRbuttons.lab1 \ -font fontTEMP_label \ -justify left \ -text \ "Window background color:" label .fRbuttons.lab2 \ -font fontTEMP_label \ -justify left \ -text \ "$COLOR_hex" pack .fRbuttons.buttExit \ .fRbuttons.buttBorder \ .fRbuttons.buttUpdate \ .fRbuttons.buttBkgdColor \ .fRbuttons.buttDWNwin \ .fRbuttons.buttUPwin \ .fRbuttons.lab1 \ .fRbuttons.lab2 \ -side left \ -anchor center \ -fill none \ -expand 0 # .fRbuttons.buttPrint \ # .fRbuttons.buttPrtPreview \ # .fRbuttons.buttLogo \ # .fRbuttons.buttHelp \ ##+######################################################## ## IN THE 'fRtitle_main' frame -- ## DEFINE 1 LABEL & 1 ENTRY WIDGETs. THEN PACK EM. ##+######################################################## label .fRtitle_main.lab1 \ -text "Plot Title:" \ -font fontTEMP_label \ -anchor w ## We initialize this var at the bottom of this script, ## in the GUI inititalization section. # set titleMain " MAIN PLOT TITLE goes here." entry .fRtitle_main.ent1 \ -width 80 \ -font fontTEMP_entry \ -bg $entryBKGD \ -relief sunken \ -bd 2 \ -textvariable titleMain pack .fRtitle_main.lab1 \ -side left \ -anchor w \ -fill none \ -expand 0 pack .fRtitle_main.ent1 \ -side left \ -anchor w \ -fill x \ -expand 1 ##+######################################################## ## IN THE 'fRsect_pcnts' frame -- ## DEFINE 1 LABEL & 1 ENTRY WIDGETs. THEN PACK EM. ##+######################################################## label .fRsect_pcnts.labPcnts \ -text "Pie-Section Percents:" \ -font fontTEMP_label \ -justify left \ -anchor w ## We initialize this var at the bottom of this script, ## in the GUI inititalization section. # set SectPcnts "10 30 40 20" entry .fRsect_pcnts.entPcnts \ -width 50 \ -font fontTEMP_entry \ -bg $entryBKGD \ -relief sunken \ -bd 2 \ -textvariable SectPcnts label .fRsect_pcnts.labPcnts2 \ -text "(No more than 100 total.)" \ -font fontTEMP_label \ -justify left \ -anchor w pack .fRsect_pcnts.labPcnts \ -side left \ -anchor w \ -fill none \ -expand 0 pack .fRsect_pcnts.entPcnts \ -side left \ -anchor w \ -fill x \ -expand 1 pack .fRsect_pcnts.labPcnts2 \ -side left \ -anchor w \ -fill none \ -expand 0 ##+######################################################## ## IN THE 'fRsect_names' frame -- ## DEFINE 1 LABEL & 1 ENTRY WIDGETs. THEN PACK EM. ##+######################################################## label .fRsect_names.labSectnames \ -text "Pie-Section Names:" \ -font fontTEMP_label \ -justify left \ -anchor w ## We initialize this var at the bottom of this script, ## in the GUI inititalization section. # set SectNames "\"BMW sportscar\" Mercedes Lamborghini Lotus" entry .fRsect_names.entSectnames \ -width 80 \ -font fontTEMP_entry \ -bg $entryBKGD \ -relief sunken \ -bd 2 \ -textvariable SectNames pack .fRsect_names.labSectnames \ -side left \ -anchor w \ -fill none \ -expand 0 pack .fRsect_names.entSectnames \ -side left \ -anchor w \ -fill x \ -expand 1 ##+######################################################## ## IN THE 'fRplot.fRmsg' frame -- DEFINE 1 LABEL WIDGET. ## THEN PACK IT. ##+######################################################## label .fRplot.fRmsg.lab \ -font fontTEMP_msg \ -justify left \ -anchor nw \ -text \ "To the right is a 'canvas' to contain a single pie-chart plot. Recommended order of actions: 1. Increase the canvas AND plot size with the 'UpCan' button. Downsize with 'DwnCan'. Use the 'BkgdColor' button to change background color. 2. After making changes in any of the several entry fields, use the 'UpdatePlot' button. 3. You can drag any of the titles and labels with mouse-button-1. When you use the 'UpdatePlot' button, titles and labels are returned to their initial locations (handy to restore labels if pulled off-canvas). You can drag labels back where wanted. 4. You can use screen-grab, image- editor, and image-view-print utilities to make an image file or to print the plot." pack .fRplot.fRmsg.lab \ -side top \ -anchor nw \ -fill none \ -expand 0 ##+######################################################## ## IN THE 'fRplot.fRcanvas' frame -- DEFINE 1 CANVAS WIDGET. ## THEN PACK IT. ##+######################################################## ## Instead of hard-coding an initial canvas size, we ## set the canvas size in proportion to the screen size. ## set canWidth 500 ## set canHeight 375 set SCRNsizex [winfo screenwidth .] set SCRNsizey [winfo screenheight .] set canWidth [ expr {6 * $SCRNsizex / 10} ] set canHeight [ expr {6 * $SCRNsizey / 10} ] ## FOR TESTING: # puts "canWidth: $canWidth" # puts "canHeight: $canHeight" canvas .fRplot.fRcanvas.c \ -relief raised \ -width $canWidth \ -height $canHeight pack .fRplot.fRcanvas.c \ -side top \ -anchor nw \ -fill both \ -expand 1 ##+################################################## ##+################################################## ## END OF THE MAIN, INITIAL GUI BUILDING SECTION. ##+################################################## ##+################################################## ##+################################################## ##+################################################## ## DEFINE BINDINGS -- for mouse actions: ## ## - to Drag slice-titles ## ## NOT IMPLEMENTED: ## - to Change color of slice-titles during their move ##+################################################## ##+################################################## ##+###################### ##+ To Drag slice-titles: ##+###################### .fRplot.fRcanvas.c bind tagTitles "plotDown .fRplot.fRcanvas.c %x %y" bind .fRplot.fRcanvas.c "plotMove .fRplot.fRcanvas.c %x %y" .fRplot.fRcanvas.c bind tagTitles ".fRplot.fRcanvas.c dtag tagSelected" ## To Drag *image* (logo): ## (Provided in case some wants to implement the Logo button and 'get_logo' proc.) # .fRplot.fRcanvas.c bind tagImage "plotDown .fRplot.fRcanvas.c %x %y" # .fRplot.fRcanvas.c bind tagImage ".fRplot.fRcanvas.c dtag tagSelected" ##+##################################################################### ##+##################################################################### ## DEFINE PROCEDURES: ## - 'plotDown' ## - 'plotMove' ## - 'print_plot' (not used yet) ## - 'print_preview' (not used yet) ## - 'update_plot' (the pie-chart maker) ## - 'toggle_border' ## - 'get_logo' (not used yet) ## - 'popup_msg_var' ## - 'getset_bkgdcolor' ## - 'set_palette' ## - 'resize_win' ## - 'downsize_canvas' ## - 'upsize_canvas' ##+##################################################################### ##+##################################################################### ##+##################################################################### ## 'plotDown' PROCEDURE ##+##################################################################### ## ## PURPOSE: ## This procedure is invoked when the mouse is pressed over one of the ## canvas items. It sets up state to allow the item to be dragged. ## Probably should be called 'itemSelect'. ## ## Arguments: ## w - The canvas window. ## x, y - The coordinates of the mouse press. ## ## CALLED BY: binding .... .fRplot.fRcanvas.c bind point <1> ##+##################################################################### set plotxy(lastX) 0 set plotxy(lastY) 0 proc plotDown {w x y} { global plotxy $w dtag tagSelected $w addtag tagSelected withtag current $w raise current set plotxy(lastX) $x set plotxy(lastY) $y } ## END of proc 'plotDown' ##+##################################################################### ## 'plotMove' PROCEDURE ##+##################################################################### ## ## PURPOSE: ## This procedure is invoked during mouse motion events. ## It drags the current item. ## Probably should be called 'itemMove'. ## ## Arguments: ## w - The canvas window. ## x, y - The coordinates of the mouse. ## ## CALLED BY: binding .... .fRplot.fRcanvas.c ##+##################################################################### proc plotMove {w x y} { global plotxy $w move tagSelected [expr {$x - $plotxy(lastX)}] [expr {$y - $plotxy(lastY)}] set plotxy(lastX) $x set plotxy(lastY) $y } ## END of proc 'plotMove' ##+##################################################################### ## 'print_plot' PROCEDURE ##+##################################################################### ## ## PURPOSE: ## This procedure is invoked to print the canvas image: .fRplot.fRcanvas.c ## ## Arguments: none ## ## CALLED BY: button .fRbuttons.buttPrint ##+##################################################################### proc print_plot {} { global env feDIR set tmp_filename "/tmp/$env(USER)_tmp_tkplot.ps" eval exec rm -f $tmp_filename .fRplot.fRcanvas.c postscript -file $tmp_filename \ -colormode gray \ -pageheight 10i \ -pagewidth 7i \ -pagex 1i \ -pagey 1i \ -pageanchor sw # -colormode color # -colormode gray # -colormode monochrome ## Use some external utility to print the postscript file. ## Examples: # set PRINTcmd "/usr/bin/kprinter" # set PRINTcmd "/usr/bin/hp-print" set fePRINTcmd "/usr/bin/cupsdoprint -H localhost:631 -P lp1" eval exec $PRINTcmd $tmp_filename # eval exec rm $tmp_filename } ## END of proc 'print_plot' ##+##################################################################### ## 'print_preview' PROCEDURE ##+##################################################################### ## ## PURPOSE: ## This procedure is invoked to preview the Postscript file of the ## canvas image: .fRplot.fRcanvas.c ## ## Arguments: none ## ## CALLED BY: button .fRbuttons.buttPrtPreview ##+##################################################################### proc print_preview {} { global env set tmp_filename "/tmp/$env(USER)_tmp_tkplot.ps" eval exec rm -f $tmp_filename .fRplot.fRcanvas.c postscript -file $tmp_filename \ -colormode color \ -pageheight 10i \ -pagewidth 7i \ -pagex 1i \ -pagey 1i \ -pageanchor sw ## Could use a PSviewer app var here. Example: set PSviewer "evince' eval exec "$PSviewer $tmp_filename &" # eval exec rm $tmp_filename } ## END of proc 'print_preview' ##+##################################################################### ## 'update_plot' PROCEDURE (for pie-chart plot) ##+##################################################################### ## ## PURPOSE: ## This procedure is invoked to (re)create the canvas items using the ## current GUI entries. Uses 'arcs' to create pie-slices in chart. ## Uses 'create oval' to create pie background (white/transparent-on-print). ## Uses 'create text' for titles and labels. ## ## Arguments: none ## ## CALLED BY: button .fRbuttons.buttUpdate ##+##################################################################### proc update_plot {} { global titleMain SectPcnts SectNames global COLOR_plottitle COLOR_pal # global fontTEMP_plottitle fontTEMP_sectnum fontTEMP_legend global borderOnOff imageOnOff set CURcanWidthPx [winfo width .fRplot.fRcanvas.c] set CURcanHeightPx [winfo height .fRplot.fRcanvas.c] ######################################################################### ## CHECK FOR EQUAL NUMBER OF SECTION (SLICE) PERCENTS AND NAMES. ######################################################################### set Npcnts [ llength $SectPcnts ] set Nnames [ llength $SectNames ] if { $Npcnts != $Nnames } { set message "Number-of-Sect-%s NOT = Number-of-Sect-Names." tk_dialog .xxx "Input Err" $message warning 0 Close return } ######################################################################### ## CHECK FOR VALID NUMERIC ENTRIES IN $SectPcnts. ## (Not implemented. Rather than preclude some format that might ## work by implementing a too-conservative regexp, we let the ## error trace-back diaglog greet the user.) ######################################################################### #### Example for splitting the numbers into a list, to process in a loop. ## set SectVals [ split [string trim $SectPcnts] " " ] #### Example for removing leading and trailing spaces. ## set SectPcnts [string trim $SectPcnts] #### Could try something like the following 'regexp'. But this is for #### 3 integer numbers, and we need an arbitrary number of floating-point nums. ## ## if [regexp {^([ ]*[0-9]+)[ ]([ ]*[0-9]+)[ ]([ ]*[0-9]+)[ ]*(.*)} $line {} r g b name] { ## .clr insert end "$r $g $b $name" ## } elseif [regexp {^!} $line] { ## } else { ## puts "$me: Can't parse \"$line\"" ## } ## ####################################################################### ## CLEAR THE CANVAS WIDGET (and set border & image/logo toggle vars to OFF). ####################################################################### .fRplot.fRcanvas.c delete all set borderOnOff OFF set imageOnOff OFF #### Alternative -- that could avoid deletion of logo & border. ## .fRplot.fRcanvas.c delete tagTitles ## .fRplot.fRcanvas.c delete ####################################################################### ## PUT MAIN TITLE NEAR TOP OF THE PLOT-CANVAS. ####################################################################### set x [expr { 0.10 * $CURcanWidthPx }] ## Note that we are placing the text with '-anchor nw'. ## Rather than setting the top position of the title to be ## proportional to the canvas height, like so: ## set y [expr { 0.04 * $CURcanHeightPx }] ## Instead we set the top postion in absolute units, pixels, ## and we use this for a margin both above and below the ## top title. set plottitleYmargin 4 .fRplot.fRcanvas.c create text \ $x $plottitleYmargin \ -anchor nw \ -justify center \ -text "$titleMain" \ -font fontTEMP_plottitle \ -fill $COLOR_plottitle \ -tags tagTitles ######################################################################## ## SET CORNERS OF PIE-SQUARE (x1,y1,x2,y2) to a square ## of height & width = $pieSquareDim -- which fits into the ## canvas height & width, with some vert margin & horiz margin. ######################################################################## ## FIRST determine size of a square that fits inside the canvas --- ## allowing some room for the legend at the bottom and title at top. ######################################################################## ## Calc legend height --- Npcnts chars above bottom of canvas. ## We throw in another char-height for some margin. set CharHeightPx [font metrics fontTEMP_legend -linespace] set legendHeightPx [ expr {($Npcnts + 1) * $CharHeightPx} ] ## Get top title height. set plottitleHeightPx [font metrics fontTEMP_plottitle -linespace] ## As a first pass at setting $pieSquareDim, base it on the canvas height ## and subtract out legend height and plottitle height and margin. # set pieSquareDim [expr { $vertFactor * $CURcanHeightPx }] set pieSquareDim [ expr {$CURcanHeightPx - \ ($legendHeightPx + $plottitleHeightPx + (2 * $plottitleYmargin))} ] ## As a second pass, check that $pieSquareDim will fit into the ## width of the canvas. if { $pieSquareDim > $CURcanWidthPx } { set pieSquareDim [expr { 0.90 * $CURcanWidthPx}] } ## FOR TESTING: # puts "update_plot > CURcanWidthPx: $CURcanWidthPx CURcanHeightPx: $CURcanHeightPx" # puts " legendHeightPx: $legendHeightPx pieSquareDim: $pieSquareDim" ######################################################################## ## SET COORDS OF MIDPOINT OF PIE-BOX -- AND 'RADIUS' OF PIE. ## (for use in computing xy-locations of labels on the slices) ######################################################################## set pieSquareRadius [expr { $pieSquareDim / 2 }] set pieSquare_xmid [expr { $CURcanWidthPx / 2 }] ## The following is too simplistic for setting the y-midpoint of the pie-box. ## set pieSquare_ymid [expr { $CURcanHeightPx / 2 }] ## Instead, we take into account the top plot title height and the legend height. set pieSquare_ymid [expr {(2 * $plottitleYmargin) + $plottitleHeightPx + $pieSquareRadius}] ######################################################################## ## SET CORNERS OF PIE-SQUARE (x1,y1,x2,y2) ######################################################################## set pieSquare_x1 [expr { $pieSquare_xmid - $pieSquareRadius }] set pieSquare_y1 [expr { $pieSquare_ymid - $pieSquareRadius }] set pieSquare_x2 [expr { $pieSquare_xmid + $pieSquareRadius }] set pieSquare_y2 [expr { $pieSquare_ymid + $pieSquareRadius }] ## FOR TESTING: # puts "Pie box coord's (in pixels): # $pieSquare_x1 $pieSquare_y1 $pieSquare_x2 $pieSquare_y2" ######################################################################### ## SET AN ARRAY OF COLORS (seven) TO USE IN THE PLOT LOOP BELOW. ## (You can use 'showrgb' on Linux to see colornames and their RGB values.) ######################################################################### ## set sectColors {red green deepskyblue cyan magenta yellow black} ## ## set sectColors {#FF0000 #00FF00 #00BFFF #00FFFF #FF00FF #FFFF00 #000000 } ## set sectColors {indianred green3 deepskyblue cyan3 \ ## ~magenta ~yellow3 ~gray78} ## ## set sectColors {#CD5C5C #00CD00 #00BFFF #00CDCD \ ## ##CC00FF #B4B400 #C7C7C7 } ## Must be lighter, for printing: set sectColors {#FD8C8C #30FD30 #30CFFF #30FDFD \ #FC30FF #E4E430 #F7F7F7 } set numColors [llength $sectColors] ###################################################################### ## PREPARE FOR PLOT LOOP --- ## set CumPcnt cumulator and baseAngle parameter. ###################################################################### set CumPcnt 0 set baseAngle 90 ###################################################################### ## CREATE FULL PIE CIRCLE ON THE CANVAS. ## (De-activated! To avoid background problems when pie sections ## do not fill pie. But someone may want to do something like this, ## so this sample code is left here.) ###################################################################### ## NOTE: The 'oval' background shows through ## for any remaining, unused slice of the pie. ## (May have to use WHITE oval, to get white background ## in printouts.) ###################################################################### ## Use -outline "" so that no arc drawn. ## Let the 'create arc' commands draw the outlines. ###################################################################### # .fRplot.fRcanvas.c create oval \ # $pieSquare_x1 $pieSquare_y1 $pieSquare_x2 $pieSquare_y2 \ # -fill white \ # -outline "" \ # -tags tagCircle # -fill $COLOR_pal \ # -outline black \ # -width 2 \ ###################################################################### ## PLOT PIE SECTIONS --- loop through the %s --- ## according to number of Section %s and names. ###################################################################### for {set i 0} {$i < $Npcnts} {incr i} { ############################################################ ## SET COLOR for current slice. ############################################################ set colorIndex [ expr {$i % $numColors} ] set color [lindex $sectColors $colorIndex] ############################################################ ## SET start,extent ANGLES for current slice. ############################################################ set startAngle [ expr {$baseAngle + (3.60 * $CumPcnt)} ] set curPcnt [lindex $SectPcnts $i ] set extentAngle [ expr {3.60 * $curPcnt} ] ## For testing: # puts "******** CREATE SLICE ****************" # puts "i: $i" # puts "SectPcnt(i): [lindex $SectPcnts $i]" # puts "SectName(i): [lindex $SectNames $i]" # puts "CumPcnt: $CumPcnt" # puts "Start angle: $startAngle" # puts "Extent angle: $extentAngle" # puts "Section Color: $color" ############################################################ ## CREATE ARC for current slice. ############################################################ .fRplot.fRcanvas.c create arc \ $pieSquare_x1 $pieSquare_y1 $pieSquare_x2 $pieSquare_y2 \ -fill $color \ -start $startAngle \ -extent $extentAngle \ -tags tagArc ############################################################ ## CREATE TEXT LABEL (slice number) for current slice. ############################################################ set midAngle [ expr {$startAngle + ( $extentAngle / 2 )} ] set pi [expr {4*atan(1)}] set text_x [expr {$pieSquare_xmid + \ ($pieSquareRadius / 2) * cos($midAngle * $pi / 180)} ] set text_y [expr {$pieSquare_ymid - \ ($pieSquareRadius / 2) * sin($midAngle * $pi / 180)} ] ## For testing: # puts "******** CREATE SLICE LABEL ****************" # puts "i: $i" # puts "CumPcnt: $CumPcnt" # puts "Start angle: $startAngle" # puts "Extent angle: $extentAngle" # puts "Mid angle: $midAngle" # puts "text_x: $text_x" # puts "text_y: $text_y" # puts "pieSquare_x1 pieSquare_y1: $pieSquare_x1 $pieSquare_y1" # puts "pieSquare_x2 pieSquare_y2: $pieSquare_x2 $pieSquare_y2" # puts "pieSquare_xmid pieSquare_ymid: $pieSquare_xmid $pieSquare_ymid" .fRplot.fRcanvas.c create text \ $text_x $text_y \ -anchor center \ -fill black \ -text "[expr {$i + 1}]"\ -font fontTEMP_sectnum \ -tags tagTitles ############################################################ ## AUGMENT CumPcnt --- and check for over 100. ############################################################ set CumPcnt [ expr { $CumPcnt + $curPcnt } ] if { $CumPcnt > 100 } { set message "Percents exceed 100." tk_dialog .xxx "Input Err" $message warning 0 Close return } } ## END of FIRST "{set i 0} {$i < $Npcnts} {incr i}" loop. ############################################################# ## PUT LEGEND AT BOTTOM OF CANVAS --- loop through the percents ## --- and use the Section percents and names in the legend. ## (We do this in a separate loop to keep the legend-creating ## logic separate from the slice-creating logic.) ############################################################# ## Indent legend-text-items 5 pixels from left of canvas. set text_x 5 ## Set top of legend at (Npcnts + 1) chars above bottom of canvas. set CharHeightPx [font metrics fontTEMP_legend -linespace] set text_y [ expr {$CURcanHeightPx - (($Npcnts + 1) * $CharHeightPx)} ] ############################################################### ## START OF 2nd LOOP ON Npcnts, to make legend. ############################################################### for {set i 0} {$i < $Npcnts} {incr i} { ############################################################ ## SET COLOR FOR CURRENT LEGEND TEXT ITEM --- ## the same color we used for the slice. ############################################################ set colorIndex [expr {$i % $numColors} ] set color [lindex $sectColors $colorIndex] ## For testing: # puts "********* BOTTOM LEGEND ***********" # puts "i: $i" # puts "SectPcnt(i): [lindex $SectPcnts $i]" # puts "SectName(i): [lindex $SectNames $i]" # puts "Text Color: $color" ############################################################ ## SET Y-LOCATION OF CURRENT LEGEND TEXT ITEM. ## (Put each item down by the legend font height.) ############################################################ set text_y [ expr {$text_y + $CharHeightPx} ] ############################################################ ## CREATE A LEGEND TEXT ITEM. ############################################################ .fRplot.fRcanvas.c create text \ $text_x $text_y \ -anchor w \ -fill black \ -text "[expr {$i + 1}] - [ lindex $SectNames $i ] [ lindex $SectPcnts $i ]%"\ -font fontTEMP_legend \ -tags tagTitles # -fill $color } ## END of SECOND "{set i 0} {$i < $Npcnts} {incr i}" loop. } ## END of proc 'update_plot' ##+##################################################################### ## 'toggle_border' PROCEDURE ##+##################################################################### ## ## PURPOSE: ## This procedure is invoked to toggle a border on/off around the ## edge of the canvas. ## ## Arguments: none ## ## CALLED BY: button .fRbuttons.buttBorder ##+##################################################################### set borderOnOff OFF proc toggle_border {} { global borderOnOff set CURcanWidthPx [winfo width .fRplot.fRcanvas.c] set CURcanHeightPx [winfo height .fRplot.fRcanvas.c] if { "$borderOnOff" == "OFF" } { ################################################# ## Set border line-width (pixels) & line-color. ################################################# set bordWIDTH 2 # set bordCOLOR black set bordCOLOR #000000 ################################################# ## Set border limits. ################################################# set xbmin [expr { 0.005 * $CURcanWidthPx } ] set xbmax [expr { 0.995 * $CURcanWidthPx } ] set ybtop [expr { 0.005 * $CURcanHeightPx }] set ybbot [expr { 0.995 * $CURcanHeightPx }] ################################################# ## Set corner arc radius. ################################################# set minDim $CURcanWidthPx if { $minDim > $CURcanHeightPx } { set minDim $CURcanHeightPx } set brad [expr { 0.03 * $minDim } ] ################################################# ## Draw the four border lines (left,right,top,bot). ################################################# .fRplot.fRcanvas.c create line \ $xbmin [expr { $ybtop + $brad } ] \ $xbmin [expr { $ybbot - $brad } ] \ -width $bordWIDTH -fill $bordCOLOR \ -tags tagBorder .fRplot.fRcanvas.c create line \ $xbmax [expr { $ybtop + $brad } ] \ $xbmax [expr { $ybbot - $brad } ] \ -width $bordWIDTH -fill $bordCOLOR \ -tags tagBorder .fRplot.fRcanvas.c create line \ [expr { $xbmin + $brad } ] $ybtop \ [expr { $xbmax - $brad } ] $ybtop \ -width $bordWIDTH -fill $bordCOLOR \ -tags tagBorder .fRplot.fRcanvas.c create line \ [expr { $xbmin + $brad } ] $ybbot \ [expr { $xbmax - $brad } ] $ybbot \ -width $bordWIDTH -fill $bordCOLOR \ -tags tagBorder ################################################# ## Draw the four border arcs (UL,UR,LR,LL). ################################################# .fRplot.fRcanvas.c create arc \ $xbmin $ybtop \ [expr { $xbmin + 2*$brad } ] [expr { $ybtop + 2*$brad } ] \ -start 90 \ -extent 90 \ -style arc -width $bordWIDTH -fill $bordCOLOR \ -tags tagBorder .fRplot.fRcanvas.c create arc \ $xbmax $ybtop \ [expr { $xbmax - 2*$brad } ] [expr { $ybtop + 2*$brad } ] \ -start 0 \ -extent 90 \ -style arc -width $bordWIDTH -fill $bordCOLOR \ -tags tagBorder .fRplot.fRcanvas.c create arc \ $xbmax $ybbot \ [expr { $xbmax - 2*$brad } ] [expr { $ybbot - 2*$brad } ] \ -start 270 \ -extent 90 \ -style arc -width $bordWIDTH -fill $bordCOLOR \ -tags tagBorder .fRplot.fRcanvas.c create arc \ $xbmin $ybbot \ [expr { $xbmin + 2*$brad } ] [expr { $ybbot - 2*$brad } ] \ -start 180 \ -extent 90 \ -style arc -width $bordWIDTH -fill $bordCOLOR \ -tags tagBorder set borderOnOff ON } else { ## Restoring the whole plot with 'update_plot' is one way to ## remove the border --- but you lose changes like title/label moves. ## update_plot .fRplot.fRcanvas.c delete tagBorder set borderOnOff OFF } ## END OF if { "$borderOnOff" == "OFF" } } ## END of proc 'toggle_border' ##+##################################################################### ## 'get_logo' PROCEDURE ## (NOT IMPLEMENTED. Not tested. Code provided as ## a starting point to implement a get-logo button.) ##+##################################################################### ## ## PURPOSE: ## This procedure is invoked to put an image (esp. a logo) on the ## canvas. ## ## Arguments: none ## ## CALLED BY: button .fRbuttons.buttLogo ## NOTE: ## The logo image is not captured by the postscript Print button opts. ## But a screen image could be captured with a screen/window capture ## utility, such as 'gnome-screenshot' on Linux --- for insertion in ## e-mails, web docs, or other docs. ## ## The captured-and-cropped image could be printed with an image ## view-print utility, such as 'eog' (Eye of Gnome) on Linux. ## ## This logo/image is draggable, if bindings above are de-commented ## and implemented. ##+##################################################################### # set curDIR "$env(HOME)" set curDIR [pwd] proc get_logo {} { global env curDIR img1 set CURcanWidthPx [winfo width .fRplot.fRcanvas.c] set CURcanHeightPx [winfo height .fRplot.fRcanvas.c] ## Get filename of a logo image file. set fName [tk_getOpenFile -parent . -title "Select LOGO GIF/PNG file to load" \ -initialdir "$curDIR" ] ## FOR TESTING: # puts "fName : $fName" if {[file exists $fName]} { set ENTRYfilename "$fName" set endIDX [ expr {[string last "/" "$fName" ] - 1} ] set CURdir [ string range $strng 0 $endIDX ] # image create photo img1 -file "$fName" set img1 [image create photo -file "$fName"] ## FOR TESTING: # puts "get_logo > img1: $img1" set x [expr { 0.99 * $CURcanWidthPx } ] set y [expr { 0.99 * $CURcanHeightPx }] .fRplot.fRcanvas.c create image \ $x $y \ -anchor se \ -image $img1 \ -tags tagImage } } ## END of proc 'get_logo' ##+######################################################################## ## 'popup_msg_var' PROCEDURE ##+######################################################################## ## PURPOSE: Report error conditions to the user. ## CALLED BY: 'get_logo' proc. ##+######################################################################## ## 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_msg_var { VARtext } { global fontTEMP_text ## global env # bell # bell ##################################### ## SETUP 'TOP LEVEL' HELP WINDOW. ##################################### set w .topmsg catch {destroy $w} toplevel $w # wm geometry $w 600x400+200+100 wm geometry $w +200+200 wm title $w "Note" wm iconname $w "Note" ##################################### ## DEFINE & PACK TEXT WIDGET. ##################################### text $w.text \ -relief raised \ -bd 2 \ -font fontTEMP_text pack $w.text \ -side top \ -anchor center \ -fill both \ -expand 0 ##################################### ## DEFINE & PACK OK BUTTON WIDGET. ##################################### button $w.butt \ -text "OK" \ -command "destroy $w" pack $w.butt \ -side bottom \ -anchor center \ -fill none \ -expand 0 ##################################### ## LOAD MSG INTO TEXT WIDGET. ##################################### ## $w.text delete 1.0 end $w.text insert end $VARtext $w.text configure -state disabled ################################################# ## 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" $w.text configure -height $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 $w.text configure -width $VARwidth ## 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. ######################################################################## } ## END OF 'popup_msg_var' PROCEDURE ##+##################################################################### ## 'getset_bkgdcolor' PROCEDURE ##+##################################################################### ## ## PURPOSE: ## This procedure is invoked to get an RGB triplet (r255 g255 b255) ## via 3 RGB slider bars. ## ## Then uses 'set_palette' proc to set window color scheme, esp. ## color of plot canvas widget. ## ## Arguments: none ## ## CALLED BY: .fRbuttons.buttBkgdColor button ##+##################################################################### proc getset_bkgdcolor {} { global r255 g255 b255 feDIR_tkguis ## FOR TESTING: # puts "r255: $r255" # puts "g255: $g255" # puts "b255: $b255" set TEMPrgb [ exec \ ./sho_colorvals_via_sliders3rgb.tk \ $r255 $g255 $b255] # $feDIR_tkguis/sho_colorvals_via_sliders3rgb.tk \ ## FOR TESTING: # puts "TEMPrgb: $TEMPrgb" if { "$TEMPrgb" == "" } { return } scan $TEMPrgb "%s %s %s %s" r255 g255 b255 hexRGB ## FOR TESTING: # puts "TEMPrgb: $TEMPrgb" # puts "r255: $r255" # puts "g255: $g255" # puts "b255: $b255" eval set r255 $r255 eval set g255 $g255 eval set b255 $b255 set_palette } ## END OF 'getset_bkgdcolor' PROCEDURE ##+##################################################################### ## 'set_palette' PROCEDURE ##+##################################################################### ## ## PURPOSE: ## This procedure is invoked to set the 'palette' for this tkGUI's ## window --- based on three global vars: r255 g255 b255. ## Uses the 'tk_setPalette' Tcl-Tk command. ## ## COULD also ## set the foreground [text] colors, for all the widgets in the GUI, ## to black(ish) or white(ish) depending on the luminance value of the ## chosen palette background color. ## ## Arguments: 3 global vars: r255 g255 b255 ## ## CALLED BY: proc 'getset_bkgdcolor' below-next, which is invoked by ## .fRtopbar.togcolor button ## AND could, perhaps, be used ## as an initialization procedure at the bottom of this script. ##+##################################################################### proc set_palette {} { global r255 g255 b255 set COLOR4gui [format "#%02X%02X%02X" $r255 $g255 $b255] tk_setPalette $COLOR4gui .fRbuttons.lab2 configure -text "$COLOR4gui" ###################################################### ## Set a foreground (text) color var --- ## to black or off-white, according to the ## 'luminance' of the palette color. ## ## NOT USED. (tk_setPalette handles this OK.) ###################################################### ## NOTE: 'Luminance' (Y) is given by a ## weighted average of RGB values, ## according to the formula: ## ## Y = .299*R + .587*G + .114*B ##################################################### # set COLOR_fg #000000 # set LOWlum 60 # set LUMval [ expr {.299*$r255 + .587*$g255 + .114*$b255} ] # if { $LUMval < $LOWlum } { # set COLOR_fg #CCCCCC # } } ## END OF 'set_palette' PROCEDURE ##+##################################################################### ## 'resize_win' PROCEDURE ##+##################################################################### ## ## PURPOSE: ## This procedure is invoked to UP/DOWN-size the Tk window by a ## given factor. ## ## Several methods could be used. ## For now, we query the current width and height (and location) ## of the window (with 'winfo' and 'wm') and apply the factor. ## ## Arguments: none ## ## CALLED BY: 'upsize_canvas' and 'downsize_canvas' procs ## ## The user can keep clicking the button to downsize ~10% per click. ## ##+##################################################################### proc resize_win {factor} { ## This is not the exact window dimensions we want, but they ## are close enough. These do not include the window decoration. set winXlen [ winfo width . ] set winYlen [ winfo height . ] ## This is not the location we want. It is the upper-left of ## the window without the window decoration. Try again, with 'wm'. # set winXloc [ winfo rootx . ] # set winYloc [ winfo rooty . ] set WMgeom [wm geometry .] # set WMsize [lindex [split $WMgeom '+'] 0] set winXloc [lindex [split $WMgeom '+'] 1] set winYloc [lindex [split $WMgeom '+'] 2] ## FOR TESTING: # puts "Down-win 1:" # puts "winXlen : $winXlen" # puts "winYlen : $winYlen" # puts "winXloc : $winXloc" # puts "winYloc : $winYloc" ## Reduce the window size about 10% set winXlen [expr {int(floor ( $factor * $winXlen ))} ] set winYlen [expr {int(floor ( $factor * $winYlen ))} ] ## Adjust the 'loc' vars for the window manager border. # set winXloc [ expr {$winXloc - 3} ] # set winYloc [ expr {$winYloc - 23} ] wm geometry . ${winXlen}x${winYlen}+${winXloc}+${winYloc} ## Could just set one same setting at every button click. # wm geometry . 650x400 ## FOR TESTING: # puts "Down-win 2:" # puts "winXlen : $winXlen" # puts "winYlen : $winYlen" # puts "winXloc : $winXloc" # puts "winYloc : $winYloc" } ## END OF 'resize_win' PROCEDURE ##+##################################################################### ## 'downsize_can' PROCEDURE ##+##################################################################### ## ## PURPOSE: ## This procedure is invoked to DOWN-size the canvas. ## ## We apply a factor to the current width and height of the canvas. ## ## Arguments: none other than global vars ## ## CALLED BY: .fRbuttons.buttDWNwin ## ## The user can keep clicking the button to downsize ~10% per click. ## ##+##################################################################### proc downsize_can {} { set CURcanWidthPx [winfo width .fRplot.fRcanvas.c] set CURcanHeightPx [winfo height .fRplot.fRcanvas.c] ## Increase the canvas size about 10% or 5%. # set factor 0.90 set factor 0.95 set NEWcanWidth [expr {int(floor ( $factor * $CURcanWidthPx ))} ] set NEWcanHeight [expr {int(floor ( $factor * $CURcanHeightPx ))} ] .fRplot.fRcanvas.c configure -width $NEWcanWidth -height $NEWcanHeight ############################################################# ## Downsize the window somewhat, so that the diminished canvas ## is not taking up too much screen space. ############################################################# # resize_win 0.95 resize_win 0.97 ## Commented this section. We do not need to re-pack. if {0} { ##################################################### # Re-pack the canvas frames, for the new canvas size. ##################################################### pack forget .fRplot.fRcanvas.c .fRplot.fRcanvas .fRplot pack .fRplot \ -side top \ -anchor center \ -fill both \ -expand 1 pack .fRplot.fRcanvas \ -side right \ -anchor center \ -fill both \ -expand 1 pack .fRplot.fRcanvas.c \ -side top \ -anchor nw \ -fill both \ -expand 1 } ## END OF if {0} COMMENTED SECTION #################################################### # Re-do the plot, according to the new canvas size. #################################################### update_plot } ## END OF 'downsize_can' PROCEDURE ##+##################################################################### ## 'upsize_can' PROCEDURE ##+##################################################################### ## ## PURPOSE: ## This procedure is invoked to UP-size the canvas. ## ## We apply a factor to the current width and height of the canvas. ## ## Arguments: none other than global vars ## ## CALLED BY: .fRbuttons.buttUPwin ## ## The user can keep clicking the button to upsize ~10% per click. ## ##+##################################################################### proc upsize_can {} { set CURcanWidthPx [winfo width .fRplot.fRcanvas.c] set CURcanHeightPx [winfo height .fRplot.fRcanvas.c] ## Increase the canvas size about 10% or 5%. # set factor 1.1 set factor 1.05 set NEWcanWidth [expr {int(floor ( $factor * $CURcanWidthPx ))} ] set NEWcanHeight [expr {int(floor ( $factor * $CURcanHeightPx ))} ] .fRplot.fRcanvas.c configure -width $NEWcanWidth -height $NEWcanHeight ################################################################ ## Upsize the window, so that the enlarged canvas is ## pretty sure to show. (If the enlarged canvas is still clipped ## by the window size, the user can enlarge the window in the ## usual window-manager ways.) ################################################################ resize_win 1.05 ## Commented this section. We do not need to re-pack. if {0} { ##################################################### # Re-pack the canvas frames, for the new canvas size. ##################################################### pack forget .fRplot.fRcanvas.c .fRplot.fRcanvas .fRplot pack .fRplot \ -side top \ -anchor center \ -fill both \ -expand 1 pack .fRplot.fRcanvas \ -side right \ -anchor center \ -fill both \ -expand 1 pack .fRplot.fRcanvas.c \ -side top \ -anchor nw \ -fill both \ -expand 1 } ## END OF if {0} COMMENTED SECTION #################################################### # Re-do the plot, according to the new canvas size. #################################################### update_plot } ## END OF 'upsize_can' PROCEDURE ##+###################################################### ## Additional GUI INITIALIZATION: ## ## Make a plot from the default entries. ##+###################################################### ## Settings for an initial sample plot. set titleMain "President's proposed federal budget, sent to Congress Feb 2012" set SectPcnts "60 6 6 5 4 19" set SectNames "\ \"Military (DeptOfDefense, Wars, VetAffairs, NuclearWeaponsPrograms)\" \ \"HealthAndHumanServices\" \ \"Education\" \ \"StateDept\" \ \"DeptOfHomelandSec.\" \ \"Other (HUD, Ag, Justice, NASA, Energy excl. NukeWeapons, Labor, Interior, EPA, etc.)\"" bind .fRplot.fRcanvas.c update_plot ====== So here is the first of 5 'PlotQuik' utilities to be converted to stand-alone mode from their 'integrated' form in the 'feHandyTools' system of the Freedom Environment software. Other Tk plot scripts to follow: 1) bar chart, created from data entered on the GUI 2) points-lines xy-plot, created from data entered on the GUI 3) math expression xy-plot, created from an expression entered on the GUI 4) xy-plot, from file of 2 or 3 columns of data <> GUI | Graphics