Updated 2012-11-21 23:44:35 by RLE (Redirected from SymDoodle)

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