XWDReader.st
author Claus Gittinger <cg@exept.de>
Sat, 11 Nov 1995 17:05:49 +0100
changeset 114 e577a2f332d0
parent 99 a656b0c9dd21
child 204 277d2523d8cb
permissions -rw-r--r--
uff - version methods changed to return stings
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
44
c6cf7d0d6337 *** empty log message ***
claus
parents: 42
diff changeset
     1
"
c6cf7d0d6337 *** empty log message ***
claus
parents: 42
diff changeset
     2
 COPYRIGHT (c) 1995 by Claus Gittinger
c6cf7d0d6337 *** empty log message ***
claus
parents: 42
diff changeset
     3
	      All Rights Reserved
c6cf7d0d6337 *** empty log message ***
claus
parents: 42
diff changeset
     4
c6cf7d0d6337 *** empty log message ***
claus
parents: 42
diff changeset
     5
 This software is furnished under a license and may be used
c6cf7d0d6337 *** empty log message ***
claus
parents: 42
diff changeset
     6
 only in accordance with the terms of that license and with the
c6cf7d0d6337 *** empty log message ***
claus
parents: 42
diff changeset
     7
 inclusion of the above copyright notice.   This software may not
c6cf7d0d6337 *** empty log message ***
claus
parents: 42
diff changeset
     8
 be provided or otherwise made available to, or used by, any
c6cf7d0d6337 *** empty log message ***
claus
parents: 42
diff changeset
     9
 other person.  No title to or ownership of the software is
c6cf7d0d6337 *** empty log message ***
claus
parents: 42
diff changeset
    10
 hereby transferred.
51
ac84315b8181 *** empty log message ***
claus
parents: 49
diff changeset
    11
ac84315b8181 *** empty log message ***
claus
parents: 49
diff changeset
    12
ac84315b8181 *** empty log message ***
claus
parents: 49
diff changeset
    13
 The above copyright does not apply to:
ac84315b8181 *** empty log message ***
claus
parents: 49
diff changeset
    14
	XWDReader>>save:onFile:
ac84315b8181 *** empty log message ***
claus
parents: 49
diff changeset
    15
 which is in the public domain.
44
c6cf7d0d6337 *** empty log message ***
claus
parents: 42
diff changeset
    16
"
42
ab4cc6362a80 Initial revision
claus
parents:
diff changeset
    17
ab4cc6362a80 Initial revision
claus
parents:
diff changeset
    18
ImageReader subclass:#XWDReader
ab4cc6362a80 Initial revision
claus
parents:
diff changeset
    19
	 instanceVariableNames:''
ab4cc6362a80 Initial revision
claus
parents:
diff changeset
    20
	 classVariableNames:''
ab4cc6362a80 Initial revision
claus
parents:
diff changeset
    21
	 poolDictionaries:''
ab4cc6362a80 Initial revision
claus
parents:
diff changeset
    22
	 category:'Graphics-Images support'
ab4cc6362a80 Initial revision
claus
parents:
diff changeset
    23
!
ab4cc6362a80 Initial revision
claus
parents:
diff changeset
    24
44
c6cf7d0d6337 *** empty log message ***
claus
parents: 42
diff changeset
    25
!XWDReader class methodsFor:'documentation'!
c6cf7d0d6337 *** empty log message ***
claus
parents: 42
diff changeset
    26
c6cf7d0d6337 *** empty log message ***
claus
parents: 42
diff changeset
    27
copyright
c6cf7d0d6337 *** empty log message ***
claus
parents: 42
diff changeset
    28
"
c6cf7d0d6337 *** empty log message ***
claus
parents: 42
diff changeset
    29
 COPYRIGHT (c) 1995 by Claus Gittinger
c6cf7d0d6337 *** empty log message ***
claus
parents: 42
diff changeset
    30
	      All Rights Reserved
c6cf7d0d6337 *** empty log message ***
claus
parents: 42
diff changeset
    31
