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.)
##+##########################################################################
#
# 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