[Richard Suchenwirth] - As another weekend fun project, here's flag
signalling in Tcl/Tk (not the colorful kind, where each
flag stands for a letter, but the moving type, where a signal mate holds two
flags in different angles to represent letters). You see the mate in the
bigger window, and can type in messages in the entry below, which he will
signal when clicking on "Go" (or hit <Return>). Apart from the fun, this
is an exercise in smooth rotation, to make the animation look more
realistic (also note the mate's grin ;-).
http://www.anbg.gov.au/flags/semaphore.html is an Australian spec of the system, officially called "Semaphore". "International Code of Signals", U.S. Pub 102 (NIMA), is at [http://164.214.12.145/pubs/pubs_j_show_sections.html?dpath=ICOS&ptid=7&rid=242].
----
 package require Tk
 proc flagman {} {
    wm title . "Flag Signals"
    set ::rangle 0; set ::langle 0
    set c [canvas .c -width 250 -height 250 -bg steelblue3]
    entry .e -textvar msg
    set ::msg "Hello Tcl and Tk world"
    bind  .e <Return> {flagman'signal .c $msg}
    focus .e
    button .go -text Go -command {flagman'signal .c $msg} -pady 0
    grid .c -
    grid .e .go -sticky news

    $c config -scrollregion {-125 -100 125 150}
    $c create rect {-125 50 125 150} -fill grey -outline grey
    $c create poly {-20 100 -5 100 0 50 5 100 20 100 20 -4 0 -10
        -20 -4} -fill white
    $c create oval {-10 -29 10 -5} -fill orange  -outline orange
    $c create line {-4 -20 -4 -17}
    $c create line {4  -20  4 -17}
    $c create arc -6 -24 6 -10 -start 220 -extent 120 -style arc -tag grin
    $c create rect {-9 -29 9 -24} -fill white -outline white
    $c create poly -25 45 -25 57 -15 57 -15 45 -smo 1 -fill orange -tag right
    $c create poly {-25 0 -25 48 -15 48 -15 0 -20 -5} -fill grey95 -tag right
    $c create poly {-21 50 -21 90 -19 90 -19 50} -fill brown -tag right
    $c create poly {-21 88 -21 60 21 60 21 88} -fill blue -tag {right rflag}
    $c create poly {-14 81 -14 67 12 67 12 81} -fill white -tag {right rflag}
    $c create poly 25 45 25 57 15 57 15 45 -smooth 1 -fill orange -tag left
    $c create poly {25 0 25 48 15 48 15 0 20 -5} -fill grey95 -tag left
    $c create poly {21 50 21 90 19 90 19 50} -fill brown -tag left  
    $c create poly {21 88 21 60 -19 60 -19 88} -fill blue  -tag {left lflag}
    $c create poly {14 81 14 67 -12 67 -12 81} -fill white -tag {left lflag} 
 }
 proc flagman'signal {w msg} {
    global langle rangle
    array set map {
        A {1 0} B {2 0} C {3 0} D {4 0} E {0 3} F {0 2} G {0 1}
        H {2 7} I {3 7} J {4 2} K {1 4} L {1 3} M {1 2} N {1 1}
        O {3 6} P {2 4} Q {2 3} R {2 2} S {2 1} T {3 4} U {3 3}
        V {4 1} W {6 3} X {7 3} Y {3 2} Z {7 2} " " {0 0}
    }
    regsub -all {[^A-Z ]} [string toupper $msg] "" msg
    $w lower grin
    foreach char [split "$msg " ""] {
        wm title . $char
        foreach {right left} $map($char) break
        smooth'rotate $w right [expr {($right-$rangle)*45}] -20 0
        set rangle $right
        smooth'rotate $w left  [expr {($left-$langle)*-45}] 20 0
        set langle $left
        after 1000
    }
    $w raise grin
    wm title . "Flag Signals"
 }
 proc smooth'rotate {w tag angle x0 y0} {
    if {abs($angle)>180} {
        set angle [expr {(360-abs($angle))*-[sgn $angle]}]
    } ;# select shortest path around the circle
    if {[set n [expr {abs($angle)/5.}]]} {
        set smoothangle [expr {$angle/$n}]
        for {set i 0} {$i<$n} {incr i} {
            rotate $w $tag $smoothangle $x0 $y0
            flag'hang $w lflag rflag
            update idletasks
        }
    }
 }
 proc flag'hang {w args} {
    foreach tag $args {
        $w raise $tag
        set item [lindex [$w find withtag $tag] 0]
        set c  [$w coords $item]
        set y1 [lindex $c 1]
        set y2 [lindex $c end]
        set xm [expr {([lindex $c 0]+[lindex $c 2])/2.}]
        if {$y2<$y1} {
            set ym [expr {([lindex $c 1]+[lindex $c 3])/2.}]
            rotate $w $tag 180 $xm $ym
        }
        if {abs($xm-[lindex $c 0])<.01} {$w lower $tag}
    }
 }
 proc sgn x {expr {$x>0? 1: $x<0? -1: 0}}
 proc rotate {w tag angle x0 y0} {
    foreach item [$w find withtag $tag] {
        set diff [expr {$angle * atan(1)/45.}]
        set points {}
        foreach {x y} [$w coords $item] {
            set rad [expr {hypot($x-$x0,$y-$y0)}]
            set th  [expr {atan2($y-$y0, $x-$x0)}]
            set x [expr {$x0+cos($th+$diff)*$rad}]
            set y [expr {$y0+sin($th+$diff)*$rad}]
            lappend points $x $y
        }
        $w coords $item $points
    }
 }
 #---------------------
 flagman
 bind . <Escape> {exec wish $argv0 &; exit}
----
''I added "package require Tk", hope that's ok with you -jcw''