c6cf7d0d6337 *** empty log message ***
claus
parents: 42
diff changeset
    32
 This software is furnished under a license and may be used
c6cf7d0d6337 *** empty log message ***
claus
parents: 42
diff changeset
    33
 only in accordance with the terms of that license and with the
c6cf7d0d6337 *** empty log message ***
claus
parents: 42
diff changeset
    34
 inclusion of the above copyright notice.   This software may not
c6cf7d0d6337 *** empty log message ***
claus
parents: 42
diff changeset
    35
 be provided or otherwise made available to, or used by, any
c6cf7d0d6337 *** empty log message ***
claus
parents: 42
diff changeset
    36
 other person.  No title to or ownership of the software is
c6cf7d0d6337 *** empty log message ***
claus
parents: 42
diff changeset
    37
 hereby transferred.
51
ac84315b8181 *** empty log message ***
claus
parents: 49
diff changeset
    38
ac84315b8181 *** empty log message ***
claus
parents: 49
diff changeset
    39
ac84315b8181 *** empty log message ***
claus
parents: 49
diff changeset
    40
 The above copyright does not apply to:
ac84315b8181 *** empty log message ***
claus
parents: 49
diff changeset
    41
	XWDReader>>save:onFile:
ac84315b8181 *** empty log message ***
claus
parents: 49
diff changeset
    42
 which is in the public domain.
44
c6cf7d0d6337 *** empty log message ***
claus
parents: 42
diff changeset
    43
"
c6cf7d0d6337 *** empty log message ***
claus
parents: 42
diff changeset
    44
!
c6cf7d0d6337 *** empty log message ***
claus
parents: 42
diff changeset
    45
c6cf7d0d6337 *** empty log message ***
claus
parents: 42
diff changeset
    46
version
114
e577a2f332d0 uff - version methods changed to return stings
Claus Gittinger <cg@exept.de>
parents: 99
diff changeset
    47
    ^ '$Header: /cvs/stx/stx/libview2/XWDReader.st,v 1.10 1995-11-11 16:05:49 cg Exp $'
44
c6cf7d0d6337 *** empty log message ***
claus
parents: 42
diff changeset
    48
!
c6cf7d0d6337 *** empty log message ***
claus
parents: 42
diff changeset
    49
c6cf7d0d6337 *** empty log message ***
claus
parents: 42
diff changeset
    50
documentation
c6cf7d0d6337 *** empty log message ***
claus
parents: 42
diff changeset
    51
"
c6cf7d0d6337 *** empty log message ***
claus
parents: 42
diff changeset
    52
    this class provides methods for loading x-window dump (xwd) images.
46
c49b204c2ef0 *** empty log message ***
claus
parents: 45
diff changeset
    53
    Image save is not supported.
44
c6cf7d0d6337 *** empty log message ***
claus
parents: 42
diff changeset
    54
"
c6cf7d0d6337 *** empty log message ***
claus
parents: 42
diff changeset
    55
! !
c6cf7d0d6337 *** empty log message ***
claus
parents: 42
diff changeset
    56
51
ac84315b8181 *** empty log message ***
claus
parents: 49
diff changeset
    57
!XWDReader class methodsFor:'queries'!
ac84315b8181 *** empty log message ***
claus
parents: 49
diff changeset
    58
ac84315b8181 *** empty log message ***
claus
parents: 49
diff changeset
    59
canRepresent:anImage
ac84315b8181 *** empty log message ***
claus
parents: 49
diff changeset
    60
    "return true, if anImage can be represented in my file format.
ac84315b8181 *** empty log message ***
claus
parents: 49
diff changeset
    61
     Only depth8 palette images are supported."
ac84315b8181 *** empty log message ***
claus
parents: 49
diff changeset
    62
ac84315b8181 *** empty log message ***
claus
parents: 49
diff changeset
    63
    anImage depth ~~ 8 ifTrue:[^ false].
ac84315b8181 *** empty log message ***
claus
parents: 49
diff changeset
    64
    anImage photometric ~~ #palette ifTrue:[^ false].
