blob: 42c499d7f2132f6b717de680857b8d50c4e31564 (
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
130
|
# This file is a Tcl script to test out BMP reading and writing.
# It is organized in the standard fashion for Tcl tests.
package require Tk
package require tcltest
tcltest::configure {*}$argv
source [file join [file dirname [info script]] constraints.tcl]
package require Img
imageInit
namespace eval ::bmp::test {
namespace import ::tcltest::*
set fmt "bmp"
set ext "bmp"
set file "testimgs/img.$ext"
set out "testimgs/img_out.$ext"
# Encoded image content.
source $file.base64
test bmp-1.1 {} -setup {
catch {image delete i}
} -body {
image create photo i -file $file
i data -format $fmt
} -cleanup {
image delete i
} -result $imgdata
test bmp-1.2 {} -setup {
catch {image delete i}
} -body {
image create photo i -data $imgdata
i data -format $fmt
} -cleanup {
image delete i
} -result $imgdata
test bmp-1.3 {} -setup {
catch {image delete i}
} -body {
image create photo i
i put $imgdata
i data -format $fmt
} -cleanup {
image delete i
} -result $imgdata
test bmp-1.4 {} -setup {
catch {image delete i}
} -body {
image create photo i
i put $imgdata -format $fmt
i data -format $fmt
} -cleanup {
image delete i
} -result $imgdata
test bmp-2.0 {Binary I/O with BMP images} -setup {
catch {image delete i}
} -body {
image create photo i
set f [open $file r]
fconfigure $f -translation binary
set return [catch {i put [read $f]} msg]
close $f
lappend return $msg
} -cleanup {
image delete i
} -result {0 {}}
test bmp-2.1 {Save with given aspect ratio} -setup {
catch {image delete i}
} -body {
image create photo i
i put $imgdata -format $fmt
i write $out -format [list $fmt -resolution {300 100}]
set f [open $out r]
fconfigure $f -translation binary
binary scan [read $f] x38i2 xyres
set return [read $f]
close $f
catch {file delete $out}
set xyres
} -cleanup {
image delete i
} -result {2925 975}
test bmp-2.2 {Save with constant resolution of 300 dpi} -setup {
catch {image delete i}
} -body {
image create photo i
i put $imgdata -format $fmt
i write $out -format [list $fmt -resolution {300 i}]
set f [open $out r]
fconfigure $f -translation binary
binary scan [read $f] x38i2 xyres
set return [read $f]
close $f
catch {file delete $out}
set xyres
} -cleanup {
image delete i
} -result {11811 11811}
test bmp-2.3 {Save with given resolution of x 100dpi and y 50dpi} -setup {
catch {image delete i}
} -body {
image create photo i
i put $imgdata -format $fmt
i write $out -format [list $fmt -resolution {100 50 i}]
set f [open $out r]
fconfigure $f -translation binary
binary scan [read $f] x38i2 xyres
set return [read $f]
close $f
catch {file delete $out}
set xyres
} -cleanup {
image delete i
} -result {3937 1969}
}
imageFinish
namespace delete ::bmp::test
|
