Version 3 of Iris animation

Updated 2005-05-17 05:32:59

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 seems to disappear.

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 frame 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 }