if 0 {[Richard Suchenwirth] 2005-05-16 - Here's another [canvas]
animation, as may be known from movies. An iris (or diaphragm) is
basically a hole whose size can be changed. People have irises in the
middle of the eyes (seen from front), cameras have them in the objective
to control the amount of light that comes in. The following canvas
animation creates a square polygon with a round hole in the middle (see
[Polygon clipping] for how that's done), and in a timed loop reduces the
size of the hole until it is too small.

[http://mini.net/files/iris.jpg]
}
 proc main {} {
    set w .c
    pack [canvas $w] -fill both -expand 1
    $w create text 189 132 -text "Hello, world!"
    iris $w 0 0 [$w cget -width] [$w cget -height] 100
 }
if 0 {The iris command first constructs the smallest circle that fully
encloses the given rectangle (normally, the canvas itself), and creates
a square polygon which, will enclose
the round hole. It then starts the timed animation.}
 proc iris {w xa ya xb yb ms} {
    set radius [expr {hypot($ya-$yb,$xa-$xb)/2}]
    set xm [expr {($xa + $xb)/2.}]
    set ym [expr {($ya + $yb)/2.}]
    set x0 [expr {$xm - $radius}]
    set x1 [expr {$xm + $radius}]
    set y0 [expr {$ym - $radius}]
    set y1 [expr {$ym + $radius}]
    set frame [list $x0 $y0 $x1 $y0 $x1 $y1 $x0 $y1]
    set id [$w create poly $frame -fill black]
    iris'close $w $id $radius $xm $ym $ms
 }
if 0 {This draws the iris hole by clipping a 32-gon with given radius
from the enclosing frame:}
 proc iris'set {w tag radius xm ym} {
    set frame [lrange [$w coords $tag] end-7 end]
    set iris {}
    for {set i 0} {$i<32} {incr i} {
        set angle [expr {acos(-1)*$i/16}]
        lappend iris [expr {$xm + $radius * cos($angle)}]
        lappend iris [expr {$ym + $radius * sin($angle)}]
    }
    $w coords $tag [poly'clip $frame $iris]
 }
if 0 {This reduces the radius by a certain amount and redraws the iris.
This is continued in ''ms'' millisecond intervals until the radius is
small enough that the hole appears fully closed.}
 proc iris'close {w tag radius xm ym ms} {
    if {$radius > 0} {
        iris'set $w $tag $radius $xm $ym 
        after $ms [list iris'close $w $tag [expr {$radius-2}] $xm $ym $ms] 
    }
 }
#-- code borrowed from [Polygon clipping]
  proc poly'clip {p1 p2} {
     set p2_ {}
     foreach {x y} $p2 {set p2_ [linsert $p2_ 0 $x $y]}
     concat [lrange $p1 0 1] [lrange $p2 0 1] $p2_ $p1
 }
#-- Testing the "hole" thing:
 main
if 0 {
----
[Category Animation] - [Arts and crafts of Tcl-Tk programming]
}