ac84315b8181 *** empty log message ***
claus
parents: 49
diff changeset
    65
    ^ true
ac84315b8181 *** empty log message ***
claus
parents: 49
diff changeset
    66
! !
ac84315b8181 *** empty log message ***
claus
parents: 49
diff changeset
    67
42
ab4cc6362a80 Initial revision
claus
parents:
diff changeset
    68
!XWDReader methodsFor:'image reading'!
ab4cc6362a80 Initial revision
claus
parents:
diff changeset
    69
ab4cc6362a80 Initial revision
claus
parents:
diff changeset
    70
fromStream: aStream 
46
c49b204c2ef0 *** empty log message ***
claus
parents: 45
diff changeset
    71
    "read an image in XWD (X Window Dump) format."
42
ab4cc6362a80 Initial revision
claus
parents:
diff changeset
    72
83
claus
parents: 51
diff changeset
    73
    |header nColors pad 
claus
parents: 51
diff changeset
    74
     srcRowByteSize bytesPerRow bitsPerPixel colormapSize depth 
44
c6cf7d0d6337 *** empty log message ***
claus
parents: 42
diff changeset
    75
     dstIndex|
42
ab4cc6362a80 Initial revision
claus
parents:
diff changeset
    76
ab4cc6362a80 Initial revision
claus
parents:
diff changeset
    77
    aStream binary.
ab4cc6362a80 Initial revision
claus
parents:
diff changeset
    78
ab4cc6362a80 Initial revision
claus
parents:
diff changeset
    79
    header := (1 to: 25) collect: [:i | aStream nextLong].
ab4cc6362a80 Initial revision
claus
parents:
diff changeset
    80
ab4cc6362a80 Initial revision
claus
parents:
diff changeset
    81
    "skip ..."
ab4cc6362a80 Initial revision
claus
parents:
diff changeset
    82
    101 to:(header at: 1) do: [:i | aStream next].
ab4cc6362a80 Initial revision
claus
parents:
diff changeset
    83
ab4cc6362a80 Initial revision
claus
parents:
diff changeset
    84
    depth := header at: 4.
ab4cc6362a80 Initial revision
claus
parents:
diff changeset
    85
    width := header at: 5.
ab4cc6362a80 Initial revision
claus
parents:
diff changeset
    86
    height := header at: 6.
ab4cc6362a80 Initial revision
claus
parents:
diff changeset
    87
    pad := header at: 11.
45
f94fc6118d0a *** empty log message ***
claus
parents: 44
diff changeset
    88
42
ab4cc6362a80 Initial revision
claus
parents:
diff changeset
    89
    bitsPerPixel := header at: 12.
ab4cc6362a80 Initial revision
claus
parents:
diff changeset
    90
    bitsPerPixel == 24 ifTrue:[
44
c6cf7d0d6337 *** empty log message ***
claus
parents: 42
diff changeset
    91
	bitsPerSample := #(8 8 8).
c6cf7d0d6337 *** empty log message ***
claus
parents: 42
diff changeset
    92
	samplesPerPixel := 3.
c6cf7d0d6337 *** empty log message ***
claus
parents: 42
diff changeset
    93
	photometric := #rgb
42
ab4cc6362a80 Initial revision
claus
parents:
diff changeset
    94
    ] ifFalse:[
44
c6cf7d0d6337 *** empty log message ***
claus
parents: 42
diff changeset
    95
	bitsPerSample := Array with:bitsPerPixel.
c6cf7d0d6337 *** empty log message ***
claus
parents: 42
diff changeset
    96
	samplesPerPixel := 1.
c6cf7d0d6337 *** empty log message ***
claus
parents: 42
diff changeset
    97
	photometric := #palette
42
ab4cc6362a80 Initial revision
claus
parents:
diff changeset
    98
    ].
45
f94fc6118d0a *** empty log message ***
claus
parents: 44
diff changeset
    99
