[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!
[WikiDbImage symdoodle.jpg]
[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 [http://mywebpages.comcast.net/jakeforce/iDoodle.tcl], and a screen shot of it running on my HP Jornada.
[http://mywebpages.comcast.net/jakeforce/iDoodle.jpg]----
[Jeff Smith] 2019-09-02 : Below is an online demo using [CloudTk]
<<inlinehtml>>
<iframe height="500" width="500" src="https://cloudtk-app.tcl-lang.org/cloudtk/VNC?session=new&Tk=A-symmetric-doodler" allowfullscreen></iframe>
<<inlinehtml>>
----
======
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
======
<<categories>> Arts and crafts of Tcl-Tk programming | Games | Graphics | Application