DimgDemo.tcl

# See <URL: http://wiki.tcl.tk/3440.html
> for details #
 pack [canvas .c -width 340 -height 340 -bg lightblue -highlightthickness 0]
 focus -force .c

 puts "performance benchmark running...."
 image create dimg t -width 320 -height 320 -mask disable -rgb SRCCOPY
 .c create image 170 170 -image t
 set start [clock click -milliseconds]
 for { set j 0 } { $j < 5 } { incr j } {
   for { set i 0 } { $i < 100 } { incr i} {
     t fill rgb gray$i
     update

   }
   for { set i 100 } { $i > 0} { incr i -1} {
     t fill rgb gray$i
     update
   }
 }
 set end [clock click -milliseconds]
 puts "[expr 1000000.0 / ($end - $start) ] frames per second"

 image delete t

 foreach {n x y} {r 20 110 g 120 110 b 70 20 } {
   image create dimg $n -width 200 -height 200 -mask SRCPAINT -rgb dis
   .c create image $x $y -image $n -anchor nw -tag $n
 }

 .c configure -bg black
 foreach {n f} {r red g green b blue} {
   $n configure -mask SRCAND -rgb SRCPAINT
   $n fill mask 7
   $n oval mask 0
   $n fill rgb black
   $n oval rgb $f
 }
 update
 puts "images with transparency"
 after 2500

 .c configure -bg black
 foreach {n f} {r 1 g 2 b 4} {
   $n configure -mask SRCPAINT -rgb dis
   $n fill mask 0
   $n oval mask $f
 }
 update
 puts "additive color merging"
 after 2500

 .c configure -bg white
 foreach {n f} {r 3 g 5 b 6} {
   $n configure -mask SRCAND -rgb dis
   $n fill mask 7
   $n oval mask $f
 }
 update
 puts "subtractive color merging"
 after 2500

 .c configure -bg orange
 foreach {n f} {r 3 g 5 b 6} {
   $n configure -mask SRCINVERT -rgb dis
   $n fill mask 0
   $n oval mask $f
 }
 update
 puts "background inversion"