XWDReader.st
author Stefan Vogel <sv@exept.de>
Mon, 13 Mar 2017 09:54:33 +0100
changeset 3941 dd9237d3a727
parent 1846 d29322944b05
child 3855 1db7742d33ad
child 4009 bece1481d314
permissions -rw-r--r--
#BUGFIX by stefan class: MIMETypes application/xml -> #isXmlType
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:''
1745
4fa0fad2a463 code cleanup (colorMap handling)
Claus Gittinger <cg@exept.de>
parents: 1736
diff changeset
    25
	category:'Graphics-Images-Readers'
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
1805
93f557cbe600 category changes
Claus Gittinger <cg@exept.de>
parents: 1754
diff changeset
    85
!XWDReader methodsFor:'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
1846
d29322944b05 dimensionReport
Claus Gittinger <cg@exept.de>
parents: 1814
diff changeset
   106
    self reportDimension.
d29322944b05 dimensionReport
Claus Gittinger <cg@exept.de>
parents: 1814
diff changeset
   107
391
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   108
    bitsPerPixel := header at: 12.
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   109
    bitsPerPixel == 24 ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   110
        bitsPerSample := #(8 8 8).
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   111
        samplesPerPixel := 3.
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   112
        photometric := #rgb
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   113
    ] ifFalse:[
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   114
        bitsPerSample := Array with:bitsPerPixel.
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   115
        samplesPerPixel := 1.
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   116
        photometric := #palette
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   117
    ].
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   118
"/  depth ~~ bitsPerPixel ifTrue:[self halt].
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   119
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   120
    colormapSize := header at: 19.
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   121
    nColors := header at: 20.
44
c6cf7d0d6337 *** empty log message ***
claus
parents: 42
diff changeset
   122
391
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   123
    colorMap := Array new:colormapSize.
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   124
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   125
    1 to:nColors do:[:i |
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   126
        |clr r g b|
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   127
1736
a8f1fcc3e6bc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 647
diff changeset
   128
        inStream nextLong.
a8f1fcc3e6bc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 647
diff changeset
   129
        r := inStream nextUnsignedShortMSB:true.
a8f1fcc3e6bc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 647
diff changeset
   130
        g := inStream nextUnsignedShortMSB:true.
a8f1fcc3e6bc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 647
diff changeset
   131
        b := inStream nextUnsignedShortMSB:true.
391
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   132
        clr := ColorValue scaledRed: (r bitShift: -3)
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   133
                        scaledGreen: (g bitShift: -3)
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   134
                         scaledBlue: (b bitShift: -3).
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   135
        colorMap at:i put:clr.
1736
a8f1fcc3e6bc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 647
diff changeset
   136
        inStream nextWord.
44
c6cf7d0d6337 *** empty log message ***
claus
parents: 42
diff changeset
   137
    ].
c6cf7d0d6337 *** empty log message ***
claus
parents: 42
diff changeset
   138
391
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   139
    nColors+1 to:colormapSize do: [:i | colorMap at:i put:Color black].
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   140
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   141
    bytesPerRow := width * bitsPerPixel // 8.
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   142
    ((width * bitsPerPixel \\ 8) ~~ 0) ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   143
        bytesPerRow := bytesPerRow + 1
44
c6cf7d0d6337 *** empty log message ***
claus
parents: 42
diff changeset
   144
    ].
391
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   145
    srcRowByteSize := width * bitsPerPixel + pad - 1 // pad * (pad / 8).
42
ab4cc6362a80 Initial revision
claus
parents:
diff changeset
   146
391
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   147
    data := ByteArray uninitializedNew: srcRowByteSize * height.
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   148
    srcRowByteSize == bytesPerRow ifTrue:[
1736
a8f1fcc3e6bc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 647
diff changeset
   149
        inStream nextBytes:srcRowByteSize * height into:data.
391
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   150
    ] ifFalse:[
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   151
        dstIndex := 1.
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   152
        1 to:height do:[:y |
1736
a8f1fcc3e6bc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 647
diff changeset
   153
            inStream nextBytes:bytesPerRow into:data startingAt:dstIndex.
a8f1fcc3e6bc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 647
diff changeset
   154
            inStream next:(srcRowByteSize - bytesPerRow).
391
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   155
            dstIndex := dstIndex + bytesPerRow.
390
d00bee0b624a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 259
diff changeset
   156
        ].
391
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   157
    ]
