![](http://perso.wanadoo.fr/maurice.ulis/tcl/color_image.gif)
The scripts
# size set size 128 package require Tk # create image image create photo img -width $size -height $size # put colors if 1 \ { # compute colors set pixels {} set k [expr {128.0 / $size}] for {set i 0} {$i < $size} {incr i} \ { set row {} for {set j 0} {$j < $size} {incr j} \ { set R [expr {int($i * 2 * $k)}] set G [expr {int(($i + $j) * $k)}] set B [expr {int($j * 2 * $k)}] lappend row [format #%02x%02x%02x $R $G $B] } lappend pixels $row } img put $pixels # save image img write test.ppm -format ppm } \ else \ { # read image img read test.ppm } # set transparency set s2 [expr {$size / 2}] for {set i 0} {$i < $s2} {incr i} \ { set i2 [expr {$s2 - $i}] for {set j 0} {$j < $size} {incr j} \ { if {$j > $i2 && $j < $size - $i2} { img transparency set $j $i 1 } } } for {} {$i < $size} {incr i} \ { set i2 [expr {$i - $s2}] for {set j 0} {$j < $size} {incr j} \ { if {$j > $i2 && $j < $size - $i2} { img transparency set $j $i 1 } } } # display image wm title . color incr size 8 canvas .c -width $size -height $size -bg azure .c create image 6 6 -anchor nw -image img pack .cSee also
- DKF: Note that these sorts of techniques are used in Functional Imaging