"/  depth ~~ bitsPerPixel ifTrue:[self halt].
42
ab4cc6362a80 Initial revision
claus
parents:
diff changeset
   100
ab4cc6362a80 Initial revision
claus
parents:
diff changeset
   101
    colormapSize := header at: 19.
ab4cc6362a80 Initial revision
claus
parents:
diff changeset
   102
    nColors := header at: 20.
ab4cc6362a80 Initial revision
claus
parents:
diff changeset
   103
44
c6cf7d0d6337 *** empty log message ***
claus
parents: 42
diff changeset
   104
    colorMap := Array new:colormapSize.
42
ab4cc6362a80 Initial revision
claus
parents:
diff changeset
   105
ab4cc6362a80 Initial revision
claus
parents:
diff changeset
   106
    1 to:nColors do:[:i |
49
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   107
	|clr r g b|
44
c6cf7d0d6337 *** empty log message ***
claus
parents: 42
diff changeset
   108
c6cf7d0d6337 *** empty log message ***
claus
parents: 42
diff changeset
   109
	aStream nextLong.
49
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   110
	r := aStream nextUnsignedShortMSB:true.
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   111
	g := aStream nextUnsignedShortMSB:true.
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   112
	b := aStream nextUnsignedShortMSB:true.
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   113
	clr := ColorValue scaledRed: (r bitShift: -3)
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   114
			scaledGreen: (g bitShift: -3)
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   115
			 scaledBlue: (b bitShift: -3).
44
c6cf7d0d6337 *** empty log message ***
claus
parents: 42
diff changeset
   116
	colorMap at:i put:clr.
c6cf7d0d6337 *** empty log message ***
claus
parents: 42
diff changeset
   117
	aStream nextWord.
c6cf7d0d6337 *** empty log message ***
claus
parents: 42
diff changeset
   118
    ].
c6cf7d0d6337 *** empty log message ***
claus
parents: 42
diff changeset
   119
c6cf7d0d6337 *** empty log message ***
claus
parents: 42
diff changeset
   120
    nColors+1 to:colormapSize do: [:i | colorMap at:i put:Color black].
42
ab4cc6362a80 Initial revision
claus
parents:
diff changeset
   121
44
c6cf7d0d6337 *** empty log message ***
claus
parents: 42
diff changeset
   122
    bytesPerRow := width * bitsPerPixel // 8.
c6cf7d0d6337 *** empty log message ***
claus
parents: 42
diff changeset
   123
    ((width * bitsPerPixel \\ 8) ~~ 0) ifTrue:[
c6cf7d0d6337 *** empty log message ***
claus
parents: 42
diff changeset
   124
	bytesPerRow := bytesPerRow + 1
c6cf7d0d6337 *** empty log message ***
claus
parents: 42
diff changeset
   125
    ].
c6cf7d0d6337 *** empty log message ***
claus
parents: 42
diff changeset
   126
    srcRowByteSize := width * bitsPerPixel + pad - 1 // pad * (pad / 8).
42
ab4cc6362a80 Initial revision
claus
parents:
diff changeset
   127
ab4cc6362a80 Initial revision
claus
parents:
diff changeset
   128
    data := ByteArray uninitializedNew: srcRowByteSize * height.
44
c6cf7d0d6337 *** empty log message ***
claus
parents: 42
diff changeset
   129
    srcRowByteSize == bytesPerRow ifTrue:[
c6cf7d0d6337 *** empty log message ***
claus
parents: 42
diff changeset
   130
	aStream nextBytes:srcRowByteSize * height into:data.
c6cf7d0d6337 *** empty log message ***
claus
parents: 42
diff changeset
   131
    ] ifFalse:[
c6cf7d0d6337 *** empty log message ***
claus
parents: 42
diff changeset
   132
	dstIndex := 1.
c6cf7d0d6337 *** empty log message ***
claus
parents: 42
diff changeset
   133
	1 to:height do:[:y |
c6cf7d0d6337 *** empty log message ***
claus
parents: 42
diff changeset
   134
	    aStream nextBytes:bytesPerRow into:data startingAt:dstIndex.
c6cf7d0d6337 *** empty log message ***
claus
parents: 42
diff changeset
   135
	    aStream next:(srcRowByteSize - bytesPerRow).
c6cf7d0d6337 *** empty log message ***
claus
parents: 42
diff changeset
   136
	    dstIndex := dstIndex + bytesPerRow.
c6cf7d0d6337 *** empty log message ***
claus
parents: 42
diff changeset
   137
	].
c6cf7d0d6337 *** empty log message ***
claus
parents: 42
diff changeset
   138
    ]
