To DRAW: Press MB1 (mouse button 1) to start a line where the arrow-cursor is currently located on the canvas. Continue to hold MB1 down and move the mouse to draw the current line segment on the canvas. Release MB1 to terminate drawing that line segment. To DELETE a line segment, press-and-release MB3 (mouse button 3) on the line segment to be deleted. Click the 'RemoveImage' button to see how your drawing is progressing. Then ... Click and release MB1 on the filename in the entry field, to RELOAD the image from the image file to the canvas. If the reload covers up your lines, click on the 'RaiseLines' button to reveal the lines again. Use MB2 to move (drag) the image to a new location. This can be useful to use additional images to help sketch the picture. Or it can be used to offset the current image and use it for addtional sketching. You can use a screen/image capture utility to capture your drawing --- with or without an underlying image in place.How to change colors is not mentioned in this help, but it should be fairly obvious that those capabilities are available (and how to make the color changes) from the presence of the 'Next line color' and 'Background color' buttons on the GUI.Those 2 color buttons call on a color-selector-GUI script to set those colors. You can make that color-selector script by cutting-and-pasting the code from the page A non-obfuscated color selector GUI on this site._____________________________________________________________________Below is the code that produced this GUI.There are comments above the sample code, in a section titled 'USING THE GENERATED IMAGE', that describe how one could 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 action BINDINGS, if needed.
4) Define PROCS, if needed.
5) Additional GUI initialization (typically with one or more of
the procs), if needed.This structure is discussed in more detail on the page A Canonical Structure for Tk Code --- and variations.This structure makes it easy for me to find code sections --- while generating and testing a Tk script, and when looking for code snippets to include in Tk scripts (code re-use)._________________________________________________________________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.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. For example, I allow the scale widget to x-expand with the window. You may want the scale widget to be a fixed size.Also, you could change the font used for the text in the widgets. 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.I modified the 'doodle' procs of Suchenwirth quite a bit --- and devised a 'doodle_delete' proc to help assure that the desired object is deleted on an MB3 click-and-release.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 'doodle_delete' 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 listen to recently released music --- which IMHO, for the most part, cannot match the music of the late 1960's and early 1970's.Code for Tk script 'sketch_onImgFromFile_utility.tk' :
#!/usr/bin/wish -f
##+###########################################################################
##
## SCRIPT: sketch_onImgFromFile_utility.tk
##
## PURPOSE: This script allows the user to select an image file and load
## its image onto a Tk canvas. The user can then 'freehand'
## draw lines (curves) of varying width and color on the image,
## using the mouse (or touchpad or touch-sensitive-screen or whatever).
##
## The user can choose from over 16 million colors for the
## various line segments drawn.
##
## The image files that can be loaded to the canvas may be GIF files
## --- and PNG eventually, by using 8.6.x versions of the 'wish'
## interpreter.
##
## (I used a utility script based on the ImageMagick 'convert'
## command to convert JPEG files to GIF files, for testing.)
##
## The user has the option of removing the image from the canvas
## (leaving the 'sketch') --- or the image can be left in place,
## along with the sketch lines.
##
## Then the user can capture the image with a screen/window capture
## tool and save the image as a PNG file (or whatever output format
## the screen capture tool supports).
##
## The user can crop the image with an image editor, and save the
## image as a PNG or JPEG or GIF file, say. Then the image file
## could be used in e-mails, web pages, or even Tk GUI's.
##
## One 'application' of the script is to use photos of relatives or
## friends or pets or favorite celebrities and make sketches
## from the photo.
##
## Note that an image file is not required. This utility can
## be used to sketch lines of various thicknesses and colors
## onto a colored canvas.
##
## A key feature is the ability to quickly delete mistakes
## (unwanted canvas objects --- lines or 'degenerate lines'=points),
## by a button-3 click on a botched line (or point).
##
## GUI DESIGN:
##
## This script provides a Tk GUI with the following widgets.
##
## 0) There is a CANVAS widget on which to load the 'photo' image
## and on which to draw 'freehand' lines/curves.
##
## 1) There is a FILENAME-ENTRY FIELD and 'Browse ...' BUTTON with
## which to get an image file to load onto the canvas widget of
## this GUI.
##
## 2) There is a set of BUTTONS --- 'Exit' and 'RemoveImage' and
## 'RemoveLines' and 'RaiseLines' and a couple of COLOR buttons
## to set the current line-drawing color --- and to set
## a background (canvas) color. The background color shows if
## the user chooses to remove the image that was placed on
## the canvas.
##
## 3) There is a SCALE widget to set the WIDTH of the next
## line-segments to be drawn.
##
## 4) Other controls were added:
## - a SCALE to set millisecs between points added to current line
## --- to let the user control the 'jitteriness' --- and
## the straightness --- of the line being drawn.
## - CHECKBUTTON to set line style: 'smooth' (curved) --- or polygonal
## - RADIOBUTTONS to set line cap-style: round/butt/projecting
## - RADIOBUTTONS to set line join-style: round/bevel/miter
## - LABELS to show 'Nobj' and 'NcurPoints', where $Nobj is the
## number of objects (lines and points) in the current drawing,
## and $NcurPoints is the number of points being generated in
## the line currently being drawn.
##
##+########################
## REFERENCES (and credits):
##
## The image file loading code (and a lot of the other code) in this script
## is based on my script 'photoFile_editing_viaFunctions.tk' from the
## http://wiki.tcl.tk/36850 - 'GUI for Editing Photo-images with Functions'.
##
## The code for the 'doodling' on the canvas was based on
## 'A minimal doodler explained' - http://wiki.tcl.tk/9625
## by Richard Suchenwirth, 2003 Aug.
##
## Similar code was posted by 'elfo', years earlier:
## http://wiki.tcl.tk/1155 - 'Canvas pixel painting'
##
## Some reading of Chapter 37 'The Canvas Widget' in the 4th edition
## of the book 'Practical Programming in Tcl and Tk' was helpful.
##
##+#######################################################################
## 'CANONICAL' STRUCTURE OF THIS CODE:
##
## 0) Set general window parms (win-name, win-position, win-color-scheme,
## fonts, widget-geometry, win-size-control).
## 1a) Define ALL frames and sub-frames.
## 1b) Pack ALL frames and sub-frames.
## 2) Define & pack all widgets in the frames.
##
## 3) Define key and mouse/touchpad/touch-sensitive-screen action
## BINDINGS, if needed.
## 4) Define PROCS, if needed.
## 5) Additional GUI INITIALIZATION (typically with one or more of
## the procs), if needed.
##
##+#################################
## Some detail of the code structure of this particular script:
##
## 1a) Define ALL frames:
##
## Top-level :
## 'fRfile' - to contain a triplet: label-entry-button widgets
## 'fRbuttons' - to contain an 'Exit' button, 'Help' button,
## 'RemoveImg' & 'RemoveLines' & 'RaiseLines' buttons,
## and 2 color selection buttons (for next line color and
## for canvas/background color).
## 'fRstatus' - to contain labels showing Nobj and NcurPoints.
## 'fRcontrols1' - to contain a label & scale widget pair for next-line
## width --- and a label & scale widget pair for
## setting a 'milliseconds tween added points' variable,
## Nmillisecs, which controls line-'jitter'/straightness
## by controlling the number of 'control points' in a line.
## 'fRcontrols2' - to contain a checkbutton to set the 'smooth' option
## of 'create line' on/off. Also to contain 2 sets of radiobuttons
## for the 'capstyle' & 'joinstyle' options of 'create line'.
## 'fRcanvas' - to contain the canvas widget.
##
## Sub-frames: none
##
## 1b) Pack ALL frames. (Note: We may change the packing order of the frames
## as we experiment with the GUI layout. In fact, some widgets may be
## switched from one frame to another.)
##
## 2) Define & pack all widgets in the frames -- basically going through
## frames & their interiors in top-to-bottom and/or left-to-right order:
##
## 3) Define bindings:
## - Button1-release - on the filename entry field - to put img on canvas
## - Return/Enter key - on the filename entry field - to put img on canvas
##
## - bind <ButtonPress-1> - on the canvas - calls proc 'doodle_start'
## - bind <Button1-Motion> - on the canvas - calls proc 'doodle_continue'
## - bind <ButtonRelease-1> - on the canvas - calls proc 'doodle_end'
##
## - bind <ButtonRelease-3> - on the canvas - calls proc 'doodle_delete'
##
## Two Button3 Enter/Leave bindings could be added to change the color of a line (say,
## to orange) when the mouse is over a line --- to let the user know which line-object
## has been detected --- to help with deleting lines/objects --- so that the
## wrong object is not deleted.
##
## - bind <Control-ButtonPress-1> - on the canvas - calls proc 'image_grab'
## - bind <Control-Button1-Motion> - on the canvas - calls proc 'image_move'
##
##
## 4) Define procs:
## - 'get_img_filename' - to get the image filename
## - 'doodle_start' - to start a 'doodle' line
## - 'doodle_continue' - to continue a 'doodle' line
## - 'doodle_end' - to finish a 'doodle' line
## - 'doodle_delete' - to delete a 'closest' doodle line
## - 'image_grab' - to start grab the image (not needed?)
## - 'image_move' - to move the image
## - 'set_line_color1' - to set the 'fill' color for drawing the next line
## - 'set_background_color' - to set the background (canvas) color
## - 'update_colors_label' - to set a COLORS label to current color vals
## - 'update_status_labels' - to set 2 counts labels to current vals
## - 'remove_all_lines' - to remove all lines from the canvas and
## reset a couple of counts
## - 'popup_msg_var' - to show help (could be used to show
## other msgs, as needed)
##
## 5) Additional GUI initialization: set a default canvas color ---
## other than that, the canvas is blank,
## waiting for the user to select an
## image and start drawing lines ---
## or simply start drawing lines.
##
##+#######################################################################
## 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 2012sep22 Started development, on Ubuntu 9.10,
## based on my code at
## http://wiki.tcl.tk/36850 -
## 'GUI for Editing Photo-images with
## Functions'
## Changed by: Blaise Montandon 2012oct05 Improve the 'doodle_delete' proc to
## make sure it deletes a line segment
## and not the image. Also add a 'halo'
## parm to delete the intended line segment.
## Add an MB2 binding to move the image.
## Changed by: Blaise Montandon 2012oct20 Added counters Nobj & NcurPoints ---
## to indicate to the user how many lines
## and points are being generated.
## Added a scale to 'fRcontrols1' to set
## the new var Nmillisecs --- to help
## draw straight lines.
## Added frames 'fRstatus' & 'fRcontrols2'
## and the label & checkbutton & radiobutton
## widgets within them.
## Added button3-enter & button3-leave
## bindings to hilite an object before
## it is deleted.
##+########################################################################
##+#######################################################################
## Set general window parms (titles,position).
##+#######################################################################
wm title . "'Sketch On' ... an image or a color background"
wm iconname . "SketchOn"
wm geometry . +15+30
##+######################################################
## Set the color scheme for the window and its widgets ---
## such as entry field background color.
##+######################################################
tk_setPalette "#e0e0e0"
set entryBKGD "#ffffff"
# set listboxBKGD "#ffffff"
## Initialize the line-drawing color
## and the background color for the canvas.
set COLOR1r 0
set COLOR1g 0
set COLOR1b 0
# set COLOR1r 255
# set COLOR1g 255
# set COLOR1b 0
set COLOR1hex [format "#%02X%02X%02X" $COLOR1r $COLOR1g $COLOR1b]
# set COLORbkGNDr 60
# set COLORbkGNDg 60
# set COLORbkGNDb 60
set COLORbkGNDr 255
set COLORbkGNDg 255
set COLORbkGNDb 255
set COLORbkGNDhex \
[format "#%02X%02X%02X" $COLORbkGNDr $COLORbkGNDg $COLORbkGNDb]
set radbuttBKGD "#f0f0f0"
##+########################################################
## We use a VARIABLE-WIDTH font for text on label and
## button widgets.
##
## We use a FIXED-WIDTH font for text in entry & listbox widgets
## and for the text in a text widget, such as help text.
##+########################################################
font create fontTEMP_varwidth \
-family {comic sans ms} \
-size -14 \
-weight bold \
-slant roman
font create fontTEMP_SMALL_varwidth \
-family {comic sans ms} \
-size -10 \
-weight bold \
-slant roman
## Some other possible (similar) variable width fonts:
## Arial
## Bitstream Vera Sans
## DejaVu Sans
## Droid Sans
## FreeSans
## Liberation Sans
## Nimbus Sans L
## Trebuchet MS
## Verdana
font create fontTEMP_fixedwidth \
-family {liberation mono} \
-size -14 \
-weight bold \
-slant roman
font create fontTEMP_SMALL_fixedwidth \
-family {liberation mono} \
-size -10 \
-weight bold \
-slant roman
## Some other possible fixed width fonts (esp. on Linux):
## Andale Mono
## Bitstream Vera Sans Mono
## Courier 10 Pitch
## DejaVu Sans Mono
## Droid Sans Mono
## FreeMono
## Nimbus Mono L
## TlwgMono
##+###########################################################
## SET GEOM VARS FOR THE VARIOUS WIDGET DEFINITIONS.
## (e.g. width and height of canvas, and padding for Buttons)
##+###########################################################
set initCanWidthPx 300
set initCanHeightPx 300
set minCanWidthPx 24
set minCanHeightPx 24
# set BDwidthPx_canvas 2
set BDwidthPx_canvas 0
## BUTTON widget geom settings:
set PADXpx_button 0
set PADYpx_button 0
set BDwidthPx_button 2
## LABEL widget geom settings:
set BDwidthPx_label 2
## ENTRY widget geom settings:
set BDwidthPx_entry 2
set initImgfileEntryWidthChars 20
## SCALE geom parameters:
set BDwidthPx_scale 2
set initScaleLengthPx 200
## LISTBOX geom settings:
# set BDwidthPx_listbox 2
# set initListboxWidthChars 30
# set initListboxHeightChars 8
##+#######################################################################
## Set a MINSIZE of the window (roughly).
##
## For width, allow for the minwidth of the '.fRbuttons' frame:
## about 4 buttons (Exit,RemoveImg,Color1,ColorBkgnd), and
## a label with current color values info.
##
## For height, allow for
## 1 char high for the '.fRfile' frame
## 2 chars high for the widgets in the '.fRbuttons' frame
## 1 char high for the '.fRstatus' frame
## 2 chars high for the '.fRcontrols1' frame
## 2 chars high for the '.fRcontrols2' frame
## a canvas at least 24 pixels high.
##+#######################################################################
set minWinWidthPx [font measure fontTEMP_varwidth \
"Exit Remove Next Line Background Colors: Line #ff00ff Bkgnd: #000000"]
## Add some pixels to account for right-left-side window decoration
## (about 8 pixels), about 5 x 8 pixels/widget for borders/padding for
## 5 widgets --- 4 buttons and 1 label.
set minWinWidthPx [expr {48 + $minWinWidthPx}]
## MIN HEIGHT ---
## for the 6 frames 'fRfile' 'fRstatus' 'fRbuttons'
## 'fRcontrols1' 'fRcontrols2' 'fRcanvas'.
## Allow
## 1 char high for 'fRfile'
## 2 char high for 'fRbuttons'
## 1 char high for 'fRstatus'
## 2 chars high for 'fRcontrols1'
## 2 chars high for 'fRcontrols2'
## 24 pixels high for 'fRcanvas'
set charHeightPx [font metrics fontTEMP_fixedwidth -linespace]
set minWinHeightPx [expr {24 + 8 * $charHeightPx}]
## Add about 28 pixels for top-bottom window decoration,
## about 6x6 pixels for each of the 6 stacked frames and their
## widgets (their borders/padding).
set minWinHeightPx [expr {$minWinHeightPx + 64}]
## FOR TESTING:
# puts "minWinWidthPx = $minWinWidthPx"
# puts "minWinHeightPx = $minWinHeightPx"
wm minsize . $minWinWidthPx $minWinHeightPx
## We allow the window to be resizable and we pack the canvas with
## '-fill both' so that the canvas can be enlarged by enlarging the
## window.
## If you want to make the window un-resizable,
## you can use the following statement.
# wm resizable . 0 0
##+################################################################
## DEFINE *ALL* THE FRAMES:
##
## Top-level : '.fRfile' '.fRbuttons' '.fRstatus'
## '.fRcontrols1' '.fRcontrols2' '.fRcanvas'
##
## Sub-frames: none
##+################################################################
# set RELIEF_frame raised
# set BDwidth_frame 2
set RELIEF_frame flat
set BDwidth_frame 0
frame .fRfile -relief $RELIEF_frame -bd $BDwidth_frame
frame .fRbuttons -relief $RELIEF_frame -bd $BDwidth_frame
frame .fRstatus -relief $RELIEF_frame -bd $BDwidth_frame
frame .fRcontrols1 -relief $RELIEF_frame -bd $BDwidth_frame
frame .fRcontrols2 -relief $RELIEF_frame -bd $BDwidth_frame
frame .fRcanvas -relief raised -bd 2
##+######################################
## PACK the FRAMES.
## NOTE: We can experiment with the order
## in which the frames are stacked.
##+######################################
pack .fRfile \
-side top \
-anchor nw \
-fill x \
-expand 0
pack .fRbuttons \
.fRstatus \
.fRcontrols2 \
.fRcontrols1 \
-side top \
-anchor nw \
-fill none \
-expand 0
pack .fRcanvas \
-side top \
-anchor nw \
-fill both \
-expand 1
## OK, frames are defined. Now start defining-and-packing widgets.
##+###############################
## In FRAME '.fRfile' -
## DEFINE-and-PACK 3 widgets -
## LABEL, ENTRY, BUTTON:
##+###############################
label .fRfile.labelFILE \
-text "ImgFilename (GIF/PNG):" \
-font fontTEMP_varwidth \
-justify left \
-anchor w \
-relief flat \
-bd 0
## We initialize this widget var (and others)
## in the GUI initialization section at the
## bottom of this script.
# set ENTRYfilename ""
entry .fRfile.entFILENAME \
-textvariable ENTRYfilename \
-bg $entryBKGD \
-font fontTEMP_fixedwidth \
-width $initImgfileEntryWidthChars \
-relief sunken \
-bd $BDwidthPx_entry
button .fRfile.buttBROWSE \
-text "Browse ..." \
-font fontTEMP_varwidth \
-padx $PADXpx_button \
-pady $PADYpx_button \
-relief raised \
-bd $BDwidthPx_button \
-command {get_img_filename}
## Pack the '.fRfile' widgets.
pack .fRfile.labelFILE \
-side left \
-anchor w \
-fill none \
-expand 0
pack .fRfile.entFILENAME \
-side left \
-anchor w \
-fill x \
-expand 1
pack .fRfile.buttBROWSE \
-side left \
-anchor w \
-fill none \
-expand 0
##+#########################################
## In FRAME '.fRbuttons' -
## DEFINE-and-PACK 7 'BUTTON' WIDGETS
## --- and a label widget.
##+#########################################
button .fRbuttons.buttEXIT \
-text "Exit" \
-font fontTEMP_varwidth \
-padx $PADXpx_button \
-pady $PADYpx_button \
-relief raised \
-bd $BDwidthPx_button \
-command {exit}
button .fRbuttons.buttHELP \
-text "Help" \
-font fontTEMP_varwidth \
-padx $PADXpx_button \
-pady $PADYpx_button \
-relief raised \
-bd $BDwidthPx_button \
-command {popup_msg_var "$HELPtext"}
button .fRbuttons.buttREMOVEIMG \
-text "RemoveImg" \
-font fontTEMP_varwidth \
-padx $PADXpx_button \
-pady $PADYpx_button \
-relief raised \
-bd $BDwidthPx_button \
-command {.fRcanvas.can delete TAGimg ; image delete imgID1}
button .fRbuttons.buttREMOVELINES \
-text "RemoveLines" \
-font fontTEMP_varwidth \
-padx $PADXpx_button \
-pady $PADYpx_button \
-relief raised \
-bd $BDwidthPx_button \
-command {remove_all_lines}
button .fRbuttons.buttRAISELINES \
-text "RaiseLines" \
-font fontTEMP_varwidth \
-padx $PADXpx_button \
-pady $PADYpx_button \
-relief raised \
-bd $BDwidthPx_button \
-command {.fRcanvas.can raise TAGlines}
button .fRbuttons.buttCOLOR1 \
-text "\
Next Line
Color" \
-font fontTEMP_SMALL_varwidth \
-padx $PADXpx_button \
-pady $PADYpx_button \
-relief raised \
-bd $BDwidthPx_button \
-command "set_line_color1"
button .fRbuttons.buttCOLORbkGND \
-text "\
Background
Color" \
-font fontTEMP_SMALL_varwidth \
-padx $PADXpx_button \
-pady $PADYpx_button \
-relief raised \
-bd $BDwidthPx_button \
-command "set_background_color"
label .fRbuttons.labelCOLORS \
-text "" \
-font fontTEMP_SMALL_varwidth \
-justify left \
-anchor w \
-relief flat \
-bd $BDwidthPx_label
##+##################################################
## Pack the widgets in the '.fRbuttons' frame.
##+##################################################
pack .fRbuttons.buttEXIT \
.fRbuttons.buttHELP \
.fRbuttons.buttREMOVEIMG \
.fRbuttons.buttREMOVELINES \
.fRbuttons.buttRAISELINES \
.fRbuttons.buttCOLOR1 \
.fRbuttons.buttCOLORbkGND \
-side left \
-anchor w \
-fill none \
-expand 0
pack .fRbuttons.labelCOLORS \
-side left \
-anchor w \
-fill x \
-expand 0
##+#########################################
## In FRAME '.fRstatus' -
## DEFINE-and-PACK 1 CHECKBUTTON WIDGET
## and 4 'LABEL' WIDGETS.
##+#########################################
## We initialize this widget var (and others)
## in the GUI initialization section at the
## bottom of this script.
# set smooth0or1 1
checkbutton .fRstatus.chkbuttSMOOTH \
-text "\
Make curves between
points in the next line." \
-font fontTEMP_varwidth \
-variable smooth0or1 \
-selectcolor "#cccccc" \
-relief raised \
-bd $BDwidthPx_button
label .fRstatus.label4COUNTobj \
-text " Lines (incl. single-point lines) currently in drawing:" \
-font fontTEMP_SMALL_varwidth \
-justify left \
-anchor w \
-relief flat \
-bd $BDwidthPx_label
label .fRstatus.labelCOUNTobj \
-text "" \
-font fontTEMP_varwidth \
-justify left \
-anchor w \
-relief flat \
-bd $BDwidthPx_label \
-padx 20
label .fRstatus.label4COUNTpoints \
-text "Points in last-created line:" \
-font fontTEMP_SMALL_varwidth \
-justify left \
-anchor w \
-relief flat \
-bd $BDwidthPx_label
label .fRstatus.labelCOUNTpoints \
-text "" \
-font fontTEMP_varwidth \
-justify left \
-anchor w \
-relief flat \
-bd $BDwidthPx_label \
-padx 20
## Pack the widgets in frame '.fRstatus'.
pack .fRstatus.chkbuttSMOOTH \
.fRstatus.label4COUNTobj \
.fRstatus.labelCOUNTobj \
.fRstatus.label4COUNTpoints \
.fRstatus.labelCOUNTpoints \
-side left \
-anchor w \
-fill none \
-expand 0
##+#########################################
## In FRAME '.fRcontrols1' -
## DEFINE-and-PACK 2 'SCALE' WIDGETS
## --- with their label widgets.
## (One scale for setting the 'next'
## line-width.
## One scale for setting the
## millisecs var to control 'jitter'
## or straightness of next line.)
##+########################################
## We initialize this widget var (and others)
## in the GUI initialization section at the
## bottom of this script.
# set lineWIDTHpx 2
## Define a label widget for the lineWIDTHpx scale widget.
label .fRcontrols1.labelLINEWIDTH \
-text "\
Width (pixels) for
the next line:" \
-font fontTEMP_varwidth \
-justify left \
-anchor w \
-relief flat \
-bd $BDwidthPx_label
scale .fRcontrols1.scaleLINEWIDTH \
-orient horizontal \
-resolution 1 \
-from 1 -to 100 \
-length $initScaleLengthPx \
-variable lineWIDTHpx
## We initialize this widget var (and others)
## in the GUI initialization section at the
## bottom of this script.
# set Nmillisecs 2
## Define a label widget for the Nmillisecs scale widget.
label .fRcontrols1.labelMILLISECS \
-text "\
Millisecs tween adding
points to next line:" \
-font fontTEMP_varwidth \
-justify left \
-anchor w \
-relief flat \
-bd $BDwidthPx_label
scale .fRcontrols1.scaleMILLISECS \
-orient horizontal \
-resolution 1 \
-from 0 -to 2000 \
-length $initScaleLengthPx \
-variable Nmillisecs
label .fRcontrols1.labelMILLISECShelp \
-text "\
Set millisecs high (> 700) to
help draw straight lines." \
-font fontTEMP_SMALL_varwidth \
-justify left \
-anchor w \
-relief flat \
-bd $BDwidthPx_label
## PACK the widgets of FRAME '.fRcontrols1' ---
## label, scale, label, scale, label.
##
## We use '-expand 1' in packing the scale widgets,
## to allow them to x-expand if window is x-expanded.
## That action depends on the pack parameters of
## frame '.fRcontrols1'.
pack .fRcontrols1.labelLINEWIDTH \
-side left \
-anchor w \
-fill none \
-expand 0
pack .fRcontrols1.scaleLINEWIDTH \
-side left \
-anchor w \
-fill x \
-expand 1
pack .fRcontrols1.labelMILLISECS \
-side left \
-anchor w \
-fill none \
-expand 0
pack .fRcontrols1.scaleMILLISECS \
-side left \
-anchor w \
-fill x \
-expand 1
pack .fRcontrols1.labelMILLISECShelp \
-side left \
-anchor w \
-fill none \
-expand 0
##+#########################################
## In FRAME '.fRcontrols2' -
## DEFINE-and-PACK 1 'CHECKBUTTON' WIDGET
## and 1 LABEL and 3 RADIOBUTTONS,
## and 1 more LABEL and 3 more RADIOBUTTONS.
## (One checkbutton for turning on/off
## the 'smooth' option of 'create line'.
## Radiobuttons for setting 'cap' and
## 'join' styles of 'create line'.)
##+########################################
label .fRcontrols2.labelCAPSTYLE \
-text "\
Cap-style of line-segs:" \
-font fontTEMP_SMALL_varwidth \
-justify left \
-anchor w \
-relief raised \
-bd $BDwidthPx_label
## We initialize this widget var (and others)
## in the GUI initialization section at the
## bottom of this script.
# set lineCAPstyle "round"
## Line cap-style options: round/butt/projecting
radiobutton .fRcontrols2.radbuttCAPSTYLE1 \
-text "round" \
-font fontTEMP_SMALL_varwidth \
-anchor w \
-variable lineCAPstyle \
-value "round" \
-selectcolor "$radbuttBKGD" \
-relief flat \
-bd $BDwidthPx_button
radiobutton .fRcontrols2.radbuttCAPSTYLE2 \
-text "butt" \
-font fontTEMP_SMALL_varwidth \
-anchor w \
-variable lineCAPstyle \
-value "butt" \
-selectcolor "$radbuttBKGD" \
-relief flat \
-bd $BDwidthPx_button
radiobutton .fRcontrols2.radbuttCAPSTYLE3 \
-text "projecting" \
-font fontTEMP_SMALL_varwidth \
-anchor w \
-variable lineCAPstyle \
-value "projecting" \
-selectcolor "$radbuttBKGD" \
-relief flat \
-bd $BDwidthPx_button \
-padx 20
label .fRcontrols2.labelJOINSTYLE \
-text "\
Join-style of line-segs:" \
-font fontTEMP_SMALL_varwidth \
-justify left \
-anchor w \
-relief raised \
-bd $BDwidthPx_label
## We initialize this widget var (and others)
## in the GUI initialization section at the
## bottom of this script.
set lineJOINstyle "round"
## Line join-style options: round/bevel/miter
radiobutton .fRcontrols2.radbuttJOINSTYLE1 \
-text "round" \
-font fontTEMP_SMALL_varwidth \
-anchor w \
-variable lineJOINstyle \
-value "round" \
-selectcolor "$radbuttBKGD" \
-relief flat \
-bd $BDwidthPx_button
radiobutton .fRcontrols2.radbuttJOINSTYLE2 \
-text "bevel" \
-font fontTEMP_SMALL_varwidth \
-anchor w \
-variable lineJOINstyle \
-value "bevel" \
-selectcolor "$radbuttBKGD" \
-relief flat \
-bd $BDwidthPx_button
radiobutton .fRcontrols2.radbuttJOINSTYLE3 \
-text "miter" \
-font fontTEMP_SMALL_varwidth \
-anchor w \
-variable lineJOINstyle \
-value "miter" \
-selectcolor "$radbuttBKGD" \
-relief flat \
-bd $BDwidthPx_button
## PACK the widgets of FRAME '.fRcontrols2' ---
## checkbutton, label, 3 radiobuttons, label, 3 radiobuttons.
pack .fRcontrols2.labelCAPSTYLE \
.fRcontrols2.radbuttCAPSTYLE1 \
.fRcontrols2.radbuttCAPSTYLE2 \
.fRcontrols2.radbuttCAPSTYLE3 \
.fRcontrols2.labelJOINSTYLE \
.fRcontrols2.radbuttJOINSTYLE1 \
.fRcontrols2.radbuttJOINSTYLE2 \
.fRcontrols2.radbuttJOINSTYLE3 \
-side left \
-anchor w \
-fill none \
-expand 0
##+###################################################
## In FRAME '.fRcanvas' -
## DEFINE-and-PACK a CANVAS WIDGET:
##+###################################################
## We set '-highlightthickness' and '-borderwidth' to
## zero, to avoid covering some of the viewable area
## of the canvas, as suggested on page 558 of the 4th
## edition of 'Practical Programming with Tcl and Tk'.
##+###################################################
canvas .fRcanvas.can \
-width $initCanWidthPx \
-height $initCanHeightPx \
-relief raised \
-highlightthickness 0 \
-borderwidth 0
pack .fRcanvas.can \
-side top \
-anchor nw \
-fill both \
-expand 1
##+##################################################
## END OF DEFINITION of the GUI widgets.
##+##################################################
## Start of BINDINGS, PROCS, Added-GUI-INIT sections.
##+##################################################
##+#######################################################################
##+#######################################################################
## BINDINGS SECTION:
## - For MB1-release on the image-filename entry field,
## load the image onto the canvas.
## - For Return-key press with text cursor in the image-filename entry field,
## load the image onto the canvas.
##
## - <ButtonPress-1> on canvas calls proc 'doodle_start'
## - <Button1-Motion> on canvas calls proc 'doodle_continue'
## - <ButtonRelease-1> on canvas calls proc 'doodle_end'
##
## - <ButtonRelease-3> on canvas calls proc 'doodle_delete'
##
## - <Control-ButtonPress-1> on canvas calls proc 'image_grab' (not needed?)
## - <Control-Button1-Motion> on canvas calls proc 'image_move'
##+#######################################################################
bind .fRfile.entFILENAME <ButtonRelease-1> {
# image delete imgID1 (not needed?)
image create photo imgID1 -file "$ENTRYfilename"
.fRcanvas.can create image 0 0 -anchor nw -image imgID1 -tag TAGimg
}
bind .fRfile.entFILENAME <Return> {
# image delete imgID1 (not needed?)
image create photo imgID1 -file "$ENTRYfilename"
.fRcanvas.can create image 0 0 -anchor nw -image imgID1 -tag TAGimg
}
bind .fRcanvas.can <ButtonPress-1> [list doodle_start %W %x %y $COLOR1hex]
bind .fRcanvas.can <Button1-Motion> {doodle_continue %W %x %y}
bind .fRcanvas.can <ButtonRelease-1> {doodle_end %W %x %y}
## FOR DELETING LINES:
## Suchenwirth used <Double-3> to delete 'all' from the canvas, with:
## bind .fRcanvas.can <Double-3> {%W delete all}
##
## We give the user the opportunity to bail out of the delete, by moving
## the mouse cursor off of the canvas before releasing button3.
## And we only delete the line nearest the current cursor location.
## (The 'doodle_delete' proc may need some improvement to make sure
## that we delete precisely the line-segment desired.)
bind .fRcanvas.can <ButtonRelease-3> {doodle_delete %W %x %y}
## We could high-light (in orange, say) an item, to help the user when
## they want to delete a line ... to make sure they delete the right one.
## We would need to get the item's current color and restore it on
## leaving the item.
# .fRcanvas.can bind TAGlines <Button3-Enter> \
# "Put the item's current color in $prevCOLOR, then do
# .fRcanvas.can itemconfig current -fill #ffaa00"
# .fRcanvas.can bind TAGlines <Button3-Leave> \
# ".fRcanvas.can itemconfig current -fill $prevCOLOR"
## Provide a way to move the IMAGE on the canvas.
# bind .fRcanvas.can <ButtonPress-2> {image_grab %W %x %y} (not needed?)
bind .fRcanvas.can <Button2-Motion> {image_move %W %x %y}
##+#############################################################################
##+#############################################################################
## DEFINE PROCS SECTION:
##
## - 'get_img_filename' - gets the filename of an image (GIF/PNG) file
## and places the image on the canvas
##
## - 'get_chars_before_last' - used in 'get_img_filename' to set curDIR
##
## - 'doodle_start' - start drawing a freehand line
## - 'doodle_continue' - continue drawing the 'current' freehand line
## - 'doodle_end' - stop drawing the 'current' freehand line
## - 'doodle_delete' - delete a 'closest' line
##
## - 'image_grab' - grab the image (not needed?)
## - 'image_move' - move the image
##
## - 'set_line_color1' - set the 'fill' color for drawing the next line
## - 'set_background_color' - set the background (canvas) color
## - 'update_colors_label' - updates the colors in the label widget
## '.fRbuttons.labelCOLORS'.
## - 'remove_all_lines' - removes all lines & points from the canvas
##
## - 'popup_msg_var' - to show help, and to show other msgs as needed
##+############################################################################
##+#########################################################################
## Proc 'get_img_filename' -
##
## PURPOSE: To get the name of an image file (GIF/PNG) and put the
## filename into global var 'ENTRYfilename'.
## Also, go ahead and load the image onto the canvas.
##
## USED BY: the '-command' option of the 'Browse ...' button.
##+#########################################################################
# set curDIR "$env(HOME)"
## FOR TESTING:
set curDIR "pwd"
proc get_img_filename {} {
global ENTRYfilename env curDIR
# global imgID1
## Provide the user a way to select an image file.
set fName [tk_getOpenFile -parent . -title "Select GIF/PNG file to load" \
-initialdir "$curDIR" ]
## FOR TESTING:
# puts "fName : $fName"
## Load the image file contents onto the canvas.
## (Since there is only one image on the canvas at any time, we will
## always use the string 'imgID1' as the image ID in this script.)
if {[file exists $fName]} {
set ENTRYfilename "$fName"
set curDIR [ get_chars_before_last / in "$ENTRYfilename" ]
# catch { image delete imgID1 } (not needed?)
image create photo imgID1 -file "$ENTRYfilename"
## Place the image on the canvas.
.fRcanvas.can create image 0 0 -anchor nw -image imgID1 -tag TAGimg
## Set the canvas size according to the size of the image.
set imgWidthPx [image width imgID1]
set imgHeightPx [image height imgID1]
.fRcanvas.can configure -width $imgWidthPx -height $imgHeightPx
## FOR TESTING:
# puts "get_img_filename > imgWidthPx: $imgWidthPx imgHeightPx: $imgHeightPx"
## Force the resizing of the canvas, esp. if a new image is
## loaded that is taller than the previous image.
pack forget .fRcanvas.can
pack .fRcanvas.can \
-side top \
-anchor nw \
-fill both \
-expand 1
## We could automatically raise any lines already drawn
## so that they are not hidden by the newly loaded image.
# catch {.fRcanvas.can raise TAGlines}
}
}
## END OF proc 'get_img_filename'
##+######################################################################
## Proc 'get_chars_before_last' -
##+######################################################################
## PURPOSE: Gets the chars before the last occurrence of a char in a string.
##
## INPUT: A character and a string.
## Note: The "in" parameter is there only for clarity.
##
## OUTPUT: Returns all of the characters in the string "strng" that
## are BEFORE the last occurence of the characater "char".
##
## EXAMPLE CALL: To extract the directory from a fully qualified file name:
##
## set directory [ get_chars_before_last "/" in "/home/abc01/junkfile" ]
##
## $directory will now be the string "/home/abc01"
##
##+######################################################################
proc get_chars_before_last { char in strng } {
set end [ expr {[string last $char $strng ] - 1} ]
# set start 0
# set output [ string range $strng $start $end ]
set output [ string range $strng 0 $end ]
## FOR TESTING:
# puts "From 'get_chars_before_last' proc:"
# puts "STRING: $strng"
# puts "CHAR: $char"
# puts "RANGE up to LAST CHAR - start: 0 end: $end"
return $output
}
## END OF 'get_chars_before_last' PROCEDURE
##+#########################################################
## proc doodle_start
##+#########################################################
## PURPOSE: Start a line using the 'create line' command
## on the canvas. Draws an 'invisible' point.
##
## Also increments Nobj and sets NcurPoints to zero
## and calls proc 'update_status_labels'.
##
## NOTE: Provides '-fill' , '-width' ,
## '-smooth' '-splinesteps' ,
## '-capstyle' , '-joinstyle' , and '-tag'
## option to 'create line'.
##
## CALLED BY: bind .fRcanvas.can <ButtonPress-1>
##+#########################################################
## We store the line-IDs in an array variable, aRlineIDs,
## and keep our own count of the lines. The line count
## and the array variable do not seem to be necessary at
## this time, but they may be useful for future enhancements.
##+#########################################################
set curObjID_CNT 1
## Initialize initX and initY for use in procs
## 'doodle_start' and 'doodle_end'.
set initX -1
set initY -1
proc doodle_start {w x y color} {
global aRlineIDs curObjID_CNT COLOR1hex lineWIDTHpx \
smooth0or1 lineCAPstyle lineJOINstyle \
Nobj NcurPoints initX initY
## Map from view coordinates to canvas coordinates, per
## page 559 of 4th edition of 'Practical Programming in Tcl & Tk'.
set x [$w canvasx $x]
set y [$w canvasy $y]
## Initialize the line for the current line-count.
## (We store a separate line-ID for each doodle
## line, in array item aRlineIDs($curObjID_CNT). This could
## be useful, for example, if we ever want to click a
## button on the GUI and show the current number of
## lines in the sketch. We would to keep track of
## deleted lines in that case. See the doodle_delete'
## proc below.)
##
## Note: The start and end point of the line is the same.
## Under certain conditions (not clear to me yet),
## Tk's 'create line' will not draw a point on the
## canvas unless the 2nd point is different from
## the first point. So this initial point may be
## 'invisible'.
## See the 'doodle_end' proc. There we could make the
## point visible, if only the initial xy points were
## in this 'doodle object'.
set aRlineIDs($curObjID_CNT) [$w create line \
$x $y $x $y \
-fill $COLOR1hex -width $lineWIDTHpx \
-smooth $smooth0or1 \
-capstyle $lineCAPstyle -joinstyle $lineJOINstyle -tag TAGlines]
## -splinesteps 1
set initX $x
set initY $y
## capstyles: butt, projecting, round
## joinstyles: bevel, miter, round
## Turning on '-smooth' seems to give nicer lines.
## '-splinesteps' may be helpful too. (best value? default value?
## hard-code it OR prompt for it?)
## NOTE1: "If the smoothing method is 'true' (1), this indicates that the
## line should be drawn as a curve, rendered as a set of quadratic
## splines: one spline is drawn for the first and second line segments,
## one for the second and third, and so on."
## "If a boolean false value or empty string is given, no smoothing is
## applied."
## NOTE2: "'-splinesteps' specifies the degree of smoothness desired
## for curves: each spline will be approximated with that number of
## line segments."
## SOURCE of notes 1 & 2: Tcl-Tk 8.5.5 documentation.
## Increment the objects-in-drawing count.
incr Nobj
## Reset the number-of-points-in-current-line counter.
set NcurPoints 1
update_status_labels
## FOR TESTING:
# puts "doodle_start > curObjID_CNT: $curObjID_CNT \
# aRlineIDs($curObjID_CNT): $aRlineIDs($curObjID_CNT)"
}
## END OF proc doodle_start
##+#########################################################
## proc doodle_continue
##+#########################################################
## PURPOSE: Adds the current x,y point to the currently
## in-process line --- after a delay of Nmillisecs.
## Also increments NcurPoints and calls proc
## 'update_status_labels'.
##
## CALLED BY: bind .fRcanvas.can <Button1-Motion>
##+#########################################################
proc doodle_continue {w x y} {
global aRlineIDs curObjID_CNT Nmillisecs NcurPoints
## Wait Nmillisecs. (This is to help user make straight lines.
## It can reduce 'jitter' in lines, by reducing the number of
## 'control points' in the line.)
after $Nmillisecs
## Map from view coordinates to canvas coordinates, per
## page 559 of 4th edition of 'Practical Programming in Tcl & Tk'.
set x [$w canvasx $x]
set y [$w canvasy $y]
## Add an end-point to the line for the current line-count.
## (We do this by getting the xy coords for ALL the points of
## the currently-being-drawn-line and concatenating the
## new point. Then use 'coords' to reset the coordinates.)
## This is what Suchenwirth did in his 'doodle_move' proc.
$w coords $aRlineIDs($curObjID_CNT) \
[concat [$w coords $aRlineIDs($curObjID_CNT)] $x $y]
## Increment the number-of-points-in-current-line count.
incr NcurPoints
update_status_labels
## FOR TESTING:
# puts "doodle_continue > Adding point $x $y"
}
## END OF proc doodle_continue
##+#################################################################
## proc doodle_end
##+#################################################################
## PURPOSE: Increments var curObjID-CN that we are using to hold
## a numeric ID for the next or current line.
##
## But before that ID is incremented, we test to see if
## we are ending a line that consisted of just one,
## not-drawn point. It that is the case, we draw the point.
##
## CALLED BY: bind .fRcanvas.can <ButtonRelease-1>
##+################################################################
proc doodle_end {w x y} {
global curObjID_CNT COLOR1hex lineWIDTHpx \
smooth0or1 lineCAPstyle lineJOINstyle \
Nobj NcurPoints initX initY
# global aRlineIDs
## If the current doodle-object has only the initial xy
## point in it and the point was not drawn (under certain
## conditions not yet clear to me), then we could test for
## those conditions and draw a single point/blot.
# if { $x == $initX && $y == $initY && $NcurPoints == 1 && \
# ... other conditions go here ... } {
#
# set aRlineIDs($curObjID_CNT) [$w create line \
# $x $y [expr {$x + 1}] $y \
# -fill $COLOR1hex -width $lineWIDTHpx \
# -smooth $smooth0or1 -splinesteps 4 \
# -capstyle $lineCAPstyle -joinstyle $lineJOINstyle -tag TAGlines]
# }
## Advance the line count so that the next 'doodle_start'
## stores the new line-ID in a different lineID array location.
incr curObjID_CNT
set initX -1
set initY -1
}
## END OF proc doodle_end
##+##################################################################
## proc doodle_delete
##+##################################################################
## PURPOSE: Deletes a line object nearest the current cursor position,
## and decrements Nobj and sets NcurPoints to 0 and
## calls proc 'update_status_labels'.
##
## CALLED BY: bind .fRcanvas.can <ButtonRelease-3>
##+##################################################################
## NOTE:
## We need a good delete-segment capability, because
## it is hard to sketch the line segments
## exactly where we want them with the mouse
## --- for every segment, the first time, every time.
##+#########################################################
set pixelTol 3
proc doodle_delete {w x y} {
global pixelTol Nobj NcurPoints
## See note below on aRlineIDs and '-1'.
# global aRlineIDs
## Map from view coordinates to canvas coordinates, per
## page 559 of 4th edition of 'Practical Programming in Tcl & Tk'.
set x [$w canvasx $x]
set y [$w canvasy $y]
## Find canvas object nearest $x $y. This returns the 'last one'
## (uppermost) in the display list.
set objID [$w find closest $x $y $pixelTol]
## We could popup a prompt to the user here indicating the
## item that will be deleted and ask the user if it is OK
## to do the delete.
set objTAGs [$w gettags $objID]
## FOR TESTING:
# puts "'doodle_delete' > objID: $objID objTAGs: $objTAGs"
## If objTAGs typically contains 'TAGlines current' when a line is
## detected by 'closest', and 'TAGimg current' when the image is detected.
## We make sure we delete a line and NOT an image on the canvas.
if { $objTAGs == "TAGlines current" || $objTAGs == "TAGlines" } {
$w delete $objID
## Decrement the number-of-objects-in-drawing count.
incr Nobj -1
## Reset the number-of-points-in-current-line count.
set NcurPoints 0
update_status_labels
}
## We could find the objectID in the array aRlineIDs
## and, for that array index, reset the array to a value,
## like DEL or -1, that indicates the line (object) is deleted.
# Search the array to find the index, idx, of the deleted object.
# set aRlineIDs($idx) "-1"
}
## END OF proc doodle_delete
##+#########################################################
## proc image_move
##+#########################################################
## PURPOSE: Moves the image on the canvas.
##
## CALLED BY: bind .fRcanvas.can <Button2-Motion>
##+#########################################################
proc image_move {w x y} {
## Map from view coordinates to canvas coordinates, per
## page 559 of 4th edition of 'Practical Programming in Tcl & Tk'.
set x [$w canvasx $x]
set y [$w canvasy $y]
## FOR TESTING:
# set tempCoords [$w coords TAGimg]
# puts "'image_move' > Current image coords: $tempCoords"
## Reset the location of the image on the canvas.
$w coords TAGimg $x $y
## FOR TESTING:
# puts "'image_move' > Moving image to $x $y"
}
## END OF proc image_move
##+#####################################################################
## proc 'set_line_color1'
##+#####################################################################
## PURPOSE: This procedure is invoked to get an RGB triplet
## via 3 RGB slider bars on the FE Color Selector GUI.
##
## Uses that RGB value to set a 'fill' color.
##
## ARGUMENTS: none
##
## CALLED BY: .fRbuttons.buttCOLOR1 button
##+#####################################################################
proc set_line_color1 {} {
global COLOR1r COLOR1g COLOR1b COLOR1hex COLOR1r COLOR1g COLOR1b
# global feDIR_tkguis
## FOR TESTING:
# puts "COLOR1r: $COLOR1r"
# puts "COLOR1g: $COLOR1g"
# puts "COLOR1b: $COLOR1b"
set TEMPrgb [ exec \
./sho_colorvals_via_sliders3rgb.tk \
$COLOR1r $COLOR1g $COLOR1b]
# $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
set COLOR1hex "#$hexRGB"
set COLOR1r $r255
set COLOR1g $g255
set COLOR1b $b255
## Update the colors-label.
update_colors_label
}
## END OF proc 'set_line_color1'
##+#####################################################################
## proc 'set_background_color'
##+#####################################################################
## PURPOSE: This procedure is invoked to get an RGB triplet
## via 3 RGB slider bars on the FE Color Selector GUI.
##
## Uses that RGB value to set the color of the canvas ---
## on which all the tagged items (lines) lie.
##
## ARGUMENTS: none
##
## CALLED BY: .fRbuttons.buttCOLORbkGND button
##+#####################################################################
proc set_background_color {} {
global COLORbkGNDr COLORbkGNDg COLORbkGNDb COLORbkGNDhex \
COLORbkGNDr COLORbkGNDg COLORbkGNDb
# global feDIR_tkguis
## FOR TESTING:
# puts "COLORbkGNDr: $COLORbkGNDr"
# puts "COLORbkGNDg: $COLORbkGNDb"
# puts "COLORbkGNDb: $COLORbkGNDb"
set TEMPrgb [ exec \
./sho_colorvals_via_sliders3rgb.tk \
$COLORbkGNDr $COLORbkGNDg $COLORbkGNDb]
# $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
set COLORbkGNDhex "#$hexRGB"
set COLORbkGNDr $r255
set COLORbkGNDg $g255
set COLORbkGNDb $b255
## Set the color of the canvas.
.fRcanvas.can config -bg $COLORbkGNDhex
## Update the colors-label.
update_colors_label
}
## END OF proc 'set_background_color'
##+#####################################################################
## proc update_colors_label
##+#####################################################################
## PURPOSE: Updates the colors in the label widget
## '.fRbuttons.labelCOLORS'.
##
## ARGUMENTS: none
##
## CALLED BY: two color-setting procs and the GUI init section at
## the bottom of this script.
##+#####################################################################
proc update_colors_label {} {
global COLOR1hex COLORbkGNDhex
.fRbuttons.labelCOLORS configure -text "\
Color for the next line: $COLOR1hex
Background Color: $COLORbkGNDhex"
}
## END OF proc 'update_colors_label'
##+#####################################################################
## proc update_status_labels
##+#####################################################################
## PURPOSE: Updates the counts in the label widgets
## '.fRstatus.labelCOUNTobj' and '.fRstatus.labelCOUNTpoints'.
##
## ARGUMENTS: none
##
## CALLED BY: 'doodle_end', 'doodle_delete' procs and the
## GUI init section at the bottom of this script.
##+#####################################################################
proc update_status_labels {} {
global Nobj NcurPoints
.fRstatus.labelCOUNTobj configure -text "$Nobj"
.fRstatus.labelCOUNTpoints configure -text "$NcurPoints"
}
## END OF proc 'update_status_labels'
##+#####################################################################
## proc remove_all_lines
##+#####################################################################
## PURPOSE: Removes all objects (lines, 'degenerate lines'=points)
## from the canvas and resets some counts accordingly.
##
## ARGUMENTS: none
##
## CALLED BY: 'doodle_end', 'doodle_delete' procs and the
## GUI init section at the bottom of this script.
##+#####################################################################
proc remove_all_lines {} {
global Nobj NcurPoints
.fRcanvas.can delete TAGlines
set Nobj 0
set NcurPoints 0
update_status_labels
}
## END OF proc 'remove_all_lines'
##+########################################################################
## 'popup_msg_var' PROCEDURE
##+########################################################################
## PURPOSE: Show help to the user.
## (Could also be used to advise user of error conditions.)
##
## CALLED BY: '-command' option of the Help button
##+########################################################################
## To have more control over the formatting of the message (esp.
## max length of lines), 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 env
# bell
# bell
#####################################
## SETUP 'TOP LEVEL' HELP WINDOW.
#####################################
set w .topmsg
catch {destroy $w}
toplevel $w
wm geometry $w +100+100
wm title $w "To You"
wm iconname $w "ToYou"
#####################################
## DEFINE & PACK TEXT WIDGET.
#####################################
text $w.text \
-relief raised \
-bd 2 \
-font fontTEMP_fixedwidth
pack $w.text \
-side top \
-anchor center \
-fill both \
-expand 0
#####################################
## DEFINE & PACK OK BUTTON WIDGET.
#####################################
button $w.butt -text "OK" \
-font fontTEMP_fixedwidth -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 maxLINEwidth 0
#############################################
## LOOK AT EACH LINE IN THE LIST.
#############################################
foreach line $VARlist {
#############################################
## Get the length of the line.
#############################################
set LINEwidth [ string length $line ]
if { $LINEwidth > $maxLINEwidth } {
set maxLINEwidth $LINEwidth
}
}
## END OF foreach line $VARlist
$w.text configure -width $maxLINEwidth
## For testing:
# puts "maxLINEwidth: $maxLINEwidth"
########################################################################
## NOTE: maxLINEwidth should work well when 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 according to the 'string length' command.
########################################################################
}
## END OF 'popup_msg_var' PROCEDURE
##+########################
## END of PROC definitions.
##+########################
set HELPtext "\
\ \ \ \ \ **HELP for the 'Sketch Lines on an Image' utility **
To DRAW:
Press MB1 (mouse button 1) to start a line where the arrow-cursor
is currently located on the canvas. Continue to hold MB1 down and
move the mouse to draw the current line segment on the canvas.
Release MB1 to terminate drawing that line segment.
To DELETE a line segment, press-and-release MB3 (mouse button 3)
on the line segment (or 'degenerate line' = point) to be deleted.
Click the 'RemoveImage' button to see how your drawing is
progressing. Then ...
Click and release MB1 on the filename in the entry field, to
RELOAD the image from the image file to the canvas. If the
reload covers up your lines, click on the 'RaiseLines' button
to reveal the lines again.
Use MB2 to move (drag) the image to a new location. This can
be useful to use additional images to help sketch the picture.
Or it can be used to offset the current image and use it for
addtional sketching.
You can reduce the number of points being captured to make the
curved/polygonal line by increasing the 'millisecs' parameter.
Click on the sliderbar trough for fine-grained control.
You can use a screen/image capture utility to capture your
drawing --- with or without an underlying image in place."
##+######################################################
##+######################################################
## Additional GUI INITIALIZATION:
##+######################################################
## Initialize some count variables and some
## scale/checkbutton/radiobutton widget variables
## that are shown on the GUI or set via the GUI.
set ENTRYfilename ""
set Nobj 0
set NcurPoints 0
# set lineWIDTHpx 2
set lineWIDTHpx 15
set Nmillisecs 50
set smooth0or1 1
set lineCAPstyle "round"
set lineJOINstyle "round"
.fRcanvas.can configure -bg $COLORbkGNDhex
update_colors_label
update_status_labels
Here is an image that shows that you do not have to use an image to do your sketching. You can simply sketch on the canvas without using the 'Browse...' button to locate an image file.
uniquename 2012oct21 UPDATE:To give potential users of this 'Sketch On' utility some ideas on how it could be used (the range of its capabilities), I decided to post some images here that might trigger some ideas on how to make use of 'SketchOn'.For example, the following image, composed completely of dots, provides a quite convincing image of a mountain range.
