#!/usr/bin/wish -f ## ##+####################################################################### ## NOTE: ## If the 'wish' interpreter is in another directory, like ## /usr/local/bin, you, as root, can make a soft-link from 'wish' there ## to /usr/bin/wish --- with a command like ## ln -s /usr/local/bin/wish /usr/bin/wish ## The form of this command: ## ln -s ##+####################################################################### ## SCRIPT: tkMakeOutlineFile_byPickPointsOnImage.tk ## ## PURPOSE: This Tk GUI script ## 1) Reads an image file (GIF or PNG) selected by the user and ## puts the image on a 'canvas' widget to serve as a background. ## ## 2) Creates two arrays, aRx_forLoopPoint and aRy_forLoopPoint, of x,y coordinates of ## points that the user selects on the image on the canvas. ## ## 3) Writes the pairs of x,y coordinates as lines of an output ## text file when the user clicks on a 'WriteFile' button. ## ## OUTLINE FILE FORMAT: ## 0) The first line of the outline file may be a comment line ## (# in column 1) with a name following the # sign. For a ## name identifying the nature of the x,y coordinates in the file, ## we may simply put the name of the image file in this 'header' line. ## ## 1) Each 'data' line of the outline file contains one pair of numbers ## (x,y coordinates), space separated. ## ## 2) For simplicity, we may simply write the x,y coordinates as two ## integers, the pixel coordinates of the points selected on the ## Tk 'canvas' widget. ## ## 3) The outline may include 'loops' of points, which are indicated by ## a comment line (# in column 1) separating one loop from the next. ## The last data line of a loop contains the same x,y coordinates ## as the first data line of the loop. The user can indicate the ## end of selecting a 'loop of points' by clicking on an 'EndLoop' ## button on the GUI. ## ## 4) The pairs of coordinates could provide an outline of almost any object ## --- for example a silouette of a person or an animal or an insect or ## a fish or a logo or alphanumeric characters in different fonts or ## geometric figures (like pentagons, hexagons, ...) or mosaic patterns or ## whatever. ## ## In writing the file, some data statistics may be gathered --- such as ## the min,max x and y values and number of 'loops'. ## ## At the conclusion of writing the output file, ## the statistics can be written in the last line(s) of the file. ## ##+############# ## GUI FEATURES: ## ## The GUI is to allow the user to ## - enter or get an image filename --- into an 'entry' widget ## - pick points on the image (and delete points selected in error) ## - specify the end of a 'loop' of points ## - write the 'outline' file --- via a 'WriteFile' 'button' widget ## ##+############## ## THE GUI LAYOUT: ## ## The options available to the user are indicated by the following ## 'sketch' of the GUI. ## ##--------------------------------------------------------------------------------- ## ## In the sketch of the GUI (below): ## ## SQUARE BRACKETS indicate a comment (not to be placed on the GUI). ## BRACES indicate a Tk 'button' widget. ## A COLON indicates that the text before the colon is on a 'label' widget. ## UNDERSCORES indicate a Tk 'entry' widget. ## ## CAPITAL-O indicates a Tk 'radiobutton' widget (if any). ## CAPITAL-X indicates a Tk 'checkbutton' widget (if any). ## ## VERTICAL-BARS and horizontal HYPHENS are used to outline a rectangular 'canvas' or ## 'listbox' or 'text' widget. ## ## If there are scrollbars: ## Less-than and greater-than signs indicate the left and right ends of a horizontal 'scrollbar'. ## Capital-V and Capital-A letters indicate the bottom and top ends of a vertical 'scrollbar'. ## ##--------------------------------------------------------------------------------- ## ## FRAMEnames ## VVVVVVVVVV ## ------------------------------------------------------------------------------------------ ## Make an Outline File - by Picking Points on an Image ## [window title] ## ------------------------------------------------------------------------------------------ ## ## .fRbuttons {Exit}{Help}{EndLoop}{EndPolyLine}{WriteFile} [a label to give feedback to user on point picks goes here] ## ## .fRimgfile Enter image filename: _______________________________________________________ {Browse...} ## ## .fRmsg [ .......... Messages go here, in a label widget ..................................... ] ## ## .fRimage ----------------------------------------------------------------------------------------- ## | A ## | | ## | [The image is put on this (scrollable) canvas.] | ## | | ## | | ## | [The user picks points on this image.] | ## | | ## | [This canvas has horizontal and vertical scrollbars | ## | --- to accomodate very large images. | ## | | ## | V ## <---------------------------------------------------------------------------------------> ## ## ------------------------------------------------------------------- ## ##+############## ## GUI components: ## ## From the GUI 'sketch' above, it is seen that the GUI consists of about ## ## - 5 button widgets ## - 3 label widgets ## - 1 entry widget ## - 1 canvas widget (with xy scrollbars) ## ## - 0 checkbutton widgets ## - 0 radiobutton widgets ## - 0 scale widgets ## - 0 listbox widgets ## - 0 text widgets ## ##+######################################################################## ## 'CANONICAL' STRUCTURE OF THIS TK CODE: ## ## 0) Set general window & widget parms (win-name, win-position, ## win-color-scheme, fonts, widget-geometry-parms, ## text-array-for-labels-etc, win-size-control). ## ## 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. ## ## 3) Define keyboard and mouse/touchpad/touch-sensitive-screen 'event' ## BINDINGS, if needed. ## ## 4) Define PROCS, if needed. ## ## 5) 'Additional GUI Initialization' section, if needed. ## (typically including calls to one or more of the procs) ## ## ## Some detail about the code structure of this particular script: ## ## 1a) Define ALL frames: ## ## Top-level : '.fRbuttons' ## '.fRimgfile' ## '.fRmsg' ## '.fRimage' ## No sub-frames. ## ## 1b) Pack ALL frames. ## ## 2) Define all WIDGETS in the frames (and pack them): ## ## - In '.fRbuttons': ## about several button widgets ('Exit','Help','EndLoop','WriteFile') ## ## - In '.fRimgfile': ## 1 label and 1 entry and 1 button widget ## ## - In '.fRmsg': ## 1 label widget to display messages to the user ## ## - In '.fRimage': ## 1 'canvas' widget ## ## 3) Define BINDINGS: see the BINDINGS section for bindings, if any ## ## 4) Define PROCS, such as: ## ## - 'get_imgFilename' - Called by the 'Browse...' button. ## ## - 'pointCreate' - Called by a binding on the canvas widget. ## ## - 'pointDelete' - Called by a binding on the canvas widget. ## ## - 'pointSelect' - Called by a binding on the canvas widget. ## ## - 'pointMove' - Called by a binding on the canvas widget. ## ## - 'end_loop' - Called by the 'EndLoop' button. ## ## - 'write_file' - Called by the 'WriteFile' button. ## ## - 'advise_user' - Called in the 'Additional GUI Initialization' ## section at the bottom of this script to ## put an initial message in frame '.fRmsg' ## --- and MAY be called by the various procs. ## ## - 'popup_msgVarWithScroll' - Called by the 'Help' button --- ## and MAY be called by the various procs. ## ## See the PROCS section for additional details. ## ## 5) Additional GUI initialization: ## Set some inital values of parameters ## such as some directory-name variables ## --- for input and output files. ## ##+######################################################################## ## DEVELOPED WITH: ## Tcl-Tk 8.5 on Ubuntu 9.10 (2009-october release, 'Karmic Koala'). ## ## $ wish ## % puts "$tcl_version $tk_version" ## showed 8.5 8.5 on Ubuntu 9.10 ## after Tcl-Tk 8.4 was replaced by 8.5 --- to get anti-aliased fonts. ##+####################################################################### ## MAINTENANCE HISTORY: ## Created by: Blaise Montandon 2017oct12 First release, in the MAPtools group. ## Changed by: Blaise Montandon 2017 ##+####################################################################### ##+####################################################################### ## SET THE TOP WINDOW NAME. ##+####################################################################### wm title . "Make an Outline File --- by Picking Points on an Image" wm iconname . "MakeOutline" # catch { wm title . "$env(FE_WIN_TITLE)" } # catch { wm iconname . "$env(FE_ICON_TITLE)" } ##+################################### ## SET THE TOP WINDOW POSITION. ##+################################### wm geometry . +15+30 # catch {eval wm geometry . "$env(FE_WIN_LOC_GEOM)" } ##+###################################################### ## SET COLOR SCHEME (palette) FOR THE WINDOW. ##+###################################################### if {1} { ## Grayish palette set Rpal255 210 set Gpal255 210 set Bpal255 210 } if {0} { ## Bluish palette set Rpal255 180 set Gpal255 180 set Bpal255 255 } if {0} { ## Greenish palette set Rpal255 180 set Gpal255 255 set Bpal255 180 } if {0} { ## Reddish palette set Rpal255 255 set Gpal255 180 set Bpal255 180 } set hexCOLORpal [format "#%02X%02X%02X" $Rpal255 $Gpal255 $Bpal255] tk_setPalette $hexCOLORpal ##+########################################### ## SET BACKGROUND COLOR FOR SOME WIDGETS. ##+########################################### ## Set entry bkgd to off-white. (not so blinding) set entryBKGD "#fcfcfc" ## Set bkgd color for the messages to user. set msgBKGD "#ff6666" ## NOT USED, yet. # set chkbuttBKGD "#f0f0f0" # set radbuttBKGD "#f0f0f0" # set scaleBKGD "#f0f0f0" # set listboxBKGD "#f0f0f0" ##+########################################################### ## SET FONT VARS to use in the 'font create' statements below. ## ## Use a VARIABLE-WIDTH FONT for label and button widgets. ## ## Use a FIXED-WIDTH FONT for entry fields (and for listbox and ## text widgets, if any). ## ## Possible (similar) variable width fonts: ## Arial ## Bitstream Vera Sans ## Comic Sans MS ## DejaVu Sans ## Droid Sans ## FreeSans ## Liberation Sans ## Nimbus Sans L ## Trebuchet MS ## Verdana ## ## Some 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 FONTsize 14 set FONT_SMALLsize 12 ## For variable width: # set FONTfamily "droid sans" # set FONTfamily "liberation sans" # set FONTfamily "freesans" # set FONTfamily "dejavu sans" set FONTfamily "comic sans ms" set FONT_varwidth \ " -family {$FONTfamily} -size -$FONTsize -weight bold -slant roman " set FONT_SMALL_varwidth \ " -family {$FONTfamily} -size -$FONT_SMALLsize -weight normal -slant roman " ## For fixed width: # set FONTfamily "droid sans mono" # set FONTfamily "liberation mono" # set FONTfamily "freemono" set FONTfamily "dejavu sans mono" set FONT_fixedwidth \ " -family {$FONTfamily} -size -$FONTsize -weight bold -slant roman " set FONT_SMALL_fixedwidth \ " -family {$FONTfamily} -size -$FONT_SMALLsize -weight normal -slant roman " ##+##################################################################### ## DEFINE (temporary) 'font create' NAMES to be used ## in '-font' widget specs below. ##+##################################################################### eval font create fontTEMP_fixedwidth $FONT_fixedwidth eval font create fontTEMP_varwidth $FONT_varwidth eval font create fontTEMP_button $FONT_varwidth eval font create fontTEMP_entry $FONT_fixedwidth eval font create fontTEMP_label $FONT_varwidth # eval font create fontTEMP_listbox $FONT_fixedwidth # eval font create fontTEMP_msg $FONT_fixedwidth # eval font create fontTEMP_scale $FONT_varwidth # eval font create fontTEMP_text $FONT_fixedwidth ## SMALL fonts: (not used, yet) # eval font create fontTEMP_SMALL_fixedwidth $FONT_SMALL_fixedwidth # eval font create fontTEMP_SMALL_varwidth $FONT_SMALL_varwidth # eval font create fontTEMP_SMALL_button $FONT_SMALL_varwidth # eval font create fontTEMP_SMALL_entry $FONT_SMALL_fixedwidth # eval font create fontTEMP_SMALL_label $FONT_SMALL_varwidth # eval font create fontTEMP_SMALL_listbox $FONT_SMALL_fixedwidth # eval font create fontTEMP_SMALL_msg $FONT_SMALL_fixedwidth # eval font create fontTEMP_SMALL_scale $FONT_SMALL_varwidth # eval font create fontTEMP_SMALL_text $FONT_SMALL_fixedwidth ##+########################################################### ## SET GEOM VARS FOR THE VARIOUS WIDGET DEFINITIONS. ## (e.g. width and height of canvas, and padding for Buttons) ## ## Possible values for '-relief' are: ## flat, groove, raised, ridge, solid, and sunken. ##+########################################################### ## BUTTON geom parameters: set PADXpx_button 0 set PADYpx_button 0 set BDwidthPx_button 2 set RELIEF_button "raised" ## LABEL geom parameters: set PADXpx_label 0 set PADYpx_label 0 set BDwidthPx_label 2 # set RELIEF_label "ridge" # set RELIEF_label "raised" set RELIEF_label "flat" ## ENTRY widget geom settings: set BDwidthPx_entry 2 set RELIEF_entry sunken ## CANVAS geom parameters: set initCanWidthPx 300 set initCanHeightPx 300 set minCanHeightPx 24 # set BDwidthPx_canvas 2 # set RELIEF_canvas raised set BDwidthPx_canvas 0 set RELIEF_canvas flat ## COMMENT some geom settings, for now. if {0} { ## CHECKBUTTON geom parameters: set PADXpx_chkbutt 0 set PADYpx_chkbutt 0 set BDwidthPx_chkbutt 2 ## RADIOBUTTON widget geom settings: set BDwidthPx_radbutt 2 # set RELIEF_radbutt "ridge" set RELIEF_radbutt "raised" ## SCALE geom parameters: set BDwidthPx_scale 2 # set initScaleLengthPx 100 set scaleThicknessPx 10 set scaleRepeatDelayMillisecs 800 } ## END OF COMMENTED geom settings ##+#################################################################### ## 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"} if {$tk_version < 8.6} { set IMGformats "GIF" } else { set IMGformats "GIF or PNG" } ## For widgets in 'fRbuttons' frame: set aRtext(buttonEXIT) "Exit" set aRtext(buttonHELP) "Help" set aRtext(buttonENDLOOP) "EndLoop" set aRtext(buttonWRITE) "WriteFile" ## For widgets in 'fRimgfile' frame: set aRtext(labelFILENAME) "Image filename (${IMGformats}):" set aRtext(buttonBROWSE) "Browse..." ## For some calls to the 'advise_user' proc: set aRtext(INITmsg) \ "*** FIRST: Select an image file (${IMGformats}) using the '$aRtext(buttonBROWSE)' button. *** Then, to create points, click on the canvas with mouse-button-1. *** Use the 'EndLoop' button to end a loop (and start a new loop). *** You can delete previously created points by clicking on them with mouse-button-3. *** Click '$aRtext(buttonWRITE)' when ready to write the 'outline' points file." set aRtext(AFTERfileLOADmsg) \ "*** To create points, click on the canvas with mouse-button-1. *** Use the 'EndLoop' button to end a loop (and start a new loop). *** You can delete previously created points by clicking on them with mouse-button-3. *** Click '$aRtext(buttonWRITE)' when ready to write the 'outline' points file." # set aRtext(INITmsg) \ # "*** After selecting an image file, use Enter key (or mouse-button-3) in the filename entry field *** # *** to (re)load the image on the canvas. Click on canvas to make points. Use 'EndLoop' to end loop. ***" # set aRtext(AFTERfileLOADmsg) \ # "** Click mouse-button-3 on image filename when ready to put image on the canvas. **" # set aRtext(PARMCHGmsg) \ # "** Click '$aRtext(buttonWRITE)' when ready to write the 'outline' points file. **" ## END OF if { "$VARlocale" == "en"} ##+################################################################### ## Set a MINSIZE of the window. ## ## For width, allow for the minwidth of the '.fRbuttons' frame: ## about 4 buttons (Exit,Help,EndLoop,WriteFile). ## We want to at least be able to see the 'Exit' button. ## ## For height, allow ## 1 char high for the '.fRbuttons' frame, ## 1 char high for the '.fRimgfile' frame, ## 2 chars high for the '.fRmsg' frame, ## 1 char high for the '.fRimage' frame. ##+################################################################### ## MIN WIDTH: set minWinWidthPx [font measure fontTEMP_varwidth \ "$aRtext(buttonEXIT) $aRtext(buttonHELP) \ $aRtext(buttonENDLOOP) $aRtext(buttonWRITE)"] ## Add some pixels to account for right-left-side window decoration ## (about 8 pixels), about 4 x 4 pixels/widget for borders/padding for ## 4 widgets. set minWinWidthPx [expr {24 + $minWinWidthPx}] ## MIN HEIGHT --- allow ## 1 char high for '.fRbuttons' ## 1 char high for '.fRimgfile' ## 2 chars high for '.fRmsg' ## 24 pixels high for '.fRimage' 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 4x4 pixels for each of the 4 stacked frames and their ## widgets (their borders/padding). set minWinHeightPx [expr {$minWinHeightPx + 44}] ## FOR TESTING: # puts "minWinWidthPx = $minWinWidthPx" # puts "minWinHeightPx = $minWinHeightPx" wm minsize . $minWinWidthPx $minWinHeightPx ## We allow the window to be resizable both horizontally ## and vertically --- but establish a minsize. ## If you want to make the window un-resizable in both x and y directions, ## you can use the following statement. # wm resizable . 0 0 ##+################################################################ ## DEFINE *ALL* THE FRAMES: ## ## Top-level : '.fRbuttons' '.fRimgfile' '.fRmsg' '.fRimage' ##+################################################################ ## FOR TESTING change 0 to 1: ## (Example1: To see appearance of frames when borders are drawn.) ## (Example2: To see sizes of frames for various '-fill' options.) ## (Example3: To see how frames expand as window is resized.) if {0} { set RELIEF_frame raised set BDwidthPx_frame 2 } else { set RELIEF_frame flat set BDwidthPx_frame 0 } frame .fRbuttons -relief $RELIEF_frame -borderwidth $BDwidthPx_frame frame .fRimgfile -relief $RELIEF_frame -borderwidth $BDwidthPx_frame # frame .fRimgfile -relief raised -borderwidth 2 frame .fRmsg -relief raised -borderwidth 2 frame .fRimage -relief $RELIEF_frame -borderwidth $BDwidthPx_frame ##+############################## ## PACK the top-level FRAMES. ##+############################## pack .fRbuttons \ .fRimgfile \ .fRmsg \ -side top \ -anchor nw \ -fill x \ -expand 0 pack .fRimage \ -side top \ -anchor nw \ -fill both \ -expand 1 ##+######################################################### ## FINISHED DEFINING AND PACKING FRAMES. ##+######################################################### ## Now we are ready to define the widgets in the frames. ##+######################################################### ##+##################################################################### ## In the '.fRbuttons' FRAME --- ## DEFINE about 4 BUTTON widgets. ## Then PACK all these widgets. ##+##################################################################### button .fRbuttons.buttEXIT \ -text "$aRtext(buttonEXIT)" \ -font fontTEMP_varwidth \ -padx $PADXpx_button \ -pady $PADYpx_button \ -bd $BDwidthPx_button \ -relief $RELIEF_button \ -command {exit} button .fRbuttons.buttHELP \ -text "$aRtext(buttonHELP)" \ -font fontTEMP_varwidth \ -padx $PADXpx_button \ -pady $PADYpx_button \ -bd $BDwidthPx_button \ -relief $RELIEF_button \ -command {popup_msgVarWithScroll .topHelp "$HELPtext" +10+10} button .fRbuttons.buttENDLOOP \ -text "$aRtext(buttonENDLOOP)" \ -font fontTEMP_varwidth \ -padx $PADXpx_button \ -pady $PADYpx_button \ -bd $BDwidthPx_button \ -relief $RELIEF_button \ -command {end_loop} button .fRbuttons.buttWRITE \ -text "$aRtext(buttonWRITE)" \ -font fontTEMP_varwidth \ -padx $PADXpx_button \ -pady $PADYpx_button \ -bd $BDwidthPx_button \ -relief $RELIEF_button \ -command {write_file} label .fRbuttons.labelSTATUS \ -text "" \ -font fontTEMP_varwidth \ -justify left \ -anchor w \ -padx $PADXpx_label \ -pady $PADYpx_label \ -bd $BDwidthPx_label \ -relief $RELIEF_label ##+########################################### ## Pack the widgets in the 'fRbuttons' frame. ##+########################################### pack .fRbuttons.buttEXIT \ .fRbuttons.buttHELP \ .fRbuttons.buttENDLOOP \ .fRbuttons.buttWRITE \ -side left \ -anchor w \ -fill none \ -expand 0 pack .fRbuttons.labelSTATUS \ -side left \ -anchor w \ -fill x \ -expand 1 ##+################################################################## ## In the '.fRimgfile' FRAME ---- ## DEFINE 1 LABEL widget, 1 ENTRY widget, and 1 BUTTON widget. ## Then PACK all these widgets. ##+################################################################## label .fRimgfile.labelFILENAME \ -text "$aRtext(labelFILENAME)" \ -font fontTEMP_varwidth \ -justify left \ -anchor w \ -padx $PADXpx_label \ -pady $PADYpx_label \ -bd $BDwidthPx_label \ -relief $RELIEF_label ## We may initialize this entry widget variable ## (like some others) in the 'Additional GUI Initialization' ## section at the bottom of this script. Example: ## set ENTRYfilename "" entry .fRimgfile.entryFILENAME \ -textvariable ENTRYfilename \ -width 62 \ -bg $entryBKGD \ -disabledbackground $entryBKGD \ -font fontTEMP_entry \ -bd $BDwidthPx_entry \ -relief $RELIEF_entry button .fRimgfile.buttonBROWSE \ -text "$aRtext(buttonBROWSE)" \ -font fontTEMP_varwidth \ -padx $PADXpx_button \ -pady $PADYpx_button \ -bd $BDwidthPx_button \ -relief $RELIEF_button \ -command {get_imgFilename} ##+############################################ ## Pack the widgets in frame '.fRimgfile'. ## ## Pack the BROWSE button before the entry ## field, so that the button is always visible. ##+############################################ pack .fRimgfile.labelFILENAME \ -side left \ -anchor w \ -fill none \ -expand 0 pack .fRimgfile.buttonBROWSE \ -side right \ -anchor e \ -fill none \ -expand 0 pack .fRimgfile.entryFILENAME \ -side left \ -anchor w \ -fill x \ -expand 1 ##+################################################################## ## In the '.fRmsg' FRAME ---- ## DEFINE-and-PACK 1 LABEL widget. ##+################################################################## label .fRmsg.labelINFO \ -text "" \ -font fontTEMP_fixedwidth \ -anchor w \ -justify left \ -bg "$msgBKGD" \ -bd $BDwidthPx_label \ -relief $RELIEF_label # -height 6 \ pack .fRmsg.labelINFO \ -side left \ -anchor w \ -fill x \ -expand 1 ##+################################################################## ## In FRAME '.fRimage' - ## DEFINE-and-PACK a CANVAS WIDGET --- with 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'by Welch, Jones, and Hobbs. ##+################################################################## canvas .fRimage.can \ -width $initCanWidthPx \ -height $initCanHeightPx \ -highlightthickness 0 \ -borderwidth 0 \ -relief flat \ -yscrollcommand ".fRimage.scrolly set" \ -xscrollcommand ".fRimage.scrollx set" scrollbar .fRimage.scrolly \ -orient vertical \ -command ".fRimage.can yview" scrollbar .fRimage.scrollx \ -orient horizontal \ -command ".fRimage.can xview" ## PACK the widgets in frame '.fRimage'. ## NOTE: ## GOOD TO PACK THE SCROLLBARS BEFORE THE CANVAS WIDGET. ## THE CANVAS WIDGET MAY TRY TO TAKE ALL THE FRAME SPACE. pack .fRimage.scrolly \ -side right \ -anchor e \ -fill y \ -expand 0 ## DO NOT USE '-expand 1' FOR Y-SCROLLBAR. IT ALLOWS Y-SCROLLBAR ## TO X-EXPAND. IT PUTS BLANK SPACE BETWEEN Y-SCROLLBAR & CANVAS. pack .fRimage.scrollx \ -side bottom \ -anchor s \ -fill x \ -expand 0 ## DO NOT USE '-expand 1' FOR X-SCROLLBAR. IT ALLOWS X-SCROLLBAR ## TO Y-EXPAND. IT KEEPS THE CANVAS FROM Y-EXPANDING. ##+##################################### ## PACK the widget in frame '.fRimage'. ##+##################################### pack .fRimage.can \ -side top \ -anchor nw \ -fill both \ -expand 1 ##+######################################## ## END OF the DEFINITION OF THE GUI WIDGETS. ##+################################################## ## Start of BINDINGS, PROCS, Added-GUI-INIT sections. ##+################################################## ##+############################### ## BINDINGS SECTION: ## ## - For MB1-release in the image filename entry field and for ## Return-key-press when focus is in the image filename entry field, ## use the filename to load an image 'structure' ## and 'connect' the image structure to the canvas. ## (We will not need this binding if we go ahead an ## put the image on the canvas in the 'get_imgFilename' proc.) ## ## - For a button1 click on the canvas widget, ## call on proc 'pointCreate' to add a point to the ## aRx_forLoopPoint,aRy_forLoopPoint arrays --- with ## aRkeep_forLoopPoint set to 1. The 'pointCreate' ## proc also uses 'create oval' to put a point indicator ## on the canvas, and saves the 'Tk ID' of that point in ## array 'aRtkID'. ## ## - For a button3 click on the canvas widget, ## call on a proc to indicate a 'closest' point is ## marked as deleted --- by setting aRkeep_forLoopPoint to zero. ##+################################################################ # bind .fRimgfile.entFILENAME {load_imagefile_to_canvas} # bind .fRimgfile.entFILENAME {load_imagefile_to_canvas} bind .fRimage.can { pointCreate %x %y } .fRimage.can bind TAGpoint { pointDelete %x %y } ## Let us give a hint when a point (oval) is a 'subject' for button action. .fRimage.can bind TAGpoint \ {.fRimage.can itemconfig current -fill $pointOUTLINECOLORhex} .fRimage.can bind TAGpoint \ {.fRimage.can itemconfig current -fill $pointFILLCOLORhex} ##+###################################################################### ## PROCS SECTION: ## ## - 'get_imgFilename' - Called by the 'Browse...' button. ## ## - 'load_imagefile_to_canvas' - Called by the 'get_imgFilename' proc. ## ## - 'set_scrollregion_size' - Called by the 'load_imagefile_to_canvas' proc. ## ## - 'pointCreate' - Called by a binding on the canvas widget. ## ## - 'pointDelete' - Called by a binding on the canvas widget. ## ## - 'end_loop' - Called by the 'EndLoop' button. ## ## - 'write_file' - Called by the 'WriteFile' button. ## ## - 'advise_user' - Called in the 'Additional GUI Initialization' ## section at the bottom of this script to ## put an initial message in frame '.fRmsg' ## --- and MAY be called by the various procs. ## ## - 'popup_msgVarWithScroll' - Called by the 'Help' button --- ## and MAY be called by the various procs ## including the 'advise_user' proc. ## ##+####################################################################### ##+##################################################################### ## PROC: 'get_imgFilename' ##+##################################################################### ## PURPOSE: To use 'tk_getOpenFile' dialog to get an image filename --- ## whose image is to be put on the canvas. ## ## CALLED BY: the 'Browse...' button ##+##################################################################### proc get_imgFilename {} { global ENTRYfilename CURimageDIR aRtext set fName "" ## We set the parent of this dialog window to be the root window, ## the top level window of this GUI. set fName [tk_getOpenFile -parent . \ -title "Select an image filename (GIF or PNG)." \ -initialdir "$CURimageDIR" ] ## FOR TESTING: # puts "fName : $fName" if {"$fName" == ""} {return} ################################################### ## Put the selected filename in the entry field and ## make the end of the filename visible in the ## entry field. ################################################### set ENTRYfilename "$fName" # set ENTRYfilename [string trim "$fName"] .fRimgfile.entryFILENAME xview end ################################################# ## Save the current data directory, to quickly ## go to this directory if another image file is ## to be selected for loading. ################################################# set CURimageDIR [ file dirname "$ENTRYfilename" ] ##################################################### ## Load the image into an in-memory image 'structure' ## and put the image structure on the canvas. ##################################################### load_imagefile_to_canvas advise_user "$aRtext(AFTERfileLOADmsg)" ###################################################### ## Put the focus on the filename entry field, to ## facilitate causing the data to be loaded from ## the file by simply pressing the Return/Enter key, ## without having to manually direct the focus there. ###################################################### ## Not needed if we load the image to canvas in this proc. ######################################################### # focus .fRimgfile.entryFILENAME } ## END OF PROC 'get_imgFilename' ##+##################################################################### ## PROC: 'load_imagefile_to_canvas' ##+##################################################################### ## PURPOSE: From the image filename in the entry field: ## - Create an image 'structure' with ID in var 'imgID0', Use ## 'image create photo' and the name of the user-selected image file. ## - Load the data from the image 'structure' $imgID0 onto the canvas ## with canvas command 'create image'. ## - Set canvas 'scrollregion' size based on size of the image. ## ## CALLED BY: called by proc 'get_imgFilename'. ##+##################################################################### proc load_imagefile_to_canvas {} { global ENTRYfilename imgID0 CURloopNUM CURpointNUM ## Clear the canvas, in case images were loaded before in this session. .fRimage.can delete all ## Create an in-memory image 'structure' from the image file contents. set imgID0 [image create photo -file "$ENTRYfilename"] ## Put the in-memory image 'structure' onto the canvas. .fRimage.can create image 0 0 -anchor nw -image $imgID0 ## Set a 'scrollregion' on the canvas, large enough to hold the image ## even if it is a very large image. set_scrollregion_size ## Reset the variables used to keep track of loop and point-within-loop ## for point loops drawn on this image. ## See procs 'createPoint' and 'end_loop' for more info. set CURloopNUM 0 set CURpointNUM 0 ## Clear the status text in that label widget. update_status "" } ## END OF PROC 'load_imagefile_to_canvas' ##+##################################################################### ## PROC: 'set_scrollregion_size' ##+##################################################################### ## PURPOSE: Set a 'scrollregion' size based on the size of the current ## in-memory image --- $imgID0. ## ## Apply the '-scrollregion' parameter to the canvas. ## ## CALLED BY: the 'load_imagefile_to_canvas' proc ##+##################################################################### proc set_scrollregion_size {} { ## FOR TESTING: (to dummy out this proc) # return ## Inputs: global imgID0 ## Outputs: global ImgWidthPx ImgHeightPx ############################################################# ## Get the size of the image that is currently in memory. ############################################################# set ImgWidthPx [image width $imgID0] set ImgHeightPx [image height $imgID0] ## FOR TESTING: if {0} { puts "" puts "PROC 'set_scrollregion_size' :" puts "ImgWidthPx: $ImgWidthPx" puts "ImgHeightPx: $ImgHeightPx" } ################################################################ ## Set the width and height and the 'scrollregion' of the canvas. ################################################################ .fRimage.can configure -width $ImgWidthPx -height $ImgHeightPx \ -scrollregion "0 0 $ImgWidthPx $ImgHeightPx" ## FOR TESTING: if {0} { puts "" puts "PROC 'set_scrollregion_size' has set the 'scrollregion' to" puts " 0 0 $ImgWidthPx $ImgHeightPx" } } ## END OF PROC 'set_scrollregion_size' ##+##################################################################### ## PROC: 'pointCreate' ##+##################################################################### ## PURPOSE: ## 1) Get the coordinates of a 'point-pick' on the canvas ## and put the x,y (pixel) values in the ## 'aRx_forLoopPoint' and 'aRy_forLoopPoint' arrays ## --- specifically in vars ## aRx_forLoopPoint($CURloopNUM,$CURpointNUM) ## aRy_forLoopPoint($CURloopNUM,$CURpointNUM). ## ## 2) Initialize the 'aRkeep_forLoopPoint' array value for this point to 1 (keep) ## --- specifically ## set aRkeep_forLoopPoint($CURloopNUM,$CURpointNUM) 1 ## ## 3) Plot a point indicator on the canvas with 'create oval'. ## Saves the loop-num and point-num corresponding to the ## 'Tk identifier' --- TEMPpointID --- of that 'canvas item' ## in arrays 'aRloopNUMforID' and 'aRpointNUMforID' ## --- specifically in vars ## aRloopNUMforID($TEMPpointID) ## aRpointNUMforID($TEMPpointID) ## This saved pair corresponding to a 'Tk identifier' value ## is used in the 'pointDelete' proc. ## ## NOTES: ## 1) The aRx_forLoopPoint,aRy_forLoopPoint,aRkeep_forLoopPoint arrays ## are indexed by CURloopNUM,CURpointNUM. ## 2) The CURpointNUM is incremented (only) in the 'createPoint' proc. ## 3) The CURloopNUM var is incremented (only) in the 'end_loop' proc. ## 4) The 'pointDelete' proc deletes a point by setting aRkeep_forLoopPoint to 0. ## ## CALLED BY: a button1 release binding on the canvas ##+##################################################################### proc pointCreate {xPx yPx} { ## FOR TESTING: # return global CURloopNUM CURpointNUM global aRx_forLoopPoint aRy_forLoopPoint aRkeep_forLoopPoint global aRloopNUMforID aRpointNUMforID global pointRADIUSpx pointOUTLINEWIDTHpx pointOUTLINECOLORhex pointFILLCOLORhex ################################################################## ## Map from view coordinates to canvas coordinates, per ## page 559 of 4th edition of 'Practical Programming in Tcl & Tk' ## by Welch, Jones, Hobbs. ################################################################## set TEMPxCANpx [.fRimage.can canvasx $xPx] set TEMPyCANpx [.fRimage.can canvasy $yPx] ## Save the x,y coords of the created point in arrays ## aRx_forLoopPoint,aRy_forLoopPoint ## with the arrays indexed by the CURloopNUM,CURpointNUM. ## NOTE: ## CURpointNUM is incremented in this 'pointCreate' proc. ## CURloopNUM is incremented in the 'end_loop' proc. if {$CURpointNUM == 0} {incr CURloopNUM} incr CURpointNUM set aRx_forLoopPoint($CURloopNUM,$CURpointNUM) $TEMPxCANpx set aRy_forLoopPoint($CURloopNUM,$CURpointNUM) $TEMPyCANpx set aRkeep_forLoopPoint($CURloopNUM,$CURpointNUM) 1 ## FOR TESTING: if {0} { puts "" puts "PROC 'pointCreate' :" puts "CURloopNUM: $CURloopNUM" puts "CURpointNUM: $CURpointNUM" puts "aRx_forLoopPoint($CURloopNUM,$CURpointNUM): $aRx_forLoopPoint($CURloopNUM,$CURpointNUM)" puts "aRy_forLoopPoint($CURloopNUM,$CURpointNUM): $aRy_forLoopPoint($CURloopNUM,$CURpointNUM)" puts "aRkeep_forLoopPoint($CURloopNUM,$CURpointNUM): $aRkeep_forLoopPoint($CURloopNUM,$CURpointNUM)" } ## Draw a point on the canvas using 'create oval'. set ulXpx [expr {$TEMPxCANpx - $pointRADIUSpx}] set ulYpx [expr {$TEMPyCANpx - $pointRADIUSpx}] set lrXpx [expr {$TEMPxCANpx + $pointRADIUSpx}] set lrYpx [expr {$TEMPyCANpx + $pointRADIUSpx}] set TEMPpointID [.fRimage.can create oval \ $ulXpx $ulYpx $lrXpx $lrYpx \ -width $pointOUTLINEWIDTHpx -outline $pointOUTLINECOLORhex \ -fill $pointFILLCOLORhex -tags TAGpoint] ## Save the loop-num and point-num for that TEMPpointID. set aRloopNUMforID($TEMPpointID) $CURloopNUM set aRpointNUMforID($TEMPpointID) $CURpointNUM ## FOR TESTING: if {0} { puts "" puts "aRtkID($CURloopNUM,$CURpointNUM): $aRtkID($CURloopNUM,$CURpointNUM)" } update_status "CURloopNUM: $CURloopNUM CURpointNUM: $CURpointNUM" } ## END OF PROC 'pointCreate' ##+######################################################################### ## PROC: 'pointDelete' ##+######################################################################### ## PURPOSE: Get the index of a point nearest a 'point-pick' on the canvas ## and set the aRkeep_forLoopPoint array value for this index to 0. ## ## CALLED BY: a button3 release binding on canvas items with tag 'TAGpoint'. ##+######################################################################### proc pointDelete {xPx yPx} { ## FOR TESTING: # return global aRloopNUMforID aRpointNUMforID aRkeep_forLoopPoint ################################################################## ## Map from view coordinates to canvas coordinates, per ## page 559 of 4th edition of 'Practical Programming in Tcl & Tk' ## by Welch, Jones, Hobbs. ################################################################## ## Not needed? We may not need the pixel coords --- just the ## 'current' tag. ################################################################## # set x [.fRimage.can canvasx $xPx] # set y [.fRimage.can canvasy $yPx] ####################################################################### ## Get the ID of the 'current' (selected) item. ####################################################################### set TEMPpointID [.fRimage.can find withtag current] ##################################################################### ## First, 'lookup' the loop,point nums for this pointID. ##################################################################### set TEMPloopNUM $aRloopNUMforID($TEMPpointID) set TEMPpointNUM $aRpointNUMforID($TEMPpointID) ##################################################################### ## For now, if this is the first point in an 'outline loop', ## we do not allow the delete (because we will use that point in ## the 'end_loop' proc). ## ## Someday we may allow this delete by finding a 'next' point in the ## loop to use as the initial point of the loop. ##################################################################### if {$TEMPpointNUM == 1} { advise_user \ "*** NOT ALLOWED TO DELETE FIRST POINT in an outline loop. *** This code may be enhanced someday to allow that." return } ##################################################################### ## 'Mark' the point as deleted --- via the 'aRkeep_forLoopPoint' array. ##################################################################### set aRkeep_forLoopPoint($TEMPloopNUM,$TEMPpointNUM) 0 ##################################################################### ## Delete the point-item (oval) from the canvas. ##################################################################### .fRimage.can delete $TEMPpointID ## FOR TESTING: if {0} { puts "" puts "PROC 'pointDelete' :" puts "TEMPpointID: $TEMPpointID" puts "TEMPloopNUM: $TEMPloopNUM" puts "TEMPpointNUM: $TEMPpointNUM" puts "aRkeep_forLoopPoint($TEMPloopNUM,$TEMPpointNUM): $aRkeep_forLoopPoint($TEMPloopNUM,$TEMPpointNUM)" } } ## END OF PROC 'pointDelete' ##+##################################################################### ## PROC: 'end_loop' ##+##################################################################### ## PURPOSE: ## 1) Add one more point to the current loop, with same x,y coordinates ## as the first point in the loop. ## 2) Save the number of points in this loop in array aRloopPOINTs ## --- specifically ## set aRnumPointsInLoop($CURloopNUM) $CURpointNUM ## --- for use in the 'write_file' proc. ## 3) Reset CURloopNUM to zero. ## (This will be used by proc 'createPoint'to know when to increment ## CURloopNUM.) ## ## CALLED BY: the 'EndLoop' button ##+##################################################################### proc end_loop {} { ## FOR TESTING: # return global CURloopNUM CURpointNUM global aRx_forLoopPoint aRy_forLoopPoint aRkeep_forLoopPoint global aRnumPointsInLoop if {$CURloopNUM == 0} { advise_user "*** No loops have been established." return } incr CURpointNUM set aRx_forLoopPoint($CURloopNUM,$CURpointNUM) $aRx_forLoopPoint($CURloopNUM,1) set aRy_forLoopPoint($CURloopNUM,$CURpointNUM) $aRy_forLoopPoint($CURloopNUM,1) set aRkeep_forLoopPoint($CURloopNUM,$CURpointNUM) 1 set aRnumPointsInLoop($CURloopNUM) $CURpointNUM update_status "CURloopNUM: $CURloopNUM CURpointNUM: $CURpointNUM" set CURpointNUM 0 } ## END OF PROC 'end_loop' ##+##################################################################### ## PROC: 'write_file' ##+##################################################################### ## PURPOSE: Write the x,y coordinate records to the output 'outline' file. ## ## METHOD: In a double-loop over loop-numbers and point-numbers, ## write an x,y coordinate pair on each record getting the x,y values ## from the aRx_forLoopPoint and aRy_forLoopPoint arrays --- and using the ## aRkeep_forLoopPoint array to indicate points to skip because ## they were deleted. ## ## CALLED BY: the 'WriteFile' button ##+##################################################################### proc write_file {} { ## FOR TESTING: # return ## Vars 'fullOUTfilename' and 'TEXTeditor' are set in the ## 'Additional GUI Initialization' section near the bottom of this script. global fullOUTfilename TEXTeditor ## For a comment line at top of output file: global ENTRYfilename ## The stored info we need to write the 'outlines' data file: global aRx_forLoopPoint aRy_forLoopPoint aRkeep_forLoopPoint aRnumPointsInLoop CURloopNUM if {$CURloopNUM == 0} { advise_user "*** No loops have been established." return } ####################################################################### ## Open the OUTPUT outline data file using a contructed filename in ## a directory for temporary files. ## (Delete a file by that name, in case it exists from a previous run.) ## ## Get a file-handle identifier, 'fout'. ####################################################################### # catch {exec rm "$fullOUTfilename"} catch {file delete "$fullOUTfilename"} set fout [open "$fullOUTfilename" w] #################################################################### ## Write the first few recs to the output file --- comment records ## containing the name of the image file. #################################################################### puts $fout "# Outline file created from points selected on the image in file" puts $fout "# $ENTRYfilename" puts $fout "#" puts $fout "# Number of outline loops: $CURloopNUM" puts $fout "#" ###################################################################### ## Initialize some variables to be used in the write loop below. ## - loopIDX and pointIDX ## - CNTdatalinesOUT to count the 'keep' data recs actually written. ###################################################################### set loopIDX 1 set pointIDX 1 set CNTdatalinesOUT 0 ############################################################ ## START of the Double-WHILE-LOOP for the 'puts' file-WRITING ## of x,y coordinate recs. ## ## loopIDX and pointIDX are is the indices being incremented ## in this 'double while loop'. ## ## If the points is not a deleted-point, we write a rec ## containing the 2 values ## aRx_forLoopPoint($loopIDX,$pointIDX) and ## aRy_forLoopPoint($loopIDX,$pointIDX) ## to the output file. ## ## The while-test below is equivalent to 'while {![eof $f]}'. ############################################################ while { $loopIDX <= $CURloopNUM} { puts $fout "#" puts $fout "# Start of loop $loopIDX which contained $aRnumPointsInLoop($loopIDX) points" puts $fout "# --- some of which may have been deleted by the user." while { $pointIDX <= $aRnumPointsInLoop($loopIDX) } { if {$aRkeep_forLoopPoint($loopIDX,$pointIDX) == 1} { ## Write x,y to a rec. set TEMPx $aRx_forLoopPoint($loopIDX,$pointIDX) set TEMPy $aRy_forLoopPoint($loopIDX,$pointIDX) puts $fout "$TEMPx $TEMPy" incr CNTdatalinesOUT ######################################################## ## If this IS the first DATA record written, initialize ## the vars that we use to save the min,max values ## of the x,y values in the data-out recs. ## ## If this is NOT the first data rec, then update the ## min,max values of x,y. ######################################################## if {$CNTdatalinesOUT == 1} { set Xmin $TEMPx set Xmax $TEMPx set Ymin $TEMPy set Ymax $TEMPy } else { if {$TEMPx < $Xmin} {set Xmin $TEMPx} if {$TEMPx > $Xmax} {set Xmax $TEMPx} if {$TEMPy < $Ymin} {set Ymin $TEMPy} if {$TEMPy > $Ymax} {set Ymax $TEMPy} } ## FOR TESTING: if {0} { puts "" puts "Proc 'write_file':" puts " loopIDX: $loopIDX" puts " pointIDX: $pointIDX" puts " TEMPx: $TEMPx" puts " TEMPy: $TEMPy" puts " CNTdatalinesOUT: $CNTdatalinesOUT" } } ## END OF if {$aRkeep_forLoopPoint($loopIDX,$pointIDX) == 1} ## In other words, this was a 'keeper' point. incr pointIDX continue } ## END OF while loop over pointIDX incr loopIDX set pointIDX 1 } ## END OF while loop over loopIDX #################################################################### ## Write summary comment records --- like tot recs written. #################################################################### puts $fout "#" puts $fout "# Total data points (records) written: $CNTdatalinesOUT" puts $fout "# Number of loops: $CURloopNUM" puts $fout "# Min-and-Max X-and-Y values for ALL the loops:" puts $fout "# Xmin: $Xmin" puts $fout "# Xmax: $Xmax" puts $fout "# Ymin: $Ymin" puts $fout "# Ymax: $Ymax" puts $fout "# These min-max values determine a 'bounding-box' for all the points." #################################### ## Close the output file. #################################### close $fout advise_user "*** FILE WAS WRITTEN to $fullOUTfilename" ######################################### ## Open the output file in a text editor. ######################################### exec $TEXTeditor "$fullOUTfilename" ## Fancier, for error checking. # set RETcode [catch {exec $TEXTeditor "$fullOUTfilename"} CatchMsg] } ## END OF PROC 'write_file' ##+##################################################################### ## PROC: 'advise_user' ##+##################################################################### ## PURPOSE: Puts a message to the user on the GUI. ## ## CALLED BY: in the 'write_file' proc, ## in some 'bind' statements in the BIND section above, ## and in the 'Additional-GUI-Initialization' section at ## the bottom of this script. ##+##################################################################### proc advise_user {text} { .fRmsg.labelINFO configure -text "$text" ## Make sure the text is displayed on the GUI. update ## Alternatively, we could put the message in the title-bar ## of the GUI window. (But it is easy for the user to ## fail to see the message there. Besides, we have more ## options in displaying the message by putting it on a ## Tk widget in the GUI.) # wm title . "$text" ## OR we could use proc 'popup_msgVarWithScroll' ## to popup a msg to the user. } ## END OF PROC 'advise_user' ##+##################################################################### ## PROC: 'update_status' ##+##################################################################### ## PURPOSE: Puts a message to the user on the GUI. ## ## CALLED BY: the 'createPoint' proc ##+##################################################################### proc update_status {text} { .fRbuttons.labelSTATUS configure -text "$text" ## Make sure the text is displayed on the GUI. update } ## END OF PROC 'update_status' ##+######################################################################## ## PROC: 'popup_msgVarWithScroll' ##+######################################################################## ## PURPOSE: Report help or error conditions to the user. ## ## We do not use focus,grab,tkwait in this proc, ## because we use it to show help when the GUI is idle, ## and we may want the user to be able to keep the Help ## window open while doing some other things with the GUI ## such as putting a filename in the filename entry field ## or clicking on a radiobutton. ## ## For a similar proc with focus-grab-tkwait added, ## see the proc 'popup_msgVarWithScroll_wait' in a ## 3DterrainGeneratorExaminer Tk script. ## ## REFERENCE: page 602 of 'Practical Programming in Tcl and Tk', ## 4th edition, by Welch, Jones, Hobbs. ## ## ARGUMENTS: A toplevel frame name (such as .fRhelp or .fRerrmsg) ## and a variable holding text (many lines, if needed). ## ## CALLED BY: 'help' button ##+######################################################################## ## To have more control over the formatting of the message (esp. ## words per line), we use this 'toplevel-text' method, ## rather than the 'tk_dialog' method -- like on page 574 of the book ## by Hattie Schroeder & Mike Doyel,'Interactive Web Applications ## with Tcl/Tk', Appendix A "ED, the Tcl Code Editor". ##+######################################################################## proc popup_msgVarWithScroll { toplevName VARtext ULloc} { ## global fontTEMP_varwidth #; Not needed. 'wish' makes this global. ## global env # bell # bell ################################################# ## Set VARwidth & VARheight from $VARtext. ################################################# ## To get VARheight, ## split at '\n' (newlines) and count 'lines'. ################################################# set VARlist [ split $VARtext "\n" ] ## For testing: # puts "VARlist: $VARlist" set VARheight [ llength $VARlist ] ## For testing: # puts "VARheight: $VARheight" ################################################# ## To get VARwidth, ## loop through the 'lines' getting length ## of each; save max. ################################################# set VARwidth 0 ############################################# ## LOOK AT EACH LINE IN THE LIST. ############################################# foreach line $VARlist { ############################################# ## Get the length of the line. ############################################# set LINEwidth [ string length $line ] if { $LINEwidth > $VARwidth } { set VARwidth $LINEwidth } } ## END OF foreach line $VARlist ## For testing: # puts "VARwidth: $VARwidth" ############################################################### ## NOTE: VARwidth works for a fixed-width font used for the ## text widget ... BUT the programmer may need to be ## careful that the contents of VARtext are all ## countable characters by the 'string length' command. ############################################################### ##################################### ## SETUP 'TOP LEVEL' HELP WINDOW. ##################################### catch {destroy $toplevName} toplevel $toplevName # wm geometry $toplevName 600x400+100+50 # wm geometry $toplevName +100+50 wm geometry $toplevName $ULloc wm title $toplevName "Note" # wm title $toplevName "Note to $env(USER)" wm iconname $toplevName "Note" ##################################### ## In the frame '$toplevName' - ## DEFINE THE TEXT WIDGET and ## its two scrollbars --- and ## DEFINE an OK BUTTON widget. ##################################### if {$VARheight > 10} { text $toplevName.text \ -wrap none \ -font fontTEMP_fixedwidth \ -width $VARwidth \ -height $VARheight \ -bg "#f0f0f0" \ -relief raised \ -bd 2 \ -yscrollcommand "$toplevName.scrolly set" \ -xscrollcommand "$toplevName.scrollx set" ## -font fontTEMP_varwidth scrollbar $toplevName.scrolly \ -orient vertical \ -command "$toplevName.text yview" scrollbar $toplevName.scrollx \ -orient horizontal \ -command "$toplevName.text xview" } else { text $toplevName.text \ -wrap none \ -font fontTEMP_fixedwidth \ -width $VARwidth \ -height $VARheight \ -bg "#f0f0f0" \ -relief raised \ -bd 2 ## -font fontTEMP_varwidth } button $toplevName.butt \ -text "OK" \ -font fontTEMP_varwidth \ -command "destroy $toplevName" ############################################### ## PACK *ALL* the widgets in frame '$toplevName'. ############################################### ## Pack the bottom button BEFORE the ## bottom x-scrollbar widget, pack $toplevName.butt \ -side bottom \ -anchor center \ -fill none \ -expand 0 if {$VARheight > 10} { ## Pack the scrollbars BEFORE the text widget, ## so that the text does not monopolize the space. pack $toplevName.scrolly \ -side right \ -anchor center \ -fill y \ -expand 0 ## DO NOT USE '-expand 1' HERE on the Y-scrollbar. ## THAT ALLOWS Y-SCROLLBAR TO EXPAND AND PUTS ## BLANK SPACE BETWEEN Y-SCROLLBAR & THE TEXT AREA. pack $toplevName.scrollx \ -side bottom \ -anchor center \ -fill x \ -expand 0 ## DO NOT USE '-expand 1' HERE on the X-scrollbar. ## THAT KEEPS THE TEXT AREA FROM EXPANDING. pack $toplevName.text \ -side top \ -anchor center \ -fill both \ -expand 1 } else { pack $toplevName.text \ -side top \ -anchor center \ -fill both \ -expand 1 } ################################################ ## Set some 'event' bindings to allow for ## easy scrolling through huge listings. ## is a press of the Page-Down key. ## is a press of the Page-Up key. ## is a press of the Home key ## to go to the top of the listing. ## is a press of the End key ## to go to the bottom of the listing. ## is a press of the Up-arrow key. ## is a press of the Down-arrow key. ################################################ bind $toplevName "$toplevName.text yview scroll +1 page" bind $toplevName "$toplevName.text yview scroll -1 page" bind $toplevName "$toplevName.text see 1.0" bind $toplevName "$toplevName.text see end" bind $toplevName "$toplevName.text yview scroll -1 unit" bind $toplevName "$toplevName.text yview scroll +1 unit" ##################################### ## LOAD MSG INTO TEXT WIDGET. ##################################### ## $toplevName.text delete 1.0 end $toplevName.text insert end $VARtext $toplevName.text configure -state disabled } ## END OF PROC 'popup_msgVarWithScroll' ##+######################################################## ## Set the 'HELPtext' var. ##+######################################################## set HELPtext \ " ** Utility to Make an 'Outline' File by Picking 'Loops' of Points on an Image ** (an FE 'tkGooie' utility in the 'MAPtools' group) (FE = Freedom Environment ; see www.freedomenv.com ) This Tk GUI script 1) Reads an image file (GIF or PNG) selected by the user and puts the image on a 'canvas' widget. The image is to serve as a background and guide for picking points. 2) Records x,y coordinates of points that the user selects on the image on the canvas. 3) By use of an 'EndLoop' button on the GUI, the user can complete a 'loop' of points and prepare for picking points on another 'loop'. 4) By use of a 'WriteFile' button on the GUI, the user can write the pairs of x,y coordinates as separate lines of an output text file. The 'outline points file' can be read into other FE 'tkGooie' utilities in the 'MAPtools' group --- for example: to plot color outlines on a color background --- or plot color-filled areas on a color background. Note: To read PNG files, you must be using the 8.6 (or above) version of the Tcl-Tk 'wish' interpreter. If you are on 8.5 or less, select GIF files. Your version is $tk_version ********************* OPERATION DESCRIPTION: ********************* The user can use the 'Browse...' button of the GUI to bring up a file selector GUI to navigate to a directory containing one or more image files (GIF or PNG). When an image file is selected and the file selector GUI closes, the image filename appears in the filename entry field of this GUI --- and the image is immediately put in the canvas area of the GUI. After the image is loaded to the canvas, this utility is meant to be used to pick out sequences of points that form 'loops' on the image --- rather than non-loop sequences of points. (This utility may be enhanced someday to allow for creating a file of both loops and 'polylines' --- where polylines are sequences of points that do not form a closed loop. If you pick some points and do not click 'EndLoop' before clicking 'WriteFile', the file will be written with the points forming a 'polyline'. If you want to make the polyline into a loop, simply copy the first x,y line to make the closing point at the bottom of the list of x,y numbers.) --------- The Loops: --------- When the user picks points on the image, a sequence of points can be terminated to form a 'loop'. There can be multiple loops. Examples: - If the user is tracing the outlines of a map, islands and lakes can be separate loops. Also contour lines can be separate loops. - If the user is tracing the outline of an animal, the eyes and mouth can be separate loops. - If the user is tracing the outlines of block letters, the interior of letters like A and B and P can be separate loops. ------------- Ending a Loop: ------------- To indicate that the user wants to end a loop, the user can click the 'EndLoop' button. The user does NOT need to close the loop by picking on the first point of the loop. This utility keeps track of the first point chosen for a loop. When the user clicks on the 'EndLoop' button, the first x,y value of the current loop is supplied as the last point of the loop. --------------- Deleting Points: --------------- Picking points is done with mouse-button-1 (a 'left click'). If the user makes a mistake in picking a point, the point can be deleted by picking its marker (a small circle) with mouse-button-3 (a 'right click). You can delete almost any point on an outline at any time, but be aware that when you resume picking outline points you should resume picking somewhere near the last undeleted point that you created --- because the undeleted points are written to the output file in the order in which you created them. ******************* OUTLINE FILE FORMAT: ******************* 0) The first lines of the outline file may be comment lines (# in column 1) with text following the # sign. For a name identifying the nature of the x,y coordinates in the file, we may simply put the name of the image file in a 'header' line. 1) Each 'data' line of the outline file contains one pair of numbers (x,y coordinates), space separated. 2) For simplicity, we simply write the x,y coordinates as two numbers that are the pixel coordinates of the points selected on the Tk 'canvas' widget. 3) The outline may include 'loops' of points, which are indicated by at least one comment line (# in column 1) --- which separates one loop from the next. (The last data line of a loop should contain the same x,y coordinates as the first data line of the loop.) 4) The pairs of coordinates could provide an outline of almost any object --- for example a silouette of a person or an animal or an insect or a fish or a logo or alphanumeric characters in different fonts or geometric figures (like pentagons, hexagons, ... ; regular or irregular) or mosaic patterns or whatever. In writing the file, some data statistics may be gathered --- such as the min,max x and y values and number of 'loops'. At the conclusion of writing the output file, the statistics can be written in the last lines of the file, as comment lines. ***************************************** SHOWING and EDITING the OUTLINE DATA FILE : ***************************************** There is a variable 'TEXTeditor' near the bottom of the script that can be set to the name of a text editor. Example: /usr/bin/gedit If this variable is set to an editor that exists on your system, when you click on the 'WriteFile' button, the file is written AND then the file is shown in the text editor. So you can immediately check the output --- and make some changes if necessary. There are variables 'DIRtemp' and 'OUTfilename' at the bottom of the script that determine the name and location of the outline file. If you do not change these settings, the outline file is written to the '/tmp' directory. If you want to keep the outline file, you can move it to a different diretory --- and change the name of the file to a more meaningful name. ********************************** USING THE OUTPUT OUTLINE DATA FILE : ********************************** The output file from this utility could be read into one of the other FE 'tkGooie' 'MAPtools' utilities --- namely: 'tkReadOutlineFile_drawOutlineImage.tk' --- to create a drawing of an outline on a Tk 'canvas' widget of that GUI --- with a choice of line, fill, and background colors. " ##+##################################################### ##+##################################################### ## ADDITIONAL GUI INITIALIZATION, if needed (or wanted). ##+##################################################### ##+##################################################### ##+################################################################## ## Set point-radius and outline-width (in pixels) for ## drawing the point ovals. ## ## We could set these as a (small) percentage of the screensize ## --- to handle a variety of screen resolutions. ##+################################################################## set pointRADIUSpx 2 set pointOUTLINEWIDTHpx 1 ##+################################################################## ## Set color parameters for drawing the point ovals. ## ## By setting the outline-color and the fill-color to extremes ## (white and black), we are pretty sure the point will show up ## no matter what the image colors under the point-oval. ##+################################################################## set pointOUTLINECOLORhex "#ffffff" set pointFILLCOLORhex "#000000" ##+############################################################ ## Save the name of the directory containing this Tk script. ## ## This directory is used below for testing purposes. ## ## This directory name could also be used to set the full-name of ## an RGB color-selector Tk script that may be used to ## allow the user to set colors for some items, such as ## canvas background or point outline color or point fill color. ##+############################################################ ## FOR TESTING: # puts "argv0: $argv0" set DIRthisScript "[file dirname $argv0]" ## For ease of testing in a Linux/Unix terminal and located at the ## directory containing this Tk script. Set the full directory name. if {"$DIRthisScript" == "."} { set DIRthisScript "[pwd]" } ##+############################################################# ## Set an initial directory location 'CURimageDIR' for use in ## the 'get_imgFilename' proc --- an initial directory in which ## to look for image filenames. ##+############################################################## ## For ease of testing in a Linux/Unix terminal whose 'current ## working directory' is located at the directory containing this ## Tk script (and a test data file), we set CURimageDIR to 'pwd' if ## it looks like this script is being run in a terminal-testing ## mode. ## ## Otherwise, we set CURimageDIR to the user home directory. ##+############################################################## set CURimageDIR "$env(HOME)" if {"$DIRthisScript" == "[pwd]"} { set CURimageDIR "[pwd]" } ##+############################################################## ## Set a directory for output (the 'outline' file) --- ## and set a name for the outline file. ## ## The user can change outline filename if they decide to keep ## the file, and they can move the file to a different, ## 'non-temporary' directory. ##+############################################################## set DIRtemp "/tmp" set OUTfilename "${env(USER)}_outline.txt" set fullOUTfilename "$DIRtemp/$OUTfilename" ##+############################################################## ## Set a file name for a text editor, to show the output file ## --- in proc 'write_file'. ##+############################################################## # set TEXTeditor "gedit" # set TEXTeditor "/usr/bin/gedit" set TEXTeditor "${env(HOME)}/apps/gscite_2.27/SciTE" # set TEXTeditor "/usr/bin/scite" ##+##################################################### ## Advise the user how to start. ##+##################################################### advise_user "$aRtext(INITmsg)"