- 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, [email protected] # 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([email protected])"} .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 Script
MG 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.
