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 (Using -from option)" 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 "testFrom.tcl: Read/Write (Using -from option)" "+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 testFrom$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 [readPhotoFile2 $fname "$fmt $opt" -1 -1 -from 140 50 200 110] 78 if { $ph eq "" } { 79 set ph [createErrImg] 80 } 81 set msg "Image $count.1: $fname Format: $fmt $sep (Read from file 2)" 82 ui_addphoto $ph $msg 83 } 84 if { $testMode & $modeBin } { 85 set ph [getCanvasPhoto .t.c] 86 set str [writePhotoFile $ph $fname "$fmt $opt" 1 -from 140 50 200 110] 87 set ph [readPhotoBinary1 $fname "$fmt $opt"] 88 if { $ph eq "" } { 89 set ph [createErrImg] 90 } 91 set msg "Image $count.2: $fname Format: $fmt $sep (Read as binary 1)" 92 ui_addphoto $ph $msg 93 } 94 if { $testMode & $modeUU } { 95 set ph [getCanvasPhoto .t.c] 96 set str [writePhotoString $ph "$fmt $opt" 1 -from 140 50 200 110] 97 if { $str eq "" } { 98 set ph [createErrImg] 99 } else { 100 set ph [readPhotoString $str "$fmt $opt" -1 -1] 101 if { $ph eq "" } { 102 set ph [createErrImg] 103 } 104 } 105 set msg "Image $count.3: $fname Format: $fmt $sep (Read as uuencoded string)" 106 ui_addphoto $ph $msg 107 } 108 109 P "" 110 incr count 111} 112 113PS 114P "End of test" 115 116P "" 117P "Package tkImg: $version" 118ui_show 119