Test Pattern Image Generator

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
 # 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

uniquename 2014jan27

For those who do not have the facilities or time to implement the code above, here is an image of the 'color swatches' that the code creates --- so you can quickly see whether this is a utility that you want to put in your arsenal of color utilities.


OR, simply save this image for future reference. (Note the these columns do not go all the way to 'FF' in each color. You may want to change the script somewhat to generate a range --- and color-spacing --- that you find more useful.)