42
ab4cc6362a80 Initial revision
claus
parents:
diff changeset
   139
    "
44
c6cf7d0d6337 *** empty log message ***
claus
parents: 42
diff changeset
   140
     XWDReader fromFile:'testfile.xwd'
42
ab4cc6362a80 Initial revision
claus
parents:
diff changeset
   141
    "
49
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   142
    "
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   143
     XWDReader save:(Image fromUser) onFile: '/tmp/st.xwd' 
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   144
     (Image fromFile: '/tmp/st.xwd') inspect 
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   145
    "
42
ab4cc6362a80 Initial revision
claus
parents:
diff changeset
   146
! !
ab4cc6362a80 Initial revision
claus
parents:
diff changeset
   147
49
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   148
!XWDReader methodsFor:'image writing'!
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   149
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   150
save:image onFile:fileName
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   151
    "Save as a version 7 color X11 window dump file (xwd) to the file fileName.
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   152
     This produces a mapped color table with 16 bit color.  The xwd file can be 
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   153
     viewed by the xwud program and printed with xpr.  There is no compression 
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   154
     encoding performed on the scanlines.
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   155
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   156
     See the file ...include/X11/XWDFile.h for a definition of the format.
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   157
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   158
     Notice:
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   159
	this method was adapted from a goody in the uiuc archive 
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   160
	(Prime time freeware).
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   161
	The original files header is:
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   162
	    NAME            imageToXWD
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   163
	    AUTHOR          Brad Schoening <brad@boole.com>
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   164
	    FUNCTION        Writes a Smalltalk image to an X11 xwd file
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   165
	    ST-VERSION      PPST 4.0 or 4.1
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   166
	    DISTRIBUTION    world
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   167
	    VERSION         1.0
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   168
	    DATE            July 1993
51
ac84315b8181 *** empty log message ***
claus
parents: 49
diff changeset
   169
ac84315b8181 *** empty log message ***
claus
parents: 49
diff changeset
   170
	thanks to Brad for giving us the base for this mehtod.
49
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   171
    "
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   172
83
claus
parents: 51
diff changeset
   173
    |aStream rgbColor paletteColors ncolors dumpName headerSize|
