XWDReader.st
author Claus Gittinger <cg@exept.de>
Mon, 02 Aug 1999 10:59:32 +0200
changeset 1212 816bee31f949
parent 647 6f26c76aa0c9
child 1736 a8f1fcc3e6bc
permissions -rw-r--r--
checkin from browser
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
391
Claus Gittinger <cg@exept.de>
parents: 390
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:''
259
62b1bbafd9ba category change
Claus Gittinger <cg@exept.de>
parents: 234
diff changeset
    23
	category:'Graphics-Images-Support'
42
ab4cc6362a80 Initial revision
claus
parents:
diff changeset
    24
!
ab4cc6362a80 Initial revision
claus
parents:
diff changeset
    25
391
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
    26
!XWDReader class methodsFor:'documentation'!
44
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
398
aef700d15416 new suffix-table
Claus Gittinger <cg@exept.de>
parents: 391
diff changeset
    61
!XWDReader class methodsFor:'initialization'!
aef700d15416 new suffix-table
Claus Gittinger <cg@exept.de>
parents: 391
diff changeset
    62
aef700d15416 new suffix-table
Claus Gittinger <cg@exept.de>
parents: 391
diff changeset
    63
initialize
aef700d15416 new suffix-table
Claus Gittinger <cg@exept.de>
parents: 391
diff changeset
    64
    "tell Image-class, that a new fileReader is present
aef700d15416 new suffix-table
Claus Gittinger <cg@exept.de>
parents: 391
diff changeset
    65
     for the '.xwd' extension."
aef700d15416 new suffix-table
Claus Gittinger <cg@exept.de>
parents: 391
diff changeset
    66
647
6f26c76aa0c9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 623
diff changeset
    67
    MIMETypes defineImageType:'image/x-xwindowdump' suffix:'xwd' reader:self
398
aef700d15416 new suffix-table
Claus Gittinger <cg@exept.de>
parents: 391
diff changeset
    68
aef700d15416 new suffix-table
Claus Gittinger <cg@exept.de>
parents: 391
diff changeset
    69
    "Created: 1.2.1997 / 15:04:46 / cg"
aef700d15416 new suffix-table
Claus Gittinger <cg@exept.de>
parents: 391
diff changeset
    70
! !
aef700d15416 new suffix-table
Claus Gittinger <cg@exept.de>
parents: 391
diff changeset
    71
391
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
    72
!XWDReader class methodsFor:'queries'!
51
ac84315b8181 *** empty log message ***
claus
parents: 49
diff changeset
    73
ac84315b8181 *** empty log message ***
claus
parents: 49
diff changeset
    74
canRepresent:anImage
391
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
    75
    "return true, if anImage can be represented in my file format.
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
    76
     Only depth8 palette images are supported."
51
ac84315b8181 *** empty log message ***
claus
parents: 49
diff changeset
    77
391
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
    78
    anImage depth ~~ 8 ifTrue:[^ false].
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
    79
    anImage photometric ~~ #palette ifTrue:[^ false].
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
    80
    ^ true
51
ac84315b8181 *** empty log message ***
claus
parents: 49
diff changeset
    81
! !
ac84315b8181 *** empty log message ***
claus
parents: 49
diff changeset
    82
391
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
    83
!XWDReader methodsFor:'image reading'!
42
ab4cc6362a80 Initial revision
claus
parents:
diff changeset
    84
204
277d2523d8cb commentary
Claus Gittinger <cg@exept.de>
parents: 114
diff changeset
    85
fromStream:aStream 
391
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
    86
    "read an image in XWD (X Window Dump) format from aStream."
42
ab4cc6362a80 Initial revision
claus
parents:
diff changeset
    87
391
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
    88
    |header nColors pad 
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
    89
     srcRowByteSize bytesPerRow bitsPerPixel colormapSize depth 
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
    90
     dstIndex|
42
ab4cc6362a80 Initial revision
claus
parents:
diff changeset
    91
