Iris animation

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.

#! /bin/env tclsh

package require Tk

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

Category Animation

Arts and crafts of Tcl-Tk programming