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