ab4cc6362a80 Initial revision
claus
parents:
diff changeset
    92
    aStream binary.
ab4cc6362a80 Initial revision
claus
parents:
diff changeset
    93
391
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
    94
    header := (1 to: 25) collect: [:i | aStream nextLong].
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
    95
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
    96
    "skip ..."
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
    97
    101 to:(header at: 1) do: [:i | aStream next].
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
    98
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
    99
    depth := header at: 4.
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   100
    width := header at: 5.
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   101
    height := header at: 6.
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   102
    pad := header at: 11.
42
ab4cc6362a80 Initial revision
claus
parents:
diff changeset
   103
391
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   104
    bitsPerPixel := header at: 12.
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   105
    bitsPerPixel == 24 ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   106
        bitsPerSample := #(8 8 8).
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   107
        samplesPerPixel := 3.
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   108
        photometric := #rgb
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   109
    ] ifFalse:[
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   110
        bitsPerSample := Array with:bitsPerPixel.
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   111
        samplesPerPixel := 1.
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   112
        photometric := #palette
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   113
    ].
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   114
"/  depth ~~ bitsPerPixel ifTrue:[self halt].
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   115
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   116
    colormapSize := header at: 19.
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   117
    nColors := header at: 20.
44
c6cf7d0d6337 *** empty log message ***
claus
parents: 42
diff changeset
   118
391
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   119
    colorMap := Array new:colormapSize.
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   120
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   121
    1 to:nColors do:[:i |
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   122
        |clr r g b|
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   123
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   124
        aStream nextLong.
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   125
        r := aStream nextUnsignedShortMSB:true.
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   126
        g := aStream nextUnsignedShortMSB:true.
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   127
        b := aStream nextUnsignedShortMSB:true.
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   128
        clr := ColorValue scaledRed: (r bitShift: -3)
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   129
                        scaledGreen: (g bitShift: -3)
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   130
                         scaledBlue: (b bitShift: -3).
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   131
        colorMap at:i put:clr.
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   132
        aStream nextWord.
44
c6cf7d0d6337 *** empty log message ***
claus
parents: 42
diff changeset
   133
    ].
c6cf7d0d6337 *** empty log message ***
claus
parents: 42
diff changeset
   134
391
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   135
    nColors+1 to:colormapSize do: [:i | colorMap at:i put:Color black].
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   136
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   137
    bytesPerRow := width * bitsPerPixel // 8.
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   138
    ((width * bitsPerPixel \\ 8) ~~ 0) ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   139
        bytesPerRow := bytesPerRow + 1
44
c6cf7d0d6337 *** empty log message ***
claus
parents: 42
diff changeset
   140
    ].
391
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   141
    srcRowByteSize := width * bitsPerPixel + pad - 1 // pad * (pad / 8).
42
ab4cc6362a80 Initial revision
claus
parents:
diff changeset
   142
391
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   143
    data := ByteArray uninitializedNew: srcRowByteSize * height.
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   144
    srcRowByteSize == bytesPerRow ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   145
        aStream nextBytes:srcRowByteSize * height into:data.
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   146
    ] ifFalse:[
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   147
        dstIndex := 1.
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   148
        1 to:height do:[:y |
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   149
            aStream nextBytes:bytesPerRow into:data startingAt:dstIndex.
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   150
            aStream next:(srcRowByteSize - bytesPerRow).
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   151
            dstIndex := dstIndex + bytesPerRow.
390
d00bee0b624a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 259
diff changeset
   152
        ].
391
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   153
    ]
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   154
    "
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   155
     XWDReader fromFile:'testfile.xwd'
42
ab4cc6362a80 Initial revision
claus
parents:
diff changeset
   156
    "
49
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   157
    "
391
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   158
     XWDReader save:(Image fromUser) onFile: '/tmp/st.xwd' 
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   159
     (Image fromFile: '/tmp/st.xwd') inspect 
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   160
    "
