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