Version 3 of A symmetric doodler
Updated 2002-07-12 16:40:58
Richard Suchenwirth - 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!
proc main {} {
set size 400 ;# canvas height and width
set axiscolor grey
set bg white
global g
set size2 [expr {$size/2}]
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 black} {
radiobutton .f.b$color -width 1 -padx 0 -pady 0 -bg $color \
-variable g(color) -value $color
}
set g(color) black
button .f.c -text C -width 3 -command {.c delete line}
eval pack [winfo children .f] -side left -fill y
symdoodle [canvas .c -height $size -width $size -bg $bg]
.c config -scrollregion [list -$size2 -$size2 $size2 $size2]
.c create line -$size2 0 $size2 0 -fill $axiscolor
.c create line 0 -$size2 0 $size2 -fill $axiscolor
eval pack [winfo children .] -fill x
wm resizable . 0 0
}
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}
}
proc symdoodle'start {w x y} {
global g
set x [$w canvasx $x]
set y [$w canvasx $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
]
}
}
proc symdoodle'move {w x y} {
global g
set x [$w canvasx $x]
set y [$w canvasx $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
}
}
}
main