42
ab4cc6362a80 Initial revision
claus
parents:
diff changeset
   161
! !
ab4cc6362a80 Initial revision
claus
parents:
diff changeset
   162
391
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   163
!XWDReader methodsFor:'image writing'!
49
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   164
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   165
save:image onFile:fileName
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   166
    "Save as a version 7 color X11 window dump file (xwd) to the file fileName.
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   167
     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
   168
     viewed by the xwud program and printed with xpr.  
277d2523d8cb commentary
Claus Gittinger <cg@exept.de>
parents: 114
diff changeset
   169
     No compression is performed.
49
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   170
205
ddb3c0dfcc0d commentary
Claus Gittinger <cg@exept.de>
parents: 204
diff changeset
   171
     See the file ...include/X11/XWDFile.h for a definition of the format."
49
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   172
205
ddb3c0dfcc0d commentary
Claus Gittinger <cg@exept.de>
parents: 204
diff changeset
   173
    "
49
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   174
     Notice:
204
277d2523d8cb commentary
Claus Gittinger <cg@exept.de>
parents: 114
diff changeset
   175
        this method was adapted from a goody in the uiuc archive 
277d2523d8cb commentary
Claus Gittinger <cg@exept.de>
parents: 114
diff changeset
   176
        (Prime time freeware).
277d2523d8cb commentary
Claus Gittinger <cg@exept.de>
parents: 114
diff changeset
   177
        The original files header is:
277d2523d8cb commentary
Claus Gittinger <cg@exept.de>
parents: 114
diff changeset
   178
            NAME            imageToXWD
277d2523d8cb commentary
Claus Gittinger <cg@exept.de>
parents: 114
diff changeset
   179
            AUTHOR          Brad Schoening <brad@boole.com>
277d2523d8cb commentary
Claus Gittinger <cg@exept.de>
parents: 114
diff changeset
   180
            FUNCTION        Writes a Smalltalk image to an X11 xwd file
277d2523d8cb commentary
Claus Gittinger <cg@exept.de>
parents: 114
diff changeset
   181
            ST-VERSION      PPST 4.0 or 4.1
277d2523d8cb commentary
Claus Gittinger <cg@exept.de>
parents: 114
diff changeset
   182
            DISTRIBUTION    world
277d2523d8cb commentary
Claus Gittinger <cg@exept.de>
parents: 114
diff changeset
   183
            VERSION         1.0
277d2523d8cb commentary
Claus Gittinger <cg@exept.de>
parents: 114
diff changeset
   184
            DATE            July 1993
51
ac84315b8181 *** empty log message ***
claus
parents: 49
diff changeset
   185
204
277d2523d8cb commentary
Claus Gittinger <cg@exept.de>
parents: 114
diff changeset
   186
        thanks to Brad for giving us the base for this mehtod.
49
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   187
    "
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   188
83
claus
parents: 51
diff changeset
   189
    |aStream rgbColor paletteColors ncolors dumpName headerSize|
49
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   190
51
ac84315b8181 *** empty log message ***
claus
parents: 49
diff changeset
   191
    (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
   192
        ^ Image cannotRepresentImageSignal 
bacef118f54a more signals to be raised if anything happens during
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
   193
            raiseWith:image
bacef118f54a more signals to be raised if anything happens during
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
   194
            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
   195
    ].
bacef118f54a more signals to be raised if anything happens during
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
   196
bacef118f54a more signals to be raised if anything happens during
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
   197
    image mask notNil ifTrue:[
bacef118f54a more signals to be raised if anything happens during
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
   198
        Image informationLostQuerySignal
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 does not support an imageMask').
49
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   201
    ].
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   202
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   203
    dumpName := 'stdin'.
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   204
    headerSize := 4 * (25 + (dumpName size / 4) ceiling).
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   205
    paletteColors := image palette "colors".
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   206
    ncolors := paletteColors size.
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   207
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   208
    "create the header (each item is 32 bits long)"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   209
    aStream := fileName asFilename writeStream.
