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