1736
a8f1fcc3e6bc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 647
diff changeset
   158
391
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   159
    "
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   160
     XWDReader fromFile:'testfile.xwd'
42
ab4cc6362a80 Initial revision
claus
parents:
diff changeset
   161
    "
49
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   162
    "
391
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   163
     XWDReader save:(Image fromUser) onFile: '/tmp/st.xwd' 
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   164
     (Image fromFile: '/tmp/st.xwd') inspect 
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   165
    "
42
ab4cc6362a80 Initial revision
claus
parents:
diff changeset
   166
! !
ab4cc6362a80 Initial revision
claus
parents:
diff changeset
   167
1805
93f557cbe600 category changes
Claus Gittinger <cg@exept.de>
parents: 1754
diff changeset
   168
!XWDReader methodsFor:'writing'!
49
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   169
1814
2f204c2a957d image saving - use save:onStream:
Claus Gittinger <cg@exept.de>
parents: 1805
diff changeset
   170
save:image onStream:aStream
49
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   171
    "Save as a version 7 color X11 window dump file (xwd) to the file fileName.
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   172
     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
   173
     viewed by the xwud program and printed with xpr.  
277d2523d8cb commentary
Claus Gittinger <cg@exept.de>
parents: 114
diff changeset
   174
     No compression is performed.
49
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   175
205
ddb3c0dfcc0d commentary
Claus Gittinger <cg@exept.de>
parents: 204
diff changeset
   176
     See the file ...include/X11/XWDFile.h for a definition of the format."
49
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   177
205
ddb3c0dfcc0d commentary
Claus Gittinger <cg@exept.de>
parents: 204
diff changeset
   178
    "
49
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   179
     Notice:
204
277d2523d8cb commentary
Claus Gittinger <cg@exept.de>
parents: 114
diff changeset
   180
        this method was adapted from a goody in the uiuc archive 
277d2523d8cb commentary
Claus Gittinger <cg@exept.de>
parents: 114
diff changeset
   181
        (Prime time freeware).
277d2523d8cb commentary
Claus Gittinger <cg@exept.de>
parents: 114
diff changeset
   182
        The original files header is:
277d2523d8cb commentary
Claus Gittinger <cg@exept.de>
parents: 114
diff changeset
   183
            NAME            imageToXWD
277d2523d8cb commentary
Claus Gittinger <cg@exept.de>
parents: 114
diff changeset
   184
            AUTHOR          Brad Schoening <brad@boole.com>
277d2523d8cb commentary
Claus Gittinger <cg@exept.de>
parents: 114
diff changeset
   185
            FUNCTION        Writes a Smalltalk image to an X11 xwd file
277d2523d8cb commentary
Claus Gittinger <cg@exept.de>
parents: 114
diff changeset
   186
            ST-VERSION      PPST 4.0 or 4.1
277d2523d8cb commentary
Claus Gittinger <cg@exept.de>
parents: 114
diff changeset
   187
            DISTRIBUTION    world
277d2523d8cb commentary
Claus Gittinger <cg@exept.de>
parents: 114
diff changeset
   188
            VERSION         1.0
277d2523d8cb commentary
Claus Gittinger <cg@exept.de>
parents: 114
diff changeset
   189
            DATE            July 1993
51
ac84315b8181 *** empty log message ***
claus
parents: 49
diff changeset
   190
204
277d2523d8cb commentary
Claus Gittinger <cg@exept.de>
parents: 114
diff changeset
   191
        thanks to Brad for giving us the base for this mehtod.
49
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   192
    "
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   193
1814
2f204c2a957d image saving - use save:onStream:
Claus Gittinger <cg@exept.de>
parents: 1805
diff changeset
   194
    |rgbColor paletteColors ncolors dumpName headerSize|
49
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   195
51
ac84315b8181 *** empty log message ***
claus
parents: 49
diff changeset
   196
    (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
   197
        ^ Image cannotRepresentImageSignal 
bacef118f54a more signals to be raised if anything happens during
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
   198
            raiseWith:image
bacef118f54a more signals to be raised if anything happens during
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
   199
            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
   200
    ].
