author | Jan Vrany <jan.vrany@labware.com> |
Tue, 04 Apr 2023 14:22:18 +0200 | |
branch | jv |
changeset 4473 | 3675eb1de41b |
parent 3855 | 1db7742d33ad |
permissions | -rw-r--r-- |
44 | 1 |
" |
204 | 2 |
COPYRIGHT (c) 1995 by Claus Gittinger |
3 |
All Rights Reserved |
|
44 | 4 |
|
204 | 5 |
This software is furnished under a license and may be used |
6 |
only in accordance with the terms of that license and with the |
|
7 |
inclusion of the above copyright notice. This software may not |
|
8 |
be provided or otherwise made available to, or used by, any |
|
9 |
other person. No title to or ownership of the software is |
|
10 |
hereby transferred. |
|
51 | 11 |
|
12 |
||
204 | 13 |
The above copyright does not apply to: |
14 |
XWDReader>>save:onFile: |
|
15 |
which was written by Brad Schoening <brad@boole.com> |
|
16 |
who placed it into the public domain. |
|
44 | 17 |
" |
3855
1db7742d33ad
Win32: Build libjpeg in its own directory, out-of-source-tree.
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
1846
diff
changeset
|
18 |
"{ Package: 'stx:libview2' }" |
42 | 19 |
|
3855
1db7742d33ad
Win32: Build libjpeg in its own directory, out-of-source-tree.
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
1846
diff
changeset
|
20 |
"{ NameSpace: Smalltalk }" |
1736 | 21 |
|
391 | 22 |
ImageReader subclass:#XWDReader |
204 | 23 |
instanceVariableNames:'' |
24 |
classVariableNames:'' |
|
25 |
poolDictionaries:'' |
|
1745
4fa0fad2a463
code cleanup (colorMap handling)
Claus Gittinger <cg@exept.de>
parents:
1736
diff
changeset
|
26 |
category:'Graphics-Images-Readers' |
42 | 27 |
! |
28 |
||
391 | 29 |
!XWDReader class methodsFor:'documentation'! |
44 | 30 |
|
31 |
copyright |
|
32 |
" |
|
204 | 33 |
COPYRIGHT (c) 1995 by Claus Gittinger |
34 |
All Rights Reserved |
|
44 | 35 |
|
204 | 36 |
This software is furnished under a license and may be used |
37 |
only in accordance with the terms of that license and with the |
|
38 |
inclusion of the above copyright notice. This software may not |
|
39 |
be provided or otherwise made available to, or used by, any |
|
40 |
other person. No title to or ownership of the software is |
|
41 |
hereby transferred. |
|
51 | 42 |
|
43 |
||
204 | 44 |
The above copyright does not apply to: |
45 |
XWDReader>>save:onFile: |
|
46 |
which was written by Brad Schoening <brad@boole.com> |
|
47 |
who placed it into the public domain. |
|
44 | 48 |
" |
49 |
! |
|
50 |
||
51 |
documentation |
|
52 |
" |
|
205 | 53 |
this class provides methods for loading/saving of x-window dump (xwd) images. |
204 | 54 |
Both reading and writing of images is supported. |
55 |
||
56 |
[See also:] |
|
234 | 57 |
Image Form Icon |
204 | 58 |
BlitImageReader FaceReader GIFReader JPEGReader PBMReader PCXReader |
210 | 59 |
ST80FormReader SunRasterReader TargaReader TIFFReader WindowsIconReader |
204 | 60 |
XBMReader XPMReader |
44 | 61 |
" |
62 |
! ! |
|
63 |
||
398 | 64 |
!XWDReader class methodsFor:'initialization'! |
65 |
||
66 |
initialize |
|
67 |
"tell Image-class, that a new fileReader is present |
|
68 |
for the '.xwd' extension." |
|
69 |
||
647 | 70 |
MIMETypes defineImageType:'image/x-xwindowdump' suffix:'xwd' reader:self |
398 | 71 |
|
72 |
"Created: 1.2.1997 / 15:04:46 / cg" |
|
73 |
! ! |
|
74 |
||
391 | 75 |
!XWDReader class methodsFor:'queries'! |
51 | 76 |
|
77 |
canRepresent:anImage |
|
391 | 78 |
"return true, if anImage can be represented in my file format. |
79 |
Only depth8 palette images are supported." |
|
51 | 80 |
|
391 | 81 |
anImage depth ~~ 8 ifTrue:[^ false]. |
82 |
anImage photometric ~~ #palette ifTrue:[^ false]. |
|
83 |
^ true |
|
51 | 84 |
! ! |
85 |
||
1805 | 86 |
!XWDReader methodsFor:'reading'! |
42 | 87 |
|
1736 | 88 |
readImage |
89 |
"read an image in XWD (X Window Dump) format from my inStream." |
|
42 | 90 |
|
391 | 91 |
|header nColors pad |
92 |
srcRowByteSize bytesPerRow bitsPerPixel colormapSize depth |
|
93 |
dstIndex| |
|
42 | 94 |
|
1736 | 95 |
inStream binary. |
42 | 96 |
|
1736 | 97 |
header := (1 to: 25) collect: [:i | inStream nextLong]. |
391 | 98 |
|
99 |
"skip ..." |
|
1736 | 100 |
101 to:(header at: 1) do: [:i | inStream next]. |
391 | 101 |
|
102 |
depth := header at: 4. |
|
103 |
width := header at: 5. |
|
104 |
height := header at: 6. |
|
105 |
pad := header at: 11. |
|
42 | 106 |
|
1846 | 107 |
self reportDimension. |
108 |
||
391 | 109 |
bitsPerPixel := header at: 12. |
110 |
bitsPerPixel == 24 ifTrue:[ |
|
111 |
bitsPerSample := #(8 8 8). |
|
112 |
samplesPerPixel := 3. |
|
113 |
photometric := #rgb |
|
114 |
] ifFalse:[ |
|
115 |
bitsPerSample := Array with:bitsPerPixel. |
|
116 |
samplesPerPixel := 1. |
|
117 |
photometric := #palette |
|
118 |
]. |
|
119 |
"/ depth ~~ bitsPerPixel ifTrue:[self halt]. |
|
120 |
||
121 |
colormapSize := header at: 19. |
|
122 |
nColors := header at: 20. |
|
44 | 123 |
|
391 | 124 |
colorMap := Array new:colormapSize. |
125 |
||
126 |
1 to:nColors do:[:i | |
|
127 |
|clr r g b| |
|
128 |
||
1736 | 129 |
inStream nextLong. |
130 |
r := inStream nextUnsignedShortMSB:true. |
|
131 |
g := inStream nextUnsignedShortMSB:true. |
|
132 |
b := inStream nextUnsignedShortMSB:true. |
|
391 | 133 |
clr := ColorValue scaledRed: (r bitShift: -3) |
134 |
scaledGreen: (g bitShift: -3) |
|
135 |
scaledBlue: (b bitShift: -3). |
|
136 |
colorMap at:i put:clr. |
|
1736 | 137 |
inStream nextWord. |
44 | 138 |
]. |
139 |
||
391 | 140 |
nColors+1 to:colormapSize do: [:i | colorMap at:i put:Color black]. |
141 |
||
142 |
bytesPerRow := width * bitsPerPixel // 8. |
|
143 |
((width * bitsPerPixel \\ 8) ~~ 0) ifTrue:[ |
|
144 |
bytesPerRow := bytesPerRow + 1 |
|
44 | 145 |
]. |
391 | 146 |
srcRowByteSize := width * bitsPerPixel + pad - 1 // pad * (pad / 8). |
42 | 147 |
|
391 | 148 |
data := ByteArray uninitializedNew: srcRowByteSize * height. |
149 |
srcRowByteSize == bytesPerRow ifTrue:[ |
|
1736 | 150 |
inStream nextBytes:srcRowByteSize * height into:data. |
391 | 151 |
] ifFalse:[ |
152 |
dstIndex := 1. |
|
153 |
1 to:height do:[:y | |
|
1736 | 154 |
inStream nextBytes:bytesPerRow into:data startingAt:dstIndex. |
155 |
inStream next:(srcRowByteSize - bytesPerRow). |
|
391 | 156 |
dstIndex := dstIndex + bytesPerRow. |
390 | 157 |
]. |
391 | 158 |
] |
1736 | 159 |
|
391 | 160 |
" |
161 |
XWDReader fromFile:'testfile.xwd' |
|
42 | 162 |
" |
49 | 163 |
" |
391 | 164 |
XWDReader save:(Image fromUser) onFile: '/tmp/st.xwd' |
165 |
(Image fromFile: '/tmp/st.xwd') inspect |
|
166 |
" |
|
42 | 167 |
! ! |
168 |
||
1805 | 169 |
!XWDReader methodsFor:'writing'! |
49 | 170 |
|
1814
2f204c2a957d
image saving - use save:onStream:
Claus Gittinger <cg@exept.de>
parents:
1805
diff
changeset
|
171 |
save:image onStream:aStream |
49 | 172 |
"Save as a version 7 color X11 window dump file (xwd) to the file fileName. |
173 |
This produces a mapped color table with 16 bit color. The xwd file can be |
|
204 | 174 |
viewed by the xwud program and printed with xpr. |
175 |
No compression is performed. |
|
49 | 176 |
|
205 | 177 |
See the file ...include/X11/XWDFile.h for a definition of the format." |
49 | 178 |
|
205 | 179 |
" |
49 | 180 |
Notice: |
204 | 181 |
this method was adapted from a goody in the uiuc archive |
182 |
(Prime time freeware). |
|
183 |
The original files header is: |
|
184 |
NAME imageToXWD |
|
185 |
AUTHOR Brad Schoening <brad@boole.com> |
|
186 |
FUNCTION Writes a Smalltalk image to an X11 xwd file |
|
187 |
ST-VERSION PPST 4.0 or 4.1 |
|
188 |
DISTRIBUTION world |
|
189 |
VERSION 1.0 |
|
190 |
DATE July 1993 |
|
51 | 191 |
|
204 | 192 |
thanks to Brad for giving us the base for this mehtod. |
49 | 193 |
" |
194 |
||
1814
2f204c2a957d
image saving - use save:onStream:
Claus Gittinger <cg@exept.de>
parents:
1805
diff
changeset
|
195 |
|rgbColor paletteColors ncolors dumpName headerSize| |
49 | 196 |
|
51 | 197 |
(self class canRepresent:image) ifFalse:[ |
461
bacef118f54a
more signals to be raised if anything happens during
Claus Gittinger <cg@exept.de>
parents:
398
diff
changeset
|
198 |
^ Image cannotRepresentImageSignal |
bacef118f54a
more signals to be raised if anything happens during
Claus Gittinger <cg@exept.de>
parents:
398
diff
changeset
|
199 |
raiseWith:image |
bacef118f54a
more signals to be raised if anything happens during
Claus Gittinger <cg@exept.de>
parents:
398
diff
changeset
|
200 |
errorString:('XWD format cannot represent this image'). |
bacef118f54a
more signals to be raised if anything happens during
Claus Gittinger <cg@exept.de>
parents:
398
diff
changeset
|
201 |
]. |
bacef118f54a
more signals to be raised if anything happens during
Claus Gittinger <cg@exept.de>
parents:
398
diff
changeset
|
202 |
|
bacef118f54a
more signals to be raised if anything happens during
Claus Gittinger <cg@exept.de>
parents:
398
diff
changeset
|
203 |
image mask notNil ifTrue:[ |
bacef118f54a
more signals to be raised if anything happens during
Claus Gittinger <cg@exept.de>
parents:
398
diff
changeset
|
204 |
Image informationLostQuerySignal |
bacef118f54a
more signals to be raised if anything happens during
Claus Gittinger <cg@exept.de>
parents:
398
diff
changeset
|
205 |
raiseWith:image |
bacef118f54a
more signals to be raised if anything happens during
Claus Gittinger <cg@exept.de>
parents:
398
diff
changeset
|
206 |
errorString:('XWD format does not support an imageMask'). |
49 | 207 |
]. |
208 |
||
209 |
dumpName := 'stdin'. |
|
210 |
headerSize := 4 * (25 + (dumpName size / 4) ceiling). |
|
211 |
paletteColors := image palette "colors". |
|
212 |
ncolors := paletteColors size. |
|
213 |
||
214 |
"create the header (each item is 32 bits long)" |
|
461
bacef118f54a
more signals to be raised if anything happens during
Claus Gittinger <cg@exept.de>
parents:
398
diff
changeset
|
215 |
|
49 | 216 |
aStream binary. |
217 |
aStream nextLongPut: headerSize. "total header size in bytes" |
|
218 |
aStream nextLongPut: 7. "XWD file version" |
|
219 |
aStream nextLongPut: 2. "pixmap format : ZPixmap" |
|
220 |
aStream nextLongPut: 8. "pixmap depth" |
|
221 |
aStream nextLongPut: image width. "pixmap cols" |
|
222 |
aStream nextLongPut: image height. "pixmap rows" |
|
223 |
aStream nextLongPut: 0. "bitmap x offset" |
|
224 |
aStream nextLongPut: 1. "byte order: MSBFirst" |
|
225 |
aStream nextLongPut: 8. "bitmap unit" |
|
226 |
aStream nextLongPut: 1. "bitmap bit order: MSBFirst" |
|
227 |
aStream nextLongPut: 8. "bitmap scanline pad" |
|
228 |
aStream nextLongPut: 8. "bits per pixel" |
|
229 |
aStream nextLongPut: image width. "bytes per scanline" |
|
230 |
aStream nextLongPut: 3. "colormap class : PseudoColor" |
|
231 |
aStream nextLongPut: 0. "Z red mask" |
|
232 |
aStream nextLongPut: 0. "Z green mask" |
|
233 |
aStream nextLongPut: 0. "Z blue mask" |
|
234 |
aStream nextLongPut: 8. "bits per rgb" |
|
235 |
aStream nextLongPut: 256. "number of color map entries" |
|
236 |
aStream nextLongPut: ncolors. "number of color structures" |
|
237 |
aStream nextLongPut: image width. "window width" |
|
238 |
aStream nextLongPut: image height. "window height" |
|
239 |
aStream nextLongPut: 0. "window upper left x coordinate" |
|
240 |
aStream nextLongPut: 0. "window upper left y coordinate" |
|
241 |
aStream nextLongPut: 0. "window border width" |
|
242 |
aStream nextPutAll: dumpName asByteArray. "name of dump" |
|
243 |
"Pad the string to the next 32-bit boundary" |
|
244 |
aStream nextPut: 0. "/ 6 |
|
245 |
aStream nextPut: 0. "/ 7 |
|
246 |
aStream nextPut: 0. "/ 8 |
|
247 |
||
1754 | 248 |
"/ [(aStream position1Based rem: 4) == 0] whileFalse: [ aStream nextPut: 0 ]. |
49 | 249 |
|
250 |
"Write out the color table. Each color table entry is 12 bytes long composed of: |
|
204 | 251 |
an index (4 bytes) |
252 |
red color value (2 bytes) |
|
253 |
green color value (2 bytes) |
|
254 |
blue color value (2 bytes) |
|
255 |
flag values (1 byte) |
|
256 |
pad (1 byte) |
|
49 | 257 |
" |
258 |
0 to: ncolors-1 do: [ :index | |
|
204 | 259 |
|r g b| |
49 | 260 |
|
204 | 261 |
aStream nextLongPut: index. |
262 |
rgbColor := paletteColors at: (1+index). |
|
263 |
(rgbColor isNil) ifTrue: [ rgbColor := ColorValue white ]. |
|
264 |
r := (rgbColor red / 100.0 * 65535) rounded. |
|
265 |
g := (rgbColor green / 100.0 * 65535) rounded. |
|
266 |
b := (rgbColor blue / 100.0 * 65535) rounded. |
|
49 | 267 |
|
204 | 268 |
aStream nextWordPut:r. |
269 |
aStream nextWordPut:g. |
|
270 |
aStream nextWordPut:b. |
|
271 |
aStream nextPut: 7. "flags" |
|
272 |
aStream nextPut: 0. "pad" |
|
49 | 273 |
]. |
274 |
||
275 |
"Write out the pixels as index color values" |
|
276 |
"/ Cursor write showWhile: [ |
|
99 | 277 |
"/ |cindex| |
83 | 278 |
"/ |
49 | 279 |
"/ 1 to: (image height) do: [ :row | |
280 |
"/ 1 to: (image width) do: [ :col | |
|
281 |
"/ cindex := image atPoint: (col-1)@(row-1). |
|
282 |
"/ aStream nextPut: cindex.]] |
|
283 |
"/ ]. |
|
284 |
aStream nextPutAll:image bits. |
|
285 |
||
286 |
" |
|
287 |
XWDReader save:(Image fromUser) onFile: '/tmp/st.xwd' |
|
288 |
(Image fromFile: '/tmp/st.xwd') inspect |
|
289 |
" |
|
461
bacef118f54a
more signals to be raised if anything happens during
Claus Gittinger <cg@exept.de>
parents:
398
diff
changeset
|
290 |
|
bacef118f54a
more signals to be raised if anything happens during
Claus Gittinger <cg@exept.de>
parents:
398
diff
changeset
|
291 |
"Modified: 27.2.1997 / 12:45:15 / cg" |
49 | 292 |
! ! |
204 | 293 |
|
391 | 294 |
!XWDReader class methodsFor:'documentation'! |
204 | 295 |
|
296 |
version |
|
1846 | 297 |
^ '$Header: /cvs/stx/stx/libview2/XWDReader.st,v 1.27 2003-11-19 15:24:16 cg Exp $' |
204 | 298 |
! ! |
1736 | 299 |
|
3855
1db7742d33ad
Win32: Build libjpeg in its own directory, out-of-source-tree.
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
1846
diff
changeset
|
300 |
|
398 | 301 |
XWDReader initialize! |