49
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   174
51
ac84315b8181 *** empty log message ***
claus
parents: 49
diff changeset
   175
    (self class canRepresent:image) ifFalse:[
ac84315b8181 *** empty log message ***
claus
parents: 49
diff changeset
   176
	self error:'XWD format only supports 8bit palette images'.
49
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   177
	^ nil
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   178
    ].
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   179
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   180
    dumpName := 'stdin'.
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   181
    headerSize := 4 * (25 + (dumpName size / 4) ceiling).
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   182
    paletteColors := image palette "colors".
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   183
    ncolors := paletteColors size.
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   184
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   185
    "create the header (each item is 32 bits long)"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   186
    aStream := fileName asFilename writeStream.
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   187
    aStream binary.
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   188
    aStream nextLongPut: headerSize.                                "total header size in bytes"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   189
    aStream nextLongPut: 7.                                         "XWD file version"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   190
    aStream nextLongPut: 2.                                         "pixmap format : ZPixmap"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   191
    aStream nextLongPut: 8.                                         "pixmap depth"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   192
    aStream nextLongPut: image width.                               "pixmap cols"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   193
    aStream nextLongPut: image height.                              "pixmap rows"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   194
    aStream nextLongPut: 0.                                         "bitmap x offset"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   195
    aStream nextLongPut: 1.                                         "byte order: MSBFirst"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   196
    aStream nextLongPut: 8.                                         "bitmap unit"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   197
    aStream nextLongPut: 1.                                         "bitmap bit order: MSBFirst"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   198
    aStream nextLongPut: 8.                                         "bitmap scanline pad"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   199
    aStream nextLongPut: 8.                                         "bits per pixel"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   200
    aStream nextLongPut: image width.                               "bytes per scanline"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   201
    aStream nextLongPut: 3.                                         "colormap class : PseudoColor"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   202
    aStream nextLongPut: 0.                                         "Z red mask"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   203
    aStream nextLongPut: 0.                                         "Z green mask"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   204
    aStream nextLongPut: 0.                                         "Z blue mask"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   205
    aStream nextLongPut: 8.                                         "bits per rgb"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   206
    aStream nextLongPut: 256.                                       "number of color map entries"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   207
    aStream nextLongPut: ncolors.                                   "number of color structures"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   208
    aStream nextLongPut: image width.                               "window width"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   209
    aStream nextLongPut: image height.                              "window height"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   210
    aStream nextLongPut: 0.                                         "window upper left x coordinate"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   211
    aStream nextLongPut: 0.                                         "window upper left y coordinate"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   212
    aStream nextLongPut: 0.                                         "window border width"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   213
    aStream nextPutAll: dumpName asByteArray.       "name of dump"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   214
    "Pad the string to the next 32-bit boundary"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   215
    aStream nextPut: 0. "/ 6
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   216
    aStream nextPut: 0. "/ 7
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   217
    aStream nextPut: 0. "/ 8
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   218
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   219
"/    [(aStream position rem: 4) == 0] whileFalse: [ aStream nextPut: 0 ].
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   220
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   221
    "Write out the color table.  Each color table entry is 12 bytes long composed of:
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   222
		    an index                (4 bytes)
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   223
		    red color value         (2 bytes)
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   224
		    green color value       (2 bytes)
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   225
		    blue color value        (2 bytes)
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   226
		    flag values             (1 byte)
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   227
		    pad                     (1 byte)
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   228
    "
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   229
    0 to: ncolors-1 do: [ :index |
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   230
	|r g b|
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   231
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   232
	aStream nextLongPut: index.
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   233
	rgbColor := paletteColors at: (1+index).
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   234
	(rgbColor isNil) ifTrue: [ rgbColor := ColorValue white ].
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   235
	r := (rgbColor red / 100.0 * 65535) rounded.
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   236
	g := (rgbColor green / 100.0 * 65535) rounded.
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   237
	b := (rgbColor blue / 100.0 * 65535) rounded.
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   238
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   239
	aStream nextWordPut:r.
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   240
	aStream nextWordPut:g.
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   241
	aStream nextWordPut:b.
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   242
	aStream nextPut: 7.                     "flags"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   243
	aStream nextPut: 0.                     "pad"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   244
    ].
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   245
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   246
    "Write out the pixels as index color values"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   247
"/    Cursor write showWhile: [ 
99
claus
parents: 96
diff changeset
   248
"/            |cindex|
83
claus
parents: 51
diff changeset
   249
"/
49
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   250
"/            1 to: (image height) do: [ :row |
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   251
"/                    1 to: (image width) do: [ :col |
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   252
"/                            cindex := image atPoint: (col-1)@(row-1).
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   253
"/                            aStream nextPut: cindex.]]
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   254
"/    ].
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   255
    aStream nextPutAll:image bits.
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   256
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   257
    aStream close
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   258
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   259
    "
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   260
     XWDReader save:(Image fromUser) onFile: '/tmp/st.xwd' 
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   261
     (Image fromFile: '/tmp/st.xwd') inspect 
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   262
    "
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   263
! !