Generating a color image

ulis, 2003-09-12. How to create, compute, fill, save, read, set transparency, display a color image.

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 .c

See also