[http://mini.net/files/symdoodle.jpg]

[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
----
[Arts and crafts of Tcl-Tk programming]