Merge commit '60d692811c12788ed4468d5ff680633304e8f641' as 'tkimg'

9 files changed, 1299 insertions, 0 deletions

diff --git a/tkimg/tests/visualtests/Readme.txt b/tkimg/tests/visualtests/Readme.txt
new file mode 100755
index 0000000..9add1b5
--- /dev/null
+++ b/tkimg/tests/visualtests/Readme.txt
@@ -0,0 +1,28 @@
+                    Description of the tests
+                    ========================
+
+testFull.tcl:  Read and write full images
+testFrom.tcl:  Read and write images with option "-from"
+testTo.tcl:    Read and write images with option "-to"
+testSmall.tcl: Read and write images with sizes from 1x1 to 4x4
+
+Each test performs the following operations:
+
+For each image format "fmt":
+  1. Draw the test canvas, store it in a photo image
+     and write it to a file in format "fmt".
+
+  2. Read the image from file in different ways and display it.
+
+
+The following ways to read image data are tested:
+Read from file 1:         image create photo -file $fileName
+Read from file 2:         set ph [image create photo] ; $ph read $fileName
+Read as binary 1:         image create photo -data $imgData
+Read as binary 2:         set ph [image create photo] ; $ph put $imgData
+Read as uuencoded string: set ph [image create photo] ; $ph put $imgData
+
+The following ways to write image data are tested:
+Write to file:             $ph write $fileName -format $fmt
+Write to uuencoded string: $ph data -format $fmt
+
diff --git a/tkimg/tests/visualtests/testFrom.tcl b/tkimg/tests/visualtests/testFrom.tcl
new file mode 100755
index 0000000..3a3c60f
--- /dev/null
+++ b/tkimg/tests/visualtests/testFrom.tcl
@@ -0,0 +1,116 @@
+package require Tk
+
+proc initPackages { args } {
+    global gPkg
+
+    foreach pkg $args {
+        set retVal [catch {package require $pkg} gPkg(ext,$pkg,version)]
+        set gPkg(ext,$pkg,avail) [expr !$retVal]
+    }
+}
+
+initPackages img::bmp  img::gif  img::ico  img::jpeg img::pcx \
+             img::png  img::ppm  img::raw  img::sgi  img::sun \
+             img::tga  img::tiff img::xbm  img::xpm  img::window
+
+set retVal [catch {package require Img} version]
+if { $retVal } {
+    error "Trying to load package Img: $version"
+}
+
+cd [file dirname [info script]]
+
+source [file join "utils" "testUtil.tcl"]
+source [file join "utils" "testGUI.tcl"]
+# We get the global variable ui_enable_tk from above Tcl module.
+
+source [file join "utils" "testImgs.tcl"]
+source [file join "utils" "testReadWrite.tcl"]
+
+if { $argc != 1 } {
+    set testMode [expr $modeFile | $modeBin | $modeUU]
+} else {
+    set testMode [lindex $argv 0]
+}
+
+PH "Image Read/Write (Using -from option)"
+
+P "This test tries to store the content of a canvas window in image files"
+P "using all file formats available in the tkImg package."
+P "After writing we try to read the image back into a photo by using the"
+P "auto-detect mechanism of tkImg. If that fails, we use the \"-format\" option."
+P ""
+if { $ui_enable_tk } {
+    P "Set the environment variable UI_TK to 0 before running this test,"
+    P "to run this test in batch mode without displaying the images."
+    P ""
+}
+
+if { $tcl_platform(platform) eq "windows" && $ui_enable_tk } {
+    catch { console show }
+}
+
+ui_init "testFrom.tcl: Read/Write (Using -from option)" "+320+30"
+SetFileTypes
+
+drawTestCanvas $version
+
+P ""
+set sep ""
+if { $ui_enable_tk } {
+    set sep "\n\t"
+}
+set count 1
+set phCanvas [getCanvasPhoto .t.c]
+foreach elem $fmtList {
+    set ext [lindex $elem 0]
+    set fmt [lindex $elem 1]
+    set opt [lindex $elem 2]
+    catch { file mkdir out }
+    set fname [file join out testFrom$ext]
+    set msg "Image $count: $fname Format: $fmt $sep (Options: $opt)"
+    P $msg
+
+    PN "\t"
+    writePhotoFile $phCanvas $fname "$fmt $opt" 0
+    if { $testMode & $modeFile } {
+        set ph [readPhotoFile2 $fname "$fmt $opt" -1 -1 -from 140 50 200 110]
+        if { $ph eq "" } {
+            set ph [createErrImg]
+        }
+        set msg "Image $count.1: $fname Format: $fmt $sep (Read from file 2)"
+        ui_addphoto $ph $msg
+    }
+    if { $testMode & $modeBin } {
+        set str [writePhotoFile $phCanvas $fname "$fmt $opt" 0 -from 140 50 200 110]
+        set ph [readPhotoBinary1 $fname "$fmt $opt"]
+        if { $ph eq "" } {
+            set ph [createErrImg]
+        }
+        set msg "Image $count.2: $fname Format: $fmt $sep (Read as binary 1)"
+        ui_addphoto $ph $msg
+    }
+    if { $testMode & $modeUU } {
+        set str [writePhotoString $phCanvas "$fmt $opt" 0 -from 140 50 200 110]
+        if { $str eq "" } {
+            set ph [createErrImg]
+        } else {
+            set ph [readPhotoString $str "$fmt $opt" -1 -1]
+            if { $ph eq "" } {
+                set ph [createErrImg]
+            }
+        }
+        set msg "Image $count.3: $fname Format: $fmt $sep (Read as uuencoded string)"
+        ui_addphoto $ph $msg
+    }
+
+    P ""
+    incr count
+}
+
+PS
+P "End of test"
+
+P ""
+P "Package tkImg: $version"
+ui_show
diff --git a/tkimg/tests/visualtests/testFull.tcl b/tkimg/tests/visualtests/testFull.tcl
new file mode 100755
index 0000000..d07056f
--- /dev/null
+++ b/tkimg/tests/visualtests/testFull.tcl
@@ -0,0 +1,129 @@
+package require Tk
+
+proc initPackages { args } {
+    global gPkg
+
+    foreach pkg $args {
+        set retVal [catch {package require $pkg} gPkg(ext,$pkg,version)]
+        set gPkg(ext,$pkg,avail) [expr !$retVal]
+    }
+}
+
+initPackages img::bmp  img::gif  img::ico  img::jpeg img::pcx \
+             img::png  img::ppm  img::raw  img::sgi  img::sun \
+             img::tga  img::tiff img::xbm  img::xpm  img::window
+
+set retVal [catch {package require Img} version]
+if { $retVal } {
+    error "Trying to load package Img: $version"
+}
+
+cd [file dirname [info script]]
+
+source [file join "utils" "testUtil.tcl"]
+source [file join "utils" "testGUI.tcl"]
+# We get the global variable ui_enable_tk from above Tcl module.
+
+source [file join "utils" "testImgs.tcl"]
+source [file join "utils" "testReadWrite.tcl"]
+
+if { $argc != 1 } {
+    set testMode [expr $modeFile | $modeBin | $modeUU]
+} else {
+    set testMode [lindex $argv 0]
+}
+
+PH "Image Read/Write (Full Images)"
+
+P "This test tries to store the content of a canvas window in image files"
+P "using all file formats available in the tkImg package."
+P "After writing we try to read the image back into a photo by using the"
+P "auto-detect mechanism of tkImg. If that fails, we use the \"-format\" option."
+P ""
+if { $ui_enable_tk } {
+    P "Set the environment variable UI_TK to 0 before running this test,"
+    P "to run this test in batch mode without displaying the images."
+    P ""
+}
+
+if { $tcl_platform(platform) eq "windows" && $ui_enable_tk } {
+    catch { console show }
+}
+
+ui_init "testFull.tcl: Read/Write (Full Images)" "+320+30"
+SetFileTypes
+
+drawTestCanvas $version
+
+P ""
+set sep ""
+if { $ui_enable_tk } {
+    set sep "\n\t"
+}
+set count 1
+set phCanvas [getCanvasPhoto .t.c]
+foreach elem $fmtList {
+    set ext [lindex $elem 0]
+    set fmt [lindex $elem 1]
+    set opt [lindex $elem 2]
+    catch { file mkdir out }
+    set fname [file join out testFull$ext]
+    set msg "Image $count: $fname Format: $fmt $sep (Options: $opt)"
+    P $msg
+
+    PN "\t"
+    writePhotoFile $phCanvas $fname "$fmt $opt" 0
+    if { $testMode & $modeFile } {
+        set ph [readPhotoFile1 $fname "$fmt $opt"]
+        if { $ph eq "" } {
+            set ph [createErrImg]
+        }
+        set msg "Image $count.1: $fname Format: $fmt $sep (Read from file 1)"
+        ui_addphoto $ph $msg
+
+        set ph [readPhotoFile2 $fname "$fmt $opt" -1 -1]
+        if { $ph eq "" } {
+            set ph [createErrImg]
+        }
+        set msg "Image $count.2: $fname Format: $fmt $sep (Read from file 2)"
+        ui_addphoto $ph $msg
+    }
+    if { $testMode & $modeBin } {
+        set ph [readPhotoBinary1 $fname "$fmt $opt"]
+        if { $ph eq "" } {
+            set ph [createErrImg]
+        }
+        set msg "Image $count.3: $fname Format: $fmt $sep (Read as binary 1)"
+        ui_addphoto $ph $msg
+
+        set ph [readPhotoBinary2 $fname "$fmt $opt" -1 -1]
+        if { $ph eq "" } {
+            set ph [createErrImg]
+        }
+        set msg "Image $count.4: $fname Format: $fmt $sep (Read as binary 2)"
+        ui_addphoto $ph $msg
+    }
+    if { $testMode & $modeUU } {
+        set str [writePhotoString $phCanvas "$fmt $opt" 0]
+        if { $str eq "" } {
+            set ph [createErrImg]
+        } else {
+            set ph [readPhotoString $str "$fmt $opt" -1 -1]
+            if { $ph eq "" } {
+                set ph [createErrImg]
+            }
+        }
+        set msg "Image $count.5: $fname Format: $fmt $sep (Read as uuencoded string)"
+        ui_addphoto $ph $msg
+    }
+
+    P ""
+    incr count
+}
+
+PS
+P "End of test"
+
+P ""
+P "Package tkImg: $version"
+ui_show
diff --git a/tkimg/tests/visualtests/testSmall.tcl b/tkimg/tests/visualtests/testSmall.tcl
new file mode 100755
index 0000000..565e518
--- /dev/null
+++ b/tkimg/tests/visualtests/testSmall.tcl
@@ -0,0 +1,137 @@
+package require Tk
+
+proc initPackages { args } {
+    global gPkg
+
+    foreach pkg $args {
+	set retVal [catch {package require $pkg} gPkg(ext,$pkg,version)]
+	set gPkg(ext,$pkg,avail) [expr !$retVal]
+    }
+}
+
+initPackages img::bmp  img::gif  img::ico  img::jpeg img::pcx \
+             img::png  img::ppm  img::raw  img::sgi  img::sun \
+             img::tga  img::tiff img::xbm  img::xpm  img::window
+
+set retVal [catch {package require Img} version]
+if { $retVal } {
+    error "Trying to load package Img: $version"
+}
+
+cd [file dirname [info script]]
+
+source [file join "utils" "testUtil.tcl"]
+source [file join "utils" "testGUI.tcl"]
+# We get the global variable ui_enable_tk from above Tcl module.
+
+source [file join "utils" "testImgs.tcl"]
+source [file join "utils" "testReadWrite.tcl"]
+
+if { $argc != 1 } {
+    set testMode [expr $modeFile | $modeBin | $modeUU]
+} else {
+    set testMode [lindex $argv 0]
+}
+
+PH "Image Read/Write (Different sizes)"
+
+P "This test tries to store the content of a canvas window in image files"
+P "using all file formats available in the tkImg package."
+P "After writing we try to read the image back into a photo by using the"
+P "auto-detect mechanism of tkImg. If that fails, we use the \"-format\" option."
+P ""
+if { $ui_enable_tk } {
+    P "Set the environment variable UI_TK to 0 before running this test,"
+    P "to run this test in batch mode without displaying the images."
+    P ""
+}
+
+if { $tcl_platform(platform) eq "windows" && $ui_enable_tk } {
+    catch { console show }
+}
+
+ui_init "testSmall.tcl: Read/Write (Different small sizes)" "+320+30"
+SetFileTypes
+
+P ""
+set sep ""
+if { $ui_enable_tk } {
+    set sep "\n\t"
+}
+set count 1
+foreach elem $fmtList {
+    set ext [lindex $elem 0]
+    set fmt [lindex $elem 1]
+    set opt [lindex $elem 2]
+    catch { file mkdir out }
+    set prefix [file join out testSmall]
+
+    P "Format $fmt :"
+    for { set w 1 } { $w <=4 } { incr w } {
+	for { set h 1 } { $h <=4 } { incr h } {
+	    P "Creating a photo of size: $w x $h"
+	    set ph [image create photo -width $w -height $h]
+	    set imgData {}
+	    for { set y 1 } { $y <= $h } { incr y } {
+	        set imgLine {}
+		for { set x 1 } { $x <= $w } { incr x } {
+		    set col 0
+		    if { $x % 2 == 1 && $y % 2 == 1 ||
+		         $x % 2 == 0 && $y % 2 == 0 } {
+			set col 255
+		    }
+		    set val [format "#%02x%02x%02x" $col $col $col]
+                    lappend imgLine $val
+                    if { $fmt eq "xbm" } {
+                        $ph put -to [expr $x-1] [expr $y-1] $val
+                        $ph transparency set [expr $x-1] [expr $y-1] [expr $col]
+                    }
+		}
+	        lappend imgData $imgLine
+	    }
+	    set zoom 8
+            if { $fmt ne "xbm" } {
+                $ph put $imgData
+            }
+	    set fname [format "%s_w%d_h%d%s" $prefix $w $h $ext]
+	    # Write the image to a file and read it back again.
+	    writePhotoFile $ph $fname "$fmt $opt" 1
+	    set ph [readPhotoFile1 $fname "$fmt $opt"]
+	    if { $ph eq "" } {
+		set ph [createErrImg]
+		set zoom 1
+	    }
+	    # Write the image to a uuencoded string and read it back again.
+	    set str [writePhotoString $ph "$fmt $opt" 1]
+	    if { $str eq "" } {
+		set ph [createErrImg]
+		set zoom 1
+	    } else {
+		set ph [readPhotoString $str "$fmt $opt" -1 -1]
+		if { $ph eq "" } {
+		    set ph [createErrImg]
+		    set zoom 1
+		}
+	    }
+	    # Write the image to a uuencoded string and read it back again.
+	    set zw [expr [image width  $ph] * $zoom]
+	    set zh [expr [image height $ph] * $zoom]
+	    set zoomPh [image create photo -width $zw -height $zh]
+	    $zoomPh copy $ph -zoom $zoom $zoom
+	    image delete $ph
+	    set msg "Image: $fname Format: $fmt $sep (Width: $w Height: $h)"
+	    ui_addphoto $zoomPh $msg
+	    P ""
+	}
+    }
+
+    P ""
+    incr count
+}
+
+PS
+P "End of test"
+
+P ""
+P "Package tkImg: $version"
+ui_show
diff --git a/tkimg/tests/visualtests/testTo.tcl b/tkimg/tests/visualtests/testTo.tcl
new file mode 100755
index 0000000..2ac23f2
--- /dev/null
+++ b/tkimg/tests/visualtests/testTo.tcl
@@ -0,0 +1,117 @@
+package require Tk
+
+proc initPackages { args } {
+    global gPkg
+
+    foreach pkg $args {
+        set retVal [catch {package require $pkg} gPkg(ext,$pkg,version)]
+        set gPkg(ext,$pkg,avail) [expr !$retVal]
+    }
+}
+
+initPackages img::bmp  img::gif  img::ico  img::jpeg img::pcx \
+             img::png  img::ppm  img::raw  img::sgi  img::sun \
+             img::tga  img::tiff img::xbm  img::xpm  img::window
+
+set retVal [catch {package require Img} version]
+if { $retVal } {
+    error "Trying to load package tkImg: $version"
+}
+
+cd [file dirname [info script]]
+
+source [file join "utils" "testUtil.tcl"]
+source [file join "utils" "testGUI.tcl"]
+# We get the global variable ui_enable_tk from above Tcl module.
+
+source [file join "utils" "testImgs.tcl"]
+source [file join "utils" "testReadWrite.tcl"]
+
+if { $argc != 1 } {
+    set testMode [expr $modeFile | $modeBin | $modeUU]
+} else {
+    set testMode [lindex $argv 0]
+}
+
+PH "Image Read/Write (Using -to option)"
+
+P "This test tries to store the content of a canvas window in image files"
+P "using all file formats available in the tkImg package."
+P "After writing we try to read the image back into a photo by using the"
+P "auto-detect mechanism of tkImg. If that fails, we use the \"-format\" option."
+P ""
+if { $ui_enable_tk } {
+    P "Set the environment variable UI_TK to 0 before running this test,"
+    P "to run this test in batch mode without displaying the images."
+    P ""
+}
+
+if { $tcl_platform(platform) eq "windows" && $ui_enable_tk } {
+    catch { console show }
+}
+
+ui_init "testTo.tcl: Read/Write (Using -to option)" "+320+30"
+SetFileTypes
+
+drawTestCanvas $version
+
+P ""
+set sep ""
+if { $ui_enable_tk } {
+    set sep "\n\t"
+}
+set count 1
+set phCanvas [getCanvasPhoto .t.c]
+foreach elem $fmtList {
+    set ext [lindex $elem 0]
+    set fmt [lindex $elem 1]
+    set opt [lindex $elem 2]
+    catch { file mkdir out }
+    set fname [file join out testTo$ext]
+    set msg "Image $count: $fname Format: $fmt $sep (Options: $opt)"
+    P $msg
+
+    PN "\t"
+    writePhotoFile $phCanvas $fname "$fmt $opt" 0
+    if { $testMode & $modeFile } {
+        set ph [readPhotoFile2 $fname "fmt $opt" 200 100 \
+                               -from 140 50 200 110 -to 10 30]
+        if { $ph eq "" } {
+            set ph [createErrImg]
+        }
+        set msg "Image $count.1: $fname Format: $fmt $sep (Read from file 2)"
+        ui_addphoto $ph $msg
+    }
+    if { $testMode & $modeBin } {
+        set str [writePhotoFile $phCanvas $fname "$fmt $opt" 0 -from 140 50 200 110]
+        set ph  [readPhotoBinary2 $fname "$fmt $opt" 200 100 -to 10 30]
+        if { $ph eq "" } {
+            set ph [createErrImg]
+        }
+        set msg "Image $count.2: $fname Format: $fmt $sep (Read as binary 2)"
+        ui_addphoto $ph $msg
+    }
+    if { $testMode & $modeUU } {
+        set str [writePhotoString $phCanvas "$fmt $opt" 0 -from 140 50 200 110]
+        if { $str eq "" } {
+            set ph [createErrImg]
+        } else {
+            set ph [readPhotoString $str "$fmt $opt" 200 100 -to 10 30]
+            if { $ph eq "" } {
+                set ph [createErrImg]
+            }
+        }
+        set msg "Image $count.3: $fname Format: $fmt $sep (Read as uuencoded string)"
+        ui_addphoto $ph $msg
+    }
+
+    P ""
+    incr count
+}
+
+PS
+P "End of test"
+
+P ""
+P "Package tkimg: $version"
+ui_show
diff --git a/tkimg/tests/visualtests/utils/testGUI.tcl b/tkimg/tests/visualtests/utils/testGUI.tcl
new file mode 100755
index 0000000..4ddc825
--- /dev/null
+++ b/tkimg/tests/visualtests/utils/testGUI.tcl
@@ -0,0 +1,279 @@
+# Set this variable to 0, if Tk should not be used for testing.
+if { [info exists env(UI_TK)] && $env(UI_TK) == 0 } {
+    set ui_enable_tk 0
+} else {
+    set ui_enable_tk 1
+}
+
+proc bmpFirst {} {
+    return {
+    #define first_width 16
+    #define first_height 16
+    static unsigned char first_bits[] = {
+	0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x1c, 0x04, 0x1c, 0x06,
+	0x1c, 0x07, 0x9c, 0x3f, 0xdc, 0x3f, 0x9c, 0x3f, 0x1c, 0x07, 0x1c, 0x06,
+	0x1c, 0x04, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
+    }
+}
+
+proc bmpLast {} {
+    return {
+    #define last_width 16
+    #define last_height 16
+    static unsigned char last_bits[] = {
+	0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x20, 0x38, 0x60, 0x38,
+	0xe0, 0x38, 0xfc, 0x39, 0xfc, 0x3b, 0xfc, 0x39, 0xe0, 0x38, 0x60, 0x38,
+	0x20, 0x38, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
+    }
+}
+
+proc bmpLeft {} {
+    return {
+    #define left_width 16
+    #define left_height 16
+    static unsigned char left_bits[] = {
+	0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x01, 0x80, 0x01,
+	0xc0, 0x01, 0xe0, 0x0f, 0xf0, 0x0f, 0xe0, 0x0f, 0xc0, 0x01, 0x80, 0x01,
+	0x00, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
+    }
+}
+
+proc bmpRight {} {
+    return {
+    #define right_width 16
+    #define right_height 16
+    static unsigned char right_bits[] = {
+	0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0x00, 0x80, 0x01,
+	0x80, 0x03, 0xf0, 0x07, 0xf0, 0x0f, 0xf0, 0x07, 0x80, 0x03, 0x80, 0x01,
+	0x80, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
+    }
+}
+
+proc bmpPlay {} {
+    return {
+    #define play_width 16
+    #define play_height 16
+    static unsigned char play_bits[] = {
+	0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x60, 0x00, 0xe0, 0x00,
+	0xe0, 0x01, 0xe0, 0x03, 0xe0, 0x07, 0xe0, 0x03, 0xe0, 0x01, 0xe0, 0x00,
+	0x60, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
+    }
+}
+
+proc bmpHalt {} {
+    return {
+    #define halt_width 16
+    #define halt_height 16
+    static unsigned char halt_bits[] = {
+	0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x18, 0x18, 0x30, 0x0c,
+	0x60, 0x06, 0xc0, 0x03, 0x80, 0x01, 0xc0, 0x03, 0x60, 0x06, 0x30, 0x0c,
+	0x18, 0x18, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
+    }
+} 
+
+proc ui_initToolhelp { w { bgColor yellow } { fgColor black } } {
+    global ui_helpWidget
+
+    # Create Toolbar help window with a simple label in it.
+    if { [winfo exists $w] } {
+        destroy $w
+    }
+    toplevel $w
+    set ui_helpWidget $w
+    label $w.l -text "??" -bg $bgColor -fg $fgColor -relief ridge
+    pack $w.l
+    wm overrideredirect $w true
+    if {[string equal [tk windowingsystem] aqua]}  {
+        ::tk::unsupported::MacWindowStyle style $w help none
+    }
+    wm geometry $w [format "+%d+%d" -100 -100]
+}
+
+proc ui_showToolhelp { x y str } {
+    global ui_helpWidget
+
+    $ui_helpWidget.l configure -text $str
+    raise $ui_helpWidget
+    wm geometry $ui_helpWidget [format "+%d+%d" $x [expr $y +10]]
+}
+
+proc ui_hideToolhelp {} {
+    global ui_helpWidget
+
+    wm geometry $ui_helpWidget [format "+%d+%d" -100 -100]
+}
+
+proc ui_button { btnName bmpData cmd helpStr } {
+    set imgData [image create bitmap -data $bmpData]
+    eval button $btnName -image $imgData -command [list $cmd] -relief flat
+    bind $btnName <Enter>  "ui_showToolhelp %X %Y [list $helpStr]"
+    bind $btnName <Leave>  { ui_hideToolhelp }
+    bind $btnName <Button> { ui_hideToolhelp }
+}
+
+proc ui_init {title {winPos "+0+0"} } {
+    global ui_enable_tk ui_curImgNo ui_noImgs ui_top
+
+    catch {wm withdraw .}
+    if { $ui_enable_tk } {
+	set ui_top .testWindow
+	ui_initToolhelp .testToolhelp
+        toplevel $ui_top
+	wm title $ui_top $title
+	wm geometry $ui_top $winPos
+        frame $ui_top.imgfr -bg lightgrey
+        frame $ui_top.menufr -relief raised -bg lightgrey
+
+	label $ui_top.imgfr.img -bg white
+	text $ui_top.imgfr.txt -height 2 -width 60 -state disabled
+	pack $ui_top.imgfr.txt -side top
+	pack $ui_top.imgfr.img -side top
+
+    	ui_button $ui_top.menufr.quit [bmpHalt] ui_exit "Quit test (Esc)"
+	pack $ui_top.menufr.quit -in $ui_top.menufr -side left
+    	pack $ui_top.menufr $ui_top.imgfr -side top -pady 2 -anchor w
+	bind $ui_top <Key-Escape> ui_exit
+	wm protocol $ui_top WM_DELETE_WINDOW ui_exit
+
+	P "Visual: [winfo screenvisual $ui_top]"
+	P "Depth:  [winfo depth $ui_top]"
+    }
+    set ui_curImgNo 0
+    set ui_noImgs   0
+}
+
+proc showimg { imgNo } {
+    global ui_enable_tk ui_strings ui_top ui_photos
+
+    if { $ui_enable_tk } {
+        $ui_top.imgfr.img config -image $ui_photos($imgNo)
+
+	$ui_top.imgfr.txt configure -state normal
+	$ui_top.imgfr.txt delete 1.0 end
+	$ui_top.imgfr.txt insert end $ui_strings($imgNo)
+	$ui_top.imgfr.txt configure -state disabled
+	update
+    }
+}
+
+proc ui_addimg { poImg str { chanMap {} } } {
+    global ui_enable_tk ui_curImgNo ui_noImgs ui_strings ui_images ui_photos
+ 
+    set ui_strings($ui_curImgNo) $str
+    set ui_images($ui_curImgNo) $poImg
+    if { $ui_enable_tk } {
+        set ui_photos($ui_curImgNo) [image create photo]
+	$poImg img_photo $ui_photos($ui_curImgNo) $chanMap
+   	showimg $ui_curImgNo
+    }
+    incr ui_curImgNo
+    set ui_noImgs $ui_curImgNo
+}
+
+proc ui_addphoto { phImg str } {
+    global ui_enable_tk ui_curImgNo ui_noImgs ui_strings ui_images ui_photos
+ 
+    set ui_strings($ui_curImgNo) $str
+    set ui_images($ui_curImgNo)  "none"
+    if { $ui_enable_tk } {
+	set ui_photos($ui_curImgNo) $phImg
+   	showimg $ui_curImgNo
+    }
+    incr ui_curImgNo
+    set ui_noImgs $ui_curImgNo
+}
+
+proc show_first {} {
+    global ui_curImgNo ui_noImgs
+
+    set ui_curImgNo 0
+    showimg $ui_curImgNo
+}
+
+proc show_last {} {
+    global ui_curImgNo ui_noImgs
+
+    set ui_curImgNo [expr ($ui_noImgs -1)]
+    showimg $ui_curImgNo
+}
+
+proc show_play {} {
+    global ui_curImgNo ui_noImgs
+
+    while { $ui_curImgNo < [expr ($ui_noImgs -1)] } {
+    	incr ui_curImgNo
+    	showimg $ui_curImgNo
+    }
+}
+
+proc show_prev {} {
+    global ui_curImgNo
+
+    if { $ui_curImgNo > 0 } {
+	incr ui_curImgNo -1
+    	showimg $ui_curImgNo
+    }
+}
+
+proc show_next {} {
+    global ui_curImgNo ui_noImgs
+
+    if { $ui_curImgNo < [expr ($ui_noImgs -1)] } {
+    	incr ui_curImgNo 1
+    	showimg $ui_curImgNo
+    }
+}
+
+proc ui_show {} {
+    global ui_enable_tk ui_curImgNo ui_noImgs ui_strings ui_top
+
+    PrintMachineInfo
+
+    set ui_noImgs $ui_curImgNo
+    incr ui_curImgNo -1
+    if { $ui_enable_tk } {
+	if { $ui_noImgs > 0 } {
+	    set fr $ui_top.menufr
+    	    ui_button $fr.first [bmpFirst] show_first "Show first image"
+    	    ui_button $fr.prev  [bmpLeft]  show_prev  "Show previous image (<-)"
+    	    ui_button $fr.next  [bmpRight] show_next  "Show next image (->)"
+    	    ui_button $fr.last  [bmpLast]  show_last  "Show last image"
+    	    ui_button $fr.play  [bmpPlay]  show_play  "Play image sequence (p)"
+	    pack $fr.first $fr.prev $fr.next $fr.last \
+	         -in $fr -side left -padx 0
+	    pack $fr.play -in $fr -side left -padx 0
+    
+	    bind $ui_top <Key-Right>  show_next
+	    bind $ui_top <Key-Left>   show_prev
+	    bind $ui_top <Key-p>      show_play
+	}
+    } else {
+	ui_exit
+    }
+}
+
+proc ui_delete {} {
+    global ui_enable_tk ui_noImgs ui_strings ui_images ui_photos ui_top
+
+	for { set i 0 } { $i < $ui_noImgs } { incr i } {
+	if { $ui_enable_tk } {
+	    image delete $ui_photos($i)
+	}
+	    if { [info commands $ui_images($i)] != {} } {
+	        deleteimg $ui_images($i)
+	    }
+	    set ui_strings($i) {}
+	}
+    if { $ui_enable_tk } {
+	destroy $ui_top.imgfr
+	destroy $ui_top.menufr
+    }
+}
+
+proc ui_exit {} {
+    ui_delete
+    if { [info commands memcheck] != {} } {
+	memcheck
+    }
+    exit
+}
diff --git a/tkimg/tests/visualtests/utils/testImgs.tcl b/tkimg/tests/visualtests/utils/testImgs.tcl
new file mode 100755
index 0000000..1144365
--- /dev/null
+++ b/tkimg/tests/visualtests/utils/testImgs.tcl
@@ -0,0 +1,147 @@
+proc unsupportedImg {} {
+return {
+R0lGODlhAAEAAeMAAP////8AAP9VVf+qqv85Of9ycv/Hx/+Ojv8dHf/j4///
+/////////////////////ywAAAAAAAEAAQAE/hDISau9OOvNu/9gKI5kaZ5o
+qq5s675wLM90bd94ru987//AoHBILBqPyKRyyWw6n9CodEqtWq/YrHbL7Xq/
+4LB4TC6bz+i0es1uu9/wuHxOr9vv+Lx+z+/7/4CBgoOEhYaHiImKi4yNjo+Q
+kZKTlJWWl5iZmpucnZ6foKGio6SlpqeoqaqrrK2ur7CxsrO0tba3uLm6u7y9
+vr/AwcLDxMXGx8jJysvMzc7P0NHS09TV1tfY2drb3N3e3+Dh4uPk5ebn6Onq
+6+zt7u/w8fLz9PX291sBAR36/fsU/vqh0GeK4A2DABBqCPhvAsOGJRSKkoiD
+YgaCFi2O0OiJIw2P/hUwQnQ4MmJJUCBlpCQpgaLGhxcf+mvBsGVIgTclzmy5
+M2fDgBxgYgBKEmdRmScBEl3YcyXPpzcvID051Sm/qT4t9OQpUujRhDJjhtW6
+cyxXpGK9kq1pFaHOkkaLDk2qIi5XqUkzbgULd6/duzlj8gWIF8Tfv4OP0iXL
+UmnUuVQXD8wbeS5eum8xj+SImK/kxlcFP177QaFpiJ2hjn7BubDr1YwdiwZs
++XLpz6BfJybt4bRs1bNzu0it+7dx3SDdftZrGDfYDb6DQ9/8E/XyvjPMFhcO
+HLlk5UEr3+5dNa7HttRzp3Tp/ATa2PCPx09ePfx2puTLW8dPPnZ0/vKx/vAS
+e7XBNt939U13n3QMKthggYQ9J1eDVm2kWXwBppZZcMQN2Fx+Hz54n0gGTlji
+Cp0ROOKA1FGWHmQQ2tdfiLyFdlmLfbk41GTsiffVWhv61CKQNWI4XV5ZFWfX
+Ukwx6dmNNaWlFgldRQkkViy9F5WWVzrpmXZQWqkUlmOytZeQPUJ2pprE0ejl
+lWftF+dsb6LpIpdS0lenYv/sWUiFEuIT6IyCAgooOnjaeag4iZbpp6CQRirp
+pJRWaumlmGaq6aacdurpp6CGKuqopJZq6qmopqrqqqy26uqrsMYq66y01mrr
+rbjmquuuvPbq66/ABivssMQWa+yxyCar7LLMQzbr7LPQRivttNRWa+212Gar
+7bbcduvtt+CGK+645JZr7rnopqvuuuy26+678MYr77z01mvvvfjmq+++/Pbr
+77/hRAAAOw==}
+}
+
+proc errorImg {} {
+return {
+R0lGODlhAAEAAeMAAP////8AAP9VVf+qqv85Of9ycv/Hx/+Ojv8dHf/j4///
+/////////////////////ywAAAAAAAEAAQAE/hDISau9OOvNu/9gKI5kaZ5o
+qq5s675wLM90bd94ru987//AoHBILBqPyKRyyWw6n9CodEqtWq/YrHbL7Xq/
+4LB4TC6bz+i0es1uu9/wuHxOr9vv+Lx+z+/7/4CBgoOEhYaHiImKi4yNjo+Q
+kZKTlJWWl5iZmpucnZ6foKGio6SlpqeoqaqrrK2ur7CxsrO0tba3uLm6u7y9
+vr/AwcLDxMXGx8jJysvMzc7P0NHS09TV1tfY2drb3N3e3+Dh4uPk5ebn6Onq
+6+zt7u/w8WwD9PImCQUEAfv8AQQFBuz0G0iwoMF+Ai4MOMiQHwIBAEM0nChA
+wIAVBvRNRHAAxMKJ/gcfRkQCsmTBhBY+mgwZ0MPKhh3vCXiJoCUHlS8J1jyS
+cyXKCjh7Dvy5QahBBAlIGEAwkMCBAUkB0Js58OJNoyeN0Ns6QGMArmDDgi3A
+j+iEBGC9igV7QADTfgU6jOVXYC1XAV73IRgRtEDUCwkODOWAlqtau/TavqW7
+hGoAEirNYnD8YWk/mx5UWiXsOEBcj/12Es77+QNlD5b5YTZyWkTkDq09OCYQ
+QjNofn8JLxaQm0PnzbD5hZitJDYIA2WD7wuRYPHqDbZBOC7NwSttEY6RmhYO
+ornqJMZBJPfNHYTgfTEz8wPeIQG/6xzOB9A+wqvkDOHj80vPuryI8Rvk/scB
+gHKth51/GizGXneXyYagS/vcJ4SAHRCI34MdeHXbVyLIt6AF8sFHQogOLieC
+hkhQOGCEyj12oInq7fMhdAZu4BwKi/U2GYbkwdifj8Ox2KOLQQJJo4yu1ZgB
+cvuIWIJ81F1oZIvg8ThBWxVZQJWEFaiYAYoxchiChxuQhSQK7ulF5YlWAuFl
+eAbQ89wFXgJm4ZFiggDml20WGYCOWvZpp5BHvClogIdWIB9/V535QZr+rBip
+CmQiOuUGi1Z56QR1WkqkB5D+ueGMfKKHZ5QmMBkAl5wmelY/gE7YZ6ca0CrB
+AIuhiiepFiTg1V67snBnoJsqlGtx6yG25wi0/mYUWqwZRLcBPlVxYGYAc5bw
+FrC1JuqsQ9AG0VlJJziG2AAV6RQuBirVZVcBbhHEa6vFMiuouYilOxB9mq5U
+rlH8btjTvPR+mkKd464UcIo5/ZsTRyUEZZJf29X7osF09gRxE4Za7ClIBFh0
+gsQMPXTAusRi7LDKXa4UMsFEdMxyxSp3NSxfSk5gwLUL09wCwhjaTCgUMq8s
+5aopSAsUuCNcC/MHDg15NKsM12vrjsWai4LSSw/9Adcn3EyBiloTPaurWM8s
+wbYoB5uB0yKoSvWGurZcL9tme3xwn3KPnPMFeEukJqV/Z1xv309cXYEBFc0N
+QJ1wR1z44mKXKmoK/l6hDPnkVavt6Zo26tU2u5xTEPkHmaL5HugJiu6E4mMf
+2mm7kjuagXfzMRc1CtcymnaB+9T9o+fdekyrV9k2mqcGUIbgle+648a6Bshz
+jLbdxD+eKKROfl16BZkft3sJ1wqPPairMwF7wdNr0DvOtmugavcbeGX+Bqpe
+LrUH7zd2fezGQ1vgRvWB03Ugf0+rAO4847MPDLBzJejU1ZpXm+8pcHz860cC
+JbBAbrWPeYxBlt4Mlz3FVY+AqAuhAzX4qMX0rHjZo8AJIUgCCV5vfhWMHwdy
+1J3FMDA+Ptyg9kYoARwOoXGN2w0Sl8jEJS7mAoxDohKRmDwJWIeJXULi/hWR
+CD0KyOchS6ziAudzMgwcIC/Lw0AUk1iWMNbvPVjkAVZAohCTzCt/BKmASebm
+w2ppIAEJC9lT0JWwF6bEjvhjSA/mOJE6loRgaOyHHksyN/nIqwMH6GND7kcB
+khkEkgfpQRNHScpS3meNphRAFYtIyiymUgBddCUTV+lFTe6LYpV5ZUVoicol
+LsMAWGrjAWhpj2Ia85jITKYyl8nMZjrzmdCMpjSnSc1qWvOa2MymNrfJzW56
+85vgDKc4x0nOcprznOhMpzrXyc52uvOd8IynPOdJz3ra8574zKc+98nPfvrz
+nwANqEAHStCCGvSgCE2oQhfK0IY69KEQjahEJidK0Ypa9KIYzahGN8rRjnr0
+oyANqUhHStKSmvSkKE2pSlfKgggAADs=}
+}
+
+proc pwrdLogo {} {
+return {
+R0lGODlhggDIAPUAAP//////zP//mf//AP/MzP/Mmf/MAP+Zmf+ZZv+ZAMz/
+/8zM/8zMzMyZzMyZmcyZZsyZAMxmZsxmM8xmAMwzM8wzAJnM/5nMzJmZzJmZ
+mZlmmZlmZpkzZpkzM5kzAGaZzGZmzGZmmWZmZmYzZmYzMzNmzDNmmTMzmTMz
+ZgAzmQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH+BSAtZGwtACH5BAEKAAIALAAA
+AACCAMgAAAb+QIFwSCwaj8ikcslsOp/QqFT6qEYkWElly+1WJNOweKysVrNa
+r3rN9kbIcHhkfqXY2/i8Hg+O+417gYKDg29/f4SJbBOKexRiCJEPaGlbfVCN
+axMJCXkGA6CMmXkRZpSjX1KoXJ8Dopqgsa6rtIKGmKutnW2tsga1wHkPqqgJ
+sXi9sQa7wc1ew1GrscxqE76vztlcU5WKELHYXrLU2uXco62/bMag5OXa55mt
+4V3K7/db8Y3H66Dq+O/0KfLXBhzAewITheo3wN3BYJegPBgFqmDFh+UiPpmY
+acA/L98GQKgV4QABAgW6AdTohOM+hxVa0XpAAIDNmwcwQovicuD+yGrtVtW8
+SRRAgYc7JVL86YUdKgkBikqNcBBBGHT0KhDMJEEqAAwfPmCoGeCgGKxAZzVC
+UJRBiRRw4aJ4AKCnuauZEtCTuZboAhBxA6c4sYEAwLOZINALqigCUQyCI6fA
+QAEf4kYTwllTS6jrTcCSI2+wjBeY00SebZoILfmEB4Sla336GIhCVAALVrOO
+3OEeyyfNGA8aymC3ZBL4fjsJtjkrngM2ixsXPGLlZVqnBXleMF0wioNJowGb
+Pcg2AAW6u8N9DTA8rlrC9wxNr763WTEqMzW3ZfOD+rjV1WKMAc5VMEZ+mC0U
+SFQX/AfXCYJsMptz6bBxYC3f0PbceQ7+wmWfHhOEZFBaDa2RAX4CelSbTaD9
+F6AgInLmRS9rnCCZEwgq8glMakAnnYMDxcKUF5sNUGNkJuAom4xteEZfdx8O
+IkuB/HghGQgtLVlgF9BB5uCLhPRCZYlqSPZBlrRcpIdqHcqzFRufZHUjmtIY
+qQddXv6H3D7xqaGiGh3M2YRdHWm4Rk1PGvddkzluMSIsWQUa2UbwGepFV9w5
+GOUWERQwVFmLVLkGBEN2IWlgJbyHikh6QOefi13Q5FWOIVm6BY8jRHYmcGmW
+eigAbW7RQQgYFLtAUQgwtCUeuQomnjTLdvVjdyiMYGNkJ3yggE05rcGXIs0G
+9iwqBJICwKv+HbKWgU2GrdHnIChMqio6rQJwbbqhedYukQoqEm9gSc6blx4E
+ZIqvZCjou8aAo9wLF5YCY6ZHAHkeLBgJdAGwbxef+DqIvBFrA0CLFgfWAVsA
+dNvFZqiAzGtyACRacgUFcKuGMTzucWpcxODjWMmRfTcUoXGOsjNcPd8TgcFA
+w4XcTSpZY2sgR6c67jsHVNx0B6ndzGQiJAi2KxSNBpN104FVAJ3GahgwdSDh
+Ii1F2cAcgG7TQttklzXL7hF3CglpcwDJQJNAwU1qQPB2IP/yPDdAB8h8sAeO
+GdV233s0nkLAUdBdCwKSpwvhUFEvzjiqgWcTQegdVsfuzZjv4ez+FFT5zDpc
+t3uYMaEeNzK7FLX7drvDu1VA1j2/RxH8PbcTHlrCNi3vzNFhSF/O7XezNgJd
+G2ezM+fKH6S5d5NBWZPnqOw8dtLv/A1gByVkn2/K+ITteGzth0aCBxg4H/QB
+oLqH/eSGv3IMUDAe6MACiCeZEQAAfauI2xgOcrQHVcCB3XGAyu7ROPCxDxjJ
+6oIHGliBECigO917R+MgVsBaHGCDFThOBTDQIONsAIK0aNz6PliLmvVEMr1h
+QA21h5EY3q+FtBgaF8aXggp04Fy7WRRGxDXBbAwFAA0YAQnG950nys9kRTQi
+AZEolKJ8gHjV2UDMWLMnjJzKgzxMok3+FFAsEBCuN+uSnBTdGJcdxrGMUAxN
+bxoArNCogQI4zMSp4KCNobzFkBU4lv62YJKTPLB+RyQjKobCQAtWwCZRHMGx
+bAKQATLSiqB8nhNxM50TQCeF2fjXCU7pjJowjToVcMwQtVcTGGrjXywMQwgE
+x8pJ0mWXoXHgJTGZAj9GYZjZ8BEbK+CAr0xHAzZJZCbsBwdoOqNLrHkNIb8o
+mGoC4CDcJIM3mwHO0LymJuQMDAPYVsoxhsEE2nCMA1izhXnG80FR8aU2wgZH
+KYggnwDYJyRt8kjWnEBvFGwmHA6aja4cIDQQ+uQad6NMbSoScBPVxuEOwMQU
+dJFNu1HjMvH+Eag4gCkYhytASb/jJONg85wRdWk5AkCAAwLoCyhlTeUwMks4
+vDQYPPWp0yqg0ts5BpblCKYYjgoMT1UwBchR6XSeihEMxKGN3wTAVZGTMUVx
+9SF+2FQw6CLGwJA1ldrrClThEQe1AqMrEmAicsxpHMPR8z5wsGst8MpEPMJV
+kMabazbS+g4ARMB9hi0ka3pTE4wwthwEOABkK7AuyUISOpaFwwcE60ICVDCy
+UdyCp0JLBhCwJ5+m5Q1nDxu0LQTgKA+xChlM8NqKnlO2nd0NcroSwqrAwTX3
+eCBwaXuxCrAVI7odQwp6a8W8Cga1kzUebnMLh+neIxLjw64huxL+RvdIwbvv
+kEAB/oac4PKTANZLDhn8A5CeNte9xylJGFMxBvriowBHay9z49IBQh1EOU9Y
+TXskcN8Bm7QyXDBwRnbbxOQoNC7IuSliI4xTtEq3wvg4gMO+E4KgxiWjEnjA
+bYpIBriAR3MkNrHTKLA2xLE2DCY9cAgC852mRqYLCBgKi6W7x3uIgMdMlXGA
+PLDFh3YYsFPwT5HfcbQLKjluD1XsYsXwlimXo8pPDKRD/wplKXQ5I8WtwAjT
+1oFt/XMw9LvxeXNcDo1VAoEKFHNoSizhu+CYzo3klgQ6QJ/eHOvNJfYoKj4M
+Vmdk7DNurYAFAIDMyFQzjIxObnSehBz+DFDaOCfBtBiWijUANDQw1fH0tCLj
+QIHCZgqgabQzuqI1uVRAw6xRY3xfbWZSl5qBENIqa55bRPM2AcMAoZhkKsAB
+m3TSpKEOI4KXQOD2mPrHYZacrvc7bSVUGyAFWOB1I7lRSwewiN1Owrfru2rk
+wLOBAeizb/6cAtI6gwIEmFZ1qvnFCJy7iI+QArrsfW8C5Ok7xwwaARQNDFiv
++yAUYECegLrqFGzA1R6OQnoIrg0auvhwJ+QxxjMOhbTtt4Rn7A1tOX6YObv4
+5BVAgQmqg6gTw9wLUzA5zFHwnZq1SNYnz3lcbi4stQXSy0F3OYiJ7piRJx0K
+dyM6F+QqdTX+SCE9GX2HpwgQgLIB4N9Vv3pckO6MbOKhslXvgtLJ3gyztwE6
+DPfzE5AMELezgS67hvna+YAAeQvC7msgbtojHAW6s4HqqwD8GuI8+Fs04W5s
+RzwqFK+GaDceCqcGuiXWNoc2lOQA8qa8F0A7+FxCgT6a/wJ0AtB5NUjgJBJA
+5MLZIPpYrbTqjmdCc5tE5i5IXvJeqP3U61L6gDth94fvPRdqpjLP0P72tN9u
+1Y1/7EjzHqoQjXCOhM8Frhe/5NZPPvaJvwfub4Etcb/3E7KXeqCO3+9cMD9Q
+4S9nJdyRD8rfQk3sEvvFQ5/2WjZkTfAk9gZ8tid9xvN86IN2aff+BMRTgF/n
+XNZTM5WQEgq4B3A3eHM3bmfHU2kWKyfxQghyAAVQgiWoB11Bf2XmbRxYep+k
+gi1XfWDkgsYDg6Qhg0NHgxXQdxr4eD+mgynWg0xwai8HhEK4BImigzQYXSwo
+GErogsZWBMvmDAnUASRwhTzXOFm4hVp0hV5IAh0QhmIYhvsVhUQwhYkghlc4
+Ajz3bGhjHCewhVnYhV8IhmMYhtS1BmY4BLXFBmI4AoDIc284iIQIF1ZDb2PX
+AYEoiIXYiI7YR2LgP484iZQoUWFAhJWYiY7oTMeniZ74iJyIg584imgTirpH
+iqjYNB+WiqyIL6vYirCoHpEIhyZQi7v+YQJhETrpgS4m0Em1aItI8ous8Ysy
+cwLC2B2zuBsfcBMVBxfLeBO1tjnWZAIjkwIlUI2C4WSfFhmeZhPRSI1zZCY3
+kRvTIQZu6Iym5mmJQo0LUAImME+YmAILwB3L2CCe1hrYKBmedgLzJBnUGI3o
+aEfFtBujZhzLGD/l1kflZk3cCCzzBCwLUGlw1j/xeI8X4FlxQY0XAALxeJDN
+lJCConSh8YwDGRgXGRgA0IzXuIyetoz+81AKsADR2I16lpE2IZPi+BYgkI+h
+UZDKeC7x+JGg8Y+hMUopcBMYxZOC4WkxGRpEOZLXpo7G4ZOs4ZFO2R8lsC1B
+6WkNcpESCWfDH+CO+jgyDCkYGimWunIuy9iMyQN102GVobGTkBaXUHSNkqiN
+zWiRICmNSJmW0XGO9rR+3ZE7J1ACJQCYZ+SMt3iM2agbveiPjGmWwGgcBTWA
+sXiZg3lPmLmZw4iInPmZuOOZoMmZlXkIogUCuTOaUmWarEkEH4CagAmLptia
+tDkEr5mamjibtbmbRZCLuEmIusmbwokEr3mYlBicw5mcTMCRg6iczmmatxmb
+LvOc1AmdqDmV1ZmdwhmW6aGd3vmdSxAEADs=}
+}
diff --git a/tkimg/tests/visualtests/utils/testReadWrite.tcl b/tkimg/tests/visualtests/utils/testReadWrite.tcl
new file mode 100755
index 0000000..df8422b
--- /dev/null
+++ b/tkimg/tests/visualtests/utils/testReadWrite.tcl
@@ -0,0 +1,287 @@
+# Some constants
+set modeFile 0x01
+set modeBin  0x02
+set modeUU   0x04
+set modeFileStr "File IO"
+set modeBinStr  "Binary IO"
+set modeUUStr   "UUencoded IO"
+
+# The list of file formats to be tested.
+# First entry specifies the file extension used to create the image filenames.
+# Second entry specifies the image format name as used by the Img extension.
+# Third entry specifies optional format options.
+
+set fmtList [list \
+        [list ".bmp"   "bmp"  ""] \
+        [list ".gif"   "gif"  ""] \
+        [list ".ico"   "ico"  ""] \
+        [list ".jpg"   "jpeg" ""] \
+        [list ".pcx"   "pcx"  ""] \
+        [list ".png"   "png"  ""] \
+        [list ".ppm"   "ppm"  ""] \
+        [list ".raw"   "raw"  "-useheader true -nomap true -nchan 3"] \
+        [list ".rgb"   "sgi"  ""] \
+        [list ".ras"   "sun"  ""] \
+        [list ".tga"   "tga"  ""] \
+        [list ".tif"   "tiff" ""] \
+        [list ".xbm"   "xbm"  ""] \
+        [list ".xpm"   "xpm"  ""] ]
+
+
+# Load image data directly from a file into a photo image.
+# Uses commands: image create photo -file "fileName"
+proc readPhotoFile1 { name fmt } {
+    PN "File read 1: "
+
+    set sTime [clock clicks -milliseconds]
+    set retVal [catch {image create photo -file $name} ph]
+    if { $retVal != 0 } {
+        P "\n\tWarning: Cannot detect image file format. Trying again with -format."
+        P "\tError message: $ph"
+        set retVal [catch {image create photo -file $name -format $fmt} ph]
+        if { $retVal != 0 } {
+            P "\tERROR: Cannot read image file with format option $fmt" 
+            P "\tError message: $ph"
+            return ""
+        }
+    }
+    set eTime [clock clicks -milliseconds]
+    PN "[format "%.2f " [expr ($eTime - $sTime) / 1.0E3]]"
+    return $ph
+}
+
+# Load image data directly from a file into a photo image.
+# Uses commands: set ph [image create photo] ; $ph read "fileName" 
+# args maybe "-from ..." and/or "-to ..." option.
+proc readPhotoFile2 { name fmt width height args } {
+    PN "File read 2: "
+
+    set sTime [clock clicks -milliseconds]
+    if { $width < 0 && $height < 0 } {
+        set ph [image create photo]
+    } else {
+        set ph [image create photo -width $width -height $height]
+    }
+    set retVal [catch {eval {$ph read $name} $args} errMsg]
+    if { $retVal != 0 } {
+        P "\n\tWarning: Cannot detect image file format. Trying again with -format."
+        P "\tError message: $errMsg"
+        set retVal [catch {eval {$ph read $name -format $fmt} $args} errMsg]
+        if { $retVal != 0 } {
+            P "\tERROR: Cannot read image file with format option $fmt" 
+            P "\tError message: $errMsg"
+            return ""
+        }
+    }
+    set eTime [clock clicks -milliseconds]
+    PN "[format "%.2f " [expr ($eTime - $sTime) / 1.0E3]]"
+    return $ph
+}
+
+# Load binary image data from a variable into a photo image.
+# Uses commands: image create photo -data $imgData
+proc readPhotoBinary1 { name fmt args } {
+    PN "Binary read 1: "
+
+    set sTime [clock clicks -milliseconds]
+    set retVal [catch {open $name r} fp]
+    if { $retVal != 0 } {
+        P "\n\tERROR: Cannot open image file $name for binary reading."
+        return ""
+    }
+    fconfigure $fp -translation binary
+    set imgData [read $fp [file size $name]]
+    close $fp
+
+    set retVal [catch {image create photo -data $imgData} ph]
+    if { $retVal != 0 } {
+        P "\n\tWarning: Cannot detect image file format. Trying again with -format."
+        P "\tError message: $ph"
+        set retVal [catch {image create photo -data $imgData -format $fmt} ph]
+        if { $retVal != 0 } {
+            P "\tERROR: Cannot create photo from binary image data." 
+            P "\tError message: $ph"
+            return ""
+        }
+    }
+    set eTime [clock clicks -milliseconds]
+    PN "[format "%.2f " [expr ($eTime - $sTime) / 1.0E3]]"
+    return $ph
+}
+
+# Load binary image data from a variable into a photo image.
+# Uses commands: set ph [image create photo] ; $ph put $imgData
+# args maybe "-to ..." option.
+proc readPhotoBinary2 { name fmt width height args } {
+    PN "Binary read 2: "
+
+    set sTime [clock clicks -milliseconds]
+    set retVal [catch {open $name r} fp]
+    if { $retVal != 0 } {
+        P "\n\tERROR: Cannot open image file $name for binary reading."
+        return ""
+    }
+    fconfigure $fp -translation binary
+    set imgData [read $fp [file size $name]]
+    close $fp
+
+    if { $width < 0 && $height < 0 } {
+        set ph [image create photo]
+    } else {
+        set ph [image create photo -width $width -height $height]
+    }
+    set retVal [catch {eval {$ph put $imgData} $args} errMsg]
+    if { $retVal != 0 } {
+        P "\n\tWarning: Cannot detect image file format. Trying again with -format."
+        P "\tError message: $errMsg"
+        set retVal [catch {eval {$ph put $imgData -format $fmt} $args} errMsg]
+        if { $retVal != 0 } {
+            P "\tERROR: Cannot create photo from binary image data."
+            P "\tError message: $errMsg"
+            return ""
+        }
+    }
+    set eTime [clock clicks -milliseconds]
+    PN "[format "%.2f " [expr ($eTime - $sTime) / 1.0E3]]"
+    return $ph
+}
+
+# Load uuencoded image data from a variable into a photo image.
+# Uses commands: set ph [image create photo] ; $ph put $imgData
+proc readPhotoString { str fmt width height args } {
+    PN "String read: "
+
+    set sTime [clock clicks -milliseconds]
+    if { $width < 0 && $height < 0 } {
+        set ph [image create photo]
+    } else {
+        set ph [image create photo -width $width -height $height]
+    }
+    set retVal [catch {eval {$ph put $str} $args}]
+    if { $retVal != 0 } {
+        P "\n\tWarning: Cannot detect image string format. Trying again with -format."
+        set retVal [catch {eval {$ph put $str -format $fmt} $args}]
+        if { $retVal != 0 } {
+            P "\tERROR: Cannot read image string with format option: $fmt" 
+            return ""
+        }
+    }
+    set eTime [clock clicks -milliseconds]
+    PN "[format "%.2f " [expr ($eTime - $sTime) / 1.0E3]]"
+    return $ph
+}
+
+proc writePhotoFile { ph name fmt del args } {
+    PN "File write: "
+
+    set sTime [clock clicks -milliseconds]
+    set retVal [catch {eval {$ph write $name -format $fmt} $args} str]
+    set eTime [clock clicks -milliseconds]
+
+    if { $retVal != 0 } {
+        P "\n\tERROR: Cannot write image file $name (Format: $fmt)" 
+        P "\tError message: $str"
+        return ""
+    }
+    if { $del } {
+        image delete $ph
+    }
+    PN "[format "%.2f " [expr ($eTime - $sTime) / 1.0E3]]"
+    return $str
+}
+
+proc writePhotoString { ph fmt del args } {
+    PN "String write: "
+
+    set sTime [clock clicks -milliseconds]
+    set retVal [catch {eval {$ph data -format $fmt} $args} str]
+    set eTime [clock clicks -milliseconds]
+    if { $retVal != 0 } {
+        P "\n\tERROR: Cannot write image to string (Format: $fmt)" 
+        P "\tError message: $str"
+        return ""
+    }
+    if { $del } {
+        image delete $ph
+    }
+    PN "[format "%.2f " [expr ($eTime - $sTime) / 1.0E3]]"
+    return $str
+}
+
+proc createErrImg {} {
+    set retVal [catch {image create photo -data [unsupportedImg]} errImg]
+    if { $retVal != 0 } {
+        P "FATAL ERROR: Cannot load uuencode GIF image into canvas."
+        P "             Test will be cancelled."
+        exit 1
+    }
+    return $errImg
+}
+
+proc getCanvasPhoto { canvId } {
+    PN "Canvas photo: "
+    set sTime [clock clicks -milliseconds]
+    set retVal [catch {image create photo -format window -data $canvId} ph]
+    set eTime [clock clicks -milliseconds]
+    if { $retVal != 0 } {
+        P "\n\tFATAL ERROR: Cannot create photo from canvas window"
+        exit 1
+    }
+    P "[format "%.2f secs" [expr ($eTime - $sTime) / 1.0E3]]"
+    return $ph
+}
+
+proc delayedUpdate {} {
+    update 
+    after 200
+}
+
+proc drawInfo { x y color font } {
+    set size 10
+    set tx [expr $x + $size * 2]
+    .t.c create rectangle $x $y [expr $x + $size] [expr $y + $size] -fill $color
+    .t.c create text $tx $y -anchor nw -fill black -text "$color box" -font $font
+    delayedUpdate
+}
+
+proc drawTestCanvas { imgVersion} {
+    toplevel .t
+    wm title .t "Canvas window"
+    wm geometry .t "+0+30"
+
+    canvas .t.c -bg gray -width 240 -height 220
+    pack .t.c
+
+    P "Loading uuencoded GIF image into canvas .." 
+    set retVal [catch {image create photo -data [pwrdLogo]} phImg]
+    if { $retVal != 0 } {
+        P "FATAL ERROR: Cannot load uuencode GIF image into canvas." 
+        P "             Test will be cancelled." 
+        exit 1
+    }
+
+    .t.c create image 0 0 -anchor nw -tags MyImage
+    .t.c itemconfigure MyImage -image $phImg
+
+    P "Drawing text and rectangles into canvas .." 
+    .t.c create rectangle 1 1 239 219 -outline black
+    .t.c create rectangle 3 3 237 217 -outline green -width 2
+    delayedUpdate
+
+    set font {-family {Courier} -size 9}
+
+    drawInfo 140  10 black   $font
+    drawInfo 140  30 white   $font
+    drawInfo 140  50 red     $font
+    drawInfo 140  70 green   $font
+    drawInfo 140  90 blue    $font
+    drawInfo 140 110 cyan    $font
+    drawInfo 140 130 magenta $font
+    drawInfo 140 150 yellow  $font
+
+    .t.c create text 140 170 -anchor nw -fill black -text "Created with:" -font $font
+    delayedUpdate
+    .t.c create text 140 185 -anchor nw -fill black -text "Tcl [info patchlevel]" -font $font
+    .t.c create text 140 200 -anchor nw -fill black -text "Img $imgVersion" -font $font
+    update
+}
diff --git a/tkimg/tests/visualtests/utils/testUtil.tcl b/tkimg/tests/visualtests/utils/testUtil.tcl
new file mode 100755
index 0000000..aa82d67
--- /dev/null
+++ b/tkimg/tests/visualtests/utils/testUtil.tcl
@@ -0,0 +1,59 @@
+proc P { str } {
+    catch {puts $str ; flush stdout}
+}
+
+proc PN { str } {
+    catch {puts -nonewline $str ; flush stdout}
+}
+
+proc PP { str } {
+    P ""
+    P $str
+    P ""
+}
+
+proc PS { } {
+    P ""
+    P "------------------------------------------------------------"
+    P ""
+}
+
+proc PH { str } {
+    P ""
+    P "Test: $str"
+    PS
+}
+
+proc PF { floatVal { prec 4 } } {
+    set fmtStr "%.${prec}f"
+    return [format $fmtStr $floatVal]
+}
+
+proc PSec { msg sec } {
+    P [format "%s: %.4f seconds" $msg $sec]
+}
+
+proc PrintMachineInfo {} {
+    global tcl_platform
+
+    P "Machine specific information:"
+    P  "platform    : $tcl_platform(platform)"
+    P  "os          : $tcl_platform(os)"
+    P  "osVersion   : $tcl_platform(osVersion)"
+    P  "machine     : $tcl_platform(machine)"
+    P  "byteOrder   : $tcl_platform(byteOrder)"
+    P  "wordSize    : $tcl_platform(wordSize)"
+    P  "user        : $tcl_platform(user)"
+    P  "hostname    : [info hostname]"
+    P  "Tcl version : [info patchlevel]"
+    P  "Visuals     : [winfo visualsavailable .]"
+}
+
+proc SetFileTypes { } {
+    global fInfo env
+
+    set fInfo(suf) ".tga"
+    set fInfo(fmt) "targa"
+    set fInfo(vsn) "int"
+    set fInfo(modfmt) 0
+}