##+##########################################################################
#
# Animated Circles.tcl
# by Keith Vetter
#
package require Tk
array set S {step 1 delay 25 stop 0}
proc Expand {xy d} {
foreach {x0 y0 x1 y1} $xy break
list [expr {$x0-$d}] [expr {$y0-$d}] [expr {$x1+$d}] [expr {$y1+$d}]
}
proc Recenter {W h w} {
set h [expr {$h / 2.0}] ; set w [expr {$w / 2.0}]
$W config -scrollregion [list -$w -$h $w $h]
}
proc Step {} {
foreach tag [.c find withtag o] {
set xy [Expand [.c coords $tag] $::S(step)]
.c coords $tag $xy
}
if {[lindex [.c coords o$::S(smallest)] 2] < 10} return
set biggest [expr {($::S(smallest) - 1) % $::S(cnt)}]
.c coords o$biggest {0 0 0 0}
set ::S(smallest) $biggest
}
proc Animate {} {
if {$::S(stop)} return
Step
after $::S(delay) Animate
}
wm title . "Animated Circles"
canvas .c -bg blue -width 400 -height 200 -highlightthickness 0
pack .c -fill both -expand 1
bind .c <Configure> {Recenter %W %h %w}
bind all <Key-F2> {console show}
set r [expr {int(1+hypot([winfo screenwidth .]/2,[winfo screenheight .]/2)/10)}]
set xy [list 0 0 0 0]
for {set i 0} {$i <= $r} {incr i} {
.c create oval $xy -outline green -width 5 -tag [list o o$i]
set xy [Expand $xy 10]
}
set S(smallest) 0
set S(cnt) [llength [.c find withtag o]]
.c create text 0 0 -anchor c -fill red -font {Helvetica 36 bold} -text "Welcome to\nTcl/tk" -justify center
Animate
returnAMG: AAUGH IT'S DOING THINGS TO MY MIND!!Heh, it would be double awesome if you could have a second set of concentric circles, contracting instead of expanding, clipped to the text.DKF: The canvas doesn't support arbitrary clipping, so that's tricky. Indeed, it doesn't support clipping at all; you'd have to add that using an extension (such as my shape extension, which does (widget) clipping by text among other things, and which IIRC comes with a demo showing how to do such clipping).uniquename 2013jul29This code could use an image to show what it produces:
Gerhard Reithofer 2017-05-11I was asked if it is possible to create an "animated widget" in TCL like it is used in modern GUIs. I tried to create a typical radio-like symbol as it is used often for WLANs.The result: Screenshot of the animated widget. Small circles fade in at first and increase their radius until they fade out.
##+##########################################################################
#
# dynwidget.tcl
# by Gerhard Reithofer
#
package require Tk 8.5
namespace eval DynWidget {
variable widget ; # canvas to draw on
variable lwidth 5 ; # drawing line width
variable dcolor "grey" ; # drawing color
variable bckgnd "white" ; # background color
variable jstyle "round" ; # line join style
variable rad ; # radius variation values
variable col ; # color variation values
variable t_font {Helvetica 14 bold}
variable version "0.2"
# wave radius values
set rad {10 20 30 40 50}
# circle fading colors (delta rad entries)
set col {
#707070 #808080 #909090 #a0a0a0 #b0b0b0
#c0c0c0 #d0d0d0 #e0e0e0 #f0f0f0 #ffffff
}
# coord components and simple item identifying method
proc CX {vec} {return [lindex $vec 0]}
proc CY {vec} {return [lindex $vec 1]}
proc ID {typ name} {return "${typ}_${name}"}
# create canvas to draw on
proc painton {w size} {
variable widget
variable bckgnd
# create canvas to paint on
set opts [list -width [CX $size] -height [CY $size] -bg $bckgnd]
pack [set widget [canvas $w.c {*}$opts]]
# returning center of the canvas
return [lmap p {width height} {expr [$widget cget -$p]/2}]
}
# create or set item properties for $cid
proc dataof {cid typ coords args} {
variable widget
# search or create object
set item [$widget find withtag $cid]
if {$item eq ""} {
set item [$widget create $typ $coords -tags $cid]
} else {
$widget coords $item $coords
}
# apply the changing options ...
$widget itemconfigure $item {*}$args
return $item
}
# draw or modify circle $cid
proc circle {cid x y r col} {
variable lwidth
set opts [list -width $lwidth -outline $col]
set coords [list [expr {$x-$r}] [expr {$y-$r}]\
[expr {$x+$r}] [expr {$y+$r}]]
return [dataof [ID "wave" $cid] oval $coords {*}$opts]
}
# draw or modify triangle $cid
proc tower {cid top hgt wh} {
variable bckgnd
variable dcolor
variable lwidth
variable jstyle
set opts [list -fill $bckgnd -width $lwidth\
-outline $dcolor -joinstyle $jstyle]
lappend top [expr {[CX $top] - $wh}] $hgt
lappend top [expr {[CX $top] + $wh}] $hgt
return [dataof [ID "tower" $cid] polygon $top {*}$opts]
}
# draw or modify text $cid
proc gtext {cid coords txt} {
variable t_font
set opts [list -font $t_font -text $txt -justify center]
return [dataof [ID "text" $cid] text $coords {*}$opts]
}
# draw or modify circles (i. e. animation)
proc wave {cx cy wait} {
variable widget
variable rad
variable col
set rmax [expr {[llength $rad]-1}]
set cmax [expr {[llength $col]-1}]
for {set ci 0} {$ci <= $cmax} {incr ci} {
set co [expr {$cmax - $ci}]
for {set ri 0} {$ri <= $rmax} {incr ri} {
set r [expr {[lindex $rad $ri] + $ci}]
switch $ri 0 {set ca [lindex $col $co] ; # fade in
} $rmax {set ca [lindex $col $ci] ; # fade out
} default {set ca [lindex $col 0]}
# draw/modify circle with new radius $r and color $ca
set item [circle $ri $cx $cy $r $ca]
$widget lower $item
update
}
after $wait
}
}
# initialize basic graphics
proc setup {w c_size t_size} {
set cp [painton $w $c_size]
tower "tower" $cp [CX $t_size] [CY $t_size]
return $cp
}
}
set cnv_size {320 240}
set tower_sz {230 30}
set tx_title "Press Esc to exit ..."
set waitmsec 100
wm title . "DynWidget $DynWidget::version"
bind . <Escape> {exit 0}
set cp [DynWidget::setup "" $cnv_size $tower_sz]
if {$tx_title ne ""} {
DynWidget::gtext "title" [list [DynWidget::CX $cp] 20] $tx_title
}
while {true} {
DynWidget::wave [DynWidget::CX $cp] [DynWidget::CY $cp] $waitmsec
}