Richard Suchenwirth 2002-01-15 - This breakfast fun project allows symmetric doodling (free-hand drawing) on a
canvas. Besides drawing a line (in selectable color) at cursor position, horizontally and/or vertically mirrored lines are also drawn. Delete a line with right mousebutton, or all with the C button. Enjoy!
KPV Fun. I modified it slightly (in place) so that you can resize it and by right clicking on a color, you can change the background.
KPV My 3 year old daughter requested fatter lines, so I added the ability to select the pen size.
GPS Thanks Richard and Keith for sharing this. I like it and so does my brother. My brother wants the ability to save images, so maybe I'll play around with Img and improve this.
MPJ After showing this to my son he wanted to play with it on my
PocketPC so I resized it and added some menus. Here is my version, called iDoodle [
1], and a screen shot of it running on my HP Jornada.
package require Tk
proc main {} {
set size 400 ;# canvas height and width
set axiscolor grey
set bg white
global g
frame .f -relief sunken -borderwidth 2
checkbutton .f.hori -text -- -variable g(hori)
set g(hori) 1
checkbutton .f.vert -text | -variable g(vert)
set g(vert) 1
foreach color {purple red orange yellow green blue white black} {
radiobutton .f.b$color -width 1 -padx 0 -pady 0 -bg $color \
-variable g(color) -value $color
bind .f.b$color <3> [list .c config -bg $color]
}
set g(color) black
button .f.c -text C -width 3 -command {.c delete line}
frame .f.f -bd 2 -relief raised
label .f.f.lbl -text "Pen Size" -bd 0
tk_optionMenu .f.f.w g(w) 1 3 5 7 9 20
.f.f.w config -highlightthickness 0 -bd 0
set g(w) 3
eval pack [winfo children .f] -side left -fill y
eval pack [winfo children .f.f] -side left -fill y
symdoodle [canvas .c -height $size -width $size -bg $bg]
.c create line -4000 0 4000 0 -fill $axiscolor
.c create line 0 -4000 0 4000 -fill $axiscolor
pack .f -side top -fill x
pack .c -side top -fill both -expand 1
}
proc symdoodle w {
bind $w <1> {symdoodle'start %W %x %y}
bind $w <B1-Motion> {symdoodle'move %W %x %y}
bind $w <3> {%W delete current}
bind $w <Configure> {symdoodle'center %W %h %w}
}
proc symdoodle'start {w x y} {
global g
set x [$w canvasx $x]
set y [$w canvasy $y]
readCheckbuttons
set g(ids) {}
foreach {xf yf} $g(todo) {
set x1 [expr {$x*$xf}]
set y1 [expr {$y*$yf}]
lappend g(ids) [
$w create line $x1 $y1 $x1 $y1 -fill $g(color) -tag line -width $g(w)
]
}
}
proc symdoodle'move {w x y} {
global g
set x [$w canvasx $x]
set y [$w canvasy $y]
foreach {xf yf} $g(todo) id $g(ids) {
set x1 [expr {$x*$xf}]
set y1 [expr {$y*$yf}]
eval $w coords $id [concat [$w coords $id] $x1 $y1]
}
}
proc readCheckbuttons {} {
global g
set g(todo) [list 1 1]
if {$g(hori)} {lappend g(todo) 1 -1}
if {$g(vert)} {
foreach {xf yf} $g(todo) {
lappend g(todo) [expr {-$xf}] $yf
}
}
}
proc symdoodle'center {W h w} {
set h [expr {$h / 2.0}]
set w [expr {$w / 2.0}]
$W config -scrollregion [list -$w -$h $w $h]
}
main
