Version 0 of A 'Sketch On' GUI ... for drawing on an image or colored background
Updated 2012-10-05 19:47:58 by uniquenameuniquename - 2012oct05
In doing some searches on this wiki for 'canvas' applications, I ran across the old 2003 Suchenwirth page A minimal doodler explained.
I pasted the code into a script and ran it. It could draw black curves on a white background. Nice.
However, an 'artistically challenged' person like myself could use some help in sketching --- like an image to use as a guide in sketching.
I had recently posted a script here that loads GIF/PNG images from an image file to a canvas --- at GUI for Editing Photo-images with Functions.
I figured that, based on that code, I should be able to make a nice sketcher utility that could be used to make some non-trivial sketches.
Some of the goals that I had for this utility were:
1) I should be able to remove the image from the canvas at any time so that I could check on the progress of the sketch. Then I should be able to quickly re-apply the image to the canvas.
2) I should be able to specify any color for the lines being sketched --- and any color for the background (the canvas).
3) I should be able to change to a different line width at any time as I laid down the line segments.
4) And, perhaps most importantly, since it is difficult to get line segments just the way you want them (the first time, every time), I needed a 'robust' delete capability that allowed me to quickly delete a line segment and re-draw it. (In Suchenwirth's 'minimal doodler' example, it could delete ALL the lines drawn, but not individual line segments.)
After a couple of long days of coding --- and reviewing and referring to Chapter 37 'The Canvas Widget' in the 4th edition of the book 'Practical Programming in Tcl and Tk', I came up with the GUI indicated by the following image.
The GUI actually has a blank canvas when it is first started up. This image demonstrates that one can load a nice image onto the canvas.
And the following image shows how the GUI may look after sketching some lines on the image.
Note that if you are having a hard time seeing the lines that you are drawing on the image, you could start with a 'faded' image. For example, you could take your GIF/PNG image file into an image editor (like 'mtpaint' on Linux). I use the 'Effects > Transform color ...' option in 'mtpaint' to access a slider bar for 'Gamma correction'. By simply sliding that bar from 100 to about 200, I can save to a paler image, and then use that image on which to sketch.
The following image shows how the image can be removed with the 'RemoveImg' button, to reveal the progress on the sketch.
The 'Help' button of the GUI shows text like the following, which indicates how one can re-apply the image to the GUI, to continue drawing. And the help indicates how one can quickly delete line segments and quickly relocate the image on the canvas.
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 presense 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 makes it easy for me to find code sections --- while generating and testing this script, and when looking for code snippets to include in other scripts.
_________________________________________________________________
As in all my scripts that use the 'pack' geometry manager (which is all of my 100-plus Tk scripts, so far), I provide the four main pack parameters --- '-side', '-anchor', '-fill', and '-expand' --- on all the 'pack' commands for the frames and widgets.
I think I have found a good setting of the '-side', '-anchor', '-fill', and '-expand' parameters on the 'pack' commands for the various widgets of this GUI. In particular ...
The 'canvas' widget expands/contracts appropriately when the window size is changed --- and button and label widgets stay fixed in size and relative-location as the window size is changed.
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.
#!/usr/bin/wish -f
##+###########################################################################
##
## SCRIPT: sketch_onImgFromFile_utility.tk
##
## PURPOSE: This script allows the user to select and read an image file
## whose image is placed on 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 --- with the ability to quickly delete
## mistakes, by a button click on a botched line segment.
##
## METHOD: 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.
##
##+########################
## 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 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).
## 'fRcontrols' - to contain a label & a scale widget (for next-line
## width) --- and maybe other controls later.
## 'fRcanvas' - to contain the canvas widget.
##
## Sub-frames: none
##
## 1b) Pack ALL frames.
##
## 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_stop'
## - bind <ButtonRelease-3> - on the canvas - calls proc 'doodle_delete'
##
## - 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_stop' - to finish a 'doodle' line
## - 'doodle_delete' - to delete a 'closest' doodle line
## - 'image_grab' - to start grab the image
## - '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
## - '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.
##+########################################################################
##+#######################################################################
## 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]
##+########################################################
## 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
## 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 a canvas at least 24 pixels high, and
## 1 char high for the '.fRfile' frame, and
## 2 chars high for the widgets in the '.fRbuttons' frame, and
## 1 char high for the '.fRcontrols' frame.
##+#######################################################################
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 4 frames 'fRfile' 'fRbuttons' 'fRcontrols' 'fRcanvas'.
## Allow
## 1 char high for 'fRfile'
## 2 char high for 'fRbuttons'
## 1 chars high for 'fRcontrols'
## 24 pixels high for 'fRcanvas'
set charHeightPx [font metrics fontTEMP_fixedwidth -linespace]
set minWinHeightPx [expr 24 + 4 * $charHeightPx]
## Add about 28 pixels for top-bottom window decoration,
## about 4x6 pixels for each of the 4 stacked frames and their
## widgets (their borders/padding).
set minWinHeightPx [expr $minWinHeightPx + 52]
## 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' 'fRcontrols' '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 .fRcontrols -relief $RELIEF_frame -bd $BDwidth_frame
frame .fRcanvas -relief raised -bd 2
##+##############################
## PACK the FRAMES.
##+##############################
pack .fRfile \
.fRbuttons \
.fRcontrols \
-side top \
-anchor nw \
-fill x \
-expand 0
pack .fRcanvas \
-side top \
-anchor nw \
-fill both \
-expand 1
## OK, frames are packed. 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
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 about 4 '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 {.fRcanvas.can delete TAGlines}
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_button
##+##################################################
## 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 '.fRcontrols' -
## DEFINE-and-PACK 'SCALE' WIDGET
## --- with a label widget.
## (For setting the current
## line-drawing width.)
##+#################################
set lineWIDTHpx 2
## Define a label widget for the scale widget.
label .fRcontrols.labelLINEWIDTH \
-text "Width for the next line (pixels):" \
-font fontTEMP_varwidth \
-justify left \
-anchor w \
-relief flat \
-bd $BDwidthPx_button
scale .fRcontrols.scaleLINEWIDTH \
-orient horizontal \
-resolution 1 \
-from 1 -to 100 \
-length $initScaleLengthPx \
-variable lineWIDTHpx
# -command "ReDraw 0"
## PACK the widgets of FRAME '.fRcontrols' ---
## label and scale.
pack .fRcontrols.labelLINEWIDTH \
-side left \
-anchor w \
-fill none \
-expand 0
pack .fRcontrols.scaleLINEWIDTH \
-side left \
-anchor w \
-fill x \
-expand 1
##+###################################################
## 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_stop'
##
## - <ButtonRelease-3> on canvas calls proc 'doodle_delete'
##
## - <Control-ButtonPress-1> on canvas calls proc 'image_grab'
## - <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_stop %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}
## 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_stop' - 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'.
##
## - '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)"
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.
##
## 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 curCNT 1
proc doodle_start {w x y color} {
global aRlineIDs curCNT COLOR1hex lineWIDTHpx
## 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 canvasx $y]
## Initialize the line for the current line-count.
## (We store a separate line-ID for each doodle
## line, in array item aRlineIDs($curCNT). 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.
## 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 is
## 'invisible'.
set aRlineIDs($curCNT) [$w create line $x $y $x $y \
-fill $COLOR1hex -width $lineWIDTHpx \
-smooth 1 -splinesteps 4 \
-capstyle round -joinstyle round -tag TAGlines]
## capstyles: butt, projecting, round
## joinstyles: bevel, miter, round
## Turning on '-smooth' seems to give nicer lines.
## '-splinesteps' may be helpful too. (?)
## FOR TESTING:
# puts "doodle_start > curCNT: $curCNT aRlineIDs($curCNT): $aRlineIDs($curCNT)"
}
## END OF proc doodle_start
##+#########################################################
## proc doodle_continue
##
## PURPOSE: Adds points to the 'current' line.
##
## CALLED BY: bind .fRcanvas.can <Button1-Motion>
##+#########################################################
proc doodle_continue {w x y} {
global aRlineIDs curCNT
## 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 canvasx $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($curCNT) [concat [$w coords $aRlineIDs($curCNT)] $x $y]
## FOR TESTING:
# puts "doodle_continue > Adding point $x $y"
}
## END OF proc doodle_continue
##+#########################################################
## proc doodle_stop
##
## CALLED BY: bind .fRcanvas.can <ButtonRelease-1>
##+#########################################################
proc doodle_stop {w x y} {
global curCNT
# global aRlineIDs
## Advance the line count so that the next 'doodle_start'
## stores the new line-ID in a different lineID array location.
incr curCNT
}
## END OF proc doodle_stop
##+#########################################################
## proc doodle_delete
##
## 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
## 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 canvasx $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
}
## 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 canvasx $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'
##+########################################################################
## '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" -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 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."
##+######################################################
##+######################################################
## Additional GUI INITIALIZATION:
##+######################################################
.fRcanvas.can configure -bg $COLORbkGNDhex
update_colors_label
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.
In this case, I used the 'Background color' button to set the canvas background to blue. And I used the 'Next line color' button to, at various times, set the line-color to white, black, and yellow.
I also used the 'Width of next line' scale to set several different line widths.
____
In summary, I think Tcler's (or their kids) can have some fun times with this 'Sketch On' utility.