Richard Suchenwirth 2003-11-01: When learning Chinese characters (ch.
hanzi, jp.
kanji, kor.
hanja), one important aspect is the "stroke order", the sequence in which to write them, stroke by stroke. That's because the characters are easier read even when scribbled quickly, as long as writer and reader agree on the same stroke order for a given character. (There are differences in "standard" stroke order between China and Japan). This weekend fun project demonstrates stroke order by animating it on a canvas.
Description edit
Even if you're not interested in Kanji, you might reuse part of this code, e.g. to animate a route on a map. But if you are, this program includes a few demo Kanji with notes on pronunciation (C: Chinese, J: Japanese) and meaning. Browse through them with the "+" button. "Animate" draws the current character in slow motion. You can also draw whatever you like, and clear the canvas with "C".
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]}
