Keith Vetter 2005-12-13 : Here's a fun little program that animates the morphing of some text.
Originally I wanted to morph on the fly but that was too slow. So instead I prebuilt all the images I need before starting the animation.
The program will morph whatever is in the photo image ::img::src, which, in this demo, is the contents of a label widget. If you just modify the code and change what is in ::img::src you can morph anything. (For grins, try morphing the bitmap of John Ousterhout which is in the tk demo directory.)
Jeff Smith 2021-03-30 : Below is an online demo using CloudTk. This demo runs "Wavy Text" in an Alpine Linux Docker Container. It is a 28MB image which is made up of Alpine Linux + tclkit + Wavy-Text.kit + libx11 + libxft + fontconfig + ttf-linux-libertine. It is run under a user account in the Container. The Container is restrictive with permissions for "Other" removed for "execute" and "read" for certain directories.
##+########################################################################## # # Wavy Text # by Keith Vetter, December, 2005 # package require Tk package require Img set S(txt) "Hello, world!" set S(font) {Times 64 bold} set S(step) 10 ;# Step size in sin function set S(scale) 5 ;# How far to shift image set S(angle) 0 ;# Starting angle set S(delay) 10 ;# How often to draw image set S(kill) 0 ;# Stops animation set S(rad) [expr {acos(-1) / 180}] proc MovePix {angle} { global S set iname ::img::dst($angle) if {[lsearch [image names] $iname] > -1} return ;# Is it already done? image create photo $iname -width $S(w) -height $S(h) for {set col 0} {$col < $S(w)} {incr col} { set dcol [::img::src data -from $col 0 [expr {$col+1}] $S(h)] set dy [expr {sin($angle * $S(rad)) + 1}] ;# 0-2 range set dy [expr {int($dy * $S(scale) + .5)}] ;# 0-scale range set dcol [RotateList $dcol $dy] $iname put $dcol -to $col 0 set angle [expr {$angle + $S(step)}] } } proc RotateList {l n} { set n [expr {$n % [llength $l]}] return [concat [lrange $l $n end] [lrange $l 0 [expr {$n-1}]]] } proc Animate {{start 0}} { if {$start} {set ::S(kill) 0} if {$::S(kill)} return .l config -image ::img::dst($::S(angle)) set ::S(angle) [expr {($::S(angle) + $::S(step)) % 360}] after $::S(delay) Animate } wm title . "Wavy Text" bind all <1> {set ::S(kill) 1} label .l -text " $S(txt) " -font $S(font) -fg red -bg black -bd 0 label .msg -textvariable S(msg) -bd 2 -relief ridge pack .l .msg -side top -fill x update image create photo ::img::src -data .l set S(w) [image width ::img::src] set S(h) [image height ::img::src] image create photo ::img::dst -width $S(w) -height $S(h) for {set i 0} {abs($i) <= 360} {incr i $S(step)} { set ia [expr {abs($i)}] set S(msg) "building images: $ia/360" update MovePix $ia } set S(msg) "" set S(step) [expr {-$S(step)}] Animate 1 return