- Doodle
- Draw lines, rectangles and ovals
- Change outline-, fill- and background color
- Save the drawing as .jpg or .gif
- Show canvas size and pointer position
# Name: ScratchPad.tcl
# Author: Martin Eder, snofix@users.sourceforge.net
# Description: A simple scratch pad which provides free-hand drawing and
# basic geometric figures (lines, rectangels, circles).
# The drawing can be saved as jpg or gif file.
namespace eval spad {
set currentmode "freehand"
set thickness 1
set thicklist "1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 22 24 26 28 30"
set pcolor "black"
set pbcolor "white"
set canbg "white"
set savename ""
}
proc spad::setcol {cvar widget} {
set newcolor [tk_chooseColor -initialcolor $cvar -parent .ppad -title "Choose new fill color"]
if {$newcolor != ""} {
set $cvar $newcolor
$widget configure -bg $newcolor
return $newcolor
}
}
proc spad::gui {} {
if {[winfo exists .ppad]} {destroy .ppad}
wm withdraw .
toplevel .ppad -padx 5 -pady 5
wm protocol .ppad WM_DELETE_WINDOW exit
wm title .ppad "Scratch Pad"
frame .ppad.f -relief ridge -borderwidth 4
canvas .ppad.f.c -bg $spad::canbg -highlightthickness 0 -width 320 -height 240
frame .ppad.panel
frame .ppad.dpanel
frame .ppad.status
label .ppad.status.pos -relief groove -width 9
label .ppad.status.size -relief groove -width 9
label .ppad.status.bar -relief groove -anchor w -width 10
label .ppad.panel.pcollab -text " Pen:"
button .ppad.panel.pcol -width 3 -bg $spad::pcolor -relief ridge -command {
set tmpcol [spad::setcol $spad::pcolor .ppad.panel.pcol]
if {$tmpcol != ""} {set spad::pcolor $tmpcol}
}
label .ppad.panel.pbcollab -text " Fill:"
button .ppad.panel.pbcol -width 3 -bg $spad::pbcolor -relief ridge -command {
set tmpcol [spad::setcol $spad::pbcolor .ppad.panel.pbcol]
if {$tmpcol != ""} {set spad::pbcolor $tmpcol}
}
label .ppad.panel.bgcollab -text " Background:"
button .ppad.panel.bgcol -width 3 -bg $spad::canbg -relief ridge -command {
set tmpcol [spad::setcol $spad::canbg .ppad.panel.bgcol]
if {$tmpcol != ""} {
.ppad.f.c configure -bg [set spad::bgcollab $tmpcol]
}
}
spinbox .ppad.dpanel.thickness -values $spad::thicklist -command {set spad::thickness [.ppad.dpanel.thickness get]} -state readonly -width 3
button .ppad.dpanel.pointer -relief raised -command spad::pointer -image [image create photo -data {
R0lGODlhEAAQAIMAAPwCBAQCBPz+xPz+BMTCBPz+/MTCxISChDQyNAAAAAAA
AAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAREEMhJg6BYWhAG
v5k2EKMXToSgEqc1DEIhvGAWpOvJFSXZyoXOxxY0BDahQDGg4xgOxmbgiWDq
poeqlGrVcZuSbLfpjwAAIf5oQ3JlYXRlZCBieSBCTVBUb0dJRiBQcm8gdmVy
c2lvbiAyLjUNCqkgRGV2ZWxDb3IgMTk5NywxOTk4LiBBbGwgcmlnaHRzIHJl
c2VydmVkLg0KaHR0cDovL3d3dy5kZXZlbGNvci5jb20AOw==}]
button .ppad.dpanel.freehand -relief raised -command spad::draw_free -image [image create photo -data {
R0lGODlhEgASAIAAAAAAAP///yH5BAEAAAEALAAAAAASABIAAAIjjI+pywgP
moty1kTvyTpw/UHfRkGGqYhpt7Gn67GopMK2UgAAOw==}]
button .ppad.dpanel.line -relief raised -command spad::draw_line -image [image create photo -data {
R0lGODlhEgASAIAAAAAAAP///yH5BAEAAAEALAAAAAASABIAAAIdjI+py+0G
wEtxUmlPzRDnzYGfN3KBaKGT6rDmGxQAOw==}]
button .ppad.dpanel.rectangle -relief raised -command spad::draw_rectangle -image [image create photo -data {
R0lGODlhEgASAIAAAAAAAP///yH5BAEAAAEALAAAAAASABIAAAImjI+py+3f
gJxUqorB1csmv4Udh4AfeZglaqgpG7gtnFVbLUP6/hQAOw==}]
button .ppad.dpanel.circle -relief raised -command spad::draw_circle -image [image create photo -data {
R0lGODlhEgASAIAAAAAAAP///yH5BAEAAAEALAAAAAASABIAAAIrjI+pywkP
X4sULKgw0tluz0iHGIIBeZlo9zWnarLjOnfxe+NVbuy8CwwWAAA7}]
.ppad configure -menu [menu .ppad.padmenu] -padx 5 -pady 5
.ppad.padmenu add cascade -label "File" -menu [menu .ppad.padmenu.file -tearoff 0]
.ppad.padmenu.file add command -label "Clear" -command {.ppad.f.c delete all}
.ppad.padmenu.file add command -label "Save" -command {spad::save_can $spad::savename}
.ppad.padmenu.file add command -label "Save As" -command {spad::save_can ""}
.ppad.padmenu.file add separator
.ppad.padmenu.file add command -label "About" -command {tk_messageBox -title "About" -message "Scratch Pad\n2006 by Martin Eder\n(snofix@users.sourceforge.net)"}
.ppad.padmenu.file add command -label "Exit" -command exit
pack .ppad.f.c -expand 1 -fill both
pack .ppad.dpanel.pointer .ppad.dpanel.freehand .ppad.dpanel.line .ppad.dpanel.rectangle .ppad.dpanel.circle -padx 2 -side top -pady 1 -fill x
pack .ppad.dpanel.thickness -side top -pady 10 -padx 2 -fill x
pack .ppad.panel.pcollab .ppad.panel.pcol .ppad.panel.pbcollab .ppad.panel.pbcol .ppad.panel.bgcollab .ppad.panel.bgcol -side left
pack .ppad.status.size .ppad.status.pos -side right
pack .ppad.status.bar -side left -expand 1 -fill x
pack .ppad.status -side bottom -fill x
pack .ppad.panel -side bottom -fill x -pady 5
pack .ppad.dpanel -side left -fill y
pack .ppad.f -side right -expand 1 -fill both
bind .ppad.f.c <3> {.ppad.f.c delete current}
bind .ppad.f.c <Configure> {.ppad.status.size configure -text "[winfo width .ppad.f.c]x[winfo height .ppad.f.c]"}
bind posupdate <Motion> {spad::update_pos %x %y}
bind posupdate <B1-Motion> {spad::update_pos %x %y}
bindtags .ppad.f.c {posupdate .ppad.f.c .ppad}
### Help text
bind .ppad.dpanel.pointer <Enter> {.ppad.status.bar configure -text "Magic wand. Move a figure by drag and drop."}
bind .ppad.dpanel.freehand <Enter> {.ppad.status.bar configure -text "Tool for free-hand drawings. Press the left mouse button and keep it pressed."}
bind .ppad.dpanel.line <Enter> {.ppad.status.bar configure -text "Draw lines. Keep the left mouse button pressed to draw the line."}
bind .ppad.dpanel.rectangle <Enter> {.ppad.status.bar configure -text "Draw rectangeles. Keep the left mouse button pressed to draw the rectangle."}
bind .ppad.dpanel.circle <Enter> {.ppad.status.bar configure -text "Draw ovals. Keep the left mouse button pressed to draw the oval."}
bind .ppad.dpanel.thickness <Enter> {.ppad.status.bar configure -text "Change the thickness of the pen."}
bind .ppad.panel.pcol <Enter> {.ppad.status.bar configure -text "Change the color of the pen."}
bind .ppad.panel.pbcol <Enter> {.ppad.status.bar configure -text "Change the fill color for rectangles and ovals."}
bind .ppad.f.c <Enter> {.ppad.status.bar configure -text "Scratch Pad. Right click to delete figures, left mouse button to draw figures."}
bind .ppad.status.pos <Enter> {.ppad.status.bar configure -text "Shows x and y position of the pointer."}
bind .ppad.status.size <Enter> {.ppad.status.bar configure -text "Shows canvas size in pixels."}
}
proc spad::pointer {} {
spad::draw_mode pointer
bind .ppad.f.c <ButtonPress-1> {
set startx %x
set starty %y
set seltag [.ppad.f.c gettag current]
puts $seltag}
bind .ppad.f.c <B1-Motion> {
.ppad.f.c move $seltag [expr %x - $startx] [expr %y - $starty]
set startx %x
set starty %y
}
bind .ppad.f.c <ButtonRelease-1> {}
}
proc spad::draw_free {} {
spad::draw_mode freehand
bind .ppad.f.c <ButtonPress-1> {set tempfree [.ppad.f.c create line %x %y %x %y -fill $spad::pcolor -width $spad::thickness]}
bind .ppad.f.c <B1-Motion> {.ppad.f.c coords $tempfree [concat [.ppad.f.c coords $tempfree] %x %y]}
bind .ppad.f.c <ButtonRelease-1> {}
}
proc spad::draw_line {} {
spad::draw_mode line
bind .ppad.f.c <ButtonPress-1> {
set linestartx %x
set linestarty %y
set tline [.ppad.f.c create line $linestartx $linestarty %x %y -width $spad::thickness -fill $spad::pcolor]
}
bind .ppad.f.c <B1-Motion> {.ppad.f.c coord $tline $linestartx $linestarty %x %y}
bind .ppad.f.c <ButtonRelease-1> {.ppad.f.c coord $tline $linestartx $linestarty %x %y}
}
proc spad::draw_rectangle {} {
spad::draw_mode rectangle
bind .ppad.f.c <ButtonPress-1> {
set rectstartx %x
set rectstarty %y
set trect [.ppad.f.c create rectangle $rectstartx $rectstarty %x %y -width $spad::thickness -fill $spad::pbcolor -outline $spad::pcolor]
}
bind .ppad.f.c <B1-Motion> {.ppad.f.c coord $trect $rectstartx $rectstarty %x %y}
bind .ppad.f.c <ButtonRelease-1> {.ppad.f.c coord $trect $rectstartx $rectstarty %x %y}
}
proc spad::draw_circle {} {
spad::draw_mode circle
bind .ppad.f.c <ButtonPress-1> {
set circstartx %x
set circstarty %y
set tcirc [.ppad.f.c create oval $circstartx $circstarty %x %y -width $spad::thickness -fill $spad::pbcolor -outline $spad::pcolor]
}
bind .ppad.f.c <B1-Motion> {.ppad.f.c coord $tcirc $circstartx $circstarty %x %y}
bind .ppad.f.c <ButtonRelease-1> {.ppad.f.c coord $tcirc $circstartx $circstarty %x %y}
}
proc spad::draw_mode {widget} {
.ppad.dpanel.$::spad::currentmode configure -relief raised
.ppad.dpanel.$widget configure -relief sunken
set ::spad::currentmode $widget
}
proc spad::save_can {filename} {
if {[catch {package require Img} err]} {
tk_messageBox -message "Could not load package Img!" -icon error
return
}
set canimg [image create photo -format window -data .ppad.f.c]
if {$filename == ""} {
set filename [tk_getSaveFile -title "Save Scratch Pad" -filetypes "\"{GIF Image} {.gif}\" \"{JPEG Image} {.jpg}\"" -initialdir [pwd] -initialfile "ScratchPad.gif"]
}
if {$filename != ""} {
switch -- [file extension $filename] {
".gif" {set fformat "GIF"}
".jpg" {set fformat "JPEG"}
default {tk_messageBox -title "Unsupported format" -message "Unsupported format.\nPlease use gif or jpg extension.\n" -icon error; return}
}
$canimg write $filename -format $fformat
}
set spad::savename $filename
}
proc spad::update_pos {xp yp} {
set offset 0
set xpos [expr $xp - $offset]
set ypos [expr $yp - $offset]
.ppad.status.pos configure -text "$xpos,$ypos"
}
spad::gui
spad::draw_free
spad::update_pos 0 0
### End of ScriptMG You could consolidate those three procs at the start for changing colours into one if you passed the info that changes (the varname to be set / proc whose colour should be altered / title) as args, to save repeating almost-identical code. Something like this (proc name changed/'if 0' added so it doesn't clash with the real code above) would probably work
if 0 {
proc set_color2 {var widget {keyword "fill"}} {
set newcolor [tk_chooseColor -initialcolor [set $var] -title "Choose new $keyword color"]
if { $newcolor != "" } {
set $var $newcolor
$widget configure -bg $newcolor
}
}
button .panel.pcol -width 3 -bg $::pcolor -relief ridge -command [list set_color2 ::pcolor .panel.pcol pencil]
}MEd 2006/02/23 Thanks for pointing this issue out. I improved the script a little bit, also including your consideration.