461
bacef118f54a more signals to be raised if anything happens during
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
   210
    aStream isNil ifTrue:[
bacef118f54a more signals to be raised if anything happens during
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
   211
        ^ Image fileCreationErrorSignal 
bacef118f54a more signals to be raised if anything happens during
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
   212
            raiseWith:image
bacef118f54a more signals to be raised if anything happens during
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
   213
            errorString:('file creation error: ' , fileName asString).
bacef118f54a more signals to be raised if anything happens during
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
   214
    ].
bacef118f54a more signals to be raised if anything happens during
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
   215
49
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   216
    aStream binary.
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   217
    aStream nextLongPut: headerSize.                                "total header size in bytes"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   218
    aStream nextLongPut: 7.                                         "XWD file version"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   219
    aStream nextLongPut: 2.                                         "pixmap format : ZPixmap"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   220
    aStream nextLongPut: 8.                                         "pixmap depth"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   221
    aStream nextLongPut: image width.                               "pixmap cols"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   222
    aStream nextLongPut: image height.                              "pixmap rows"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   223
    aStream nextLongPut: 0.                                         "bitmap x offset"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   224
    aStream nextLongPut: 1.                                         "byte order: MSBFirst"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   225
    aStream nextLongPut: 8.                                         "bitmap unit"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   226
    aStream nextLongPut: 1.                                         "bitmap bit order: MSBFirst"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   227
    aStream nextLongPut: 8.                                         "bitmap scanline pad"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   228
    aStream nextLongPut: 8.                                         "bits per pixel"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   229
    aStream nextLongPut: image width.                               "bytes per scanline"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   230
    aStream nextLongPut: 3.                                         "colormap class : PseudoColor"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   231
    aStream nextLongPut: 0.                                         "Z red mask"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   232
    aStream nextLongPut: 0.                                         "Z green mask"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   233
    aStream nextLongPut: 0.                                         "Z blue mask"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   234
    aStream nextLongPut: 8.                                         "bits per rgb"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   235
    aStream nextLongPut: 256.                                       "number of color map entries"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   236
    aStream nextLongPut: ncolors.                                   "number of color structures"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   237
    aStream nextLongPut: image width.                               "window width"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   238
    aStream nextLongPut: image height.                              "window height"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   239
    aStream nextLongPut: 0.                                         "window upper left x coordinate"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   240
    aStream nextLongPut: 0.                                         "window upper left y coordinate"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   241
    aStream nextLongPut: 0.                                         "window border width"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   242
    aStream nextPutAll: dumpName asByteArray.       "name of dump"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   243
    "Pad the string to the next 32-bit boundary"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   244
    aStream nextPut: 0. "/ 6
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   245
    aStream nextPut: 0. "/ 7
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   246
    aStream nextPut: 0. "/ 8
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   247
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   248
"/    [(aStream position rem: 4) == 0] whileFalse: [ aStream nextPut: 0 ].
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   249
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   250
    "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
   251
                    an index                (4 bytes)
277d2523d8cb commentary
Claus Gittinger <cg@exept.de>
parents: 114
diff changeset
   252
                    red color value         (2 bytes)
277d2523d8cb commentary
Claus Gittinger <cg@exept.de>
parents: 114
diff changeset
   253
                    green color value       (2 bytes)
277d2523d8cb commentary
Claus Gittinger <cg@exept.de>
parents: 114
diff changeset
   254
                    blue color value        (2 bytes)
277d2523d8cb commentary
Claus Gittinger <cg@exept.de>
parents: 114
diff changeset
   255
                    flag values             (1 byte)
277d2523d8cb commentary
Claus Gittinger <cg@exept.de>
parents: 114
diff changeset
   256
                    pad                     (1 byte)
