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