1package require Tk 2 3proc initPackages { args } { 4 global gPkg 5 6 foreach pkg $args { 7 set retVal [catch {package require $pkg} gPkg(ext,$pkg,version)] 8 set gPkg(ext,$pkg,avail) [expr !$retVal] 9 } 10} 11 12initPackages img::bmp img::gif img::ico img::jpeg img::pcx \ 13 img::png img::ppm img::raw img::sgi img::sun \ 14 img::tga img::tiff img::xbm img::xpm img::window 15 16set retVal [catch {package require Img} version] 17if { $retVal } { 18 error "Trying to load package Img: $version" 19} 20 21cd [file dirname [info script]] 22 23source [file join "utils" "testUtil.tcl"] 24source [file join "utils" "testGUI.tcl"] 25# We get the global variable ui_enable_tk from above Tcl module. 26 27source [file join "utils" "testImgs.tcl"] 28source [file join "utils" "testReadWrite.tcl"] 29 30if { $argc != 1 } { 31 set testMode [expr $modeFile | $modeBin | $modeUU] 32} else { 33 set testMode [lindex $argv 0] 34} 35 36PH "Image Read/Write (Full Images)" 37 38P "This test tries to store the content of a canvas window in image files" 39P "using all file formats available in the tkImg package." 40P "After writing we try to read the image back into a photo by using the" 41P "auto-detect mechanism of tkImg. If that fails, we use the \"-format\" option." 42P "" 43if { $ui_enable_tk } { 44 P "Set the environment variable UI_TK to 0 before running this test," 45 P "to run this test in batch mode without displaying the images." 46 P "" 47} 48 49if { $tcl_platform(platform) eq "windows" && $ui_enable_tk } { 50 catch { console show } 51} 52 53ui_init "testFull.tcl: Read/Write (Full Images)" "+320+30" 54SetFileTypes 55 56drawTestCanvas $version 57 58P "" 59set sep "" 60if { $ui_enable_tk } { 61 set sep "\n\t" 62} 63set count 1 64foreach elem $fmtList { 65 set ext [lindex $elem 0] 66 set fmt [lindex $elem 1] 67 set opt [lindex $elem 2] 68 catch { file mkdir out } 69 set fname [file join out testFull$ext] 70 set msg "Image $count: $fname Format: $fmt $sep (Options: $opt)" 71 P $msg 72 73 PN "\t" 74 set ph [getCanvasPhoto .t.c] 75 writePhotoFile $ph $fname "$fmt $opt" 1 76 if { $testMode & $modeFile } { 77 set ph [readPhotoFile1 $fname "$fmt $opt"] 78 if { $ph eq "" } { 79 set ph [createErrImg] 80 } 81 set msg "Image $count.1: $fname Format: $fmt $sep (Read from file 1)" 82 ui_addphoto $ph $msg 83 84 set ph [readPhotoFile2 $fname "$fmt $opt" -1 -1] 85 if { $ph eq "" } { 86 set ph [createErrImg] 87 } 88 set msg "Image $count.2: $fname Format: $fmt $sep (Read from file 2)" 89 ui_addphoto $ph $msg 90 } 91 if { $testMode & $modeBin } { 92 set ph [readPhotoBinary1 $fname "$fmt $opt"] 93 if { $ph eq "" } { 94 set ph [createErrImg] 95 } 96 set msg "Image $count.3: $fname Format: $fmt $sep (Read as binary 1)" 97 ui_addphoto $ph $msg 98 99 set ph [readPhotoBinary2 $fname "$fmt $opt" -1 -1] 100 if { $ph eq "" } { 101 set ph [createErrImg] 102 } 103 set msg "Image $count.4: $fname Format: $fmt $sep (Read as binary 2)" 104 ui_addphoto $ph $msg 105 } 106 if { $testMode & $modeUU } { 107 set ph [getCanvasPhoto .t.c] 108 set str [writePhotoString $ph "$fmt $opt" 1] 109 if { $str eq "" } { 110 set ph [createErrImg] 111 } else { 112 set ph [readPhotoString $str "$fmt $opt" -1 -1] 113 if { $ph eq "" } { 114 set ph [createErrImg] 115 } 116 } 117 set msg "Image $count.5: $fname Format: $fmt $sep (Read as uuencoded string)" 118 ui_addphoto $ph $msg 119 } 120 121 P "" 122 incr count 123} 124 125PS 126P "End of test" 127 128P "" 129P "Package tkImg: $version" 130ui_show 131