49
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   257
    "
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   258
    0 to: ncolors-1 do: [ :index |
204
277d2523d8cb commentary
Claus Gittinger <cg@exept.de>
parents: 114
diff changeset
   259
        |r g b|
49
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   260
204
277d2523d8cb commentary
Claus Gittinger <cg@exept.de>
parents: 114
diff changeset
   261
        aStream nextLongPut: index.
277d2523d8cb commentary
Claus Gittinger <cg@exept.de>
parents: 114
diff changeset
   262
        rgbColor := paletteColors at: (1+index).
277d2523d8cb commentary
Claus Gittinger <cg@exept.de>
parents: 114
diff changeset
   263
        (rgbColor isNil) ifTrue: [ rgbColor := ColorValue white ].
277d2523d8cb commentary
Claus Gittinger <cg@exept.de>
parents: 114
diff changeset
   264
        r := (rgbColor red / 100.0 * 65535) rounded.
277d2523d8cb commentary
Claus Gittinger <cg@exept.de>
parents: 114
diff changeset
   265
        g := (rgbColor green / 100.0 * 65535) rounded.
277d2523d8cb commentary
Claus Gittinger <cg@exept.de>
parents: 114
diff changeset
   266
        b := (rgbColor blue / 100.0 * 65535) rounded.
49
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   267
204
277d2523d8cb commentary
Claus Gittinger <cg@exept.de>
parents: 114
diff changeset
   268
        aStream nextWordPut:r.
277d2523d8cb commentary
Claus Gittinger <cg@exept.de>
parents: 114
diff changeset
   269
        aStream nextWordPut:g.
277d2523d8cb commentary
Claus Gittinger <cg@exept.de>
parents: 114
diff changeset
   270
        aStream nextWordPut:b.
277d2523d8cb commentary
Claus Gittinger <cg@exept.de>
parents: 114
diff changeset
   271
        aStream nextPut: 7.                     "flags"
277d2523d8cb commentary
Claus Gittinger <cg@exept.de>
parents: 114
diff changeset
   272
        aStream nextPut: 0.                     "pad"
49
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   273
    ].
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   274
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   275
    "Write out the pixels as index color values"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   276
"/    Cursor write showWhile: [ 
99
claus
parents: 96
diff changeset
   277
"/            |cindex|
83
claus
parents: 51
diff changeset
   278
"/
49
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   279
"/            1 to: (image height) do: [ :row |
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   280
"/                    1 to: (image width) do: [ :col |
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   281
"/                            cindex := image atPoint: (col-1)@(row-1).
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   282
"/                            aStream nextPut: cindex.]]
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   283
"/    ].
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   284
    aStream nextPutAll:image bits.
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   285
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   286
    aStream close
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   287
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   288
    "
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   289
     XWDReader save:(Image fromUser) onFile: '/tmp/st.xwd' 
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   290
     (Image fromFile: '/tmp/st.xwd') inspect 
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   291
    "
461
bacef118f54a more signals to be raised if anything happens during
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
   292
bacef118f54a more signals to be raised if anything happens during
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
   293
    "Modified: 27.2.1997 / 12:45:15 / cg"
49
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   294
! !
204
277d2523d8cb commentary
Claus Gittinger <cg@exept.de>
parents: 114
diff changeset
   295
391
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   296
!XWDReader class methodsFor:'documentation'!
204
277d2523d8cb commentary
Claus Gittinger <cg@exept.de>
parents: 114
diff changeset
   297
277d2523d8cb commentary
Claus Gittinger <cg@exept.de>
parents: 114
diff changeset
   298
version
647
6f26c76aa0c9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 623
diff changeset
   299
    ^ '$Header: /cvs/stx/stx/libview2/XWDReader.st,v 1.21 1997-06-30 20:56:45 cg Exp $'
204
277d2523d8cb commentary
Claus Gittinger <cg@exept.de>
parents: 114
diff changeset
   300
! !
398
aef700d15416 new suffix-table
Claus Gittinger <cg@exept.de>
parents: 391
diff changeset
   301
XWDReader initialize!