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