bacef118f54a more signals to be raised if anything happens during
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
   201
bacef118f54a more signals to be raised if anything happens during
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
   202
    image mask notNil ifTrue:[
bacef118f54a more signals to be raised if anything happens during
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
   203
        Image informationLostQuerySignal
bacef118f54a more signals to be raised if anything happens during
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
   204
            raiseWith:image
bacef118f54a more signals to be raised if anything happens during
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
   205
            errorString:('XWD format does not support an imageMask').
49
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   206
    ].
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   207
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   208
    dumpName := 'stdin'.
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   209
    headerSize := 4 * (25 + (dumpName size / 4) ceiling).
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   210
    paletteColors := image palette "colors".
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   211
    ncolors := paletteColors size.
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   212
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   213
    "create the header (each item is 32 bits long)"
461
bacef118f54a more signals to be raised if anything happens during
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
   214
49
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   215
    aStream binary.
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   216
    aStream nextLongPut: headerSize.                                "total header size in bytes"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   217
    aStream nextLongPut: 7.                                         "XWD file version"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   218
    aStream nextLongPut: 2.                                         "pixmap format : ZPixmap"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   219
    aStream nextLongPut: 8.                                         "pixmap depth"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   220
    aStream nextLongPut: image width.                               "pixmap cols"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   221
    aStream nextLongPut: image height.                              "pixmap rows"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   222
    aStream nextLongPut: 0.                                         "bitmap x offset"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   223
    aStream nextLongPut: 1.                                         "byte order: MSBFirst"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   224
    aStream nextLongPut: 8.                                         "bitmap unit"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   225
    aStream nextLongPut: 1.                                         "bitmap bit order: MSBFirst"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   226
    aStream nextLongPut: 8.                                         "bitmap scanline pad"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   227
    aStream nextLongPut: 8.                                         "bits per pixel"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   228
    aStream nextLongPut: image width.                               "bytes per scanline"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   229
    aStream nextLongPut: 3.                                         "colormap class : PseudoColor"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   230
    aStream nextLongPut: 0.                                         "Z red mask"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   231
    aStream nextLongPut: 0.                                         "Z green mask"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   232
    aStream nextLongPut: 0.                                         "Z blue mask"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   233
    aStream nextLongPut: 8.                                         "bits per rgb"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   234
    aStream nextLongPut: 256.                                       "number of color map entries"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   235
    aStream nextLongPut: ncolors.                                   "number of color structures"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   236
    aStream nextLongPut: image width.                               "window width"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   237
    aStream nextLongPut: image height.                              "window height"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   238
    aStream nextLongPut: 0.                                         "window upper left x coordinate"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   239
    aStream nextLongPut: 0.                                         "window upper left y coordinate"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   240
    aStream nextLongPut: 0.                                         "window border width"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   241
    aStream nextPutAll: dumpName asByteArray.       "name of dump"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   242
    "Pad the string to the next 32-bit boundary"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   243
    aStream nextPut: 0. "/ 6
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   244
    aStream nextPut: 0. "/ 7
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   245
    aStream nextPut: 0. "/ 8
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   246
1754
cc844dc3504e avoid position
Claus Gittinger <cg@exept.de>
parents: 1745
diff changeset
   247
"/    [(aStream position1Based rem: 4) == 0] whileFalse: [ aStream nextPut: 0 ].
49
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   248
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   249
    "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
   250
                    an index                (4 bytes)
277d2523d8cb commentary
Claus Gittinger <cg@exept.de>
parents: 114
diff changeset
   251
                    red color value         (2 bytes)
277d2523d8cb commentary
Claus Gittinger <cg@exept.de>
parents: 114
diff changeset
   252
                    green color value       (2 bytes)
277d2523d8cb commentary
Claus Gittinger <cg@exept.de>
parents: 114
diff changeset
   253
                    blue color value        (2 bytes)
277d2523d8cb commentary
Claus Gittinger <cg@exept.de>
parents: 114
diff changeset
   254
                    flag values             (1 byte)
277d2523d8cb commentary
Claus Gittinger <cg@exept.de>
parents: 114
diff changeset
   255
                    pad                     (1 byte)
