summaryrefslogtreecommitdiffstats
path: root/tkimg/tests/visualtests
diff options
context:
space:
mode:
authorWilliam Joye <wjoye@cfa.harvard.edu>2019-01-08 21:02:55 (GMT)
committerWilliam Joye <wjoye@cfa.harvard.edu>2019-01-08 21:02:55 (GMT)
commitdbbb38af9cefef9e9e1a03c97945ee59063aa782 (patch)
treedeefc089aa3327ebd4daa943b47c0d8f34af6bc7 /tkimg/tests/visualtests
parent54ae0375ebd9242bdf2eeceacee4c5b2de914bc1 (diff)
downloadblt-dbbb38af9cefef9e9e1a03c97945ee59063aa782.zip
blt-dbbb38af9cefef9e9e1a03c97945ee59063aa782.tar.gz
blt-dbbb38af9cefef9e9e1a03c97945ee59063aa782.tar.bz2
update tkimg 1.4.7
Diffstat (limited to 'tkimg/tests/visualtests')
-rwxr-xr-xtkimg/tests/visualtests/Readme.txt28
-rwxr-xr-xtkimg/tests/visualtests/testFrom.tcl116
-rwxr-xr-xtkimg/tests/visualtests/testFull.tcl129
-rwxr-xr-xtkimg/tests/visualtests/testSmall.tcl137
-rwxr-xr-xtkimg/tests/visualtests/testTo.tcl117
-rwxr-xr-xtkimg/tests/visualtests/utils/testGUI.tcl279
-rwxr-xr-xtkimg/tests/visualtests/utils/testImgs.tcl147
-rwxr-xr-xtkimg/tests/visualtests/utils/testReadWrite.tcl287
-rwxr-xr-xtkimg/tests/visualtests/utils/testUtil.tcl59
9 files changed, 0 insertions, 1299 deletions
diff --git a/tkimg/tests/visualtests/Readme.txt b/tkimg/tests/visualtests/Readme.txt
deleted file mode 100755
index 9add1b5..0000000
--- a/tkimg/tests/visualtests/Readme.txt
+++ /dev/null
@@ -1,28 +0,0 @@
- 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
deleted file mode 100755
index 3a3c60f..0000000
--- a/tkimg/tests/visualtests/testFrom.tcl
+++ /dev/null
@@ -1,116 +0,0 @@
-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
deleted file mode 100755
index d07056f..0000000
--- a/tkimg/tests/visualtests/testFull.tcl
+++ /dev/null
@@ -1,129 +0,0 @@
-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
deleted file mode 100755
index 565e518..0000000
--- a/tkimg/tests/visualtests/testSmall.tcl
+++ /dev/null
@@ -1,137 +0,0 @@
-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
deleted file mode 100755
index 2ac23f2..0000000
--- a/tkimg/tests/visualtests/testTo.tcl
+++ /dev/null
@@ -1,117 +0,0 @@
-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
deleted file mode 100755
index 4ddc825..0000000
--- a/tkimg/tests/visualtests/utils/testGUI.tcl
+++ /dev/null
@@ -1,279 +0,0 @@
-# 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
deleted file mode 100755
index 1144365..0000000
--- a/tkimg/tests/visualtests/utils/testImgs.tcl
+++ /dev/null
@@ -1,147 +0,0 @@
-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
deleted file mode 100755
index df8422b..0000000
--- a/tkimg/tests/visualtests/utils/testReadWrite.tcl
+++ /dev/null
@@ -1,287 +0,0 @@
-# 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
deleted file mode 100755
index aa82d67..0000000
--- a/tkimg/tests/visualtests/utils/testUtil.tcl
+++ /dev/null
@@ -1,59 +0,0 @@
-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
-}