[Richard Suchenwirth] 2006-02-10 - Just for the fun, during a lengthy build, I contributed yet another plugin for [Sepp] for [eTcl] on [PocketPC] (but runnable anywhere): a little doodler, where you can select color and linewidth. Maybe I'll need it for a quick sketch (or a bored kid) sometimes...

[WikiDbImage doodle.jpg]
----
 proc doodle {} {
   set w  .canvas
   if ![winfo exists $w] {
      toplevel    $w
      wm geometry $w 240x268
      wm title    $w Canvas
      pack [canvas $w.c -bg white] -fill both -expand 1
      doodle'bind   $w.c
      interp alias {} c {} $w.c
      palette $w.c
      set ::color black; set ::width 1
   }
   wm deiconify $w; focus -force $w
 }
 proc palette w {
   set x 5; set y 5
   foreach color {black blue cyan green yellow orange red magenta} {
      $w create oval $x $y [expr $x+12] [expr $y+12] -fill $color -tag pal
      incr x 14
   }
   incr y 7
   $w bind pal <1> {palette'color %W}
   foreach width {1 2 3 4 5 6 7 8} {
      $w create line $x $y [expr $x+10] $y -width $width -tag width
      incr x 12
   }
   $w bind width <1> {palette'width %W}
   incr x 5
   $w create text $x $y -text C -tag clear
   $w bind clear <1> {%W delete line}
 }
 proc palette'color w {
    $w itemconfig pal -width 1
    $w itemconfig current -width 3
    set ::color [$w itemcget current -fill]
 }
 proc palette'width w {
    $w itemconfig width -fill black
    $w itemconfig current -fill red
    set ::width [$w itemcget current -width]
 }
 proc doodle'bind w {
    bind $w <1>         [list doodle'start %W %x %y]
    bind $w <B1-Motion> {doodle'move %W %x %y}
 }
 proc doodle'start {w x y} {
      if {$y<20} return ;# don't write on the palette
        set ::_id [$w create line $x $y $x $y \
        -fill $::color -width $::width -tag line]
 }
 proc doodle'move {w x y} {
      if {$y<20} return ;# don't write on the palette
        $w coords $::_id [concat [$w coords $::_id] $x $y]
 }
#-- Self-test when sourced alone:
 if {[file tail [info script]] eq [file tail $argv0]} {
    wm withdraw .; doodle
 }

----
[Category Graphics]