49
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   256
    "
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   257
    0 to: ncolors-1 do: [ :index |
204
277d2523d8cb commentary
Claus Gittinger <cg@exept.de>
parents: 114
diff changeset
   258
        |r g b|
49
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   259
204
277d2523d8cb commentary
Claus Gittinger <cg@exept.de>
parents: 114
diff changeset
   260
        aStream nextLongPut: index.
277d2523d8cb commentary
Claus Gittinger <cg@exept.de>
parents: 114
diff changeset
   261
        rgbColor := paletteColors at: (1+index).
277d2523d8cb commentary
Claus Gittinger <cg@exept.de>
parents: 114
diff changeset
   262
        (rgbColor isNil) ifTrue: [ rgbColor := ColorValue white ].
277d2523d8cb commentary
Claus Gittinger <cg@exept.de>
parents: 114
diff changeset
   263
        r := (rgbColor red / 100.0 * 65535) rounded.
277d2523d8cb commentary
Claus Gittinger <cg@exept.de>
parents: 114
diff changeset
   264
        g := (rgbColor green / 100.0 * 65535) rounded.
277d2523d8cb commentary
Claus Gittinger <cg@exept.de>
parents: 114
diff changeset
   265
        b := (rgbColor blue / 100.0 * 65535) rounded.
49
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   266
204
277d2523d8cb commentary
Claus Gittinger <cg@exept.de>
parents: 114
diff changeset
   267
        aStream nextWordPut:r.
277d2523d8cb commentary
Claus Gittinger <cg@exept.de>
parents: 114
diff changeset
   268
        aStream nextWordPut:g.
277d2523d8cb commentary
Claus Gittinger <cg@exept.de>
parents: 114
diff changeset
   269
        aStream nextWordPut:b.
277d2523d8cb commentary
Claus Gittinger <cg@exept.de>
parents: 114
diff changeset
   270
        aStream nextPut: 7.                     "flags"
277d2523d8cb commentary
Claus Gittinger <cg@exept.de>
parents: 114
diff changeset
   271
        aStream nextPut: 0.                     "pad"
49
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   272
    ].
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   273
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   274
    "Write out the pixels as index color values"
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   275
"/    Cursor write showWhile: [ 
99
claus
parents: 96
diff changeset
   276
"/            |cindex|
83
claus
parents: 51
diff changeset
   277
"/
49
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   278
"/            1 to: (image height) do: [ :row |
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   279
"/                    1 to: (image width) do: [ :col |
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   280
"/                            cindex := image atPoint: (col-1)@(row-1).
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   281
"/                            aStream nextPut: cindex.]]
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   282
"/    ].
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   283
    aStream nextPutAll:image bits.
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   284
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   285
    "
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   286
     XWDReader save:(Image fromUser) onFile: '/tmp/st.xwd' 
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   287
     (Image fromFile: '/tmp/st.xwd') inspect 
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   288
    "
461
bacef118f54a more signals to be raised if anything happens during
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
   289
bacef118f54a more signals to be raised if anything happens during
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
   290
    "Modified: 27.2.1997 / 12:45:15 / cg"
49
f7938135fb9a *** empty log message ***
claus
parents: 46
diff changeset
   291
! !
204
277d2523d8cb commentary
Claus Gittinger <cg@exept.de>
parents: 114
diff changeset
   292
391
Claus Gittinger <cg@exept.de>
parents: 390
diff changeset
   293
!XWDReader class methodsFor:'documentation'!
204
277d2523d8cb commentary
Claus Gittinger <cg@exept.de>
parents: 114
diff changeset
   294
277d2523d8cb commentary
Claus Gittinger <cg@exept.de>
parents: 114
diff changeset
   295
version
1846
d29322944b05 dimensionReport
Claus Gittinger <cg@exept.de>
parents: 1814
diff changeset
   296
    ^ '$Header: /cvs/stx/stx/libview2/XWDReader.st,v 1.27 2003-11-19 15:24:16 cg Exp $'
204
277d2523d8cb commentary
Claus Gittinger <cg@exept.de>
parents: 114
diff changeset
   297
! !
1736
a8f1fcc3e6bc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 647
diff changeset
   298
398
aef700d15416 new suffix-table
Claus Gittinger <cg@exept.de>
parents: 391
diff changeset
   299
XWDReader initialize!