This is a simple Test Pattern Image Generator that I (Andy Gaskell) did. I take a set of parameters and generates a canvas and a tiff and bitmap. We were doing hardware debug on a DVI product and needed a wide variety of test images with various hues and colours, so I wrote this script to generate the test image files. I creates three columns, Red, Green and Blue with the tint changing from top (darkest) to bottom (lightest).
The whole code is just pasted in below, it's got a fair few comments in, but any bits that don't make sense, just add a question.
# Simple script to create test images
# andy gaskell 11/07/2006
# test_image_creator.tcl
#load image package
package require Img
# user configurable vars
set topcolor 127 ;# top value of colors to go up to (max 256)
set incrcolor 4 ;# how many color numbers will each band vary from the previous one
set spreaddif 18 ;# heigth of the stripes of color
set outputfilename "test_image" ;# output file name
# util vars
set count 0
set spreadcount 1
# GUI setup
wm title . "Test Image Creator"
wm minsize . 800 600
wm maxsize . 800 600
frame .w
canvas .w.image -width 800 -height 600 -background black
pack .w.image
pack .w
.w.image create rect 0 0 800 600 -fill black
# loop making the image
while { $count < $topcolor } {
# setup the x and y vals for the top left and bottom right corners
set col1x1 1
set col1x2 266
set col1y1 $spreadcount
set col1y2 [ expr $spreadcount + $spreaddif ]
set col2x1 267
set col2x2 532
set col2y1 $spreadcount
set col2y2 [ expr $spreadcount + $spreaddif ]
set col3x1 533
set col3x2 798
set col3y1 $spreadcount
set col3y2 [ expr $spreadcount + $spreaddif ]
# set the colors
set redvar [format "#%.2X%.2X%.2X" $count 0 0]
set greenvar [format "#%.2X%.2X%.2X" 0 $count 0]
set bluevar [format "#%.2X%.2X%.2X" 0 0 $count]
# create the colored boxes
.w.image create rect $col1x1 $col1y1 $col1x2 $col1y2 -fill $redvar
.w.image create rect $col2x1 $col2y1 $col2x2 $col2y2 -fill $greenvar
.w.image create rect $col3x1 $col3y1 $col3x2 $col3y2 -fill $bluevar
# add text to the canvas
.w.image create text [ expr $col1x1 + 140 ] [ expr $col1y1 + [ expr $spreaddif / 2 ] ] -text "line: [ expr $count / $incrcolor ], colour: $redvar" -justify left -fill white -font -adobe-helvetica-medium-r-normal-*-10-80-100-100-p-56-iso8859-1
.w.image create text [ expr $col2x1 + 140 ] [ expr $col2y1 + [ expr $spreaddif / 2 ] ] -text "line: [ expr $count / $incrcolor ], colour: $greenvar" -justify left -fill white -font -adobe-helvetica-medium-r-normal-*-10-80-100-100-p-56-iso8859-1
.w.image create text [ expr $col3x1 + 140 ] [ expr $col3y1 + [ expr $spreaddif / 2 ] ] -text "line: [ expr $count / $incrcolor ], colour: $bluevar" -justify left -fill white -font -adobe-helvetica-medium-r-normal-*-10-80-100-100-p-56-iso8859-1
# increment the counts
set count [ expr $count + $incrcolor ]
set spreadcount [ expr $spreadcount + $spreaddif ]
}
# make sure the GUI updates
update
# grab the contents of the canvas canvas into photo image testimage.
set testimage [ image create photo -format window -data .w.image ]
# write the file(s)
$testimage write -format bmp $outputfilename.bmp
$testimage write -format tiff $outputfilename.tif
# pop a box
tk_messageBox -message " Done \n $outputfilename created \n " -type ok -title "Done" -icon info