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