proc main {} {
    button .a -text Animate -command {animate .c line 50}
    button .+ -text + -command {show .c [lcycle Kanji]}
    button .clear -text C -command {.c delete line; set info ""}
    canvas .c -background white -height 120 -width 120
    doodle .c -width 3 -tag line
    # auxiliary lines, as used in calligraphy schoolbooks
    foreach line {
        {10 10 10 110 110 110 110 10 10 10}
        {10 60 110 60} {60 10 60 110}
        {10 10 110 110} {10 110 110 10}
    } {
        .c create line $line -fill pink -dash .
    }
    label .info -textvar info -width 34
    set ::info "Kanji - how they're written, what they mean"
    grid .a .+ .clear -sticky we
    grid .c    - -
    grid .info - -
}
if 0 {This is a generic "doodling" routine that allows free-hand drawing
with the mouse on the specified canvas. Right-click on a line to delete it.}
proc doodle {w args} {
    bind $w <1> "set ID \[eval %W create line %x %y %x %y $args\]"
    bind $w <B1-Motion> {%W coords $ID [concat [%W coords $ID] %x %y]}
    bind $w <ButtonRelease-1> {%W coords $ID [smoothen [%W coords $ID]]}
    bind $w <3> {%W delete current}
}
if 0 {When doodling with the mouse, x/y positions are collected at a
certain sampling rate, which may produce very many points on slow
movement. The following eliminates redundant "collinear" points:}
proc smoothen xylist {
    foreach {x0 y0 x1 y1} $xylist break
    set res [list $x0 $y0]
    set a1 [expr {atan2($y1-$y0,$x1-$x0)}]
    foreach {x y} [lrange $xylist 4 end] {
        set a2 [expr {atan2($y-$y1,$x-$x1)}]
        if {abs($a1-$a2) > 0.4} {
            lappend res $x $y
            set a1 $a2
        }
        set x1 $x
        set y1 $y
    }
    if [info exists x] {
        lappend res $x $y
    } else {
        concat $res $res ;# for single points
    }
}

if 0 {For the animation, first all items with a specified tag are buffered and
deleted, then slowly redrawn (by appending one set of x/y coordinates
in every step) one by one, the current stroke highlighted
in blue:}
proc animate {w tag delay} {
    set lines {}
    foreach id [$w find withtag $tag] {lappend lines [$w coords $id]}
    $w delete $tag
    foreach line $lines {
        set id [$w create line [lrange $line 0 3] -width 3 \
            -fill blue -tag $tag]
        foreach {x y} [lrange $line 4 end] {
            $w coords $id [concat [$w coords $id] $x $y]
            update
            after $delay
        }
        $w itemconfig $id -fill black
    }
}
#-- serialize the current line set
proc dump {w tag} {
    set res {}
    foreach item [$w find withtag $tag] {lappend res [$w coords $item]}
    string map {.0 ""} $res
}
#-- Display a canned character
proc show {w data} {
    $w delete line
    set ::info [lindex $data 0]
    foreach line [lindex $data 1] {
        $w create line $line -width 3 -tag line
    }
    animate $w line 30
}
proc lcycle listName {
    upvar 1 $listName list
    set res [lindex $list 0]
    set list [concat [lrange $list 1 end] [list $res]]
    set res
}
#-- Some example Kanji (pardon my bad mouse-calligraphy :-)
set Kanji {
    {"C:yi1 J:ichi - one" {{10 60 30 60 50 60 70 60 90 60 110 60}}}
    {"C:zhong1 J:naka,chuu - center, middle" {
        {33 44 33 45 34 45 34 46 36 77 36 79 37 80 37 81}
        {35 45 37 46 42 47 50 45 52 45 55 44 56 44 63 43 65 43 70 43
        80 43 81 44 82 44 89 45 88 46 87 46 84 48 76 63 73 77 73 79
        72 86 72 85} {34 75 71 76 72 76}
        {61 15 60 40 59 78 59 79 59 104}
    }}
    {"C:guo2 - J:koku,kuni - country" {
        {15 14 15 15 16 15 16 18 14 102} {19 14 92 13 90 27 90 29 94 66
        95 78 97 85 97 86 96 91 96 92 95 97 95 98 95 101} {28 34 38 36
        42 37 55 35 57 35 59 34 60 34 62 33 63 33 72 34 73 34 76 33 77 33}
        {29 56 32 55 38 54 44 56 45 56 48 57 50 57 86 60} {52 34 52 35
        52 88 53 88} {61 67 63 68 65 71 66 73 68 77 69 78 72 83 72 83}
        {27 90 29 89 31 89 43 90 44 90 62 89 63 89 66 88 67 88 76 89
        77 89 76 89} {14 101 47 102 48 102 54 101 57 100 70 101 76 100
        77 100 79 99 82 98 90 96 91 96 92 97 93 97 93 98 94 98 93 98 92 99}
    }}
    {"C:shi2 J:juu - ten" {
        {10 55 30 60 50 60 70 60 90 60 110 60}
        {60 10 60 30 60 50 60 70 60 90 60 110}
    }}
    {"C:ren2 J:jin,hito - man, human" {
        {61 14 61 15 57 40 21 101 20 103 19 104 19 105}
        {58 46 58 47 61 60 62 63 63 65 76 86 78 87 79 89 88 97 95 102
        96 103 97 103 98 103}
    }}
    {"C:tian1 J:ten - heaven" {
    {19 13 31 14 32 14 48 16 50 16 55 15 59 15 72 14 73 14 91 13 92 13 94 12 94 12}
    {12 57 12 58 13 58 14 59 18 59 100 58 101 58 106 57 107 57 110 56 111 56 111 56}
    {62 16 62 17 60 58 60 59 59 62 59 64 58 65 57 67 54 72 51 76 49 78 48 80 48
    81 47 82 44 84 42 86 40 87 37 90 34 91 33 92 32 92 30 93 28 94 27 95 26 95
    25 96 24 96 23 97 22 97 21 98 18 100 18 100} {62 61 62 62 63 62 66 72 68
    74 80 87 81 88 83 89 84 91 86 92 87 93 89 94 90 95 92 96 93 97 94 97 95 98
    96 98 96 99 97 99 98 100}
    }}
    {"C:da4 J:dai - big, great" {
    {12 57 12 58 13 58 14 59 18 59 100 58 101 58 106 57 107 57 110 56 111 56}
    {62 16 62 17 60 58 60 59 59 62 59 64 58 65 57 67 54 72 51 76 49 78 48 80 48
    81 47 82 44 84 42 86 40 87 37 90 34 91 33 92 32 92 30 93 28 94 27 95 26 95
    25 96 24 96 23 97 22 97 21 98 18 100} {62 61 62 62 63 62 66 72 68
    74 80 87 81 88 83 89 84 91 86 92 87 93 89 94 90 95 92 96 93 97 94 97 95 98
    96 98 96 99 97 99 98 100}
    }}
    {"C:xiao3 - J:chiisai - small, little" {
        {62 20 62 21 61 26 61 27 60 37 60 39 61 74 61 76 62 81 62 82 63 84 63 85
        63 97 62 95 61 95 61 94 59 93 57 93 57 93 57 92 55 91 54 91 53 90 53 89
        52 88 51 86 50 86 50 85 49 85 48 85} {46 45 46 46 45 47 44 47 40 49 38
        50 37 50 37 51 36 51 35 52 17 65 16 66 14 69 15 69 15 71 16 71 16 71}
        {79 47 79 48 83 50 88 52 89 53 96 61 97 61 98 63 99 67 100 67 100 68
        101 70 102 75 102 76}
    }}
    {"C:kou3 J:guchi - mouth" {
        {25 22 26 23 27 41 27 44 34 97 34 98}
        {28 21 93 25 94 25 95 24 96 24 97 23 98 23 97 26 89 98}
        {36 93 90 93 89 93 89 92 88 92}
    }}
    {"C:ri4 J:nichi - Sun, day" {
        {25 22 26 23 27 41 27 44 34 97 34 98}
        {28 21 93 25 94 25 95 24 96 24 97 23 98 23 97 26 89 98}
        {34 62 88 65 89 65 91 65} {36 93 90 93 89 93 89 92 88 92}
    }}
    {"C:ben3 J:hon,moto - root, origin" {
        {21 29 92 33 93 33 99 32} {62 10 63 11 64 93 64 95 64 100}
        {60 33 60 34 61 34 60 35 56 44 54 46 54 48 53 50 41 65 28 74 27 75 24
        80 23 80 23 81 22 82 21 82 21 83 20 85} {67 35 68 36 69 43 73 51
        74 53 76 54 77 56 80 58 80 59 81 60 82 63 83 63 83 64 85 65 93 72 94
        72 95 74 96 74 97 76 98 76 98 77 99 77 99 78 100 79 100 80 101 80 103
        83 105 85} {51 76 74 78 77 78 79 79 80 79}
    }}
    {"C:shan1 J:yama,san - mountain" {
        {60 12 60 13 58 87 58 90 57 94 57 96 57 97} {20 52 20 53 21 55 22 59
        22 88 21 93 20 94 20 95 19 98 19 99 20 100 22 100 29 99 30 99 31 98
        32 98 34 97 35 97 37 96 38 96 40 95 41 95 72 95 73 95 74 94 75 94 76
        93 78 93 80 92 83 91 87 90 88 90 88 91 89 91 89 92 89 91}
        {89 45 89 46 90 95 90 96 90 98}
    }}
}
#-------------------------------------------------------- 
main
show .c [lcycle Kanji]
bind . <Escape> {exec wish $argv0 &; exit}
bind . <F1> {console show; puts [dump .c line]}